]> code.delx.au - gnu-emacs/blob - lisp/textmodes/flyspell.el
(flyspell-check-tex-math-command): Use "non-nil" in docstrings.
[gnu-emacs] / lisp / textmodes / flyspell.el
1 ;;; flyspell.el --- on-the-fly spell checker
2
3 ;; Copyright (C) 1998, 2000, 2002, 2003, 2004,
4 ;; 2005, 2006 Free Software Foundation, Inc.
5
6 ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
7 ;; Maintainer: FSF
8 ;; Keywords: convenience
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs 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 2, or (at your option)
15 ;; any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
26
27 ;;; Commentary:
28 ;;
29 ;; Flyspell is a minor Emacs mode performing on-the-fly spelling
30 ;; checking.
31 ;;
32 ;; To enable Flyspell minor mode, type M-x flyspell-mode.
33 ;; This applies only to the current buffer.
34 ;;
35 ;; To enable Flyspell in text representing computer programs, type
36 ;; M-x flyspell-prog-mode.
37 ;; In that mode only text inside comments is checked.
38 ;;
39 ;; Note: consider setting the variable ispell-parser to `tex' to
40 ;; avoid TeX command checking; use `(setq ispell-parser 'tex)'.
41 ;;
42 ;; Some user variables control the behavior of flyspell. They are
43 ;; those defined under the `User variables' comment.
44
45 ;;; Code:
46
47 (require 'ispell)
48
49 ;;*---------------------------------------------------------------------*/
50 ;;* Group ... */
51 ;;*---------------------------------------------------------------------*/
52 (defgroup flyspell nil
53 "Spell checking on the fly."
54 :tag "FlySpell"
55 :prefix "flyspell-"
56 :group 'ispell
57 :group 'processes)
58
59 ;;*---------------------------------------------------------------------*/
60 ;;* User configuration ... */
61 ;;*---------------------------------------------------------------------*/
62 (defcustom flyspell-highlight-flag t
63 "How Flyspell should indicate misspelled words.
64 Non-nil means use highlight, nil means use minibuffer messages."
65 :group 'flyspell
66 :type 'boolean)
67
68 (defcustom flyspell-mark-duplications-flag t
69 "Non-nil means Flyspell reports a repeated word as an error.
70 Detection of repeated words is not implemented in
71 \"large\" regions; see `flyspell-large-region'."
72 :group 'flyspell
73 :type 'boolean)
74
75 (defcustom flyspell-sort-corrections nil
76 "Non-nil means, sort the corrections alphabetically before popping them."
77 :group 'flyspell
78 :version "21.1"
79 :type 'boolean)
80
81 (defcustom flyspell-duplicate-distance -1
82 "The maximum distance for finding duplicates of unrecognized words.
83 This applies to the feature that when a word is not found in the dictionary,
84 if the same spelling occurs elsewhere in the buffer,
85 Flyspell uses a different face (`flyspell-duplicate') to highlight it.
86 This variable specifies how far to search to find such a duplicate.
87 -1 means no limit (search the whole buffer).
88 0 means do not search for duplicate unrecognized spellings."
89 :group 'flyspell
90 :version "21.1"
91 :type 'number)
92
93 (defcustom flyspell-delay 3
94 "The number of seconds to wait before checking, after a \"delayed\" command."
95 :group 'flyspell
96 :type 'number)
97
98 (defcustom flyspell-persistent-highlight t
99 "Non-nil means misspelled words remain highlighted until corrected.
100 If this variable is nil, only the most recently detected misspelled word
101 is highlighted."
102 :group 'flyspell
103 :type 'boolean)
104
105 (defcustom flyspell-highlight-properties t
106 "Non-nil means highlight incorrect words even if a property exists for this word."
107 :group 'flyspell
108 :type 'boolean)
109
110 (defcustom flyspell-default-delayed-commands
111 '(self-insert-command
112 delete-backward-char
113 backward-or-forward-delete-char
114 delete-char
115 scrollbar-vertical-drag
116 backward-delete-char-untabify)
117 "The standard list of delayed commands for Flyspell.
118 See `flyspell-delayed-commands'."
119 :group 'flyspell
120 :version "21.1"
121 :type '(repeat (symbol)))
122
123 (defcustom flyspell-delayed-commands nil
124 "List of commands that are \"delayed\" for Flyspell mode.
125 After these commands, Flyspell checking is delayed for a short time,
126 whose length is specified by `flyspell-delay'."
127 :group 'flyspell
128 :type '(repeat (symbol)))
129
130 (defcustom flyspell-default-deplacement-commands
131 '(next-line
132 previous-line
133 scroll-up
134 scroll-down)
135 "The standard list of deplacement commands for Flyspell.
136 See `flyspell-deplacement-commands'."
137 :group 'flyspell
138 :version "21.1"
139 :type '(repeat (symbol)))
140
141 (defcustom flyspell-deplacement-commands nil
142 "List of commands that are \"deplacement\" for Flyspell mode.
143 After these commands, Flyspell checking is performed only if the previous
144 command was not the very same command."
145 :group 'flyspell
146 :version "21.1"
147 :type '(repeat (symbol)))
148
149 (defcustom flyspell-issue-welcome-flag t
150 "Non-nil means that Flyspell should display a welcome message when started."
151 :group 'flyspell
152 :type 'boolean)
153
154 (defcustom flyspell-issue-message-flag t
155 "Non-nil means that Flyspell emits messages when checking words."
156 :group 'flyspell
157 :type 'boolean)
158
159 (defcustom flyspell-incorrect-hook nil
160 "List of functions to be called when incorrect words are encountered.
161 Each function is given three arguments. The first two
162 arguments are the beginning and the end of the incorrect region.
163 The third is either the symbol `doublon' or the list
164 of possible corrections as returned by `ispell-parse-output'.
165
166 If any of the functions return non-nil, the word is not highlighted as
167 incorrect."
168 :group 'flyspell
169 :version "21.1"
170 :type 'hook)
171
172 (defcustom flyspell-default-dictionary nil
173 "A string that is the name of the default dictionary.
174 This is passed to the `ispell-change-dictionary' when flyspell is started.
175 If the variable `ispell-local-dictionary' or `ispell-dictionary' is non-nil
176 when flyspell is started, the value of that variable is used instead
177 of `flyspell-default-dictionary' to select the default dictionary.
178 Otherwise, if `flyspell-default-dictionary' is nil, it means to use
179 Ispell's ultimate default dictionary."
180 :group 'flyspell
181 :version "21.1"
182 :type '(choice string (const :tag "Default" nil)))
183
184 (defcustom flyspell-tex-command-regexp
185 "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
186 "A string that is the regular expression that matches TeX commands."
187 :group 'flyspell
188 :version "21.1"
189 :type 'string)
190
191 (defcustom flyspell-check-tex-math-command nil
192 "Non-nil means check even inside TeX math environment.
193 TeX math environments are discovered by the TEXMATHP that implemented
194 inside the texmathp.el Emacs package. That package may be found at:
195 http://strw.leidenuniv.nl/~dominik/Tools"
196 :group 'flyspell
197 :type 'boolean)
198
199 (defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
200 '("francais" "deutsch8" "norsk")
201 "List of dictionary names that consider `-' as word delimiter."
202 :group 'flyspell
203 :version "21.1"
204 :type '(repeat (string)))
205
206 (defcustom flyspell-abbrev-p
207 nil
208 "If non-nil, add correction to abbreviation table."
209 :group 'flyspell
210 :version "21.1"
211 :type 'boolean)
212
213 (defcustom flyspell-use-global-abbrev-table-p
214 nil
215 "If non-nil, prefer global abbrev table to local abbrev table."
216 :group 'flyspell
217 :version "21.1"
218 :type 'boolean)
219
220 (defcustom flyspell-mode-line-string " Fly"
221 "String displayed on the modeline when flyspell is active.
222 Set this to nil if you don't want a modeline indicator."
223 :group 'flyspell
224 :type '(choice string (const :tag "None" nil)))
225
226 (defcustom flyspell-large-region 1000
227 "The threshold that determines if a region is small.
228 If the region is smaller than this number of characters,
229 `flyspell-region' checks the words sequentially using regular
230 flyspell methods. Else, if the region is large, a new Ispell process is
231 spawned for speed.
232
233 Doubled words are not detected in a large region, because Ispell
234 does not check for them.
235
236 If `flyspell-large-region' is nil, all regions are treated as small."
237 :group 'flyspell
238 :version "21.1"
239 :type '(choice number (const :tag "All small" nil)))
240
241 (defcustom flyspell-insert-function (function insert)
242 "Function for inserting word by flyspell upon correction."
243 :group 'flyspell
244 :type 'function)
245
246 (defcustom flyspell-before-incorrect-word-string nil
247 "String used to indicate an incorrect word starting."
248 :group 'flyspell
249 :type '(choice string (const nil)))
250
251 (defcustom flyspell-after-incorrect-word-string nil
252 "String used to indicate an incorrect word ending."
253 :group 'flyspell
254 :type '(choice string (const nil)))
255
256 (defcustom flyspell-use-meta-tab t
257 "Non-nil means that flyspell uses M-TAB to correct word."
258 :group 'flyspell
259 :type 'boolean)
260
261 (defcustom flyspell-auto-correct-binding
262 [(control ?\;)]
263 "The key binding for flyspell auto correction."
264 :group 'flyspell)
265
266 ;;*---------------------------------------------------------------------*/
267 ;;* Mode specific options */
268 ;;* ------------------------------------------------------------- */
269 ;;* Mode specific options enable users to disable flyspell on */
270 ;;* certain word depending of the emacs mode. For instance, when */
271 ;;* using flyspell with mail-mode add the following expression */
272 ;;* in your .emacs file: */
273 ;;* (add-hook 'mail-mode */
274 ;;* '(lambda () (setq flyspell-generic-check-word-predicate */
275 ;;* 'mail-mode-flyspell-verify))) */
276 ;;*---------------------------------------------------------------------*/
277 (defvar flyspell-generic-check-word-predicate nil
278 "Function providing per-mode customization over which words are flyspelled.
279 Returns t to continue checking, nil otherwise.
280 Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
281 property of the major mode name.")
282 (make-variable-buffer-local 'flyspell-generic-check-word-predicate)
283 (defvaralias 'flyspell-generic-check-word-p
284 'flyspell-generic-check-word-predicate)
285
286 ;;*--- mail mode -------------------------------------------------------*/
287 (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
288 (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
289 (defun mail-mode-flyspell-verify ()
290 "Function used for `flyspell-generic-check-word-predicate' in Mail mode."
291 (let ((header-end (save-excursion
292 (goto-char (point-min))
293 (re-search-forward
294 (concat "^"
295 (regexp-quote mail-header-separator)
296 "$")
297 nil t)
298 (point)))
299 (signature-begin (save-excursion
300 (goto-char (point-max))
301 (re-search-backward message-signature-separator
302 nil t)
303 (point))))
304 (cond ((< (point) header-end)
305 (and (save-excursion (beginning-of-line)
306 (looking-at "^Subject:"))
307 (> (point) (match-end 0))))
308 ((> (point) signature-begin)
309 nil)
310 (t
311 (save-excursion
312 (beginning-of-line)
313 (not (looking-at "[>}|]\\|To:")))))))
314
315 ;;*--- texinfo mode ----------------------------------------------------*/
316 (put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify)
317 (defun texinfo-mode-flyspell-verify ()
318 "Function used for `flyspell-generic-check-word-predicate' in Texinfo mode."
319 (save-excursion
320 (forward-word -1)
321 (not (looking-at "@"))))
322
323 ;;*--- tex mode --------------------------------------------------------*/
324 (put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify)
325 (defun tex-mode-flyspell-verify ()
326 "Function used for `flyspell-generic-check-word-predicate' in LaTeX mode."
327 (and
328 (not (save-excursion
329 (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t)))
330 (not (save-excursion
331 (let ((this (point-marker))
332 (e (progn (end-of-line) (point-marker))))
333 (beginning-of-line)
334 (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t)
335 (and (>= this (match-beginning 0))
336 (<= this (match-end 0)) )))))))
337
338 ;;*--- sgml mode -------------------------------------------------------*/
339 (put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
340 (put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
341
342 (defun sgml-mode-flyspell-verify ()
343 "Function used for `flyspell-generic-check-word-predicate' in SGML mode."
344 (not (save-excursion
345 (let ((this (point-marker))
346 (s (progn (beginning-of-line) (point-marker)))
347 (e (progn (end-of-line) (point-marker))))
348 (or (progn
349 (goto-char this)
350 (and (re-search-forward "[^<]*>" e t)
351 (= (match-beginning 0) this)))
352 (progn
353 (goto-char this)
354 (and (re-search-backward "<[^>]*" s t)
355 (= (match-end 0) this)))
356 (and (progn
357 (goto-char this)
358 (and (re-search-forward "[^&]*;" e t)
359 (= (match-beginning 0) this)))
360 (progn
361 (goto-char this)
362 (and (re-search-backward "&[^;]*" s t)
363 (= (match-end 0) this)))))))))
364
365 ;;*---------------------------------------------------------------------*/
366 ;;* Programming mode */
367 ;;*---------------------------------------------------------------------*/
368 (defvar flyspell-prog-text-faces
369 '(font-lock-string-face font-lock-comment-face font-lock-doc-face)
370 "Faces corresponding to text in programming-mode buffers.")
371
372 (defun flyspell-generic-progmode-verify ()
373 "Used for `flyspell-generic-check-word-predicate' in programming modes."
374 (let ((f (get-text-property (point) 'face)))
375 (memq f flyspell-prog-text-faces)))
376
377 ;;;###autoload
378 (defun flyspell-prog-mode ()
379 "Turn on `flyspell-mode' for comments and strings."
380 (interactive)
381 (setq flyspell-generic-check-word-predicate
382 'flyspell-generic-progmode-verify)
383 (flyspell-mode 1)
384 (run-hooks 'flyspell-prog-mode-hook))
385
386 ;;*---------------------------------------------------------------------*/
387 ;;* Overlay compatibility */
388 ;;*---------------------------------------------------------------------*/
389 (autoload 'make-overlay "overlay" "Overlay compatibility kit." t)
390 (autoload 'overlayp "overlay" "Overlay compatibility kit." t)
391 (autoload 'overlays-in "overlay" "Overlay compatibility kit." t)
392 (autoload 'delete-overlay "overlay" "Overlay compatibility kit." t)
393 (autoload 'overlays-at "overlay" "Overlay compatibility kit." t)
394 (autoload 'overlay-put "overlay" "Overlay compatibility kit." t)
395 (autoload 'overlay-get "overlay" "Overlay compatibility kit." t)
396 (autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t)
397
398 ;;*---------------------------------------------------------------------*/
399 ;;* The minor mode declaration. */
400 ;;*---------------------------------------------------------------------*/
401 (defvar flyspell-mouse-map
402 (let ((map (make-sparse-keymap)))
403 (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2])
404 #'flyspell-correct-word)
405 map)
406 "Keymap for Flyspell to put on erroneous words.")
407
408 (defvar flyspell-mode-map
409 (let ((map (make-sparse-keymap)))
410 (if flyspell-use-meta-tab
411 (define-key map "\M-\t" 'flyspell-auto-correct-word))
412 (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
413 (define-key map [(control ?\,)] 'flyspell-goto-next-error)
414 (define-key map [(control ?\.)] 'flyspell-auto-correct-word)
415 map)
416 "Minor mode keymap for Flyspell mode--for the whole buffer.")
417
418 ;; dash character machinery
419 (defvar flyspell-consider-dash-as-word-delimiter-flag nil
420 "*Non-nil means that the `-' char is considered as a word delimiter.")
421 (make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
422 (defvar flyspell-dash-dictionary nil)
423 (make-variable-buffer-local 'flyspell-dash-dictionary)
424 (defvar flyspell-dash-local-dictionary nil)
425 (make-variable-buffer-local 'flyspell-dash-local-dictionary)
426
427 ;;*---------------------------------------------------------------------*/
428 ;;* Highlighting */
429 ;;*---------------------------------------------------------------------*/
430 (defface flyspell-incorrect
431 '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
432 (t (:bold t)))
433 "Face used to display a misspelled word in Flyspell."
434 :group 'flyspell)
435 ;; backward-compatibility alias
436 (put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect)
437
438 (defface flyspell-duplicate
439 '((((class color)) (:foreground "Gold3" :bold t :underline t))
440 (t (:bold t)))
441 "Face used to display subsequent occurrences of a misspelled word.
442 See also `flyspell-duplicate-distance'."
443 :group 'flyspell)
444 ;; backward-compatibility alias
445 (put 'flyspell-duplicate-face 'face-alias 'flyspell-duplicate)
446
447 (defvar flyspell-overlay nil)
448
449 ;;*---------------------------------------------------------------------*/
450 ;;* flyspell-mode ... */
451 ;;*---------------------------------------------------------------------*/
452 ;;;###autoload(defvar flyspell-mode nil)
453 ;;;###autoload
454 (define-minor-mode flyspell-mode
455 "Minor mode performing on-the-fly spelling checking.
456 This spawns a single Ispell process and checks each word.
457 The default flyspell behavior is to highlight incorrect words.
458 With no argument, this command toggles Flyspell mode.
459 With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
460
461 Bindings:
462 \\[ispell-word]: correct words (using Ispell).
463 \\[flyspell-auto-correct-word]: automatically correct word.
464 \\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word.
465 \\[flyspell-correct-word] (or down-mouse-2): popup correct words.
466
467 Hooks:
468 This runs `flyspell-mode-hook' after flyspell is entered.
469
470 Remark:
471 `flyspell-mode' uses `ispell-mode'. Thus all Ispell options are
472 valid. For instance, a personal dictionary can be used by
473 invoking `ispell-change-dictionary'.
474
475 Consider using the `ispell-parser' to check your text. For instance
476 consider adding:
477 \(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
478 in your .emacs file.
479
480 \\[flyspell-region] checks all words inside a region.
481 \\[flyspell-buffer] checks the whole buffer."
482 :lighter flyspell-mode-line-string
483 :keymap flyspell-mode-map
484 :group 'flyspell
485 (if flyspell-mode
486 (flyspell-mode-on)
487 (flyspell-mode-off)))
488
489 ;;;###autoload
490 (defun turn-on-flyspell ()
491 "Unconditionally turn on Flyspell mode."
492 (flyspell-mode 1))
493
494 ;;;###autoload
495 (defun turn-off-flyspell ()
496 "Unconditionally turn off Flyspell mode."
497 (flyspell-mode -1))
498
499 (custom-add-option 'text-mode-hook 'turn-on-flyspell)
500
501 ;;*---------------------------------------------------------------------*/
502 ;;* flyspell-buffers ... */
503 ;;* ------------------------------------------------------------- */
504 ;;* For remembering buffers running flyspell */
505 ;;*---------------------------------------------------------------------*/
506 (defvar flyspell-buffers nil)
507
508 ;;*---------------------------------------------------------------------*/
509 ;;* flyspell-minibuffer-p ... */
510 ;;*---------------------------------------------------------------------*/
511 (defun flyspell-minibuffer-p (buffer)
512 "Is BUFFER a minibuffer?"
513 (let ((ws (get-buffer-window-list buffer t)))
514 (and (consp ws) (window-minibuffer-p (car ws)))))
515
516 ;;*---------------------------------------------------------------------*/
517 ;;* flyspell-accept-buffer-local-defs ... */
518 ;;*---------------------------------------------------------------------*/
519 (defvar flyspell-last-buffer nil
520 "The buffer in which the last flyspell operation took place.")
521
522 (defun flyspell-accept-buffer-local-defs (&optional force)
523 ;; When flyspell-word is used inside a loop (e.g. when processing
524 ;; flyspell-changes), the calls to `ispell-accept-buffer-local-defs' end
525 ;; up dwarfing everything else, so only do it when the buffer has changed.
526 (when (or force (not (eq flyspell-last-buffer (current-buffer))))
527 (setq flyspell-last-buffer (current-buffer))
528 ;; Strange problem: If buffer in current window has font-lock turned on,
529 ;; but SET-BUFFER was called to point to an invisible buffer, this ispell
530 ;; call will reset the buffer to the buffer in the current window.
531 ;; However, it only happens at startup (fix by Albert L. Ting).
532 (save-current-buffer
533 (ispell-accept-buffer-local-defs))
534 (unless (and (eq flyspell-dash-dictionary ispell-dictionary)
535 (eq flyspell-dash-local-dictionary ispell-local-dictionary))
536 ;; The dictionary has changed
537 (setq flyspell-dash-dictionary ispell-dictionary)
538 (setq flyspell-dash-local-dictionary ispell-local-dictionary)
539 (setq flyspell-consider-dash-as-word-delimiter-flag
540 (member (or ispell-local-dictionary ispell-dictionary)
541 flyspell-dictionaries-that-consider-dash-as-word-delimiter)))))
542
543 (defun flyspell-kill-ispell-hook ()
544 (setq flyspell-last-buffer nil)
545 (dolist (buf (buffer-list))
546 (with-current-buffer buf
547 (kill-local-variable 'flyspell-word-cache-word))))
548
549 ;; Make sure we flush our caches when needed. Do it here rather than in
550 ;; flyspell-mode-on, since flyspell-region may be used without ever turning
551 ;; on flyspell-mode.
552 (add-hook 'ispell-kill-ispell-hook 'flyspell-kill-ispell-hook)
553
554 ;;*---------------------------------------------------------------------*/
555 ;;* flyspell-mode-on ... */
556 ;;*---------------------------------------------------------------------*/
557 (defun flyspell-mode-on ()
558 "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead."
559 (ispell-maybe-find-aspell-dictionaries)
560 (setq ispell-highlight-face 'flyspell-incorrect)
561 ;; local dictionaries setup
562 (or ispell-local-dictionary ispell-dictionary
563 (if flyspell-default-dictionary
564 (ispell-change-dictionary flyspell-default-dictionary)))
565 ;; we have to force ispell to accept the local definition or
566 ;; otherwise it could be too late, the local dictionary may
567 ;; be forgotten!
568 ;; Pass the `force' argument for the case where flyspell was active already
569 ;; but the buffer's local-defs have been edited.
570 (flyspell-accept-buffer-local-defs 'force)
571 ;; we put the `flyspell-delayed' property on some commands
572 (flyspell-delay-commands)
573 ;; we put the `flyspell-deplacement' property on some commands
574 (flyspell-deplacement-commands)
575 ;; we bound flyspell action to post-command hook
576 (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)
577 ;; we bound flyspell action to pre-command hook
578 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
579 ;; we bound flyspell action to after-change hook
580 (add-hook 'after-change-functions 'flyspell-after-change-function nil t)
581 ;; set flyspell-generic-check-word-predicate based on the major mode
582 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
583 (if mode-predicate
584 (setq flyspell-generic-check-word-predicate mode-predicate)))
585 ;; the welcome message
586 (if (and flyspell-issue-message-flag
587 flyspell-issue-welcome-flag
588 (interactive-p))
589 (let ((binding (where-is-internal 'flyspell-auto-correct-word
590 nil 'non-ascii)))
591 (message "%s"
592 (if binding
593 (format "Welcome to flyspell. Use %s or Mouse-2 to correct words."
594 (key-description binding))
595 "Welcome to flyspell. Use Mouse-2 to correct words."))))
596 ;; we end with the flyspell hooks
597 (run-hooks 'flyspell-mode-hook))
598
599 ;;*---------------------------------------------------------------------*/
600 ;;* flyspell-delay-commands ... */
601 ;;*---------------------------------------------------------------------*/
602 (defun flyspell-delay-commands ()
603 "Install the standard set of Flyspell delayed commands."
604 (mapcar 'flyspell-delay-command flyspell-default-delayed-commands)
605 (mapcar 'flyspell-delay-command flyspell-delayed-commands))
606
607 ;;*---------------------------------------------------------------------*/
608 ;;* flyspell-delay-command ... */
609 ;;*---------------------------------------------------------------------*/
610 (defun flyspell-delay-command (command)
611 "Set COMMAND to be delayed, for Flyspell.
612 When flyspell `post-command-hook' is invoked because a delayed command
613 as been used the current word is not immediately checked.
614 It will be checked only after `flyspell-delay' seconds."
615 (interactive "SDelay Flyspell after Command: ")
616 (put command 'flyspell-delayed t))
617
618 ;;*---------------------------------------------------------------------*/
619 ;;* flyspell-deplacement-commands ... */
620 ;;*---------------------------------------------------------------------*/
621 (defun flyspell-deplacement-commands ()
622 "Install the standard set of Flyspell deplacement commands."
623 (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands)
624 (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands))
625
626 ;;*---------------------------------------------------------------------*/
627 ;;* flyspell-deplacement-command ... */
628 ;;*---------------------------------------------------------------------*/
629 (defun flyspell-deplacement-command (command)
630 "Set COMMAND that implement cursor movements, for Flyspell.
631 When flyspell `post-command-hook' is invoked because of a deplacement command
632 as been used the current word is checked only if the previous command was
633 not the very same deplacement command."
634 (interactive "SDeplacement Flyspell after Command: ")
635 (put command 'flyspell-deplacement t))
636
637 ;;*---------------------------------------------------------------------*/
638 ;;* flyspell-word-cache ... */
639 ;;*---------------------------------------------------------------------*/
640 (defvar flyspell-word-cache-start nil)
641 (defvar flyspell-word-cache-end nil)
642 (defvar flyspell-word-cache-word nil)
643 (defvar flyspell-word-cache-result '_)
644 (make-variable-buffer-local 'flyspell-word-cache-start)
645 (make-variable-buffer-local 'flyspell-word-cache-end)
646 (make-variable-buffer-local 'flyspell-word-cache-word)
647 (make-variable-buffer-local 'flyspell-word-cache-result)
648
649 ;;*---------------------------------------------------------------------*/
650 ;;* The flyspell pre-hook, store the current position. In the */
651 ;;* post command hook, we will check, if the word at this position */
652 ;;* has to be spell checked. */
653 ;;*---------------------------------------------------------------------*/
654 (defvar flyspell-pre-buffer nil)
655 (defvar flyspell-pre-point nil)
656 (defvar flyspell-pre-column nil)
657 (defvar flyspell-pre-pre-buffer nil)
658 (defvar flyspell-pre-pre-point nil)
659
660 ;;*---------------------------------------------------------------------*/
661 ;;* flyspell-previous-command ... */
662 ;;*---------------------------------------------------------------------*/
663 (defvar flyspell-previous-command nil
664 "The last interactive command checked by Flyspell.")
665
666 ;;*---------------------------------------------------------------------*/
667 ;;* flyspell-pre-command-hook ... */
668 ;;*---------------------------------------------------------------------*/
669 (defun flyspell-pre-command-hook ()
670 "Save the current buffer and point for Flyspell's post-command hook."
671 (interactive)
672 (setq flyspell-pre-buffer (current-buffer))
673 (setq flyspell-pre-point (point))
674 (setq flyspell-pre-column (current-column)))
675
676 ;;*---------------------------------------------------------------------*/
677 ;;* flyspell-mode-off ... */
678 ;;*---------------------------------------------------------------------*/
679 ;;;###autoload
680 (defun flyspell-mode-off ()
681 "Turn Flyspell mode off."
682 ;; we remove the hooks
683 (remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
684 (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
685 (remove-hook 'after-change-functions 'flyspell-after-change-function t)
686 ;; we remove all the flyspell hilightings
687 (flyspell-delete-all-overlays)
688 ;; we have to erase pre cache variables
689 (setq flyspell-pre-buffer nil)
690 (setq flyspell-pre-point nil)
691 ;; we mark the mode as killed
692 (setq flyspell-mode nil))
693
694 ;;*---------------------------------------------------------------------*/
695 ;;* flyspell-check-pre-word-p ... */
696 ;;*---------------------------------------------------------------------*/
697 (defun flyspell-check-pre-word-p ()
698 "Return non-nil if we should check the word before point.
699 More precisely, it applies to the word that was before point
700 before the current command."
701 (cond
702 ((or (not (numberp flyspell-pre-point))
703 (not (bufferp flyspell-pre-buffer))
704 (not (buffer-live-p flyspell-pre-buffer)))
705 nil)
706 ((and (eq flyspell-pre-pre-point flyspell-pre-point)
707 (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
708 nil)
709 ((or (and (= flyspell-pre-point (- (point) 1))
710 (eq (char-syntax (char-after flyspell-pre-point)) ?w))
711 (= flyspell-pre-point (point))
712 (= flyspell-pre-point (+ (point) 1)))
713 nil)
714 ((and (symbolp this-command)
715 (not executing-kbd-macro)
716 (or (get this-command 'flyspell-delayed)
717 (and (get this-command 'flyspell-deplacement)
718 (eq flyspell-previous-command this-command)))
719 (or (= (current-column) 0)
720 (= (current-column) flyspell-pre-column)
721 (eq (char-syntax (char-after flyspell-pre-point)) ?w)))
722 nil)
723 ((not (eq (current-buffer) flyspell-pre-buffer))
724 t)
725 ((not (and (numberp flyspell-word-cache-start)
726 (numberp flyspell-word-cache-end)))
727 t)
728 (t
729 (or (< flyspell-pre-point flyspell-word-cache-start)
730 (> flyspell-pre-point flyspell-word-cache-end)))))
731
732 ;;*---------------------------------------------------------------------*/
733 ;;* The flyspell after-change-hook, store the change position. In */
734 ;;* the post command hook, we will check, if the word at this */
735 ;;* position has to be spell checked. */
736 ;;*---------------------------------------------------------------------*/
737 (defvar flyspell-changes nil)
738 (make-variable-buffer-local 'flyspell-changes)
739
740 ;;*---------------------------------------------------------------------*/
741 ;;* flyspell-after-change-function ... */
742 ;;*---------------------------------------------------------------------*/
743 (defun flyspell-after-change-function (start stop len)
744 "Save the current buffer and point for Flyspell's post-command hook."
745 (push (cons start stop) flyspell-changes))
746
747 ;;*---------------------------------------------------------------------*/
748 ;;* flyspell-check-changed-word-p ... */
749 ;;*---------------------------------------------------------------------*/
750 (defun flyspell-check-changed-word-p (start stop)
751 "Return t when the changed word has to be checked.
752 The answer depends of several criteria.
753 Mostly we check word delimiters."
754 (cond
755 ((and (memq (char-after start) '(?\n ? )) (> stop start))
756 t)
757 ((not (numberp flyspell-pre-point))
758 t)
759 ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
760 nil)
761 ((let ((pos (point)))
762 (or (>= pos start) (<= pos stop) (= pos (1+ stop))))
763 nil)
764 (t
765 t)))
766
767 ;;*---------------------------------------------------------------------*/
768 ;;* flyspell-check-word-p ... */
769 ;;*---------------------------------------------------------------------*/
770 (defun flyspell-check-word-p ()
771 "Return t when the word at `point' has to be checked.
772 The answer depends of several criteria.
773 Mostly we check word delimiters."
774 (cond
775 ((<= (- (point-max) 1) (point-min))
776 ;; the buffer is not filled enough
777 nil)
778 ((and (and (> (current-column) 0)
779 (not (eq (current-column) flyspell-pre-column)))
780 (save-excursion
781 (backward-char 1)
782 (and (looking-at (flyspell-get-not-casechars))
783 (or flyspell-consider-dash-as-word-delimiter-flag
784 (not (looking-at "-"))))))
785 ;; yes because we have reached or typed a word delimiter.
786 t)
787 ((symbolp this-command)
788 (cond
789 ((get this-command 'flyspell-deplacement)
790 (not (eq flyspell-previous-command this-command)))
791 ((get this-command 'flyspell-delayed)
792 ;; the current command is not delayed, that
793 ;; is that we must check the word now
794 (and (not unread-command-events)
795 (sit-for flyspell-delay)))
796 (t t)))
797 (t t)))
798
799 ;;*---------------------------------------------------------------------*/
800 ;;* flyspell-debug-signal-no-check ... */
801 ;;*---------------------------------------------------------------------*/
802 (defun flyspell-debug-signal-no-check (msg obj)
803 (setq debug-on-error t)
804 (with-current-buffer (get-buffer-create "*flyspell-debug*")
805 (erase-buffer)
806 (insert "NO-CHECK:\n")
807 (insert (format " %S : %S\n" msg obj))))
808
809 ;;*---------------------------------------------------------------------*/
810 ;;* flyspell-debug-signal-pre-word-checked ... */
811 ;;*---------------------------------------------------------------------*/
812 (defun flyspell-debug-signal-pre-word-checked ()
813 (setq debug-on-error t)
814 (with-current-buffer (get-buffer-create "*flyspell-debug*")
815 (insert "PRE-WORD:\n")
816 (insert (format " pre-point : %S\n" flyspell-pre-point))
817 (insert (format " pre-buffer : %S\n" flyspell-pre-buffer))
818 (insert (format " cache-start: %S\n" flyspell-word-cache-start))
819 (insert (format " cache-end : %S\n" flyspell-word-cache-end))
820 (goto-char (point-max))))
821
822 ;;*---------------------------------------------------------------------*/
823 ;;* flyspell-debug-signal-word-checked ... */
824 ;;*---------------------------------------------------------------------*/
825 (defun flyspell-debug-signal-word-checked ()
826 (setq debug-on-error t)
827 (let ((oldbuf (current-buffer))
828 (point (point)))
829 (with-current-buffer (get-buffer-create "*flyspell-debug*")
830 (insert "WORD:\n")
831 (insert (format " this-cmd : %S\n" this-command))
832 (insert (format " delayed : %S\n" (and (symbolp this-command)
833 (get this-command 'flyspell-delayed))))
834 (insert (format " point : %S\n" point))
835 (insert (format " prev-char : [%c] %S\n"
836 (with-current-buffer oldbuf
837 (let ((c (if (> (point) (point-min))
838 (save-excursion
839 (backward-char 1)
840 (char-after (point)))
841 ? )))
842 c))
843 (with-current-buffer oldbuf
844 (let ((c (if (> (point) (point-min))
845 (save-excursion
846 (backward-char 1)
847 (and (and (looking-at (flyspell-get-not-casechars)) 1)
848 (and (or flyspell-consider-dash-as-word-delimiter-flag
849 (not (looking-at "\\-"))) 2))))))
850 c))))
851 (insert (format " because : %S\n"
852 (cond
853 ((not (and (symbolp this-command)
854 (get this-command 'flyspell-delayed)))
855 ;; the current command is not delayed, that
856 ;; is that we must check the word now
857 'not-delayed)
858 ((with-current-buffer oldbuf
859 (let ((c (if (> (point) (point-min))
860 (save-excursion
861 (backward-char 1)
862 (and (looking-at (flyspell-get-not-casechars))
863 (or flyspell-consider-dash-as-word-delimiter-flag
864 (not (looking-at "\\-"))))))))
865 c))
866 ;; yes because we have reached or typed a word delimiter.
867 'separator)
868 ((not (integerp flyspell-delay))
869 ;; yes because the user had set up a no-delay configuration.
870 'no-delay)
871 (t
872 'sit-for))))
873 (goto-char (point-max)))))
874
875 ;;*---------------------------------------------------------------------*/
876 ;;* flyspell-debug-signal-changed-checked ... */
877 ;;*---------------------------------------------------------------------*/
878 (defun flyspell-debug-signal-changed-checked ()
879 (setq debug-on-error t)
880 (let ((point (point)))
881 (with-current-buffer (get-buffer-create "*flyspell-debug*")
882 (insert "CHANGED WORD:\n")
883 (insert (format " point : %S\n" point))
884 (goto-char (point-max)))))
885
886 ;;*---------------------------------------------------------------------*/
887 ;;* flyspell-post-command-hook ... */
888 ;;* ------------------------------------------------------------- */
889 ;;* It is possible that we check several words: */
890 ;;* 1- the current word is checked if the predicate */
891 ;;* FLYSPELL-CHECK-WORD-P is true */
892 ;;* 2- the word that used to be the current word before the */
893 ;;* THIS-COMMAND is checked if: */
894 ;;* a- the previous word is different from the current word */
895 ;;* b- the previous word as not just been checked by the */
896 ;;* previous FLYSPELL-POST-COMMAND-HOOK */
897 ;;* 3- the words changed by the THIS-COMMAND that are neither the */
898 ;;* previous word nor the current word */
899 ;;*---------------------------------------------------------------------*/
900 (defun flyspell-post-command-hook ()
901 "The `post-command-hook' used by flyspell to check a word in-the-fly."
902 (interactive)
903 (let ((command this-command)
904 ;; Prevent anything we do from affecting the mark.
905 deactivate-mark)
906 (if (flyspell-check-pre-word-p)
907 (with-current-buffer flyspell-pre-buffer
908 '(flyspell-debug-signal-pre-word-checked)
909 (save-excursion
910 (goto-char flyspell-pre-point)
911 (flyspell-word))))
912 (if (flyspell-check-word-p)
913 (progn
914 '(flyspell-debug-signal-word-checked)
915 (flyspell-word)
916 ;; we remember which word we have just checked.
917 ;; this will be used next time we will check a word
918 ;; to compare the next current word with the word
919 ;; that as been registered in the pre-command-hook
920 ;; that is these variables are used within the predicate
921 ;; FLYSPELL-CHECK-PRE-WORD-P
922 (setq flyspell-pre-pre-buffer (current-buffer))
923 (setq flyspell-pre-pre-point (point)))
924 (progn
925 (setq flyspell-pre-pre-buffer nil)
926 (setq flyspell-pre-pre-point nil)
927 ;; when a word is not checked because of a delayed command
928 ;; we do not disable the ispell cache.
929 (if (and (symbolp this-command) (get this-command 'flyspell-delayed))
930 (progn
931 (setq flyspell-word-cache-end -1)
932 (setq flyspell-word-cache-result '_)))))
933 (while (and (not (input-pending-p)) (consp flyspell-changes))
934 (let ((start (car (car flyspell-changes)))
935 (stop (cdr (car flyspell-changes))))
936 (if (flyspell-check-changed-word-p start stop)
937 (save-excursion
938 '(flyspell-debug-signal-changed-checked)
939 (goto-char start)
940 (flyspell-word)))
941 (setq flyspell-changes (cdr flyspell-changes))))
942 (setq flyspell-previous-command command)))
943
944 ;;*---------------------------------------------------------------------*/
945 ;;* flyspell-notify-misspell ... */
946 ;;*---------------------------------------------------------------------*/
947 (defun flyspell-notify-misspell (word poss)
948 (let ((replacements (if (stringp poss)
949 poss
950 (if flyspell-sort-corrections
951 (sort (car (cdr (cdr poss))) 'string<)
952 (car (cdr (cdr poss)))))))
953 (if flyspell-issue-message-flag
954 (message "misspelling `%s' %S" word replacements))))
955
956 ;;*---------------------------------------------------------------------*/
957 ;;* flyspell-word-search-backward ... */
958 ;;*---------------------------------------------------------------------*/
959 (defun flyspell-word-search-backward (word bound)
960 (save-excursion
961 (let ((r '())
962 (inhibit-point-motion-hooks t)
963 p)
964 (while (and (not r) (setq p (search-backward word bound t)))
965 (let ((lw (flyspell-get-word '())))
966 (if (and (consp lw) (string-equal (car lw) word))
967 (setq r p)
968 (goto-char p))))
969 r)))
970
971 ;;*---------------------------------------------------------------------*/
972 ;;* flyspell-word-search-forward ... */
973 ;;*---------------------------------------------------------------------*/
974 (defun flyspell-word-search-forward (word bound)
975 (save-excursion
976 (let ((r '())
977 (inhibit-point-motion-hooks t)
978 p)
979 (while (and (not r) (setq p (search-forward word bound t)))
980 (let ((lw (flyspell-get-word '())))
981 (if (and (consp lw) (string-equal (car lw) word))
982 (setq r p)
983 (goto-char (1+ p)))))
984 r)))
985
986 ;;*---------------------------------------------------------------------*/
987 ;;* flyspell-word ... */
988 ;;*---------------------------------------------------------------------*/
989 (defun flyspell-word (&optional following)
990 "Spell check a word."
991 (interactive (list ispell-following-word))
992 (save-excursion
993 ;; use the correct dictionary
994 (flyspell-accept-buffer-local-defs)
995 (let* ((cursor-location (point))
996 (flyspell-word (flyspell-get-word following))
997 start end poss word ispell-filter)
998 (if (or (eq flyspell-word nil)
999 (and (fboundp flyspell-generic-check-word-predicate)
1000 (not (funcall flyspell-generic-check-word-predicate))))
1001 t
1002 (progn
1003 ;; destructure return flyspell-word info list.
1004 (setq start (car (cdr flyspell-word))
1005 end (car (cdr (cdr flyspell-word)))
1006 word (car flyspell-word))
1007 ;; before checking in the directory, we check for doublons.
1008 (cond
1009 ((and (or (not (eq ispell-parser 'tex))
1010 (and (> start (point-min))
1011 (not (memq (char-after (1- start)) '(?\} ?\\)))))
1012 flyspell-mark-duplications-flag
1013 (save-excursion
1014 (goto-char start)
1015 (let* ((bound
1016 (- start
1017 (- end start)
1018 (- (skip-chars-backward " \t\n\f"))))
1019 (p (when (>= bound (point-min))
1020 (flyspell-word-search-backward word bound))))
1021 (and p (/= p start)))))
1022 ;; yes, this is a doublon
1023 (flyspell-highlight-incorrect-region start end 'doublon)
1024 nil)
1025 ((and (eq flyspell-word-cache-start start)
1026 (eq flyspell-word-cache-end end)
1027 (string-equal flyspell-word-cache-word word))
1028 ;; this word had been already checked, we skip
1029 flyspell-word-cache-result)
1030 ((and (eq ispell-parser 'tex)
1031 (flyspell-tex-command-p flyspell-word))
1032 ;; this is a correct word (because a tex command)
1033 (flyspell-unhighlight-at start)
1034 (if (> end start)
1035 (flyspell-unhighlight-at (- end 1)))
1036 t)
1037 (t
1038 ;; we setup the cache
1039 (setq flyspell-word-cache-start start)
1040 (setq flyspell-word-cache-end end)
1041 (setq flyspell-word-cache-word word)
1042 ;; now check spelling of word.
1043 (ispell-send-string "%\n")
1044 ;; put in verbose mode
1045 (ispell-send-string (concat "^" word "\n"))
1046 ;; we mark the ispell process so it can be killed
1047 ;; when emacs is exited without query
1048 (set-process-query-on-exit-flag ispell-process nil)
1049 ;; Wait until ispell has processed word. Since this code is often
1050 ;; executed from post-command-hook but the ispell process may not
1051 ;; be responsive, it's important to make sure we re-enable C-g.
1052 (with-local-quit
1053 (while (progn
1054 (accept-process-output ispell-process)
1055 (not (string= "" (car ispell-filter))))))
1056 ;; (ispell-send-string "!\n")
1057 ;; back to terse mode.
1058 ;; Remove leading empty element
1059 (setq ispell-filter (cdr ispell-filter))
1060 ;; ispell process should return something after word is sent.
1061 ;; Tag word as valid (i.e., skip) otherwise
1062 (or ispell-filter
1063 (setq ispell-filter '(*)))
1064 (if (consp ispell-filter)
1065 (setq poss (ispell-parse-output (car ispell-filter))))
1066 (let ((res (cond ((eq poss t)
1067 ;; correct
1068 (setq flyspell-word-cache-result t)
1069 (flyspell-unhighlight-at start)
1070 (if (> end start)
1071 (flyspell-unhighlight-at (- end 1)))
1072 t)
1073 ((and (stringp poss) flyspell-highlight-flag)
1074 ;; correct
1075 (setq flyspell-word-cache-result t)
1076 (flyspell-unhighlight-at start)
1077 (if (> end start)
1078 (flyspell-unhighlight-at (- end 1)))
1079 t)
1080 ((null poss)
1081 (setq flyspell-word-cache-result t)
1082 (flyspell-unhighlight-at start)
1083 (if (> end start)
1084 (flyspell-unhighlight-at (- end 1)))
1085 t)
1086 ((or (and (< flyspell-duplicate-distance 0)
1087 (or (save-excursion
1088 (goto-char start)
1089 (flyspell-word-search-backward
1090 word
1091 (point-min)))
1092 (save-excursion
1093 (goto-char end)
1094 (flyspell-word-search-forward
1095 word
1096 (point-max)))))
1097 (and (> flyspell-duplicate-distance 0)
1098 (or (save-excursion
1099 (goto-char start)
1100 (flyspell-word-search-backward
1101 word
1102 (- start
1103 flyspell-duplicate-distance)))
1104 (save-excursion
1105 (goto-char end)
1106 (flyspell-word-search-forward
1107 word
1108 (+ end
1109 flyspell-duplicate-distance))))))
1110 ;; This is a misspelled word which occurs
1111 ;; twice within flyspell-duplicate-distance.
1112 (setq flyspell-word-cache-result nil)
1113 (if flyspell-highlight-flag
1114 (flyspell-highlight-duplicate-region
1115 start end poss)
1116 (message "duplicate `%s'" word))
1117 nil)
1118 (t
1119 (setq flyspell-word-cache-result nil)
1120 ;; incorrect highlight the location
1121 (if flyspell-highlight-flag
1122 (flyspell-highlight-incorrect-region
1123 start end poss)
1124 (flyspell-notify-misspell word poss))
1125 nil))))
1126 ;; return to original location
1127 (goto-char cursor-location)
1128 (if ispell-quit (setq ispell-quit nil))
1129 res))))))))
1130
1131 ;;*---------------------------------------------------------------------*/
1132 ;;* flyspell-tex-math-initialized ... */
1133 ;;*---------------------------------------------------------------------*/
1134 (defvar flyspell-tex-math-initialized nil)
1135
1136 ;;*---------------------------------------------------------------------*/
1137 ;;* flyspell-math-tex-command-p ... */
1138 ;;* ------------------------------------------------------------- */
1139 ;;* This function uses the texmathp package to check if (point) */
1140 ;;* is within a tex command. In order to avoid using */
1141 ;;* condition-case each time we use the variable */
1142 ;;* flyspell-tex-math-initialized to make a special case the first */
1143 ;;* time that function is called. */
1144 ;;*---------------------------------------------------------------------*/
1145 (defun flyspell-math-tex-command-p ()
1146 (when (fboundp 'texmathp)
1147 (cond
1148 (flyspell-check-tex-math-command
1149 nil)
1150 ((eq flyspell-tex-math-initialized t)
1151 (texmathp))
1152 ((eq flyspell-tex-math-initialized 'error)
1153 nil)
1154 (t
1155 (setq flyspell-tex-math-initialized t)
1156 (condition-case nil
1157 (texmathp)
1158 (error (progn
1159 (setq flyspell-tex-math-initialized 'error)
1160 nil)))))))
1161
1162 ;;*---------------------------------------------------------------------*/
1163 ;;* flyspell-tex-command-p ... */
1164 ;;*---------------------------------------------------------------------*/
1165 (defun flyspell-tex-command-p (word)
1166 "Return t if WORD is a TeX command."
1167 (or (save-excursion
1168 (let ((b (car (cdr word))))
1169 (and (re-search-backward "\\\\" (- (point) 100) t)
1170 (or (= (match-end 0) b)
1171 (and (goto-char (match-end 0))
1172 (looking-at flyspell-tex-command-regexp)
1173 (>= (match-end 0) b))))))
1174 (flyspell-math-tex-command-p)))
1175
1176 ;;*---------------------------------------------------------------------*/
1177 ;;* flyspell-casechars-cache ... */
1178 ;;*---------------------------------------------------------------------*/
1179 (defvar flyspell-casechars-cache nil)
1180 (defvar flyspell-ispell-casechars-cache nil)
1181 (make-variable-buffer-local 'flyspell-casechars-cache)
1182 (make-variable-buffer-local 'flyspell-ispell-casechars-cache)
1183
1184 ;;*---------------------------------------------------------------------*/
1185 ;;* flyspell-get-casechars ... */
1186 ;;*---------------------------------------------------------------------*/
1187 (defun flyspell-get-casechars ()
1188 "This function builds a string that is the regexp of word chars.
1189 In order to avoid one useless string construction,
1190 this function changes the last char of the `ispell-casechars' string."
1191 (let ((ispell-casechars (ispell-get-casechars)))
1192 (cond
1193 ((eq ispell-parser 'tex)
1194 (setq flyspell-ispell-casechars-cache ispell-casechars)
1195 (setq flyspell-casechars-cache
1196 (concat (substring ispell-casechars
1197 0
1198 (- (length ispell-casechars) 1))
1199 "]"))
1200 flyspell-casechars-cache)
1201 (t
1202 (setq flyspell-ispell-casechars-cache ispell-casechars)
1203 (setq flyspell-casechars-cache ispell-casechars)
1204 flyspell-casechars-cache))))
1205
1206 ;;*---------------------------------------------------------------------*/
1207 ;;* flyspell-get-not-casechars-cache ... */
1208 ;;*---------------------------------------------------------------------*/
1209 (defvar flyspell-not-casechars-cache nil)
1210 (defvar flyspell-ispell-not-casechars-cache nil)
1211 (make-variable-buffer-local 'flyspell-not-casechars-cache)
1212 (make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
1213
1214 ;;*---------------------------------------------------------------------*/
1215 ;;* flyspell-get-not-casechars ... */
1216 ;;*---------------------------------------------------------------------*/
1217 (defun flyspell-get-not-casechars ()
1218 "This function builds a string that is the regexp of non-word chars."
1219 (let ((ispell-not-casechars (ispell-get-not-casechars)))
1220 (cond
1221 ((eq ispell-parser 'tex)
1222 (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
1223 (setq flyspell-not-casechars-cache
1224 (concat (substring ispell-not-casechars
1225 0
1226 (- (length ispell-not-casechars) 1))
1227 "]"))
1228 flyspell-not-casechars-cache)
1229 (t
1230 (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
1231 (setq flyspell-not-casechars-cache ispell-not-casechars)
1232 flyspell-not-casechars-cache))))
1233
1234 ;;*---------------------------------------------------------------------*/
1235 ;;* flyspell-get-word ... */
1236 ;;*---------------------------------------------------------------------*/
1237 (defun flyspell-get-word (following &optional extra-otherchars)
1238 "Return the word for spell-checking according to Ispell syntax.
1239 If optional argument FOLLOWING is non-nil or if `flyspell-following-word'
1240 is non-nil when called interactively, then the following word
1241 \(rather than preceding\) is checked when the cursor is not over a word.
1242 Optional second argument contains otherchars that can be included in word
1243 many times.
1244
1245 Word syntax described by `flyspell-dictionary-alist' (which see)."
1246 (let* ((flyspell-casechars (flyspell-get-casechars))
1247 (flyspell-not-casechars (flyspell-get-not-casechars))
1248 (ispell-otherchars (ispell-get-otherchars))
1249 (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
1250 (word-regexp (concat flyspell-casechars
1251 "+\\("
1252 (if (not (string= "" ispell-otherchars))
1253 (concat ispell-otherchars "?"))
1254 (if extra-otherchars
1255 (concat extra-otherchars "?"))
1256 flyspell-casechars
1257 "+\\)"
1258 (if (or ispell-many-otherchars-p
1259 extra-otherchars)
1260 "*" "?")))
1261 did-it-once prevpt
1262 start end word)
1263 ;; find the word
1264 (if (not (looking-at flyspell-casechars))
1265 (if following
1266 (re-search-forward flyspell-casechars nil t)
1267 (re-search-backward flyspell-casechars nil t)))
1268 ;; move to front of word
1269 (re-search-backward flyspell-not-casechars nil 'start)
1270 (while (and (or (and (not (string= "" ispell-otherchars))
1271 (looking-at ispell-otherchars))
1272 (and extra-otherchars (looking-at extra-otherchars)))
1273 (not (bobp))
1274 (or (not did-it-once)
1275 ispell-many-otherchars-p)
1276 (not (eq prevpt (point))))
1277 (if (and extra-otherchars (looking-at extra-otherchars))
1278 (progn
1279 (backward-char 1)
1280 (if (looking-at flyspell-casechars)
1281 (re-search-backward flyspell-not-casechars nil 'move)))
1282 (setq did-it-once t
1283 prevpt (point))
1284 (backward-char 1)
1285 (if (looking-at flyspell-casechars)
1286 (re-search-backward flyspell-not-casechars nil 'move)
1287 (backward-char -1))))
1288 ;; Now mark the word and save to string.
1289 (if (not (re-search-forward word-regexp nil t))
1290 nil
1291 (progn
1292 (setq start (match-beginning 0)
1293 end (point)
1294 word (buffer-substring-no-properties start end))
1295 (list word start end)))))
1296
1297 ;;*---------------------------------------------------------------------*/
1298 ;;* flyspell-small-region ... */
1299 ;;*---------------------------------------------------------------------*/
1300 (defun flyspell-small-region (beg end)
1301 "Flyspell text between BEG and END."
1302 (save-excursion
1303 (if (> beg end)
1304 (let ((old beg))
1305 (setq beg end)
1306 (setq end old)))
1307 (goto-char beg)
1308 (let ((count 0))
1309 (while (< (point) end)
1310 (if (and flyspell-issue-message-flag (= count 100))
1311 (progn
1312 (message "Spell Checking...%d%%"
1313 (* 100 (/ (float (- (point) beg)) (- end beg))))
1314 (setq count 0))
1315 (setq count (+ 1 count)))
1316 (flyspell-word)
1317 (sit-for 0)
1318 (let ((cur (point)))
1319 (forward-word 1)
1320 (if (and (< (point) end) (> (point) (+ cur 1)))
1321 (backward-char 1)))))
1322 (backward-char 1)
1323 (if flyspell-issue-message-flag (message "Spell Checking completed."))
1324 (flyspell-word)))
1325
1326 ;;*---------------------------------------------------------------------*/
1327 ;;* flyspell-external-ispell-process ... */
1328 ;;*---------------------------------------------------------------------*/
1329 (defvar flyspell-external-ispell-process '()
1330 "The external Flyspell Ispell process.")
1331
1332 ;;*---------------------------------------------------------------------*/
1333 ;;* flyspell-external-ispell-buffer ... */
1334 ;;*---------------------------------------------------------------------*/
1335 (defvar flyspell-external-ispell-buffer '())
1336 (defvar flyspell-large-region-buffer '())
1337 (defvar flyspell-large-region-beg (point-min))
1338 (defvar flyspell-large-region-end (point-max))
1339
1340 ;;*---------------------------------------------------------------------*/
1341 ;;* flyspell-external-point-words ... */
1342 ;;*---------------------------------------------------------------------*/
1343 (defun flyspell-external-point-words ()
1344 "Mark words from a buffer listing incorrect words in order of appearance.
1345 The list of incorrect words should be in `flyspell-external-ispell-buffer'.
1346 \(We finish by killing that buffer and setting the variable to nil.)
1347 The buffer to mark them in is `flyspell-large-region-buffer'."
1348 (let (words-not-found
1349 (ispell-otherchars (ispell-get-otherchars))
1350 (buffer-scan-pos flyspell-large-region-beg)
1351 case-fold-search)
1352 (with-current-buffer flyspell-external-ispell-buffer
1353 (goto-char (point-min))
1354 ;; Loop over incorrect words, in the order they were reported,
1355 ;; which is also the order they appear in the buffer being checked.
1356 (while (re-search-forward "\\([^\n]+\\)\n" nil t)
1357 ;; Bind WORD to the next one.
1358 (let ((word (match-string 1)) (wordpos (point)))
1359 ;; Here there used to be code to see if WORD is the same
1360 ;; as the previous iteration, and count the number of consecutive
1361 ;; identical words, and the loop below would search for that many.
1362 ;; That code seemed to be incorrect, and on principle, should
1363 ;; be unnecessary too. -- rms.
1364 (if flyspell-issue-message-flag
1365 (message "Spell Checking...%d%% [%s]"
1366 (* 100 (/ (float (point)) (point-max)))
1367 word))
1368 (with-current-buffer flyspell-large-region-buffer
1369 (goto-char buffer-scan-pos)
1370 (let ((keep t))
1371 ;; Iterate on string search until string is found as word,
1372 ;; not as substring
1373 (while keep
1374 (if (search-forward word
1375 flyspell-large-region-end t)
1376 (let* ((found-list
1377 (save-excursion
1378 ;; Move back into the match
1379 ;; so flyspell-get-word will find it.
1380 (forward-char -1)
1381 (flyspell-get-word nil)))
1382 (found (car found-list))
1383 (found-length (length found))
1384 (misspell-length (length word)))
1385 (when (or
1386 ;; Size matches, we really found it.
1387 (= found-length misspell-length)
1388 ;; Matches as part of a boundary-char separated word
1389 (member word
1390 (split-string found ispell-otherchars))
1391 ;; Misspelling has higher length than
1392 ;; what flyspell considers the
1393 ;; word. Caused by boundary-chars
1394 ;; mismatch. Validating seems safe.
1395 (< found-length misspell-length)
1396 ;; ispell treats beginning of some TeX
1397 ;; commands as nroff control sequences
1398 ;; and strips them in the list of
1399 ;; misspelled words thus giving a
1400 ;; non-existent word. Skip if ispell
1401 ;; is used, string is a TeX command
1402 ;; (char before beginning of word is
1403 ;; backslash) and none of the previous
1404 ;; contitions match
1405 (and (not ispell-really-aspell)
1406 (save-excursion
1407 (goto-char (- (nth 1 found-list) 1))
1408 (if (looking-at "[\\]" )
1409 t
1410 nil))))
1411 (setq keep nil)
1412 (flyspell-word)
1413 ;; Search for next misspelled word will begin from
1414 ;; end of last validated match.
1415 (setq buffer-scan-pos (point))))
1416 ;; Record if misspelling is not found and try new one
1417 (add-to-list 'words-not-found
1418 (concat " -> " word " - "
1419 (int-to-string wordpos)))
1420 (setq keep nil)))))))
1421 ;; we are done
1422 (if flyspell-issue-message-flag (message "Spell Checking completed.")))
1423 ;; Warn about not found misspellings
1424 (dolist (word words-not-found)
1425 (message "%s: word not found" word))
1426 ;; Kill and forget the buffer with the list of incorrect words.
1427 (kill-buffer flyspell-external-ispell-buffer)
1428 (setq flyspell-external-ispell-buffer nil)))
1429
1430 ;;*---------------------------------------------------------------------*/
1431 ;;* flyspell-process-localwords ... */
1432 ;;* ------------------------------------------------------------- */
1433 ;;* This function is used to prevent marking of words explicitly */
1434 ;;* declared correct. */
1435 ;;*---------------------------------------------------------------------*/
1436 (defun flyspell-process-localwords (misspellings-buffer)
1437 (let (localwords case-fold-search
1438 (ispell-casechars (ispell-get-casechars)))
1439 ;; Get localwords from the original buffer
1440 (save-excursion
1441 (goto-char (point-min))
1442 ;; Localwords parsing copied from ispell.el.
1443 (while (search-forward ispell-words-keyword nil t)
1444 (let ((end (save-excursion (end-of-line) (point)))
1445 string)
1446 ;; buffer-local words separated by a space, and can contain
1447 ;; any character other than a space. Not rigorous enough.
1448 (while (re-search-forward " *\\([^ ]+\\)" end t)
1449 (setq string (buffer-substring-no-properties (match-beginning 1)
1450 (match-end 1)))
1451 ;; This can fail when string contains a word with invalid chars.
1452 ;; Error handling needs to be added between Ispell and Emacs.
1453 (if (and (< 1 (length string))
1454 (equal 0 (string-match ispell-casechars string)))
1455 (push string localwords))))))
1456 ;; Remove localwords matches from misspellings-buffer.
1457 ;; The usual mechanism of communicating the local words to ispell
1458 ;; does not affect the special ispell process used by
1459 ;; flyspell-large-region.
1460 (with-current-buffer misspellings-buffer
1461 (save-excursion
1462 (dolist (word localwords)
1463 (goto-char (point-min))
1464 (let ((regexp (concat "^" word "\n")))
1465 (while (re-search-forward regexp nil t)
1466 (delete-region (match-beginning 0) (match-end 0)))))))))
1467
1468 ;;* ---------------------------------------------------------------
1469 ;;* flyspell-check-region-doublons
1470 ;;* ---------------------------------------------------------------
1471 (defun flyspell-check-region-doublons (beg end)
1472 "Check for adjacent duplicated words (doublons) in the given region."
1473 (save-excursion
1474 (goto-char beg)
1475 (flyspell-word) ; Make sure current word is checked
1476 (backward-word 1)
1477 (while (and (< (point) end)
1478 (re-search-forward "\\<\\(\\w+\\)\\>[ \n\t\f]+\\1\\>"
1479 end 'move))
1480 (flyspell-word)
1481 (backward-word 1))
1482 (flyspell-word)))
1483
1484 ;;*---------------------------------------------------------------------*/
1485 ;;* flyspell-large-region ... */
1486 ;;*---------------------------------------------------------------------*/
1487 (defun flyspell-large-region (beg end)
1488 (let* ((curbuf (current-buffer))
1489 (buffer (get-buffer-create "*flyspell-region*")))
1490 (setq flyspell-external-ispell-buffer buffer)
1491 (setq flyspell-large-region-buffer curbuf)
1492 (setq flyspell-large-region-beg beg)
1493 (setq flyspell-large-region-end end)
1494 (flyspell-accept-buffer-local-defs)
1495 (set-buffer buffer)
1496 (erase-buffer)
1497 ;; this is done, we can start checking...
1498 (if flyspell-issue-message-flag (message "Checking region..."))
1499 (set-buffer curbuf)
1500 (ispell-check-version)
1501 (let ((c (apply 'call-process-region beg
1502 end
1503 ispell-program-name
1504 nil
1505 buffer
1506 nil
1507 (if ispell-really-aspell "list" "-l")
1508 (let (args)
1509 ;; Local dictionary becomes the global dictionary in use.
1510 (if ispell-local-dictionary
1511 (setq ispell-dictionary ispell-local-dictionary))
1512 (setq args (ispell-get-ispell-args))
1513 (if ispell-dictionary ; use specified dictionary
1514 (setq args
1515 (append (list "-d" ispell-dictionary) args)))
1516 (if ispell-personal-dictionary ; use specified pers dict
1517 (setq args
1518 (append args
1519 (list "-p"
1520 (expand-file-name
1521 ispell-personal-dictionary)))))
1522 (setq args (append args ispell-extra-args))
1523 args))))
1524 (if (eq c 0)
1525 (progn
1526 (flyspell-process-localwords buffer)
1527 (with-current-buffer curbuf
1528 (flyspell-delete-region-overlays beg end)
1529 (flyspell-check-region-doublons beg end))
1530 (flyspell-external-point-words))
1531 (error "Can't check region...")))))
1532
1533 ;;*---------------------------------------------------------------------*/
1534 ;;* flyspell-region ... */
1535 ;;* ------------------------------------------------------------- */
1536 ;;* Because `ispell -a' is too slow, it is not possible to use */
1537 ;;* it on large region. Then, when ispell is invoked on a large */
1538 ;;* text region, a new `ispell -l' process is spawned. The */
1539 ;;* pointed out words are then searched in the region a checked with */
1540 ;;* regular flyspell means. */
1541 ;;*---------------------------------------------------------------------*/
1542 ;;;###autoload
1543 (defun flyspell-region (beg end)
1544 "Flyspell text between BEG and END."
1545 (interactive "r")
1546 (if (= beg end)
1547 ()
1548 (save-excursion
1549 (if (> beg end)
1550 (let ((old beg))
1551 (setq beg end)
1552 (setq end old)))
1553 (if (and flyspell-large-region (> (- end beg) flyspell-large-region))
1554 (flyspell-large-region beg end)
1555 (flyspell-small-region beg end)))))
1556
1557 ;;*---------------------------------------------------------------------*/
1558 ;;* flyspell-buffer ... */
1559 ;;*---------------------------------------------------------------------*/
1560 ;;;###autoload
1561 (defun flyspell-buffer ()
1562 "Flyspell whole buffer."
1563 (interactive)
1564 (flyspell-region (point-min) (point-max)))
1565
1566 ;;*---------------------------------------------------------------------*/
1567 ;;* old next error position ... */
1568 ;;*---------------------------------------------------------------------*/
1569 (defvar flyspell-old-buffer-error nil)
1570 (defvar flyspell-old-pos-error nil)
1571
1572 ;;*---------------------------------------------------------------------*/
1573 ;;* flyspell-goto-next-error ... */
1574 ;;*---------------------------------------------------------------------*/
1575 (defun flyspell-goto-next-error ()
1576 "Go to the next previously detected error.
1577 In general FLYSPELL-GOTO-NEXT-ERROR must be used after
1578 FLYSPELL-BUFFER."
1579 (interactive)
1580 (let ((pos (point))
1581 (max (point-max)))
1582 (if (and (eq (current-buffer) flyspell-old-buffer-error)
1583 (eq pos flyspell-old-pos-error))
1584 (progn
1585 (if (= flyspell-old-pos-error max)
1586 ;; goto beginning of buffer
1587 (progn
1588 (message "Restarting from beginning of buffer")
1589 (goto-char (point-min)))
1590 (forward-word 1))
1591 (setq pos (point))))
1592 ;; seek the next error
1593 (while (and (< pos max)
1594 (let ((ovs (overlays-at pos))
1595 (r '()))
1596 (while (and (not r) (consp ovs))
1597 (if (flyspell-overlay-p (car ovs))
1598 (setq r t)
1599 (setq ovs (cdr ovs))))
1600 (not r)))
1601 (setq pos (1+ pos)))
1602 ;; save the current location for next invocation
1603 (setq flyspell-old-pos-error pos)
1604 (setq flyspell-old-buffer-error (current-buffer))
1605 (goto-char pos)
1606 (if (= pos max)
1607 (message "No more miss-spelled word!"))))
1608
1609 ;;*---------------------------------------------------------------------*/
1610 ;;* flyspell-overlay-p ... */
1611 ;;*---------------------------------------------------------------------*/
1612 (defun flyspell-overlay-p (o)
1613 "A predicate that return true iff O is an overlay used by flyspell."
1614 (and (overlayp o) (overlay-get o 'flyspell-overlay)))
1615
1616 ;;*---------------------------------------------------------------------*/
1617 ;;* flyspell-delete-region-overlays, flyspell-delete-all-overlays */
1618 ;;* ------------------------------------------------------------- */
1619 ;;* Remove overlays introduced by flyspell. */
1620 ;;*---------------------------------------------------------------------*/
1621 (defun flyspell-delete-region-overlays (beg end)
1622 "Delete overlays used by flyspell in a given region."
1623 (remove-overlays beg end 'flyspell-overlay t))
1624
1625
1626 (defun flyspell-delete-all-overlays ()
1627 "Delete all the overlays used by flyspell."
1628 (remove-overlays (point-min) (point-max) 'flyspell-overlay t))
1629
1630 ;;*---------------------------------------------------------------------*/
1631 ;;* flyspell-unhighlight-at ... */
1632 ;;*---------------------------------------------------------------------*/
1633 (defun flyspell-unhighlight-at (pos)
1634 "Remove the flyspell overlay that are located at POS."
1635 (if flyspell-persistent-highlight
1636 (let ((overlays (overlays-at pos)))
1637 (while (consp overlays)
1638 (if (flyspell-overlay-p (car overlays))
1639 (delete-overlay (car overlays)))
1640 (setq overlays (cdr overlays))))
1641 (if (flyspell-overlay-p flyspell-overlay)
1642 (delete-overlay flyspell-overlay))))
1643
1644 ;;*---------------------------------------------------------------------*/
1645 ;;* flyspell-properties-at-p ... */
1646 ;;* ------------------------------------------------------------- */
1647 ;;* Is there an highlight properties at position pos? */
1648 ;;*---------------------------------------------------------------------*/
1649 (defun flyspell-properties-at-p (pos)
1650 "Return t if there is a text property at POS, not counting `local-map'.
1651 If variable `flyspell-highlight-properties' is set to nil,
1652 text with properties are not checked. This function is used to discover
1653 if the character at POS has any other property."
1654 (let ((prop (text-properties-at pos))
1655 (keep t))
1656 (while (and keep (consp prop))
1657 (if (and (eq (car prop) 'local-map) (consp (cdr prop)))
1658 (setq prop (cdr (cdr prop)))
1659 (setq keep nil)))
1660 (consp prop)))
1661
1662 ;;*---------------------------------------------------------------------*/
1663 ;;* make-flyspell-overlay ... */
1664 ;;*---------------------------------------------------------------------*/
1665 (defun make-flyspell-overlay (beg end face mouse-face)
1666 "Allocate an overlay to highlight an incorrect word.
1667 BEG and END specify the range in the buffer of that word.
1668 FACE and MOUSE-FACE specify the `face' and `mouse-face' properties
1669 for the overlay."
1670 (let ((overlay (make-overlay beg end nil t nil)))
1671 (overlay-put overlay 'face face)
1672 (overlay-put overlay 'mouse-face mouse-face)
1673 (overlay-put overlay 'flyspell-overlay t)
1674 (overlay-put overlay 'evaporate t)
1675 (overlay-put overlay 'help-echo "mouse-2: correct word at point")
1676 (overlay-put overlay 'keymap flyspell-mouse-map)
1677 (when (eq face 'flyspell-incorrect)
1678 (and (stringp flyspell-before-incorrect-word-string)
1679 (overlay-put overlay 'before-string
1680 flyspell-before-incorrect-word-string))
1681 (and (stringp flyspell-after-incorrect-word-string)
1682 (overlay-put overlay 'after-string
1683 flyspell-after-incorrect-word-string)))
1684 overlay))
1685
1686 ;;*---------------------------------------------------------------------*/
1687 ;;* flyspell-highlight-incorrect-region ... */
1688 ;;*---------------------------------------------------------------------*/
1689 (defun flyspell-highlight-incorrect-region (beg end poss)
1690 "Set up an overlay on a misspelled word, in the buffer from BEG to END.
1691 POSS is usually a list of possible spelling/correction lists,
1692 as returned by `ispell-parse-output'.
1693 It can also be the symbol `doublon', in the case where the word
1694 is itself incorrect, but suspiciously repeated."
1695 (let ((inhibit-read-only t))
1696 (unless (run-hook-with-args-until-success
1697 'flyspell-incorrect-hook beg end poss)
1698 (if (or flyspell-highlight-properties
1699 (not (flyspell-properties-at-p beg)))
1700 (progn
1701 ;; we cleanup all the overlay that are in the region, not
1702 ;; beginning at the word start position
1703 (if (< (1+ beg) end)
1704 (let ((os (overlays-in (1+ beg) end)))
1705 (while (consp os)
1706 (if (flyspell-overlay-p (car os))
1707 (delete-overlay (car os)))
1708 (setq os (cdr os)))))
1709 ;; we cleanup current overlay at the same position
1710 (flyspell-unhighlight-at beg)
1711 ;; now we can use a new overlay
1712 (setq flyspell-overlay
1713 (make-flyspell-overlay
1714 beg end
1715 (if (eq poss 'doublon) 'flyspell-duplicate 'flyspell-incorrect)
1716 'highlight)))))))
1717
1718 ;;*---------------------------------------------------------------------*/
1719 ;;* flyspell-highlight-duplicate-region ... */
1720 ;;*---------------------------------------------------------------------*/
1721 (defun flyspell-highlight-duplicate-region (beg end poss)
1722 "Set up an overlay on a duplicate misspelled word, in the buffer from BEG to END.
1723 POSS is a list of possible spelling/correction lists,
1724 as returned by `ispell-parse-output'."
1725 (let ((inhibit-read-only t))
1726 (unless (run-hook-with-args-until-success
1727 'flyspell-incorrect-hook beg end poss)
1728 (if (or flyspell-highlight-properties
1729 (not (flyspell-properties-at-p beg)))
1730 (progn
1731 ;; we cleanup current overlay at the same position
1732 (flyspell-unhighlight-at beg)
1733 ;; now we can use a new overlay
1734 (setq flyspell-overlay
1735 (make-flyspell-overlay beg end
1736 'flyspell-duplicate
1737 'highlight)))))))
1738
1739 ;;*---------------------------------------------------------------------*/
1740 ;;* flyspell-auto-correct-cache ... */
1741 ;;*---------------------------------------------------------------------*/
1742 (defvar flyspell-auto-correct-pos nil)
1743 (defvar flyspell-auto-correct-region nil)
1744 (defvar flyspell-auto-correct-ring nil)
1745 (defvar flyspell-auto-correct-word nil)
1746 (make-variable-buffer-local 'flyspell-auto-correct-pos)
1747 (make-variable-buffer-local 'flyspell-auto-correct-region)
1748 (make-variable-buffer-local 'flyspell-auto-correct-ring)
1749 (make-variable-buffer-local 'flyspell-auto-correct-word)
1750
1751 ;;*---------------------------------------------------------------------*/
1752 ;;* flyspell-check-previous-highlighted-word ... */
1753 ;;*---------------------------------------------------------------------*/
1754 (defun flyspell-check-previous-highlighted-word (&optional arg)
1755 "Correct the closer misspelled word.
1756 This function scans a mis-spelled word before the cursor. If it finds one
1757 it proposes replacement for that word. With prefix arg, count that many
1758 misspelled words backwards."
1759 (interactive)
1760 (let ((pos1 (point))
1761 (pos (point))
1762 (arg (if (or (not (numberp arg)) (< arg 1)) 1 arg))
1763 ov ovs)
1764 (if (catch 'exit
1765 (while (and (setq pos (previous-overlay-change pos))
1766 (not (= pos pos1)))
1767 (setq pos1 pos)
1768 (if (> pos (point-min))
1769 (progn
1770 (setq ovs (overlays-at (1- pos)))
1771 (while (consp ovs)
1772 (setq ov (car ovs))
1773 (setq ovs (cdr ovs))
1774 (if (and (flyspell-overlay-p ov)
1775 (= 0 (setq arg (1- arg))))
1776 (throw 'exit t)))))))
1777 (save-excursion
1778 (goto-char pos)
1779 (ispell-word))
1780 (error "No word to correct before point"))))
1781
1782 ;;*---------------------------------------------------------------------*/
1783 ;;* flyspell-display-next-corrections ... */
1784 ;;*---------------------------------------------------------------------*/
1785 (defun flyspell-display-next-corrections (corrections)
1786 (let ((string "Corrections:")
1787 (l corrections)
1788 (pos '()))
1789 (while (< (length string) 80)
1790 (if (equal (car l) flyspell-auto-correct-word)
1791 (setq pos (cons (+ 1 (length string)) pos)))
1792 (setq string (concat string " " (car l)))
1793 (setq l (cdr l)))
1794 (while (consp pos)
1795 (let ((num (car pos)))
1796 (put-text-property num
1797 (+ num (length flyspell-auto-correct-word))
1798 'face 'flyspell-incorrect
1799 string))
1800 (setq pos (cdr pos)))
1801 (if (fboundp 'display-message)
1802 (display-message 'no-log string)
1803 (message "%s" string))))
1804
1805 ;;*---------------------------------------------------------------------*/
1806 ;;* flyspell-abbrev-table ... */
1807 ;;*---------------------------------------------------------------------*/
1808 (defun flyspell-abbrev-table ()
1809 (if flyspell-use-global-abbrev-table-p
1810 global-abbrev-table
1811 (or local-abbrev-table global-abbrev-table)))
1812
1813 ;;*---------------------------------------------------------------------*/
1814 ;;* flyspell-define-abbrev ... */
1815 ;;*---------------------------------------------------------------------*/
1816 (defun flyspell-define-abbrev (name expansion)
1817 (let ((table (flyspell-abbrev-table)))
1818 (when table
1819 (define-abbrev table name expansion))))
1820
1821 ;;*---------------------------------------------------------------------*/
1822 ;;* flyspell-auto-correct-word ... */
1823 ;;*---------------------------------------------------------------------*/
1824 (defun flyspell-auto-correct-word ()
1825 "Correct the current word.
1826 This command proposes various successive corrections for the current word."
1827 (interactive)
1828 (let ((pos (point))
1829 (old-max (point-max)))
1830 ;; use the correct dictionary
1831 (flyspell-accept-buffer-local-defs)
1832 (if (and (eq flyspell-auto-correct-pos pos)
1833 (consp flyspell-auto-correct-region))
1834 ;; we have already been using the function at the same location
1835 (let* ((start (car flyspell-auto-correct-region))
1836 (len (cdr flyspell-auto-correct-region)))
1837 (flyspell-unhighlight-at start)
1838 (delete-region start (+ start len))
1839 (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring))
1840 (let* ((word (car flyspell-auto-correct-ring))
1841 (len (length word)))
1842 (rplacd flyspell-auto-correct-region len)
1843 (goto-char start)
1844 (if flyspell-abbrev-p
1845 (if (flyspell-already-abbrevp (flyspell-abbrev-table)
1846 flyspell-auto-correct-word)
1847 (flyspell-change-abbrev (flyspell-abbrev-table)
1848 flyspell-auto-correct-word
1849 word)
1850 (flyspell-define-abbrev flyspell-auto-correct-word word)))
1851 (funcall flyspell-insert-function word)
1852 (flyspell-word)
1853 (flyspell-display-next-corrections flyspell-auto-correct-ring))
1854 (flyspell-ajust-cursor-point pos (point) old-max)
1855 (setq flyspell-auto-correct-pos (point)))
1856 ;; fetch the word to be checked
1857 (let ((word (flyspell-get-word nil)))
1858 (if (consp word)
1859 (let ((start (car (cdr word)))
1860 (end (car (cdr (cdr word))))
1861 (word (car word))
1862 poss ispell-filter)
1863 (setq flyspell-auto-correct-word word)
1864 ;; now check spelling of word.
1865 (ispell-send-string "%\n") ;put in verbose mode
1866 (ispell-send-string (concat "^" word "\n"))
1867 ;; wait until ispell has processed word.
1868 (while (progn
1869 (accept-process-output ispell-process)
1870 (not (string= "" (car ispell-filter)))))
1871 ;; Remove leading empty element
1872 (setq ispell-filter (cdr ispell-filter))
1873 ;; ispell process should return something after word is sent.
1874 ;; Tag word as valid (i.e., skip) otherwise
1875 (or ispell-filter
1876 (setq ispell-filter '(*)))
1877 (if (consp ispell-filter)
1878 (setq poss (ispell-parse-output (car ispell-filter))))
1879 (cond
1880 ((or (eq poss t) (stringp poss))
1881 ;; don't correct word
1882 t)
1883 ((null poss)
1884 ;; ispell error
1885 (error "Ispell: error in Ispell process"))
1886 (t
1887 ;; the word is incorrect, we have to propose a replacement
1888 (let ((replacements (if flyspell-sort-corrections
1889 (sort (car (cdr (cdr poss))) 'string<)
1890 (car (cdr (cdr poss))))))
1891 (setq flyspell-auto-correct-region nil)
1892 (if (consp replacements)
1893 (progn
1894 (let ((replace (car replacements)))
1895 (let ((new-word replace))
1896 (if (not (equal new-word (car poss)))
1897 (progn
1898 ;; the save the current replacements
1899 (setq flyspell-auto-correct-region
1900 (cons start (length new-word)))
1901 (let ((l replacements))
1902 (while (consp (cdr l))
1903 (setq l (cdr l)))
1904 (rplacd l (cons (car poss) replacements)))
1905 (setq flyspell-auto-correct-ring
1906 replacements)
1907 (flyspell-unhighlight-at start)
1908 (delete-region start end)
1909 (funcall flyspell-insert-function new-word)
1910 (if flyspell-abbrev-p
1911 (if (flyspell-already-abbrevp
1912 (flyspell-abbrev-table) word)
1913 (flyspell-change-abbrev
1914 (flyspell-abbrev-table)
1915 word
1916 new-word)
1917 (flyspell-define-abbrev word
1918 new-word)))
1919 (flyspell-word)
1920 (flyspell-display-next-corrections
1921 (cons new-word flyspell-auto-correct-ring))
1922 (flyspell-ajust-cursor-point pos
1923 (point)
1924 old-max))))))))))
1925 (setq flyspell-auto-correct-pos (point))
1926 (ispell-pdict-save t)))))))
1927
1928 ;;*---------------------------------------------------------------------*/
1929 ;;* flyspell-auto-correct-previous-pos ... */
1930 ;;*---------------------------------------------------------------------*/
1931 (defvar flyspell-auto-correct-previous-pos nil
1932 "Holds the start of the first incorrect word before point.")
1933
1934 ;;*---------------------------------------------------------------------*/
1935 ;;* flyspell-auto-correct-previous-hook ... */
1936 ;;*---------------------------------------------------------------------*/
1937 (defun flyspell-auto-correct-previous-hook ()
1938 "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
1939 Sets `flyspell-auto-correct-previous-pos' to nil"
1940 (interactive)
1941 (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t)
1942 (unless (eq this-command (function flyspell-auto-correct-previous-word))
1943 (setq flyspell-auto-correct-previous-pos nil)))
1944
1945 ;;*---------------------------------------------------------------------*/
1946 ;;* flyspell-auto-correct-previous-word ... */
1947 ;;*---------------------------------------------------------------------*/
1948 (defun flyspell-auto-correct-previous-word (position)
1949 "Auto correct the first mispelled word that occurs before point.
1950 But don't look beyond what's visible on the screen."
1951 (interactive "d")
1952
1953 (let (top bot)
1954 (save-excursion
1955 (move-to-window-line 0)
1956 (setq top (point))
1957 (move-to-window-line -1)
1958 (setq bot (point)))
1959 (save-excursion
1960 (save-restriction
1961 (narrow-to-region top bot)
1962 (overlay-recenter (point))
1963
1964 (add-hook 'pre-command-hook
1965 (function flyspell-auto-correct-previous-hook) t t)
1966
1967 (unless flyspell-auto-correct-previous-pos
1968 ;; only reset if a new overlay exists
1969 (setq flyspell-auto-correct-previous-pos nil)
1970
1971 (let ((overlay-list (overlays-in (point-min) position))
1972 (new-overlay 'dummy-value))
1973
1974 ;; search for previous (new) flyspell overlay
1975 (while (and new-overlay
1976 (or (not (flyspell-overlay-p new-overlay))
1977 ;; check if its face has changed
1978 (not (eq (get-char-property
1979 (overlay-start new-overlay) 'face)
1980 'flyspell-incorrect))))
1981 (setq new-overlay (car-safe overlay-list))
1982 (setq overlay-list (cdr-safe overlay-list)))
1983
1984 ;; if nothing new exits new-overlay should be nil
1985 (if new-overlay ;; the length of the word may change so go to the start
1986 (setq flyspell-auto-correct-previous-pos
1987 (overlay-start new-overlay)))))
1988
1989 (when flyspell-auto-correct-previous-pos
1990 (save-excursion
1991 (goto-char flyspell-auto-correct-previous-pos)
1992 (let ((ispell-following-word t)) ;; point is at start
1993 (if (numberp flyspell-auto-correct-previous-pos)
1994 (goto-char flyspell-auto-correct-previous-pos))
1995 (flyspell-auto-correct-word))
1996 ;; the point may have moved so reset this
1997 (setq flyspell-auto-correct-previous-pos (point))))))))
1998
1999 ;;*---------------------------------------------------------------------*/
2000 ;;* flyspell-correct-word ... */
2001 ;;*---------------------------------------------------------------------*/
2002 (defun flyspell-correct-word (event)
2003 "Pop up a menu of possible corrections for a misspelled word.
2004 The word checked is the word at the mouse position."
2005 (interactive "e")
2006 ;; use the correct dictionary
2007 (flyspell-accept-buffer-local-defs)
2008 ;; retain cursor location (I don't know why but save-excursion here fails).
2009 (let ((save (point)))
2010 (mouse-set-point event)
2011 (let ((cursor-location (point))
2012 (word (flyspell-get-word nil)))
2013 (if (consp word)
2014 (let ((start (car (cdr word)))
2015 (end (car (cdr (cdr word))))
2016 (word (car word))
2017 poss ispell-filter)
2018 ;; now check spelling of word.
2019 (ispell-send-string "%\n") ;put in verbose mode
2020 (ispell-send-string (concat "^" word "\n"))
2021 ;; wait until ispell has processed word
2022 (while (progn
2023 (accept-process-output ispell-process)
2024 (not (string= "" (car ispell-filter)))))
2025 ;; Remove leading empty element
2026 (setq ispell-filter (cdr ispell-filter))
2027 ;; ispell process should return something after word is sent.
2028 ;; Tag word as valid (i.e., skip) otherwise
2029 (or ispell-filter
2030 (setq ispell-filter '(*)))
2031 (if (consp ispell-filter)
2032 (setq poss (ispell-parse-output (car ispell-filter))))
2033 (cond
2034 ((or (eq poss t) (stringp poss))
2035 ;; don't correct word
2036 t)
2037 ((null poss)
2038 ;; ispell error
2039 (error "Ispell: error in Ispell process"))
2040 ((featurep 'xemacs)
2041 (flyspell-xemacs-popup
2042 poss word cursor-location start end save))
2043 (t
2044 ;; The word is incorrect, we have to propose a replacement.
2045 (flyspell-do-correct (flyspell-emacs-popup event poss word)
2046 poss word cursor-location start end save)))
2047 (ispell-pdict-save t))))))
2048
2049 ;;*---------------------------------------------------------------------*/
2050 ;;* flyspell-do-correct ... */
2051 ;;*---------------------------------------------------------------------*/
2052 (defun flyspell-do-correct (replace poss word cursor-location start end save)
2053 "The popup menu callback."
2054 ;; Originally, the XEmacs code didn't do the (goto-char save) here and did
2055 ;; it instead right after calling the function.
2056 (cond ((eq replace 'ignore)
2057 (goto-char save)
2058 nil)
2059 ((eq replace 'save)
2060 (goto-char save)
2061 (ispell-send-string (concat "*" word "\n"))
2062 ;; This was added only to the XEmacs side in revision 1.18 of
2063 ;; flyspell. I assume its absence on the Emacs side was an
2064 ;; oversight. --Stef
2065 (ispell-send-string "#\n")
2066 (flyspell-unhighlight-at cursor-location)
2067 (setq ispell-pdict-modified-p '(t)))
2068 ((or (eq replace 'buffer) (eq replace 'session))
2069 (ispell-send-string (concat "@" word "\n"))
2070 (flyspell-unhighlight-at cursor-location)
2071 (if (null ispell-pdict-modified-p)
2072 (setq ispell-pdict-modified-p
2073 (list ispell-pdict-modified-p)))
2074 (goto-char save)
2075 (if (eq replace 'buffer)
2076 (ispell-add-per-file-word-list word)))
2077 (replace
2078 ;; This was added only to the Emacs side. I assume its absence on
2079 ;; the XEmacs side was an oversight. --Stef
2080 (flyspell-unhighlight-at cursor-location)
2081 (let ((old-max (point-max))
2082 (new-word (if (atom replace)
2083 replace
2084 (car replace)))
2085 (cursor-location (+ (- (length word) (- end start))
2086 cursor-location)))
2087 (unless (equal new-word (car poss))
2088 (delete-region start end)
2089 (goto-char start)
2090 (funcall flyspell-insert-function new-word)
2091 (if flyspell-abbrev-p
2092 (flyspell-define-abbrev word new-word)))
2093 ;; In the original Emacs code, this was only called in the body
2094 ;; of the if. I arbitrarily kept the XEmacs behavior instead.
2095 (flyspell-ajust-cursor-point save cursor-location old-max)))
2096 (t
2097 (goto-char save)
2098 nil)))
2099
2100 ;;*---------------------------------------------------------------------*/
2101 ;;* flyspell-ajust-cursor-point ... */
2102 ;;*---------------------------------------------------------------------*/
2103 (defun flyspell-ajust-cursor-point (save cursor-location old-max)
2104 (if (>= save cursor-location)
2105 (let ((new-pos (+ save (- (point-max) old-max))))
2106 (goto-char (cond
2107 ((< new-pos (point-min))
2108 (point-min))
2109 ((> new-pos (point-max))
2110 (point-max))
2111 (t new-pos))))
2112 (goto-char save)))
2113
2114 ;;*---------------------------------------------------------------------*/
2115 ;;* flyspell-emacs-popup ... */
2116 ;;*---------------------------------------------------------------------*/
2117 (defun flyspell-emacs-popup (event poss word)
2118 "The Emacs popup menu."
2119 (if (not event)
2120 (let* ((mouse-pos (mouse-position))
2121 (mouse-pos (if (nth 1 mouse-pos)
2122 mouse-pos
2123 (set-mouse-position (car mouse-pos)
2124 (/ (frame-width) 2) 2)
2125 (mouse-position))))
2126 (setq event (list (list (car (cdr mouse-pos))
2127 (1+ (cdr (cdr mouse-pos))))
2128 (car mouse-pos)))))
2129 (let* ((corrects (if flyspell-sort-corrections
2130 (sort (car (cdr (cdr poss))) 'string<)
2131 (car (cdr (cdr poss)))))
2132 (cor-menu (if (consp corrects)
2133 (mapcar (lambda (correct)
2134 (list correct correct))
2135 corrects)
2136 '()))
2137 (affix (car (cdr (cdr (cdr poss)))))
2138 show-affix-info
2139 (base-menu (let ((save (if (and (consp affix) show-affix-info)
2140 (list
2141 (list (concat "Save affix: " (car affix))
2142 'save)
2143 '("Accept (session)" session)
2144 '("Accept (buffer)" buffer))
2145 '(("Save word" save)
2146 ("Accept (session)" session)
2147 ("Accept (buffer)" buffer)))))
2148 (if (consp cor-menu)
2149 (append cor-menu (cons "" save))
2150 save)))
2151 (menu (cons "flyspell correction menu" base-menu)))
2152 (car (x-popup-menu event
2153 (list (format "%s [%s]" word (or ispell-local-dictionary
2154 ispell-dictionary))
2155 menu)))))
2156
2157 ;;*---------------------------------------------------------------------*/
2158 ;;* flyspell-xemacs-popup ... */
2159 ;;*---------------------------------------------------------------------*/
2160 (defun flyspell-xemacs-popup (poss word cursor-location start end save)
2161 "The XEmacs popup menu."
2162 (let* ((corrects (if flyspell-sort-corrections
2163 (sort (car (cdr (cdr poss))) 'string<)
2164 (car (cdr (cdr poss)))))
2165 (cor-menu (if (consp corrects)
2166 (mapcar (lambda (correct)
2167 (vector correct
2168 (list 'flyspell-do-correct
2169 correct
2170 (list 'quote poss)
2171 word
2172 cursor-location
2173 start
2174 end
2175 save)
2176 t))
2177 corrects)
2178 '()))
2179 (affix (car (cdr (cdr (cdr poss)))))
2180 show-affix-info
2181 (menu (let ((save (if (and (consp affix) show-affix-info)
2182 (vector
2183 (concat "Save affix: " (car affix))
2184 (list 'flyspell-do-correct
2185 ''save
2186 (list 'quote poss)
2187 word
2188 cursor-location
2189 start
2190 end
2191 save)
2192 t)
2193 (vector
2194 "Save word"
2195 (list 'flyspell-do-correct
2196 ''save
2197 (list 'quote poss)
2198 word
2199 cursor-location
2200 start
2201 end
2202 save)
2203 t)))
2204 (session (vector "Accept (session)"
2205 (list 'flyspell-do-correct
2206 ''session
2207 (list 'quote poss)
2208 word
2209 cursor-location
2210 start
2211 end
2212 save)
2213 t))
2214 (buffer (vector "Accept (buffer)"
2215 (list 'flyspell-do-correct
2216 ''buffer
2217 (list 'quote poss)
2218 word
2219 cursor-location
2220 start
2221 end
2222 save)
2223 t)))
2224 (if (consp cor-menu)
2225 (append cor-menu (list "-" save session buffer))
2226 (list save session buffer)))))
2227 (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary
2228 ispell-dictionary))
2229 menu))))
2230
2231 ;;*---------------------------------------------------------------------*/
2232 ;;* Some example functions for real autocorrecting */
2233 ;;*---------------------------------------------------------------------*/
2234 (defun flyspell-maybe-correct-transposition (beg end poss)
2235 "Check replacements for transposed characters.
2236
2237 If the text between BEG and END is equal to a correction suggested by
2238 Ispell, after transposing two adjacent characters, correct the text,
2239 and return t.
2240
2241 The third arg POSS is either the symbol 'doublon' or a list of
2242 possible corrections as returned by `ispell-parse-output'.
2243
2244 This function is meant to be added to `flyspell-incorrect-hook'."
2245 (when (consp poss)
2246 (catch 'done
2247 (let ((str (buffer-substring beg end))
2248 (i 0) (len (- end beg)) tmp)
2249 (while (< (1+ i) len)
2250 (setq tmp (aref str i))
2251 (aset str i (aref str (1+ i)))
2252 (aset str (1+ i) tmp)
2253 (when (member str (nth 2 poss))
2254 (save-excursion
2255 (goto-char (+ beg i 1))
2256 (transpose-chars 1))
2257 (throw 'done t))
2258 (setq tmp (aref str i))
2259 (aset str i (aref str (1+ i)))
2260 (aset str (1+ i) tmp)
2261 (setq i (1+ i))))
2262 nil)))
2263
2264 (defun flyspell-maybe-correct-doubling (beg end poss)
2265 "Check replacements for doubled characters.
2266
2267 If the text between BEG and END is equal to a correction suggested by
2268 Ispell, after removing a pair of doubled characters, correct the text,
2269 and return t.
2270
2271 The third arg POSS is either the symbol 'doublon' or a list of
2272 possible corrections as returned by `ispell-parse-output'.
2273
2274 This function is meant to be added to `flyspell-incorrect-hook'."
2275 (when (consp poss)
2276 (catch 'done
2277 (let ((str (buffer-substring beg end))
2278 (i 0) (len (- end beg)))
2279 (while (< (1+ i) len)
2280 (when (and (= (aref str i) (aref str (1+ i)))
2281 (member (concat (substring str 0 (1+ i))
2282 (substring str (+ i 2)))
2283 (nth 2 poss)))
2284 (goto-char (+ beg i))
2285 (delete-char 1)
2286 (throw 'done t))
2287 (setq i (1+ i))))
2288 nil)))
2289
2290 ;;*---------------------------------------------------------------------*/
2291 ;;* flyspell-already-abbrevp ... */
2292 ;;*---------------------------------------------------------------------*/
2293 (defun flyspell-already-abbrevp (table word)
2294 (let ((sym (abbrev-symbol word table)))
2295 (and sym (symbolp sym))))
2296
2297 ;;*---------------------------------------------------------------------*/
2298 ;;* flyspell-change-abbrev ... */
2299 ;;*---------------------------------------------------------------------*/
2300 (defun flyspell-change-abbrev (table old new)
2301 (set (abbrev-symbol old table) new))
2302
2303 (provide 'flyspell)
2304
2305 ;; arch-tag: 05d915b9-e9cf-44fb-9137-fc28f5eaab2a
2306 ;;; flyspell.el ends here