]> code.delx.au - gnu-emacs-elpa/blob - packages/wcheck-mode/wcheck-mode.el
* wcheck-mode.el: Fix minor compiler warnings.
[gnu-emacs-elpa] / packages / wcheck-mode / wcheck-mode.el
1 ;;; wcheck-mode.el --- General interface for text checkers
2
3 ;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
4
5 ;; Author: Teemu Likonen <tlikonen@iki.fi>
6 ;; Maintainer: Teemu Likonen <tlikonen@iki.fi>
7 ;; Created: 2009-07-04
8 ;; URL: https://github.com/tlikonen/wcheck-mode
9 ;; Keywords: text spell check languages ispell
10 ;; Version: 2014.6.21
11
12 ;; This program is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or (at
15 ;; your option) any later version.
16 ;;
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
21 ;;
22 ;; The license text: <http://www.gnu.org/licenses/gpl-3.0.html>
23
24
25 ;; INSTALLATION
26 ;;
27 ;; Put this file to some directory in your Emacs's "load-path" and add
28 ;; the following lines to Emacs's initialization file (~/.emacs):
29 ;;
30 ;; (autoload 'wcheck-mode "wcheck-mode"
31 ;; "Toggle wcheck-mode." t)
32 ;; (autoload 'wcheck-change-language "wcheck-mode"
33 ;; "Switch wcheck-mode languages." t)
34 ;; (autoload 'wcheck-actions "wcheck-mode"
35 ;; "Open actions menu." t)
36 ;; (autoload 'wcheck-jump-forward "wcheck-mode"
37 ;; "Move point forward to next marked text area." t)
38 ;; (autoload 'wcheck-jump-backward "wcheck-mode"
39 ;; "Move point backward to previous marked text area." t)
40 ;;
41 ;; See customize group "wcheck" for information on how to configure
42 ;; Wcheck mode. (M-x customize-group RET wcheck RET)
43
44
45 ;;; Commentary:
46 ;;
47 ;; A general interface for text checkers
48 ;;
49 ;; Wcheck mode is a general-purpose text-checker interface for Emacs
50 ;; text editor. Wcheck mode a minor mode which provides an on-the-fly
51 ;; text checker. It checks the visible text area, as you type, and
52 ;; possibly highlights some parts of it. What is checked and how are all
53 ;; configurable.
54 ;;
55 ;; Wcheck mode can use external programs or Emacs Lisp functions for
56 ;; checking text. For example, Wcheck mode can be used with
57 ;; spell-checker programs such as Ispell, Enchant and Hunspell, but
58 ;; actually any tool that can receive text from standard input stream
59 ;; and send text to standard output can be used. Wcheck mode sends parts
60 ;; of buffer's content to an external program or an Emacs Lisp function
61 ;; and, based on their output, decides if some parts of text should be
62 ;; marked in the buffer.
63
64 ;;; Code:
65
66
67 (eval-when-compile
68 ;; Silence compiler
69 (declare-function show-entry "outline"))
70
71
72 ;;; Settings
73
74
75 ;;;###autoload
76 (defgroup wcheck nil
77 "General interface for text checkers."
78 :group 'applications)
79
80
81 (defconst wcheck--language-data-customize-interface
82 '(choice
83 :format "%[Option%] %v"
84
85 (cons :tag "Program" :format "%v"
86 (const :tag "Program" :format "%t: " program)
87 (choice :format "%[Type%] %v"
88 (file :tag "Filename" :format "\n\t\t%t: %v")
89 (function :tag "Function" :format "\n\t\t%t: %v")))
90
91 (cons :tag "Arguments" :format "%v"
92 (const :format "" args)
93 (repeat :tag "Arguments"
94 (string :format "%v")))
95
96 (cons :tag "Output parser function" :format "%v"
97 (const :tag "Output parser" :format "%t: " parser)
98 (choice :format "%[Parser%] %v" :value nil
99 (const :tag "Lines" wcheck-parser-lines)
100 (const :tag "Whitespace" wcheck-parser-whitespace)
101 (function :tag "Custom function"
102 :format "%t:\n\t\t%v")))
103
104 (cons :tag "Connection type" :format "%v"
105 (const :tag "Connection: " :format "%t" connection)
106 (choice :format "%[Type%] %v" :value nil
107 (const :tag "pipe (nil)" nil)
108 (const :tag "pty" :match (lambda (widget value)
109 (or (eq value t)
110 (eq value 'pty)))
111 pty)))
112
113 (cons :tag "Face" :format "%v"
114 (const :tag "Face" :format "%t: " face)
115 (symbol :format "%v"))
116
117 (cons :tag "Syntax table" :format "%v"
118 (const :tag "Syntax table" :format "%t: " syntax)
119 (variable :format "%v"))
120
121 (cons :tag "Regexp start" :format "%v"
122 (const :tag "Regexp start" :format "%t: " regexp-start)
123 (regexp :format "%v"))
124
125 (cons :tag "Regexp body" :format "%v"
126 (const :tag "Regexp body" :format "%t: " regexp-body)
127 (regexp :format "%v"))
128
129 (cons :tag "Regexp end" :format "%v"
130 (const :tag "Regexp end" :format "%t: " regexp-end)
131 (regexp :format "%v"))
132
133 (cons :tag "Regexp discard" :format "%v"
134 (const :tag "Regexp discard" :format "%t: " regexp-discard)
135 (regexp :format "%v"))
136
137 (cons :tag "Regexp case" :format "%v"
138 (const :tag "Regexp" :format "%t: " case-fold)
139 (choice :format "%[Case%] %v" :value nil
140 :match (lambda (widget value) t)
141 :value-to-internal (lambda (widget value)
142 (if value t nil))
143 (const :tag "sensitive" nil)
144 (const :tag "insensitive" t)))
145
146 (cons
147 :tag "Read or skip faces" :format "%v"
148 (const :tag "Read or skip faces" :format "%t" read-or-skip-faces)
149 (repeat
150 :tag ""
151 (cons :format "%v"
152
153 (choice :format "%[Major mode%] %v"
154 (const :tag "All major modes"
155 :match (lambda (widget value) (null value))
156 nil)
157 (repeat
158 :tag "Select major modes"
159 :match (lambda (widget value)
160 (or (symbolp value) (consp value)))
161 :value-to-internal (lambda (widget value)
162 (if (symbolp value)
163 (list value)
164 value))
165 :value-to-external (lambda (widget value)
166 (if (and (consp value)
167 (symbolp (car value))
168 (null (cdr value)))
169 (car value)
170 value))
171 (symbol :format "%v")))
172
173 (choice :format "%[Operation mode%] %v"
174 (const :tag "Read everything" nil)
175 (cons :tag "Read selected faces" :format "%v"
176 (const :tag "Read selected faces"
177 :format "%t" read)
178 (repeat :tag "" (sexp :format "%v")))
179 (cons :tag "Skip selected faces" :format "%v"
180 (const :tag "Skip selected faces"
181 :format "%t" skip)
182 (repeat :tag "" (sexp :format "%v")))))))
183
184 (cons :tag "Action program" :format "%v"
185 (const :tag "Action program" :format "%t: " action-program)
186 (choice :format "%[Type%] %v"
187 (file :tag "Filename" :format "\n\t\t%t: %v")
188 (function :tag "Function" :format "\n\t\t%t: %v")))
189
190 (cons :tag "Action program's arguments" :format "%v"
191 (const :format "" action-args)
192 (repeat :tag "Action program's arguments"
193 (string :format "%v")))
194
195 (cons :tag "Action parser function" :format "%v"
196 (const :tag "Action parser" :format "%t: "
197 action-parser)
198 (choice :format "%[Parser%] %v" :value nil
199 (const :tag "Ispell" wcheck-parser-ispell-suggestions)
200 (const :tag "Lines" wcheck-parser-lines)
201 (const :tag "Whitespace" wcheck-parser-whitespace)
202 (function :tag "Custom function"
203 :format "%t:\n\t\t%v")))
204
205 (cons :tag "Action autoselect mode" :format "%v"
206 (const :tag "Action autoselect" :format "%t: " action-autoselect)
207 (choice :format "%[Mode%] %v" :value nil
208 :match (lambda (widget value) t)
209 :value-to-internal (lambda (widget value)
210 (if value t nil))
211 (const :tag "off" nil)
212 (const :tag "on" t)))))
213
214
215 ;;;###autoload
216 (defcustom wcheck-language-data nil
217 "Language configuration for `wcheck-mode'.
218
219 The variable is an association list (alist) and its elements are
220 of the form:
221
222 (LANGUAGE (KEY . VALUE) [(KEY . VALUE) ...])
223
224 LANGUAGE is a name string for this particular configuration unit
225 and KEY and VALUE pairs denote settings for the language.
226
227 Below is the documentation of possible KEYs and corresponding
228 VALUEs. The documentation is divided in two parts: checker
229 options and action options. The first part describes all options
230 related to checking the content of an Emacs buffer (and possibly
231 marking some of it). The second part describes options which
232 configure actions which user can choose for a marked text on
233 buffer.
234
235 NOTE: There is also variable `wcheck-language-data-defaults'
236 which is used to define default values. The defaults are used
237 when a language-specific option in `wcheck-language-data' does
238 not exist or is not valid.
239
240
241 Checker options
242 ---------------
243
244 The checker options configure LANGUAGE's text-checking and
245 text-marking features. With these you can configure how buffer's
246 content is examined, what checker engine is used and how text is
247 marked in the buffer.
248
249 program
250 args
251 `program' is either the name (a string) of an external
252 executable program or an Emacs Lisp function (a symbol or a
253 lambda expression). They are used as the checker engine for
254 the LANGUAGE. When `program' names an external executable
255 program then `args' are the command-line arguments (a list of
256 strings) for the program.
257
258 `wcheck-mode' collects text strings from the buffer and sends
259 them to `program' to analyze. When `program' is an external
260 executable program the collected strings are sent (each on a
261 separate line) through the standard input stream to the
262 program. The program must write to standard output stream all
263 the strings which it thinks should be marked in the Emacs
264 buffer. The output of the program is then parsed with
265 `parser' function (see below).
266
267 When `program' is an Emacs Lisp function (a symbol or a
268 lambda expression) the function is called with one argument:
269 a list of strings collected from the buffer. The function is
270 supposed to check them and return a list of strings (or nil).
271 The returned strings will be marked in the buffer.
272
273 See options `regexp-start', `regexp-body' and `regexp-end'
274 below for details on how text is collected from the buffer.
275
276 parser
277 VALUE of this option is an Emacs Lisp function which is
278 responsible for parsing the output of `program'. This parser
279 function is only used when `program' is an external
280 executable program (not a function).
281
282 The parser function is run without arguments and within the
283 context of a buffer that contains all the output from the
284 external program. The point is located at the beginning of
285 the buffer. From that buffer the `parser' function should
286 collect all the strings that are meant to be marked in the
287 buffer that is being checked. The function must return them
288 as a list of strings or nil if there are none to be marked.
289
290 For the most common cases there are two parser functions
291 already implemented:
292
293 `wcheck-parser-lines' turns each line in program's output
294 to a separate string. You should use this function as the
295 output parser if you spell-check with Ispell-like program
296 with its \"-l\" command-line option. They output each
297 misspelled word on a separate line. This is the default
298 output parser.
299
300 `wcheck-parser-whitespace' turns each whitespace-
301 separated token in the output to a separate string.
302
303 connection
304 The VALUE is used to set variable `process-connection-type'
305 when starting the process for LANGUAGE. If the VALUE is nil
306 use a pipe for communication; if it's `pty' (or t) use a PTY.
307 The default is to use a pipe (nil). (This option is ignored
308 when the program is a function.)
309
310 face
311 A symbol referring to the face which is used to mark text with
312 this LANGUAGE. The default is `wcheck-default-face'.
313
314 syntax
315 VALUE is a variable (a symbol) referring to an Emacs syntax
316 table. This option temporarily sets the effective syntax
317 table when buffer's content is scanned with `regexp-start',
318 `regexp-body', `regexp-end' and `regexp-discard' (see below)
319 as well as when `program', `parser', `action-program' and
320 `action-parser' functions are called. The default value is
321 `text-mode-syntax-table'. This option does not affect syntax
322 table settings anywhere else. See the Info node
323 `(elisp)Syntax Tables' for more information on the topic.
324
325 regexp-start
326 regexp-body
327 regexp-end
328 Regular expression strings which match the start of a string
329 body, characters within the body and the end of the body,
330 respectively.
331
332 This is how they are used in practice: `wcheck-mode' scans
333 buffer's content and looks for strings that match the
334 following regular expression
335
336 REGEXP-START\\(REGEXP-BODY\\)REGEXP-END
337
338 The regular expression back reference \\1 is used to extract
339 `regexp-body' part from the matched string. That string is
340 then matched against `regexp-discard' (see below) and if it
341 doesn't match the string is sent to the text checker program
342 or function to analyze.
343
344 Strings returned from the program or function are quoted for
345 regular expression special characters (with `regexp-quote'
346 function) and marked in Emacs buffer using the following
347 construction: `regexp-start + STRING + regexp-end'. The
348 STRING part is marked with `face' (see above).
349
350 You can't use grouping constructs `\\( ... \\)' in
351 `regexp-start' because the back reference `\\1' is used for
352 separating the `regexp-body' match string from the
353 `regexp-start' and `regexp-end' match strings. You can use
354 \"shy\" groups `\\(?: ... \\)' which do not record the
355 matched substring. Grouping constructs `\\( ... \\)' are
356 allowed in `regexp-body' and `regexp-end'. Just note that the
357 first group and back reference \\1 is already taken.
358
359 The default values for the regular expressions are
360
361 \\=\\<'* (regexp-start)
362 \\w+? (regexp-body)
363 '*\\=\\> (regexp-end)
364
365 Effectively they match a series of word characters defined in
366 the effective syntax table. Single quotes (') at the start
367 and end of a word are excluded. This is probably a good thing
368 when using `wcheck-mode' as a spelling checker.
369
370 regexp-discard
371 The string that matched `regexp-body' is then matched against
372 the value of this option. If this regular expression matches,
373 then the string is discarded and won't be sent to the
374 text-checker program or function to analyze. You can use this
375 to define exceptions to the `regexp-body' match. The default
376 value is
377
378 \\`'+\\'
379
380 which discards the body string if it consists only of single
381 quotes. This was chosen as the default because the default
382 syntax table `text-mode-syntax-table' defines single quote as
383 a word character. It's probably not useful to mark individual
384 single quotes in a buffer when `wcheck-mode' is used as a
385 spelling checker.
386
387 If you don't want to have any discarding rules set this
388 option to empty string (\"\").
389
390 case-fold
391 This boolean value is used to temporarily bind the value of
392 variable `case-fold-search'. The nil value means
393 case-sensitive and a non-nil means case-insensitive search.
394 The default is case-sensitive (nil). This option is effective
395 with `regexp-start', `regexp-body', `regexp-end' and
396 `regexp-discard' as well as when `program', `parser',
397 `action-program' and `action-parser' functions are called.
398
399 read-or-skip-faces
400 This option controls which faces `wcheck-mode' should read or
401 skip when scanning buffer's content. The value must be a list
402 and its items are also lists:
403
404 (MAJOR-MODE [OPERATION-MODE [FACE ...]])
405
406 MAJOR-MODE is a symbol or a list of symbols. Symbols refer to
407 the major mode(s) which the settings are for. Use nil as the
408 MAJOR-MODE to define default settings. Settings that come
409 after the pseudo major-mode nil are ignored.
410
411 OPERATION-MODE is symbol `read' or `skip' defining whether
412 the FACEs should be read or skipped. If it's `read' then only
413 the listed faces are read. If it's `skip' then the listed
414 faces are skipped and all other faces are read. If there is
415 no OPERATION-MODE at all (i.e., the list has just one
416 element, MAJOR-MODE) then everything is read.
417
418 The rest of the items are FACEs. They are typically symbols
419 but some Emacs modes may use strings, property lists or cons
420 cells for defining faces. For more information see Info
421 node `(elisp) Special Properties'. Use nil as the face to
422 refer to the normal text which does not have a face text
423 property.
424
425 Example:
426
427 (read-or-skip-faces
428 ((emacs-lisp-mode c-mode) read
429 font-lock-comment-face font-lock-doc-face)
430 (org-mode skip font-lock-comment-face org-link)
431 (text-mode)
432 (nil read nil))
433
434 It says that in `emacs-lisp-mode' and `c-mode' only the text
435 which have been highlighted with `font-lock-comment-face' or
436 `font-lock-doc-face' is read (i.e., checked). In `org-mode'
437 faces `font-lock-comment-face' and `org-link' are
438 skipped (i.e., not checked) and all other faces are read. In
439 `text-mode' everything is read. Finally, in all other major
440 modes only the normal text (nil) is read.
441
442 Most likely not all `read-or-skip-faces' settings are
443 specific to a certain language so it could be more useful to
444 put them in variable `wcheck-language-data-defaults' instead.
445 That way they are used with all languages. Normally the
446 global default is equivalent to
447
448 (read-or-skip-faces
449 (nil))
450
451 which means that in all major modes read everything. It is
452 sometimes useful to have this setting in language-specific
453 options because the parsing stops right there. Therefore it
454 overrides all global settings which user may have changed
455 with variable `wcheck-language-data-defaults'.
456
457 Note: You can use command `\\[what-cursor-position]' with a
458 prefix argument to see what faces are active at the cursor
459 position. Then you can use the information to configure this
460 option.
461
462
463 Action options
464 --------------
465
466 \"Actions\" are any kind of operations that can be executed for
467 marked text in an Emacs buffer. Actions are presented to user
468 through a menu which is activated either by (1) clicking the
469 right mouse button on a marked text or (2) executing interactive
470 command `wcheck-actions' while the cursor (the point) is on a
471 marked text.
472
473 If you use `wcheck-mode' as a spelling checker then it's natural
474 to configure an action menu that offers spelling suggestions for
475 the misspelled word. The action menu could also have an option to
476 add the word to spell-checker's dictionary, so that the word is
477 recognized next time.
478
479 action-program
480 action-args
481 `action-program' is either the name (a string) of an external
482 executable program or an Emacs Lisp function (a symbol or a
483 lambda expression). When it's the name of an executable
484 program then `action-args' are the command-line arguments (a
485 list of strings) for the program.
486
487 When `action-program' is an external executable program the
488 marked text is sent to the program through the standard input
489 stream. The program should send its feedback data (usually
490 suggested substitute strings) to the standard output stream.
491 The output is parsed with `action-parser' function (see
492 below) and function's return value is used to construct an
493 action menu for user. The format and effect of
494 `action-parser' function's return value is described below.
495
496 When `action-program' is an Emacs Lisp function the function
497 is called with one argument: a vector returned by
498 `wcheck-marked-text-at' function. The `action-program'
499 function is supposed to gather some substitute suggestion
500 strings or give other actions for the marked text in the
501 buffer. Function's return value is used to construct an
502 action menu for user. The format and effect of
503 `action-program' function's return value is described below.
504
505 action-parser
506 VALUE of this option is an Emacs Lisp function which is
507 responsible for parsing the output of `action-program'. This
508 parser function is only used when `action-program' is an
509 external executable program (not a function).
510
511 The parser function is run with one argument: a vector
512 returned by `wcheck-marked-text-at' for the marked text in
513 question. The parser function is called within the context of
514 a buffer that contains all the output from `action-program'.
515 The point is located at the beginning of the buffer.
516
517 The `action-parser' function should examine the buffer for
518 interesting information (such as spelling suggestions) and
519 return them in the format that is described below.
520
521 For the most common cases there are three parser functions
522 already implemented:
523
524 `wcheck-parser-ispell-suggestions' parses substitute
525 suggestions from the output of Ispell or compatible
526 program, such as Enchant. Use this function as the
527 `action-parser' if you get spelling suggestions from an
528 Ispell-like program with its \"-a\" command-line option.
529
530 `wcheck-parser-lines' function turns each line in the
531 output to individual substitute suggestions.
532
533 `wcheck-parser-whitespace'. Each whitespace-separated
534 token in the program's output is a separate suggestion.
535
536 action-autoselect
537 If this option is non-nil and the action menu has only one
538 menu item then the item is chosen automatically without
539 actually showing the menu. If this option is nil (which is
540 the default) then the menu is always shown.
541
542
543 The return value of `action-program' function and `action-parser'
544 function must be a list. The empty list (nil) means that there
545 are no actions available for the marked text. Otherwise each
546 elements in the list must be either a string or a cons cell. If
547 an element is a string it is an individual substitute suggestion
548 string for the original marked text. The same string is shown in
549 the actions menu. When user chooses such option from the action
550 menu the original text is substituted in the Emacs buffer.
551
552 If an element is a cons cell it must be one of
553
554 (\"Menu item\" . \"substitute string\")
555 (\"Menu item\" . some-function)
556
557 The \"car\" value of the cons cell must be a string. The string
558 is shown in the action menu as one of the options. The \"cdr\"
559 value of the cons cell defines the action that is taken for the
560 menu option. If the \"cdr\" value is a string then that string is
561 the substitute string. If the \"cdr\" value is a function (a
562 symbol or a lambda expression) then that function is called when
563 user chooses the menu option. The function is called with one
564 argument: a vector returned by `wcheck-marked-text-at' function
565 for the marked text in question.
566
567 Effectively `action-program' function or `action-program'
568 executable program with `action-parser' function provide a
569 feature that can offer spelling suggestions for user: just return
570 suggestions as a list of strings. Alternatively they can offer
571 any kind of useful actions by calling custom functions. There are
572 a lot of possibilities.
573
574
575 For configuration examples, see the README file in URL
576 `https://github.com/tlikonen/wcheck-mode'."
577
578 :group 'wcheck
579 :type
580 `(repeat
581 (list :format "%v"
582 (string :tag "Language")
583 (repeat :inline t
584 :tag "Options"
585 ,wcheck--language-data-customize-interface))))
586
587
588 ;;;###autoload
589 (defconst wcheck--language-data-defaults-hard-coded
590 '((parser . wcheck-parser-lines)
591 (connection . nil)
592 (face . wcheck-default-face)
593 (syntax . text-mode-syntax-table)
594 (regexp-start . "\\<'*")
595 (regexp-body . "\\w+?")
596 (regexp-end . "'*\\>")
597 (regexp-discard . "\\`'+\\'")
598 (case-fold . nil)
599 (read-or-skip-faces (nil))
600 (action-autoselect . nil))
601 "Hard-coded default language configuration for `wcheck-mode'.
602 This constant is for Wcheck mode's internal use only. This
603 provides useful defaults if both `wcheck-language-data' and
604 `wcheck-language-data-defaults' fail.")
605
606
607 ;;;###autoload
608 (defcustom wcheck-language-data-defaults
609 wcheck--language-data-defaults-hard-coded
610 "Default language configuration for `wcheck-mode'.
611 These default values are used when language-specific settings
612 don't provide a valid value. `wcheck-mode' will choose some
613 useful defaults even if this variable is not (properly) set. See
614 variable `wcheck-language-data' for information about possible
615 settings.
616
617 Here's an example value for the variable:
618
619 ((parser . wcheck-parser-lines)
620 (action-parser . wcheck-parser-ispell-suggestions)
621 (connection . nil)
622 (face . wcheck-default-face)
623 (syntax . text-mode-syntax-table)
624 (regexp-start . \"\\\\=\\<'*\")
625 (regexp-body . \"\\\\w+?\")
626 (regexp-end . \"'*\\\\=\\>\")
627 (regexp-discard . \"\\\\`'+\\\\'\")
628 (case-fold . nil)
629 (read-or-skip-faces
630 ((emacs-lisp-mode c-mode) read
631 font-lock-comment-face font-lock-doc-face)
632 (message-mode read nil
633 message-header-subject message-cited-text)))"
634
635 :group 'wcheck
636 :type `(repeat ,wcheck--language-data-customize-interface))
637
638
639 ;;;###autoload
640 (defcustom wcheck-language ""
641 "Default language for `wcheck-mode'.
642
643 Normally the global value defines the language for new buffers.
644 If a buffer-local value exists it is used instead. This variable
645 becomes automatically buffer-local when `wcheck-mode' is turned
646 on in a buffer, so changing the global value does not affect
647 buffers which already have `wcheck-mode' turned on.
648
649 User is free to set this variable directly (e.g., in programs)
650 but in interactive use it is usually better to use the command
651 `\\[wcheck-change-language]' instead. The command can change
652 language immediately while `wcheck-mode' is turned on, whereas
653 changing just the value of this variable takes effect only when
654 `wcheck-mode' is turned on next time."
655 :type '(string :tag "Default language")
656 :group 'wcheck)
657 (make-variable-buffer-local 'wcheck-language)
658
659
660 ;;;###autoload
661 (defface wcheck-default-face
662 '((t (:underline "red")))
663 "Default face for marking strings in a buffer.
664 This is used when language does not define a face."
665 :group 'wcheck)
666
667
668 ;;; Variables
669
670
671 (defvar wcheck-mode nil)
672 (defvar wcheck-mode-map (make-sparse-keymap)
673 "Keymap for `wcheck-mode'.")
674
675 (defvar wcheck--timer nil)
676 (defvar wcheck--timer-idle .3
677 "`wcheck-mode' idle timer delay (in seconds).")
678 (defvar wcheck--timer-paint-event-count 0)
679
680 (defvar wcheck--timer-paint-event-count-std 3
681 "Run buffer paint event this many times in a row.
682 With too low values all data from external processes may not have
683 arrived and window gets only partially painted. A higher value
684 increases the probability that windows get fully painted but it
685 also makes `wcheck-jump-forward' and `wcheck-jump-backward'
686 slower. A suitable compromise may be 3 or 4.")
687
688 (defvar wcheck--change-language-history nil
689 "Language history for command `wcheck-change-language'.")
690
691 (defvar wcheck--buffer-data nil)
692
693 (defvar wcheck--jump-step 5000)
694
695
696 ;;; Macros
697
698
699 (defmacro wcheck--define-condition (name superclass &optional message)
700 (declare (indent defun))
701 `(progn
702 (put ',name 'error-conditions
703 (append (get ',superclass 'error-conditions) (list ',name)))
704 (put ',name 'error-message ,message)
705 ',name))
706
707
708 (defmacro wcheck--loop-over-reqs-engine (key var &rest body)
709 `(dolist (,var (delq nil (mapcar (lambda (buffer)
710 (when (wcheck--buffer-data-get
711 :buffer buffer ,key)
712 buffer))
713 (wcheck--buffer-data-get-all :buffer))))
714 (when (buffer-live-p ,var)
715 (with-current-buffer ,var
716 ,@body))))
717
718
719 (defmacro wcheck--loop-over-read-reqs (var &rest body)
720 (declare (indent 1))
721 `(wcheck--loop-over-reqs-engine :read-req ,var ,@body))
722 (defmacro wcheck--loop-over-paint-reqs (var &rest body)
723 (declare (indent 1))
724 `(wcheck--loop-over-reqs-engine :paint-req ,var ,@body))
725 (defmacro wcheck--loop-over-jump-reqs (var &rest body)
726 (declare (indent 1))
727 `(wcheck--loop-over-reqs-engine :jump-req ,var ,@body))
728
729
730 (defmacro wcheck--with-language-data (var-lang bindings &rest body)
731 (declare (indent 2))
732 (let ((language (make-symbol "--wck-language--")))
733 `(let* ((,language ,(cadr var-lang))
734 ,@(when (car var-lang)
735 `((,(car var-lang) ,language)))
736 ,@(mapcar
737 (lambda (var)
738 (cond ((symbolp var)
739 (list var `(wcheck-query-language-data
740 ,language ',var)))
741 ((and var (listp var))
742 (list (car var) `(wcheck-query-language-data
743 ,language ',(cadr var))))))
744 bindings))
745 ,@body)))
746
747
748 ;;; Conditions
749
750
751 (wcheck--define-condition wcheck--error error)
752 (wcheck--define-condition wcheck--language-does-not-exist-error wcheck--error)
753 (wcheck--define-condition wcheck--program-not-configured-error wcheck--error)
754 (wcheck--define-condition wcheck--not-a-list-of-strings-error wcheck--error)
755 (wcheck--define-condition wcheck--funcall-error wcheck--error)
756 (wcheck--define-condition wcheck--action-error wcheck--error)
757 (wcheck--define-condition wcheck--action-program-error wcheck--action-error)
758 (wcheck--define-condition wcheck--parser-function-not-configured-error
759 wcheck--action-error)
760 (wcheck--define-condition wcheck--overlay-not-found-error wcheck--error)
761
762
763 ;;; Interactive commands
764
765
766 ;;;###autoload
767 (defun wcheck-change-language (language &optional global)
768 "Change language for current buffer (or globally).
769 Change `wcheck-mode' language to LANGUAGE. The change is
770 buffer-local but if GLOBAL is non-nil (prefix argument if called
771 interactively) then change the global default language."
772 (interactive
773 (let* ((comp (mapcar #'car wcheck-language-data))
774 (default (cond ((and current-prefix-arg
775 (member (default-value 'wcheck-language) comp))
776 (default-value 'wcheck-language))
777 ((member wcheck-language comp)
778 wcheck-language)
779 ((car comp))
780 (t ""))))
781 (list (completing-read
782 (format (if current-prefix-arg
783 "Global default language (%s): "
784 "Language for the current buffer (%s): ")
785 default)
786 comp nil t nil 'wcheck--change-language-history default)
787 current-prefix-arg)))
788
789 (condition-case error-data
790 (when (stringp language)
791 ;; Change the language, locally or globally, and update buffer
792 ;; database, if needed.
793 (if global
794 ;; Just change the global value and leave.
795 (setq-default wcheck-language language)
796
797 ;; Change the buffer-local value.
798 (setq wcheck-language language)
799 ;; If the mode is currently turned on check if language's
800 ;; checker program or function is configured and if all is OK
801 ;; request update for the buffer.
802 (when wcheck-mode
803 (if (wcheck--program-configured-p wcheck-language)
804 ;; It's OK; update the buffer.
805 (progn
806 (wcheck--buffer-lang-proc-data-update
807 (current-buffer) wcheck-language)
808 (wcheck--buffer-data-set (current-buffer) :read-req t)
809 (wcheck--remove-overlays))
810
811 (signal 'wcheck--program-not-configured-error wcheck-language))))
812
813 ;; Return the language.
814 language)
815
816 (wcheck--program-not-configured-error
817 (wcheck-mode -1)
818 (message "Language \"%s\": checker program is not configured"
819 (cdr error-data)))))
820
821
822 (defun wcheck--mode-turn-on ()
823 ;; Turn the mode on, but first some checks.
824 (let ((buffer (current-buffer))
825 (language wcheck-language))
826 (condition-case error-data
827 (cond
828 ((minibufferp buffer)
829 (signal 'wcheck--error "Can't use `wcheck-mode' in a minibuffer"))
830
831 ((not (wcheck--language-exists-p language))
832 (signal 'wcheck--language-does-not-exist-error language))
833
834 ((not (wcheck--program-configured-p language))
835 (signal 'wcheck--program-not-configured-error language))
836
837 (t
838 (make-local-variable 'wcheck-language)
839 (wcheck--add-local-hooks buffer)
840 (wcheck--add-global-hooks)
841 (wcheck--buffer-lang-proc-data-update buffer language)
842 (wcheck--timer-start)
843 (wcheck--buffer-data-set buffer :read-req t)))
844
845 (wcheck--program-not-configured-error
846 (wcheck-mode -1)
847 (message "Language \"%s\": checker program not configured"
848 (cdr error-data)))
849
850 (wcheck--language-does-not-exist-error
851 (wcheck-mode -1)
852 (message "Language \"%s\" does not exist" (cdr error-data))))))
853
854
855 (defun wcheck--mode-turn-off ()
856 (let ((buffer (current-buffer)))
857 ;; We clear overlays form the buffer, remove the buffer from buffer
858 ;; database.
859 (wcheck--remove-overlays)
860 (wcheck--buffer-lang-proc-data-update buffer nil)
861
862 ;; If there are no buffers using wcheck-mode anymore, stop the idle
863 ;; timer and remove global hooks.
864 (when (null (wcheck--buffer-data-get-all :buffer))
865 (wcheck--timer-stop)
866 (wcheck--remove-global-hooks))
867 (wcheck--remove-local-hooks buffer)))
868
869
870 (defun wcheck--mode-line-lang ()
871 (condition-case nil
872 (let (lang-code)
873 (catch 'enough
874 (mapc (lambda (c)
875 (when (char-equal ?w (char-syntax c))
876 (push c lang-code)
877 (when (>= (length lang-code) 2)
878 (throw 'enough t))))
879 (wcheck--buffer-data-get :buffer (current-buffer) :language)))
880 (apply #'string (nreverse lang-code)))
881 (error "")))
882
883
884 ;;;###autoload
885 (define-minor-mode wcheck-mode
886 "General interface for text checkers.
887
888 With optional (prefix) ARG turn on the mode if ARG is positive,
889 otherwise turn it off. If ARG is not given toggle the mode.
890
891 Wcheck is a minor mode for automatically checking and marking
892 strings in Emacs buffer. Wcheck sends (parts of) buffer's content
893 to a text-checker back-end and, based on its output, decides if
894 some parts of text should be marked.
895
896 Wcheck can be used with external spell-checker programs such as
897 Ispell and Enchant, but actually any tool that can receive text
898 stream from standard input and send text to standard output can
899 be used. The checker back-end can also be an Emacs Lisp function.
900
901 Different configuration units are called \"languages\". See the
902 documentation of variables `wcheck-language-data',
903 `wcheck-language-data-defaults' and `wcheck-language' for
904 information on how to configure Wcheck mode. You can access and
905 configure the variables through customize group `wcheck'.
906
907 Interactive command `wcheck-change-language' is used to switch
908 languages. Command `wcheck-actions' gives an action menu for the
909 marked text at point (also accessible through the right-click
910 mouse menu). Commands `wcheck-jump-forward' and
911 `wcheck-jump-backward' move point to next/previous marked text
912 area.
913
914 A note for Emacs Lisp programmers: Emacs Lisp function
915 `wcheck-marked-text-at' returns information about marked text at
916 a buffer position. Function `wcheck-query-language-data' can be
917 used for querying effective configuration data for any language."
918
919 :init-value nil
920 :lighter (" W:" (:eval (wcheck--mode-line-lang)))
921 :keymap wcheck-mode-map
922
923 (condition-case error-data
924 (if wcheck-mode
925 (wcheck--mode-turn-on)
926 (wcheck--mode-turn-off))
927
928 (wcheck--error
929 (wcheck-mode -1)
930 (message "%s" (cdr error-data)))))
931
932
933 ;;; Timers
934
935
936 (defun wcheck--timer-start ()
937 "Start `wcheck-mode' idle timer if it's not running already."
938 (unless wcheck--timer
939 (setq wcheck--timer
940 (run-with-idle-timer wcheck--timer-idle t
941 #'wcheck--timer-read-event))))
942
943
944 (defun wcheck--timer-stop ()
945 "Stop `wcheck-mode' idle timer."
946 (when wcheck--timer
947 (cancel-timer wcheck--timer)
948 (setq wcheck--timer nil)))
949
950
951 (defun wcheck--funcall-after-idle (function &rest args)
952 (apply #'run-with-idle-timer
953 (+ wcheck--timer-idle (wcheck--current-idle-time-seconds))
954 nil function args))
955
956
957 (defun wcheck--timer-paint-event-run (&optional count)
958 (if (integerp count)
959 (let ((at-least (max count wcheck--timer-paint-event-count)))
960 (if (> wcheck--timer-paint-event-count 0)
961 (setq wcheck--timer-paint-event-count at-least)
962 (setq wcheck--timer-paint-event-count at-least)
963 (wcheck--funcall-after-idle #'wcheck--timer-paint-event)))
964 (if (> (setq wcheck--timer-paint-event-count
965 (1- wcheck--timer-paint-event-count))
966 0)
967 (wcheck--funcall-after-idle #'wcheck--timer-paint-event)
968 (wcheck--timer-jump-event))))
969
970
971 (defun wcheck--force-read (buffer)
972 (redisplay t)
973 (wcheck--buffer-data-set buffer :read-req t)
974 (wcheck--timer-read-event))
975
976
977 (defun wcheck--timer-read-event ()
978 "Send windows' content to checker program or function.
979
980 This function is usually called by the `wcheck-mode' idle timer.
981 The function walks through all windows which belong to buffers
982 that have requested update. It reads windows' content and sends
983 it checker program or function associated with the buffer's
984 language. Finally, this function starts another idle timer for
985 marking strings in buffers."
986
987 (wcheck--loop-over-read-reqs buffer
988 (unless (wcheck--buffer-data-get :buffer buffer :jump-req)
989 ;; We are about to fulfill buffer's window-reading request so
990 ;; remove the request. Reset also the list of received strings and
991 ;; visible window areas.
992 (wcheck--buffer-data-set buffer :read-req nil)
993 (wcheck--buffer-data-set buffer :strings nil)
994 (wcheck--buffer-data-set buffer :areas nil)
995
996 ;; Walk through all windows which belong to this buffer.
997 (let (area-alist strings)
998 (walk-windows (lambda (window)
999 (when (eq buffer (window-buffer window))
1000 ;; Store the visible buffer area.
1001 (push (cons (window-start window)
1002 (window-end window t))
1003 area-alist)))
1004 'nomb t)
1005
1006 ;; Combine overlapping buffer areas and read strings from all
1007 ;; areas.
1008 (let ((combined (wcheck--combine-overlapping-areas area-alist)))
1009 (wcheck--buffer-data-set buffer :areas combined)
1010 (dolist (area combined)
1011 (setq strings (append (wcheck--read-strings
1012 buffer (car area) (cdr area))
1013 strings))))
1014 ;; Send strings to checker engine.
1015 (wcheck--send-strings buffer strings))))
1016
1017 ;; Start a timer which will mark text in buffers/windows.
1018 (wcheck--timer-paint-event-run wcheck--timer-paint-event-count-std))
1019
1020
1021 (defun wcheck--send-strings (buffer strings)
1022 "Send STRINGS for the process that handles BUFFER.
1023 STRINGS is a list of strings to be sent as input for the external
1024 process which handles BUFFER. Each string in STRINGS is sent as
1025 separate line."
1026 (wcheck--with-language-data
1027 (nil (wcheck--buffer-data-get :buffer buffer :language))
1028 (program syntax (case-fold-search case-fold))
1029
1030 (condition-case nil
1031 (cond ((or (wcheck--buffer-data-get :buffer buffer :process)
1032 (stringp program))
1033 (process-send-string
1034 (wcheck--start-get-process buffer)
1035 (concat (mapconcat #'identity strings "\n") "\n"))
1036 (condition-case nil
1037 (with-current-buffer
1038 (process-buffer (wcheck--buffer-data-get
1039 :buffer buffer :process))
1040 (erase-buffer))
1041 (error nil)))
1042
1043 ((functionp program)
1044 (when (buffer-live-p buffer)
1045 (with-current-buffer buffer
1046 (let ((received
1047 (save-match-data
1048 (condition-case nil
1049 (with-syntax-table (eval syntax)
1050 (funcall program strings))
1051 (error (signal 'wcheck--funcall-error nil))))))
1052 (if (wcheck--list-of-strings-p received)
1053 (when received
1054 (wcheck--buffer-data-set buffer :strings received)
1055 (wcheck--buffer-data-set buffer :paint-req t))
1056 (signal 'wcheck--not-a-list-of-strings-error nil)))))))
1057
1058 (wcheck--not-a-list-of-strings-error
1059 (with-current-buffer buffer
1060 (wcheck-mode -1)
1061 (message (concat "Checker function did not return a list of "
1062 "strings (or nil)"))))
1063
1064 (wcheck--funcall-error
1065 (message "Checker function signaled an error")))))
1066
1067
1068 (defun wcheck--receive-strings (process string)
1069 "`wcheck-mode' process output handler function."
1070 (let ((buffer (wcheck--buffer-data-get :process process :buffer)))
1071 (wcheck--with-language-data
1072 (nil (wcheck--buffer-data-get :process process :language))
1073 (parser syntax (case-fold-search case-fold))
1074 (when (buffer-live-p buffer)
1075 (with-current-buffer buffer
1076
1077 ;; If process is running proceed to collect and paint the
1078 ;; strings.
1079 (condition-case error-data
1080 (if (wcheck--process-running-p process)
1081 (with-current-buffer (process-buffer process)
1082 (save-excursion
1083 (goto-char (point-max))
1084 (insert string)
1085 (let ((parsed-strings
1086 (save-match-data
1087 (save-excursion
1088 (goto-char (point-min))
1089 (condition-case nil
1090 (with-syntax-table (eval syntax)
1091 (funcall parser))
1092 (error (signal 'wcheck--funcall-error
1093 nil)))))))
1094 (when (and parsed-strings
1095 (wcheck--list-of-strings-p parsed-strings))
1096 (wcheck--buffer-data-set
1097 buffer :strings parsed-strings)
1098 (wcheck--buffer-data-set buffer :paint-req t)))))
1099
1100 ;; It's not running. Turn off the mode.
1101 (wcheck-mode -1)
1102 (signal 'wcheck--error
1103 (format "Process is not running for buffer \"%s\""
1104 (buffer-name buffer))))
1105
1106 (wcheck--funcall-error
1107 (message "Checker output parser function signaled an error"))
1108
1109 (wcheck--error
1110 (message "%s" (cdr error-data)))))))))
1111
1112
1113 (defun wcheck--timer-paint-event ()
1114 "Mark strings in windows.
1115
1116 This is normally called by the `wcheck-mode' idle timer. This
1117 function marks (with overlays) strings in the buffers that have
1118 requested it."
1119
1120 (wcheck--loop-over-paint-reqs buffer
1121 (unless (wcheck--buffer-data-get :buffer buffer :jump-req)
1122 (wcheck--remove-overlays))
1123 ;; We are about to mark text in this buffer so remove this buffer's
1124 ;; request.
1125 (wcheck--buffer-data-set buffer :paint-req nil)
1126 ;; Walk through the visible text areas and mark text based on the
1127 ;; string list returned by an external process.
1128 (when wcheck-mode
1129 (dolist (area (wcheck--buffer-data-get :buffer buffer :areas))
1130 (wcheck--paint-strings buffer (car area) (cdr area)
1131 (wcheck--buffer-data-get :buffer buffer
1132 :strings)
1133 ;; If jump-req is active then paint
1134 ;; invisible text too.
1135 (wcheck--buffer-data-get :buffer buffer
1136 :jump-req)))))
1137
1138 (wcheck--timer-paint-event-run))
1139
1140
1141 (defun wcheck--timer-jump-event ()
1142 (wcheck--loop-over-jump-reqs buffer
1143 (let* ((jump-req (wcheck--buffer-data-get :buffer buffer :jump-req))
1144 (start (wcheck--jump-req-start jump-req))
1145 (bound (wcheck--jump-req-bound jump-req))
1146 (window (wcheck--jump-req-window jump-req)))
1147
1148 (wcheck--buffer-data-set buffer :jump-req nil)
1149
1150 (condition-case nil
1151 (cond ((> bound start)
1152 (let ((ol (wcheck--overlay-next start bound)))
1153 (cond (ol
1154 (if (and (window-live-p window)
1155 (eq buffer (window-buffer window)))
1156 (set-window-point window (overlay-end ol))
1157 (goto-char (overlay-end ol)))
1158 (when (invisible-p (point))
1159 (show-entry))
1160 (message "Found from line %s"
1161 (line-number-at-pos (point)))
1162 (wcheck--force-read buffer))
1163 ((< bound (point-max))
1164 (wcheck--jump-req buffer window (1+ bound)
1165 (+ (1+ bound) wcheck--jump-step)))
1166 (t
1167 (signal 'wcheck--overlay-not-found-error nil)))))
1168 ((< bound start)
1169 (let ((ol (wcheck--overlay-previous start bound)))
1170 (cond (ol
1171 (if (and (window-live-p window)
1172 (eq buffer (window-buffer window)))
1173 (set-window-point window (overlay-start ol))
1174 (goto-char (overlay-start ol)))
1175 (when (invisible-p (point))
1176 (show-entry))
1177 (message "Found from line %s"
1178 (line-number-at-pos (point)))
1179 (wcheck--force-read buffer))
1180 ((> bound (point-min))
1181 (wcheck--jump-req buffer window (1- bound)
1182 (- (1- bound) wcheck--jump-step)))
1183 (t
1184 (signal 'wcheck--overlay-not-found-error nil)))))
1185 (t
1186 (signal 'wcheck--overlay-not-found-error nil)))
1187
1188 (wcheck--overlay-not-found-error
1189 (message "Found nothing")
1190 (wcheck--force-read buffer))))))
1191
1192
1193 ;;; Hooks
1194
1195
1196 (defun wcheck--add-local-hooks (buffer)
1197 (with-current-buffer buffer
1198 (dolist (hook '((kill-buffer-hook . wcheck--hook-kill-buffer)
1199 (window-scroll-functions . wcheck--hook-window-scroll)
1200 (after-change-functions . wcheck--hook-after-change)
1201 (change-major-mode-hook . wcheck--hook-change-major-mode)
1202 (outline-view-change-hook
1203 . wcheck--hook-outline-view-change)))
1204 (add-hook (car hook) (cdr hook) nil t))))
1205
1206
1207 (defun wcheck--remove-local-hooks (buffer)
1208 (with-current-buffer buffer
1209 (dolist (hook '((kill-buffer-hook . wcheck--hook-kill-buffer)
1210 (window-scroll-functions . wcheck--hook-window-scroll)
1211 (after-change-functions . wcheck--hook-after-change)
1212 (change-major-mode-hook . wcheck--hook-change-major-mode)
1213 (outline-view-change-hook
1214 . wcheck--hook-outline-view-change)))
1215 (remove-hook (car hook) (cdr hook) t))))
1216
1217
1218 (defun wcheck--add-global-hooks ()
1219 (dolist (hook '((window-size-change-functions
1220 . wcheck--hook-window-size-change)
1221 (window-configuration-change-hook
1222 . wcheck--hook-window-configuration-change)))
1223 (add-hook (car hook) (cdr hook))))
1224
1225
1226 (defun wcheck--remove-global-hooks ()
1227 (dolist (hook '((window-size-change-functions
1228 . wcheck--hook-window-size-change)
1229 (window-configuration-change-hook
1230 . wcheck--hook-window-configuration-change)))
1231 (remove-hook (car hook) (cdr hook))))
1232
1233
1234 (defun wcheck--hook-window-scroll (window _window-start)
1235 "`wcheck-mode' hook for window scroll.
1236 Request update for the buffer when its window have been scrolled."
1237 (with-current-buffer (window-buffer window)
1238 (when wcheck-mode
1239 (wcheck--buffer-data-set (current-buffer) :read-req t))))
1240
1241
1242 (defun wcheck--hook-window-size-change (frame)
1243 "`wcheck-mode' hook for window size change.
1244 Request update for the buffer when its window's size has
1245 changed."
1246 (walk-windows (lambda (window)
1247 (with-current-buffer (window-buffer window)
1248 (when wcheck-mode
1249 (wcheck--buffer-data-set (current-buffer)
1250 :read-req t))))
1251 'nomb
1252 frame))
1253
1254
1255 (defun wcheck--hook-window-configuration-change ()
1256 "`wcheck-mode' hook for window configuration change.
1257 Request update for the buffer when its window's configuration has
1258 changed."
1259 (walk-windows (lambda (window)
1260 (with-current-buffer (window-buffer window)
1261 (when wcheck-mode
1262 (wcheck--buffer-data-set (current-buffer)
1263 :read-req t))))
1264 'nomb
1265 'currentframe))
1266
1267
1268 (defun wcheck--hook-after-change (_beg _end _len)
1269 "`wcheck-mode' hook for buffer content change.
1270 Request update for the buffer when its content has been edited."
1271 ;; The buffer that has changed is the current buffer when this hook
1272 ;; function is called.
1273 (when wcheck-mode
1274 (wcheck--buffer-data-set (current-buffer) :read-req t)))
1275
1276
1277 (defun wcheck--hook-outline-view-change ()
1278 "`wcheck-mode' hook for outline view change.
1279 Request update for the buffer when its outline view has changed."
1280 (when wcheck-mode
1281 (wcheck--buffer-data-set (current-buffer) :read-req t)))
1282
1283
1284 (defun wcheck--hook-kill-buffer ()
1285 "`wcheck-mode' hook for kill-buffer operation.
1286 Turn off `wcheck-mode' when buffer is being killed."
1287 (wcheck-mode -1))
1288
1289
1290 (defun wcheck--hook-change-major-mode ()
1291 "`wcheck-mode' hook for major mode change.
1292 Turn off `wcheck-mode' before changing major mode."
1293 (wcheck-mode -1))
1294
1295
1296 ;;; Processes
1297
1298
1299 (defun wcheck--start-get-process (buffer)
1300 "Start or get external process for BUFFER.
1301 Start a new process or get already existing process for BUFFER.
1302 Return the object of that particular process or nil if the
1303 operation was unsuccessful."
1304 ;; If process for this BUFFER exists return it.
1305 (or (wcheck--buffer-data-get :buffer buffer :process)
1306 ;; It doesn't exist so start a new one.
1307 (wcheck--with-language-data
1308 (nil (wcheck--buffer-data-get :buffer buffer :language))
1309 (program args (process-connection-type connection))
1310
1311 (when (wcheck--program-executable-p program)
1312 ;; Start the process.
1313 (let ((proc (apply #'start-process "wcheck" nil program args)))
1314 ;; Add the process Lisp object to database.
1315 (wcheck--buffer-data-set buffer :process proc)
1316 ;; Set the output handler function and the associated buffer.
1317 (set-process-filter proc #'wcheck--receive-strings)
1318 (set-process-buffer proc (generate-new-buffer
1319 (concat " *wcheck-process <"
1320 (buffer-name buffer) ">*")))
1321 ;; Prevent Emacs from querying user about running processes
1322 ;; when killing Emacs.
1323 (set-process-query-on-exit-flag proc nil)
1324 ;; Return the process object.
1325 proc)))))
1326
1327
1328 (defun wcheck--buffer-lang-proc-data-update (buffer language)
1329 "Update process and language data for BUFFER.
1330 Calling this function is the primary way to maintain the language
1331 and process data associated to BUFFER. If LANGUAGE is nil remove
1332 BUFFER from the list."
1333 (when (and (bufferp buffer)
1334 (or (stringp language)
1335 (not language)))
1336
1337 ;; Construct a list of currently used processes.
1338 (let ((old-processes (remq nil (wcheck--buffer-data-get-all :process))))
1339
1340 ;; Remove dead buffers and possible minibuffers from the list.
1341 (dolist (item (wcheck--buffer-data-get-all :buffer))
1342 (when (or (not (buffer-live-p item))
1343 (minibufferp item))
1344 (wcheck--buffer-data-delete item)))
1345
1346 (if language
1347 (progn
1348 ;; LANGUAGE was given. If data for this buffer does not
1349 ;; exist create it.
1350 (unless (wcheck--buffer-data-get :buffer buffer)
1351 (wcheck--buffer-data-create buffer))
1352 ;; Add this BUFFER's language info and reset the process
1353 ;; info.
1354 (wcheck--buffer-data-set buffer :language language)
1355 (wcheck--buffer-data-set buffer :process nil))
1356
1357 ;; LANGUAGE was not given so this normally means that
1358 ;; wcheck-mode is being turned off for this buffer. Remove
1359 ;; BUFFER's data.
1360 (wcheck--buffer-data-delete buffer))
1361
1362 ;; Construct a list of processes that are still used.
1363 (let ((new-processes (remq nil (wcheck--buffer-data-get-all :process))))
1364 ;; Stop those processes which are no longer needed.
1365 (dolist (proc old-processes)
1366 (unless (memq proc new-processes)
1367 (kill-buffer (process-buffer proc))
1368 (delete-process proc))))))
1369
1370 (wcheck--buffer-data-get :buffer buffer))
1371
1372
1373 ;;; Read and paint strings
1374
1375
1376 (defun wcheck--read-strings (buffer beg end &optional invisible)
1377 "Return a list of text elements in BUFFER.
1378 Scan BUFFER between positions BEG and END and search for text
1379 elements according to buffer's language settings (see
1380 `wcheck-language-data'). If INVISIBLE is non-nil read all buffer
1381 areas, including invisible ones. Otherwise skip invisible text."
1382
1383 (when (buffer-live-p buffer)
1384 (with-current-buffer buffer
1385 (save-excursion
1386
1387 (when font-lock-mode
1388 (save-excursion
1389 (jit-lock-fontify-now (min beg end) (max beg end))))
1390
1391 (wcheck--with-language-data
1392 (language (wcheck--buffer-data-get :buffer buffer :language))
1393 (regexp-start regexp-body regexp-end regexp-discard
1394 syntax (case-fold-search case-fold))
1395
1396 (let ((regexp
1397 (concat regexp-start "\\(" regexp-body "\\)" regexp-end))
1398 (face-p (wcheck--generate-face-predicate language major-mode))
1399 (search-spaces-regexp nil)
1400 (old-point 0)
1401 strings)
1402
1403 (with-syntax-table (eval syntax)
1404 (goto-char beg)
1405 (save-match-data
1406 (while (and (re-search-forward regexp end t)
1407 (> (point) old-point))
1408 (cond ((and (not invisible)
1409 (invisible-p (match-beginning 1)))
1410 ;; This point is invisible. Let's jump forward
1411 ;; to next change of "invisible" property.
1412 (goto-char (next-single-char-property-change
1413 (match-beginning 1) 'invisible buffer
1414 end)))
1415
1416 ((and (eval face-p)
1417 (or (equal regexp-discard "")
1418 (not (string-match
1419 regexp-discard
1420 (match-string-no-properties 1)))))
1421 ;; Add the match to the string list.
1422 (push (match-string-no-properties 1) strings)))
1423 (setq old-point (point)))))
1424 (delete-dups strings)))))))
1425
1426
1427 (defun wcheck--paint-strings (buffer beg end strings &optional invisible)
1428 "Mark strings in buffer.
1429
1430 Mark all strings in STRINGS which are visible in BUFFER within
1431 position range from BEG to END. If INVISIBLE is non-nil paint all
1432 buffer areas, including invisible ones. Otherwise skip invisible
1433 text."
1434
1435 (when (buffer-live-p buffer)
1436 (with-current-buffer buffer
1437 (save-excursion
1438
1439 (wcheck--with-language-data
1440 (language (wcheck--buffer-data-get :buffer buffer :language))
1441 (regexp-start regexp-end syntax (case-fold-search case-fold)
1442 (ol-face face) action-program)
1443
1444 (let ((face-p (wcheck--generate-face-predicate language major-mode))
1445 (search-spaces-regexp nil)
1446 (ol-keymap (make-sparse-keymap))
1447 (ol-mouse-face nil)
1448 (ol-help-echo nil)
1449 regexp old-point)
1450
1451 (when action-program
1452 (define-key ol-keymap [down-mouse-3] 'wcheck--mouse-click-overlay)
1453 (define-key ol-keymap [mouse-3] 'undefined)
1454 (setq ol-mouse-face 'highlight
1455 ol-help-echo "mouse-3: show actions"))
1456
1457 (with-syntax-table (eval syntax)
1458 (save-match-data
1459 (dolist (string strings)
1460 (setq regexp (concat regexp-start "\\("
1461 (regexp-quote string) "\\)"
1462 regexp-end)
1463 old-point 0)
1464 (goto-char beg)
1465
1466 (while (and (re-search-forward regexp end t)
1467 (> (point) old-point))
1468 (cond ((and (not invisible)
1469 (invisible-p (match-beginning 1)))
1470 ;; The point is invisible so jump forward to
1471 ;; the next change of "invisible" text
1472 ;; property.
1473 (goto-char (next-single-char-property-change
1474 (match-beginning 1) 'invisible buffer
1475 end)))
1476 ((eval face-p)
1477 ;; Make an overlay.
1478 (wcheck--make-overlay
1479 buffer ol-face ol-mouse-face ol-help-echo ol-keymap
1480 (match-beginning 1) (match-end 1))))
1481 (setq old-point (point))))))))))))
1482
1483
1484 ;;; Jump forward or backward
1485
1486
1487 (defun wcheck--overlay-next (start bound)
1488 (unless (>= start (point-max))
1489 (catch 'overlay
1490 (dolist (ol (overlays-at start))
1491 (when (overlay-get ol 'wcheck-mode)
1492 (throw 'overlay ol)))
1493 (let ((pos start))
1494 (while (and (setq pos (next-overlay-change pos))
1495 (< pos (min bound (point-max))))
1496 (dolist (ol (overlays-at pos))
1497 (when (overlay-get ol 'wcheck-mode)
1498 (throw 'overlay ol))))))))
1499
1500
1501 (defun wcheck--overlay-previous (start bound)
1502 (unless (<= start (point-min))
1503 (catch 'overlay
1504 (let ((pos start))
1505 (while t
1506 (setq pos (previous-overlay-change pos))
1507 (dolist (ol (overlays-at pos))
1508 (when (overlay-get ol 'wcheck-mode)
1509 (throw 'overlay ol)))
1510 (when (<= pos (max bound (point-min)))
1511 (throw 'overlay nil)))))))
1512
1513
1514 (defun wcheck--line-start-at (pos)
1515 (save-excursion
1516 (goto-char pos)
1517 (line-beginning-position)))
1518
1519
1520 (defun wcheck--line-end-at (pos)
1521 (save-excursion
1522 (goto-char pos)
1523 (line-end-position)))
1524
1525
1526 (defun wcheck--jump-req (buffer window start bound)
1527 (unless (= start bound)
1528 (with-current-buffer buffer
1529 (setq bound (funcall (if (> bound start)
1530 'wcheck--line-end-at
1531 'wcheck--line-start-at)
1532 bound))
1533 (message "Searching in lines %d-%d..."
1534 (line-number-at-pos start)
1535 (line-number-at-pos bound))
1536 (wcheck--buffer-data-set buffer :jump-req (wcheck--jump-req-create
1537 window start bound))
1538 (wcheck--buffer-data-set buffer :areas (list (cons (min start bound)
1539 (max start bound))))
1540 (wcheck--send-strings buffer (wcheck--read-strings
1541 buffer (min start bound)
1542 (max start bound) t))
1543 (wcheck--timer-paint-event-run wcheck--timer-paint-event-count-std))))
1544
1545
1546 (defun wcheck--invisible-text-in-area-p (buffer beg end)
1547 (catch 'invisible
1548 (let ((pos (min beg end))
1549 (end (max beg end)))
1550 (when (invisible-p pos)
1551 (throw 'invisible t))
1552 (while (and (setq pos (next-single-char-property-change
1553 pos 'invisible buffer))
1554 (< pos end))
1555 (when (invisible-p pos)
1556 (throw 'invisible t))))))
1557
1558
1559 ;;;###autoload
1560 (defun wcheck-jump-forward ()
1561 "Move point forward to next marked text area."
1562 (interactive)
1563 (let ((buffer (current-buffer))
1564 (window (selected-window)))
1565 (unless wcheck-mode
1566 (wcheck-mode 1))
1567 (when wcheck-mode
1568 (wcheck--buffer-data-set buffer :jump-req nil)
1569 (let ((ol (wcheck--overlay-next
1570 (point) (window-end (selected-window) t))))
1571 (if (and ol (not (wcheck--invisible-text-in-area-p
1572 buffer (point) (overlay-end ol))))
1573 (goto-char (overlay-end ol))
1574 (if (eobp)
1575 (message "End of buffer")
1576 (wcheck--jump-req buffer window (point)
1577 (+ (point) wcheck--jump-step))))))))
1578
1579
1580 ;;;###autoload
1581 (defun wcheck-jump-backward ()
1582 "Move point backward to previous marked text area."
1583 (interactive)
1584 (let ((buffer (current-buffer))
1585 (window (selected-window)))
1586 (unless wcheck-mode
1587 (wcheck-mode 1))
1588 (when wcheck-mode
1589 (wcheck--buffer-data-set buffer :jump-req nil)
1590 (let ((ol (wcheck--overlay-previous
1591 (point) (window-start (selected-window)))))
1592 (if (and ol (not (wcheck--invisible-text-in-area-p
1593 buffer (point) (overlay-start ol))))
1594 (goto-char (overlay-start ol))
1595 (if (bobp)
1596 (message "Beginning of buffer")
1597 (wcheck--jump-req buffer window (point)
1598 (- (point) wcheck--jump-step))))))))
1599
1600
1601 ;;; Actions
1602
1603
1604 (defun wcheck-marked-text-at (pos)
1605 "Return information about marked text at POS.
1606
1607 POS is a buffer position. The return value is a vector of five
1608 elements: (1) the marked text string, (2) buffer position at the
1609 beginning of the text, (3) position at the end of the text, (4)
1610 the overlay object which marks the text and (5) the current
1611 language as a string. The return value is nil if there are no
1612 marked text at POS.
1613
1614 If you need more information about the current language settings
1615 use `wcheck-query-language-data' for querying effective language
1616 settings."
1617
1618 (let ((overlay (catch 'my-overlay
1619 (dolist (ol (overlays-at pos))
1620 (when (overlay-get ol 'wcheck-mode)
1621 (throw 'my-overlay ol))))))
1622 (when overlay
1623 (let ((start (overlay-start overlay))
1624 (end (overlay-end overlay)))
1625 (vector (buffer-substring-no-properties start end)
1626 start end overlay
1627 (wcheck--buffer-data-get
1628 :buffer (current-buffer) :language))))))
1629
1630
1631 ;;;###autoload
1632 (defun wcheck-actions (pos &optional event)
1633 "Offer actions for marked text.
1634
1635 This function is usually called through a right mouse button
1636 event or interactively by a user. In both cases function's
1637 arguments are filled automatically.
1638
1639 If buffer position POS is on marked text (and action program is
1640 properly configured) show a menu of actions. When this function
1641 is called interactively POS is automatically the current point
1642 position. Optional EVENT argument is a mouse event which is
1643 present if this function is called through a right mouse button
1644 click on marked text. If EVENT is non-nil use a graphic toolkit's
1645 menu (when available) for selecting actions. Otherwise use a text
1646 menu.
1647
1648 When user chooses one of the options from the menu the related
1649 action is executed. It could mean that the original marked text
1650 is replaced with the chosen substitute. Menu options can trigger
1651 any kind of actions, though."
1652
1653 (interactive "d")
1654 (condition-case error-data
1655 (let ((marked-text (or (wcheck-marked-text-at pos)
1656 (wcheck-marked-text-at (1- pos))))
1657 (return-value nil))
1658
1659 (if (not marked-text)
1660 (signal 'wcheck--action-error "There is no marked text here")
1661 (let* ((start (copy-marker (aref marked-text 1)))
1662 (end (copy-marker (aref marked-text 2)))
1663 (actions (wcheck--get-actions marked-text))
1664 (choice (cond ((and (null (cdr actions))
1665 (wcheck-query-language-data
1666 (aref marked-text 4) 'action-autoselect))
1667 (cdar actions))
1668 ((and event (display-popup-menus-p))
1669 (wcheck--choose-action-popup actions event))
1670 (t (wcheck--choose-action-minibuffer actions)))))
1671
1672 (cond ((and (stringp choice)
1673 (markerp start)
1674 (markerp end))
1675 (with-current-buffer (marker-buffer start)
1676 (if buffer-read-only
1677 (signal 'wcheck--action-error "Buffer is read-only")
1678 (delete-region start end)
1679 (goto-char start)
1680 (insert choice)
1681 (setq return-value choice))))
1682 ((functionp choice)
1683 (funcall choice marked-text)
1684 (setq return-value choice)))
1685
1686 (if (markerp start) (set-marker start nil))
1687 (if (markerp end) (set-marker end nil))))
1688 return-value)
1689
1690 (wcheck--action-program-error
1691 (message "Language \"%s\": action program is not configured"
1692 (cdr error-data)))
1693
1694 (wcheck--parser-function-not-configured-error
1695 (message "Language \"%s\": parser function is not configured"
1696 (cdr error-data)))
1697
1698 (wcheck--error
1699 (message "%s" (cdr error-data)))))
1700
1701
1702 (defun wcheck--get-actions (marked-text)
1703 "Get actions from external program or a function.
1704
1705 MARKED-TEXT must be a vector such as the one returned by
1706 `wcheck-marked-text-at' function."
1707
1708 (wcheck--with-language-data
1709 (language (aref marked-text 4))
1710 ((program action-program)
1711 (args action-args)
1712 (parser action-parser)
1713 (case-fold-search case-fold)
1714 syntax)
1715
1716 (with-syntax-table (eval syntax)
1717 (cond ((not (wcheck--action-program-configured-p language))
1718 (signal 'wcheck--action-program-error language))
1719
1720 ((and (stringp program)
1721 (not parser))
1722 (signal 'wcheck--parser-function-not-configured-error language))
1723
1724 ((stringp program)
1725 (with-temp-buffer
1726 (insert (aref marked-text 0))
1727 (apply #'call-process-region (point-min) (point-max)
1728 program t t nil args)
1729 (goto-char (point-min))
1730 (wcheck--clean-actions
1731 (save-match-data
1732 (condition-case nil (funcall parser marked-text)
1733 (error (signal 'wcheck--funcall-error
1734 (concat "Action parser function "
1735 "signaled an error"))))))))
1736
1737 ((functionp program)
1738 (wcheck--clean-actions
1739 (save-match-data
1740 (condition-case nil (funcall program marked-text)
1741 (error (signal 'wcheck--funcall-error
1742 (concat "Action function signaled "
1743 "an error")))))))))))
1744
1745
1746 (defun wcheck--clean-actions (actions)
1747 (when (listp actions)
1748 (delete nil (mapcar (lambda (item)
1749 (cond ((stringp item)
1750 (cons (wcheck--clean-string item)
1751 item))
1752 ((and (consp item)
1753 (stringp (car item))
1754 (or (functionp (cdr item))
1755 (stringp (cdr item))))
1756 (cons (wcheck--clean-string (car item))
1757 (cdr item)))))
1758 actions))))
1759
1760
1761 (defun wcheck--clean-string (string)
1762 (if (equal string "")
1763 "[Empty string]"
1764 (setq string (replace-regexp-in-string "[^[:print:]]+" "" string))
1765 (if (not (string-match "[^[:space:]]" string))
1766 "[Space or control chars]"
1767 (replace-regexp-in-string "\\(?:\\` +\\| +\\'\\)" "" string))))
1768
1769
1770 (defun wcheck--choose-action-popup (actions event)
1771 "Create a pop-up menu to choose an action.
1772 ACTIONS is a list of strings. EVENT is the mouse event that
1773 originated this sequence of function calls. Return user's
1774 choice (a string) or nil."
1775 (let ((menu (list "Choose"
1776 (cons "" (if actions
1777 (mapcar (lambda (item)
1778 (cons (wcheck--clean-string
1779 (car item))
1780 (cdr item)))
1781 actions)
1782 (list "[No actions]"))))))
1783 (x-popup-menu event menu)))
1784
1785
1786 (defun wcheck--read-key (prompt)
1787 (if (fboundp 'read-key)
1788 (read-key prompt)
1789 (read-char prompt)))
1790
1791
1792 (defun wcheck--choose-action-minibuffer (actions)
1793 "Create a text menu to choose a substitute action.
1794 ACTIONS is a list of strings. Return user's choice (a string)
1795 or nil."
1796 (if actions
1797 (let ((chars (append (number-sequence ?1 ?9) (list ?0)
1798 (number-sequence ?a ?z)))
1799 alist)
1800
1801 (with-temp-buffer
1802 (setq mode-line-format (list "--- Choose %-")
1803 cursor-type nil
1804 truncate-lines t)
1805
1806 (let (sug string)
1807 (while (and actions chars)
1808 (setq sug (car actions)
1809 actions (cdr actions)
1810 string (concat (propertize (format "%c)" (car chars))
1811 'face 'bold)
1812 " " (wcheck--clean-string (car sug)) " ")
1813 alist (cons (cons (car chars) (cdr sug)) alist)
1814 chars (cdr chars))
1815 (insert string)
1816 (when (and actions chars
1817 (> (+ (- (point) (line-beginning-position))
1818 (length (concat "x) " (caar actions))))
1819 (window-width)))
1820 (delete-char -2)
1821 (newline 1))))
1822
1823 (delete-char -2)
1824 (goto-char (point-min))
1825 (setq buffer-read-only t)
1826
1827 (let* ((window-min-height 2)
1828 (split-window-keep-point t)
1829 (window (split-window-vertically
1830 (- 0 (min (count-lines (point-min) (point-max))
1831 (- (window-body-height) 2))
1832 1)))
1833 (prompt
1834 (apply #'propertize
1835 (let ((last (caar alist)))
1836 (format "Number %s(%s):"
1837 (if (memq last (number-sequence ?a ?z))
1838 "or letter "
1839 "")
1840 (cond ((= last ?1) "1")
1841 ((memq last (number-sequence ?2 ?9))
1842 (format "1-%c" last))
1843 ((= last ?0) "1-9,0")
1844 ((= last ?a) "1-9,0,a")
1845 ((memq last (number-sequence ?b ?z))
1846 (format "1-9,0,a-%c" last))
1847 (t ""))))
1848 minibuffer-prompt-properties)))
1849 (set-window-buffer window (current-buffer))
1850 (set-window-dedicated-p window t)
1851 ;; Return the choice or nil.
1852 (cond ((cdr (assq (wcheck--read-key prompt) alist)))
1853 (t (message "Abort") nil)))))
1854 (message "No actions")
1855 nil))
1856
1857
1858 (defun wcheck-parser-lines (&rest _ignored)
1859 "Parser for newline-separated output.
1860 Return current buffer's lines as a list of strings."
1861 (delete-dups (split-string (buffer-substring-no-properties
1862 (point-min) (point-max))
1863 "\n+" t)))
1864
1865
1866 (defun wcheck-parser-whitespace (&rest _ignored)
1867 "Parser for whitespace-separated output.
1868 Split current buffer's content to whitespace-separated tokens and
1869 return them as a list of strings."
1870 (delete-dups (split-string (buffer-substring-no-properties
1871 (point-min) (point-max))
1872 "[ \f\t\n\r\v]+" t)))
1873
1874
1875 (defun wcheck-parser-ispell-suggestions (&rest _ignored)
1876 "Parser for Ispell-compatible programs' spelling suggestions."
1877 (let ((search-spaces-regexp nil))
1878 (when (re-search-forward "^& [^ ]+ \\([0-9]+\\) [0-9]+: \\(.+\\)$" nil t)
1879 (let ((count (string-to-number (match-string-no-properties 1)))
1880 (words (split-string (match-string-no-properties 2) ", " t)))
1881 (delete-dups (nbutlast words (- (length words) count)))))))
1882
1883
1884 ;;; Face information functions
1885
1886
1887 (defun wcheck--collect-faces (beg end)
1888 "Return a list of faces between positions BEG and END."
1889 (let ((pos beg)
1890 face faces)
1891 (while (< pos end)
1892 (setq face (get-text-property pos 'face)
1893 pos (1+ pos))
1894 (if (and face (listp face))
1895 (setq faces (append face faces))
1896 (push face faces)))
1897 (delete-dups faces)))
1898
1899
1900 (defun wcheck--major-mode-face-settings (language mode)
1901 "Return read/skip face settings for MODE."
1902 (let ((data (wcheck-query-language-data language 'read-or-skip-faces))
1903 conf)
1904 (catch 'answer
1905 (while data
1906 (setq conf (pop data))
1907 (when (or (eq nil (car conf))
1908 (eq mode (car conf))
1909 (and (listp (car conf))
1910 (memq mode (car conf))))
1911 (throw 'answer conf))))))
1912
1913
1914 (defun wcheck--face-found-p (user-faces buffer-faces)
1915 "Return t if a symbol in USER-FACES is found from BUFFER-FACES.
1916 Both arguments are lists."
1917 (catch 'found
1918 (dolist (face user-faces)
1919 (when (member face buffer-faces)
1920 (throw 'found t)))))
1921
1922
1923 (defun wcheck--generate-face-predicate (language mode)
1924 "Generate a face predicate expression for scanning buffer.
1925 Return a predicate expression that is used to decide whether
1926 `wcheck-mode' should read or paint text at the current point
1927 position with LANGUAGE and MODE. Evaluating the predicate
1928 expression will return a boolean."
1929 (let* ((face-settings (wcheck--major-mode-face-settings
1930 language mode))
1931 (mode (nth 1 face-settings))
1932 (faces (nthcdr 2 face-settings)))
1933 (cond ((not font-lock-mode)
1934 t)
1935 ((eq mode 'read)
1936 `(wcheck--face-found-p
1937 ',faces (wcheck--collect-faces
1938 (match-beginning 1) (match-end 1))))
1939 ((eq mode 'skip)
1940 `(not (wcheck--face-found-p
1941 ',faces (wcheck--collect-faces
1942 (match-beginning 1) (match-end 1)))))
1943 (t t))))
1944
1945
1946 ;;; Miscellaneous low-level functions
1947
1948
1949 (defun wcheck--language-data-valid-p (key value)
1950 (cond ((and (eq key 'syntax)
1951 (syntax-table-p (and (boundp value) (eval value)))))
1952 ((and (eq key 'face)
1953 (facep value)))
1954 ((and (or (eq key 'regexp-start)
1955 (eq key 'regexp-body)
1956 (eq key 'regexp-end)
1957 (eq key 'regexp-discard))
1958 (stringp value)))
1959 ((and (or (eq key 'program)
1960 (eq key 'action-program))
1961 (or (stringp value)
1962 (functionp value))))
1963 ((and (eq key 'args)
1964 (wcheck--list-of-strings-p value)))
1965 ((and (eq key 'action-args)
1966 (wcheck--list-of-strings-p value)))
1967 ((and (or (eq key 'parser)
1968 (eq key 'action-parser))
1969 (functionp value)))
1970 ((or (eq key 'connection)
1971 (eq key 'case-fold)
1972 (eq key 'action-autoselect)))
1973 ((and (eq key 'read-or-skip-faces)
1974 (wcheck--list-of-lists-p value)))))
1975
1976
1977 (defun wcheck-query-language-data (language key)
1978 "Query `wcheck-mode' language data.
1979
1980 Return LANGUAGE's value for KEY. Valid keys (symbols) are
1981 described in the documentation of user variable
1982 `wcheck-language-data'. If that variable does not define
1983 a (valid) value for the KEY then query the value from
1984 `wcheck-language-data-defaults' or use internal defaults."
1985
1986 (when (wcheck--language-exists-p language)
1987 (let* ((data
1988 (and (wcheck--list-of-lists-p wcheck-language-data)
1989 (assq key (cdr (assoc language wcheck-language-data)))))
1990 (default
1991 (and (wcheck--list-of-lists-p wcheck-language-data-defaults)
1992 (assq key wcheck-language-data-defaults)))
1993 (hard-coded
1994 (and (wcheck--list-of-lists-p
1995 wcheck--language-data-defaults-hard-coded)
1996 (assq key wcheck--language-data-defaults-hard-coded)))
1997 (conf
1998 (list (when (wcheck--language-data-valid-p key (cdr data))
1999 data)
2000 (when (wcheck--language-data-valid-p key (cdr default))
2001 default)
2002 (when (wcheck--language-data-valid-p key (cdr hard-coded))
2003 hard-coded))))
2004
2005 (if (eq key 'read-or-skip-faces)
2006 (apply #'append (mapcar #'cdr conf))
2007 (cdr (assq key conf))))))
2008
2009
2010 (defun wcheck--language-exists-p (language)
2011 "Return t if LANGUAGE exists in `wcheck-language-data'."
2012 (and (wcheck--list-of-lists-p wcheck-language-data)
2013 (member language (mapcar #'car wcheck-language-data))
2014 (stringp language)
2015 (> (length language) 0)
2016 t))
2017
2018
2019 (defun wcheck--program-executable-p (program)
2020 "Return t if PROGRAM is executable regular file."
2021 (and (stringp program)
2022 (file-regular-p program)
2023 (file-executable-p program)
2024 t))
2025
2026
2027 (defun wcheck--program-configured-p (language)
2028 (let ((program (wcheck-query-language-data language 'program)))
2029 (or (wcheck--program-executable-p program)
2030 (functionp program))))
2031
2032
2033 (defun wcheck--action-program-configured-p (language)
2034 (let ((program (wcheck-query-language-data language 'action-program)))
2035 (or (wcheck--program-executable-p program)
2036 (functionp program))))
2037
2038
2039 (defun wcheck--list-of-strings-p (object)
2040 (and (listp object)
2041 (not (memq nil (mapcar #'stringp object)))))
2042
2043
2044 (defun wcheck--list-of-lists-p (object)
2045 (and (listp object)
2046 (not (memq nil (mapcar #'listp object)))))
2047
2048
2049 (defun wcheck--process-running-p (process)
2050 (eq 'run (process-status process)))
2051
2052
2053 (defun wcheck--current-idle-time-seconds ()
2054 "Return current idle time in seconds.
2055 The returned value is a floating point number."
2056 (let* ((idle (or (current-idle-time)
2057 '(0 0 0)))
2058 (high (nth 0 idle))
2059 (low (nth 1 idle))
2060 (micros (nth 2 idle)))
2061 (+ (* high
2062 (expt 2 16))
2063 low
2064 (/ micros 1000000.0))))
2065
2066
2067 (defun wcheck--combine-overlapping-areas (alist)
2068 "Combine overlapping items in ALIST.
2069 ALIST is a list of (A . B) items in which A and B are integers.
2070 Each item denote a buffer position range from A to B. This
2071 function returns a new list which has items in increasing order
2072 according to A's and all overlapping A B ranges are combined."
2073 (let ((alist (sort (copy-sequence alist)
2074 (lambda (a b)
2075 (< (car a) (car b)))))
2076 final previous)
2077 (while alist
2078 (while (not (equal previous alist))
2079 (setq previous alist
2080 alist (append (wcheck--combine-two (car previous) (cadr previous))
2081 (nthcdr 2 previous))))
2082 (setq final (cons (car alist) final)
2083 alist (cdr alist)
2084 previous nil))
2085 (nreverse final)))
2086
2087
2088 (defun wcheck--combine-two (a b)
2089 (let ((a1 (car a))
2090 (a2 (cdr a))
2091 (b1 (car b))
2092 (b2 (cdr b)))
2093 (cond ((and a b)
2094 (if (>= (1+ a2) b1)
2095 (list (cons a1 (if (> b2 a2) b2 a2)))
2096 (list a b)))
2097 ((not a) (list b))
2098 (t (append (list a) b)))))
2099
2100
2101 ;;; Overlays
2102
2103
2104 (defun wcheck--make-overlay (buffer face mouse-face help-echo keymap beg end)
2105 "Create an overlay to mark text.
2106 Create an overlay in BUFFER from range BEG to END. FACE,
2107 MOUSE-FACE, HELP-ECHO and KEYMAP are overlay's properties."
2108 (let ((overlay (make-overlay beg end buffer)))
2109 (dolist (prop `((wcheck-mode . t)
2110 (face . ,face)
2111 (mouse-face . ,mouse-face)
2112 (modification-hooks wcheck--remove-changed-overlay)
2113 (insert-in-front-hooks wcheck--remove-changed-overlay)
2114 (insert-behind-hooks wcheck--remove-changed-overlay)
2115 (evaporate . t)
2116 (keymap . ,keymap)
2117 (help-echo . ,help-echo)))
2118 (overlay-put overlay (car prop) (cdr prop)))))
2119
2120
2121 (defun wcheck--remove-overlays (&optional beg end)
2122 "Remove `wcheck-mode' overlays from current buffer.
2123 If optional arguments BEG and END exist remove overlays from
2124 range BEG to END. Otherwise remove all overlays."
2125 (remove-overlays beg end 'wcheck-mode t))
2126
2127
2128 (defun wcheck--remove-changed-overlay (overlay after _beg _end &optional _len)
2129 "Hook for removing overlay which is being edited."
2130 (unless after
2131 (delete-overlay overlay)))
2132
2133
2134 (defun wcheck--mouse-click-overlay (event)
2135 "Overlay mouse-click event.
2136 Send the mouse pointer position and mouse event to the
2137 `wcheck-actions' function."
2138 (interactive "e")
2139 (wcheck-actions (posn-point (event-end event)) event))
2140
2141
2142 ;;; Buffer data access functions
2143
2144
2145 (defconst wcheck--buffer-data-keys
2146 '(:buffer :process :language :read-req :paint-req :jump-req :areas :strings))
2147
2148
2149 (defun wcheck--buffer-data-key-index (key)
2150 "Return the index of KEY in buffer data object."
2151 (let ((index 0))
2152 (catch 'answer
2153 (dolist (data-key wcheck--buffer-data-keys nil)
2154 (if (eq key data-key)
2155 (throw 'answer index)
2156 (setq index (1+ index)))))))
2157
2158
2159 (defun wcheck--buffer-data-create (buffer)
2160 "Create data instance for BUFFER.
2161 But only if it doesn't exist already."
2162 (unless (wcheck--buffer-data-get :buffer buffer)
2163 (let ((data (make-vector (length wcheck--buffer-data-keys) nil)))
2164 (aset data (wcheck--buffer-data-key-index :buffer) buffer)
2165 (push data wcheck--buffer-data))))
2166
2167
2168 (defun wcheck--buffer-data-delete (buffer)
2169 "Delete all data associated to BUFFER."
2170 (let ((index (wcheck--buffer-data-key-index :buffer)))
2171 (setq wcheck--buffer-data
2172 (delq nil (mapcar (lambda (item)
2173 (unless (eq buffer (aref item index))
2174 item))
2175 wcheck--buffer-data)))))
2176
2177
2178 (defun wcheck--buffer-data-get (key value &optional target-key)
2179 "Query the first matching KEY VALUE pair and return TARGET-KEY.
2180 If optional TARGET-KEY is not given return all data associated
2181 with the matching KEY VALUE."
2182 (catch 'answer
2183 (dolist (item wcheck--buffer-data)
2184 (when (equal value (aref item (wcheck--buffer-data-key-index key)))
2185 (throw 'answer (if target-key
2186 (aref item (wcheck--buffer-data-key-index
2187 target-key))
2188 item))))))
2189
2190
2191 (defun wcheck--buffer-data-get-all (&optional key)
2192 "Return every buffer's value for KEY.
2193 If KEY is nil return all buffer's all data."
2194 (if key
2195 (let ((index (wcheck--buffer-data-key-index key)))
2196 (mapcar (lambda (item)
2197 (aref item index))
2198 wcheck--buffer-data))
2199 wcheck--buffer-data))
2200
2201
2202 (defun wcheck--buffer-data-set (buffer key value)
2203 "Set KEY's VALUE for BUFFER."
2204 (let ((item (wcheck--buffer-data-get :buffer buffer)))
2205 (when item
2206 (aset item (wcheck--buffer-data-key-index key) value))))
2207
2208
2209 (defun wcheck--jump-req-create (window start bound)
2210 (when (and (number-or-marker-p start)
2211 (number-or-marker-p bound)
2212 (windowp window))
2213 (vector window start bound)))
2214
2215
2216 (defun wcheck--jump-req-window (jump-req)
2217 (aref jump-req 0))
2218 (defun wcheck--jump-req-start (jump-req)
2219 (aref jump-req 1))
2220 (defun wcheck--jump-req-bound (jump-req)
2221 (aref jump-req 2))
2222
2223
2224 (provide 'wcheck-mode)
2225
2226 ;;; wcheck-mode.el ends here