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