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