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