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