Mercurial > emacs
comparison lisp/textmodes/flyspell.el @ 22611:38463342cd56
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 26 Jun 1998 01:24:05 +0000 |
parents | |
children | 6def3da74c7c |
comparison
equal
deleted
inserted
replaced
22610:f5539d91e129 | 22611:38463342cd56 |
---|---|
1 ;;; flyspell.el --- On-the-fly spell checker | |
2 | |
3 ;; Copyright (C) 1998 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Manuel Serrano <Manuel.Serrano@unice.fr> | |
6 ;; version 1.2h | |
7 ;; new version may be found at: | |
8 ;; | |
9 ;; http://kaolin.unice.fr/~serrano | |
10 | |
11 ;;; This file is part of GNU Emacs. | |
12 | |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 ;; it under the terms of the GNU General Public License as published by | |
15 ;; the Free Software Foundation; either version 2, or (at your option) | |
16 ;; any later version. | |
17 | |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;; GNU General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
26 ;; Boston, MA 02111-1307, USA. | |
27 | |
28 ;;; commentary: | |
29 ;; | |
30 ;; Flyspell is a minor Emacs mode performing on-the-fly spelling | |
31 ;; checking. It requires `font-lock' and `ispell'. It has been | |
32 ;; tested on gnu-emacs 19.29, 19.34 and Xemacs 19.15. | |
33 ;; | |
34 ;; To install it, copy the flyspell.el file in your Emacs path and | |
35 ;; add to your .emacs file: | |
36 ;; `(autoload 'flyspell-mode "flyspell" "On-the-fly Ispell." t)' | |
37 ;; | |
38 ;; To enter the flyspell minor mode, Meta-x flyspell-mode. | |
39 ;; | |
40 ;; Note: consider setting the variable ispell-parser to 'tex to | |
41 ;; avoid TeX command checking (use `(setq ispell-parser 'tex)') | |
42 ;; _before_ entering flyspell. | |
43 ;; | |
44 ;; Some user variables control the behavior of flyspell. They are | |
45 ;; those defined under the `User variables' comment. | |
46 ;; | |
47 ;; Note: as suggested by Yaron M. Minsky, if you use flyspell when | |
48 ;; sending mails, you should add the following: | |
49 ;; (add-hook 'mail-send-hook 'flyspell-mode-off) | |
50 ;; ------------------------------------------------------------- | |
51 ;; Release 1.2h: | |
52 ;; - Fix a bug on mouse-2 (yank-at-click) for gnu-emacs. | |
53 ;; Release 1.2g: | |
54 ;; - Support for flyspell-generic-check-word-p (has suggested | |
55 ;; by Eric M. Ludlam). | |
56 ;; - Compliance to emacs-lisp comments. | |
57 ;; Release 1.2f: | |
58 ;; - Improved TeX handling. | |
59 ;; - Improved word fetch implementation. | |
60 ;; - flyspell-sort-corrections was not used inside | |
61 ;; flyspell-auto-correct-word. The consequence was that auto | |
62 ;; corrections where not sorted even if the variable was set | |
63 ;; to non-nil. | |
64 ;; - Support for flyspell-multi-language-p variable. Setting | |
65 ;; this variable to nil will prevent flyspell to spawn a new | |
66 ;; Ispell process per buffer. | |
67 ;; Release 1.2e: | |
68 ;; - Fix two popup bugs on Xemacs. If no replacement words are | |
69 ;; proposed only the save option is available. Corrected words | |
70 ;; were not inserted at the correct position in the buffer. | |
71 ;; - Addition of flyspell-region and flyspell-buffer. | |
72 ;; Release 1.2d: | |
73 ;; - Make-face-... expressions are now enclosed in | |
74 ;; condition-case expressions. | |
75 ;; - Fix bugs when flyspell-auto-correct-binding is set to nil | |
76 ;; (thanks to Eli Tziperman). | |
77 ;; Release 1.2c: | |
78 ;; - Fix the overlay keymap problem for Emacs (it was correctly | |
79 ;; working with Xemacs). | |
80 ;; - Thanks to Didier Remy, flyspell now uses a cache in order | |
81 ;; to improve efficiency and make uses of a pre-command-hook | |
82 ;; in order to check a word when living it. | |
83 ;; - Remaned flyspell-ignore-command into | |
84 ;; flyspell-delay-command. | |
85 ;; - Add the flyspell-issue-welcome (as suggested by Joshua | |
86 ;; Guttman). | |
87 ;; - Ispell process are now killed when the buffer they are | |
88 ;; running in is deleted (thanks to Jeff Miller and Roland | |
89 ;; Rosenfled). | |
90 ;; - When used on a B&W terminal flyspell used boldness instead | |
91 ;; of color for incorrect words. | |
92 ;; Release 1.2: | |
93 ;; - Breaks (space or newline) inside incorrect words are now | |
94 ;; better handled. | |
95 ;; - Flyspell sorts the proposed replacement words (thanks to | |
96 ;; Carsten Dominik). See new variable | |
97 ;; `flyspell-sort-corrections'. | |
98 ;; - The mouse binding to correct mispelled word is now mouse-2 | |
99 ;; on an highlighted region. This enhancement (as well as a | |
100 ;; lot of code cleaning) has been acheived by Carsten Dominik. | |
101 ;; - flyspell-mode arg is now optional. | |
102 ;; - flyspell bindings are better displayed. | |
103 ;; - flyspell nows is able to handle concurent and different | |
104 ;; dictionaries (that each buffer running flyspell uses its | |
105 ;; own (buffer local) Ispell process). | |
106 ;; - default value for flyspell-highlight-property has been | |
107 ;; turned to t. | |
108 ;; - flyspell popup menus now support session and buffer | |
109 ;; dictionaries. | |
110 ;; - corrected words are now correctly unhighlighted (no | |
111 ;; highlighted characters left). | |
112 ;; Note: I think emacs-19.34 has a bug on the overlay event | |
113 ;; handling. When an overlay (or a text property) has uses a | |
114 ;; local-map, if this map does not include a key binding, | |
115 ;; instead of looking at the enclosing local-map emacs-19.34 | |
116 ;; uses the global-map. I have not tested this with emacs-20. | |
117 ;; I have checked with Xemacs that does contain this error. | |
118 ;; Release 1.1: | |
119 ;; - Add an automatic replacement for incorrect word. | |
120 ;; Release 1.0: | |
121 ;; - Add popup menu for fast correction. | |
122 ;; Release 0.9: | |
123 ;; - Add an Ispell bug workaround. Now, in french mode, word | |
124 ;; starting by the '-' character does not, any longer, make | |
125 ;; Ispell to fall in infinite loops. | |
126 ;; Release 0.8: | |
127 ;; - Better Xemacs support | |
128 ;; Release 0.7: | |
129 ;; - Rather than hard-coding the ignored commend I now uses a | |
130 ;; property field to check if a command is ignored. The | |
131 ;; advantage is that user may now add its own ignored | |
132 ;; commands. | |
133 ;; Release 0.6: | |
134 ;; - Fix flyspell mode name (in modeline bar) bug. | |
135 ;; - Fix the bug on flyspell quitting. Overlays are now really | |
136 ;; removed. | |
137 ;; Release 0.5: | |
138 ;; - Persistent hilightings. | |
139 ;; - Refresh of the modeline on flyspell ending | |
140 ;; - Do not hilight text with properties (e.g. font lock text) | |
141 | |
142 ;;; Code: | |
143 (require 'font-lock) | |
144 (require 'ispell) | |
145 | |
146 ;*---------------------------------------------------------------------*/ | |
147 ;* defcustom stuff. This ensure that we have the correct custom */ | |
148 ;* library. */ | |
149 ;*---------------------------------------------------------------------*/ | |
150 (eval-and-compile | |
151 (condition-case () (require 'custom) (error nil)) | |
152 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) | |
153 ;; We have got what we need | |
154 (if (not (string-match "XEmacs" emacs-version)) | |
155 ;; suppress warnings | |
156 (progn | |
157 ;; This is part of bytecomp.el in 19.35: | |
158 (put 'custom-declare-variable 'byte-hunk-handler | |
159 'byte-compile-file-form-custom-declare-variable) | |
160 (defun byte-compile-file-form-custom-declare-variable (form) | |
161 (if (memq 'free-vars byte-compile-warnings) | |
162 (setq byte-compile-bound-variables | |
163 (cons (nth 1 (nth 1 form)) | |
164 byte-compile-bound-variables))) | |
165 form))) | |
166 ;; We have the old custom-library, hack around it! | |
167 (defmacro defgroup (&rest args) nil) | |
168 (defmacro defcustom (var value doc &rest args) | |
169 (` (defvar (, var) (, value) (, doc)))))) | |
170 | |
171 (defgroup flyspell nil | |
172 "Spellchecking on the fly." | |
173 :tag "FlySpell" | |
174 :prefix "flyspell-" | |
175 :group 'processes) | |
176 | |
177 ;*---------------------------------------------------------------------*/ | |
178 ;* User variables ... */ | |
179 ;*---------------------------------------------------------------------*/ | |
180 (defcustom flyspell-highlight-flag t | |
181 "*Non-nil means use highlight, nil means use mini-buffer messages." | |
182 :group 'flyspell | |
183 :type 'boolean) | |
184 | |
185 (defcustom flyspell-doublon-as-error-flag t | |
186 "*Non-nil means consider doublon as misspelling." | |
187 :group 'flyspell | |
188 :type 'boolean) | |
189 | |
190 (defcustom flyspell-sort-corrections t | |
191 "*Non-nil means, sort the corrections alphabetically before popping them." | |
192 :group 'flyspell | |
193 :type 'boolean) | |
194 | |
195 (defcustom flyspell-incorrect-color "OrangeRed" | |
196 "*The color used for highlighting incorrect words." | |
197 :group 'flyspell | |
198 :type 'string) | |
199 | |
200 (defcustom flyspell-duplicate-color "Gold3" | |
201 "*The color used for highlighting incorrect words but appearing at least twice." | |
202 :group 'flyspell | |
203 :type 'string) | |
204 | |
205 (defcustom flyspell-underline-p t | |
206 "*Non-nil means, incorrect words are underlined." | |
207 :group 'flyspell | |
208 :type 'boolean) | |
209 | |
210 (defcustom flyspell-auto-correct-binding | |
211 "\M-\t" | |
212 "*Non-nil means that its value (a binding) will bound to the flyspell | |
213 auto-correct." | |
214 :group 'flyspell | |
215 :type '(choice (const nil string))) | |
216 | |
217 (defcustom flyspell-command-hook t | |
218 "*Non-nil means that `post-command-hook' is used to check | |
219 already typed words." | |
220 :group 'flyspell | |
221 :type 'boolean) | |
222 | |
223 (defcustom flyspell-duplicate-distance -1 | |
224 "*The distance from duplication. | |
225 -1 means no limit. | |
226 0 means no window." | |
227 :group 'flyspell | |
228 :type 'number) | |
229 | |
230 (defcustom flyspell-delay 3 | |
231 "*The number of second before checking words on post-command-hook if | |
232 the current command is a delay command." | |
233 :group 'flyspell | |
234 :type 'number) | |
235 | |
236 (defcustom flyspell-persistent-highlight t | |
237 "*T means that hilighted words are not removed until the word are corrected." | |
238 :group 'flyspell | |
239 :type 'boolean) | |
240 | |
241 (defcustom flyspell-highlight-properties t | |
242 "*T means highlight incorrect words even if a property exists for this word." | |
243 :group 'flyspell | |
244 :type 'boolean) | |
245 | |
246 (defcustom flyspell-default-delayed-commands | |
247 '(self-insert-command | |
248 delete-backward-char | |
249 delete-char) | |
250 "The list of always delayed command (that is flyspell is not activated | |
251 after any of these commands." | |
252 :group 'flyspell | |
253 :type '(repeat (symbol))) | |
254 | |
255 (defcustom flyspell-delayed-commands | |
256 nil | |
257 "*If non nil, this variable must hold a list a symbol. Each symbol is | |
258 the name of an delayed command (that is a command that does not activate | |
259 flyspell checking." | |
260 :group 'flyspell | |
261 :type '(repeat (symbol))) | |
262 | |
263 (defcustom flyspell-issue-welcome-flag t | |
264 "*Non-nil means that flyspell issues a welcome message when started." | |
265 :group 'flyspell | |
266 :type 'boolean) | |
267 | |
268 (defcustom flyspell-consider-dash-as-word-delimiter-flag nil | |
269 "*Non-nil means that the `-' char is considered as a word delimiter." | |
270 :group 'flyspell | |
271 :type 'boolean) | |
272 | |
273 (defcustom flyspell-incorrect-hook nil | |
274 "*Non-nil means a list of hooks to be executed when incorrect | |
275 words are encountered. Each hook is a function of two arguments that are | |
276 location of the beginning and the end of the incorrect region." | |
277 :group 'flyspell) | |
278 | |
279 (defcustom flyspell-multi-language-p t | |
280 "*Non-nil means that flyspell could be use with several buffers checking | |
281 several languages. Non-nil means that a new ispell process will be spawned | |
282 per buffer. If nil, only one unique ispell process will be running." | |
283 :group 'flyspell | |
284 :type 'boolean) | |
285 | |
286 ;*---------------------------------------------------------------------*/ | |
287 ;* Mode specific options */ | |
288 ;* ------------------------------------------------------------- */ | |
289 ;* Mode specific options enable users to disable flyspell on */ | |
290 ;* certain word depending of the emacs mode. For instance, when */ | |
291 ;* using flyspell with mail-mode add the following expression */ | |
292 ;* in your .emacs file: */ | |
293 ;* (add-hook 'mail-mode */ | |
294 ;* '(lambda () (setq flyspell-generic-check-word-p */ | |
295 ;* 'mail-mode-flyspell-verify))) */ | |
296 ;*---------------------------------------------------------------------*/ | |
297 (defvar flyspell-generic-check-word-p nil | |
298 "Function providing per-mode customization over which words are flyspelled. | |
299 Returns t to continue checking, nil otherwise.") | |
300 (make-variable-buffer-local 'flyspell-generic-check-word-p) | |
301 | |
302 (defun mail-mode-flyspell-verify () | |
303 "Return t if we want flyspell to check the word under point." | |
304 (save-excursion | |
305 (not (or (re-search-forward mail-header-separator nil t) | |
306 (re-search-backward message-signature-separator nil t) | |
307 (progn | |
308 (beginning-of-line) | |
309 (looking-at "[>}|]")))))) | |
310 | |
311 (defun texinfo-mode-flyspell-verify () | |
312 "Return t if we want flyspell to check the word under point." | |
313 (save-excursion | |
314 (forward-word -1) | |
315 (not (looking-at "@")))) | |
316 | |
317 ;*---------------------------------------------------------------------*/ | |
318 ;* Overlay compatibility */ | |
319 ;*---------------------------------------------------------------------*/ | |
320 (autoload 'make-overlay "overlay" "" t) | |
321 (autoload 'move-overlay "overlay" "" t) | |
322 (autoload 'overlayp "overlay" "" t) | |
323 (autoload 'overlay-properties "overlay" "" t) | |
324 (autoload 'overlays-in "overlay" "" t) | |
325 (autoload 'delete-overlay "overlay" "" t) | |
326 (autoload 'overlays-at "overlay" "" t) | |
327 (autoload 'overlay-put "overlay" "" t) | |
328 (autoload 'overlay-get "overlay" "" t) | |
329 | |
330 (defun flyspell-font-lock-make-face (l) | |
331 "Because emacs and xemacs does not behave the same I uses my owe | |
332 font-lock-make-face function. This function is similar to the gnu-emacs | |
333 font-lock-make-face function." | |
334 (let ((fname (car l)) | |
335 (color (car (cdr l))) | |
336 (italic (car (cdr (cdr l)))) | |
337 (bold (car (cdr (cdr (cdr l))))) | |
338 (underline (car (cdr (cdr (cdr (cdr l))))))) | |
339 (let ((face (copy-face 'default fname))) | |
340 (if color | |
341 (set-face-foreground face color)) | |
342 (if (and italic bold) | |
343 (condition-case nil | |
344 (make-face-bold-italic face) | |
345 (error nil)) | |
346 (progn | |
347 (if italic | |
348 (condition-case nil | |
349 (make-face-italic face) | |
350 (error nil))) | |
351 (if bold | |
352 (condition-case nil | |
353 (make-face-bold face) | |
354 (error nil))))) | |
355 (if underline | |
356 (condition-case nil | |
357 (set-face-underline-p face t) | |
358 (error nil))) | |
359 (if (not (x-display-color-p)) | |
360 (condition-case nil | |
361 (make-face-bold face) | |
362 (error nil))) | |
363 face))) | |
364 | |
365 ;*---------------------------------------------------------------------*/ | |
366 ;* Which emacs are we currently running */ | |
367 ;*---------------------------------------------------------------------*/ | |
368 (defvar flyspell-emacs | |
369 (cond | |
370 ((string-match "XEmacs" emacs-version) | |
371 'xemacs) | |
372 (t | |
373 'emacs)) | |
374 "The Emacs we are currently running.") | |
375 | |
376 ;*---------------------------------------------------------------------*/ | |
377 ;* cl compatibility */ | |
378 ;*---------------------------------------------------------------------*/ | |
379 (defmacro push (x place) | |
380 "(push X PLACE): insert X at the head of the list stored in PLACE. | |
381 Analogous to (setf PLACE (cons X PLACE)), though more careful about | |
382 evaluating each argument only once and in the right order. PLACE has | |
383 to be a symbol." | |
384 (list 'setq place (list 'cons x place))) | |
385 | |
386 ;*---------------------------------------------------------------------*/ | |
387 ;* The minor mode declaration. */ | |
388 ;*---------------------------------------------------------------------*/ | |
389 (defvar flyspell-mode nil) | |
390 (make-variable-buffer-local 'flyspell-mode) | |
391 | |
392 (defvar flyspell-mode-map (make-sparse-keymap)) | |
393 (defvar flyspell-mouse-map (make-sparse-keymap)) | |
394 | |
395 (or (assoc 'flyspell-mode minor-mode-alist) | |
396 (push '(flyspell-mode " Fly") minor-mode-alist)) | |
397 | |
398 (or (assoc 'flyspell-mode minor-mode-map-alist) | |
399 (push (cons 'flyspell-mode flyspell-mode-map) minor-mode-map-alist)) | |
400 | |
401 (if flyspell-auto-correct-binding | |
402 (define-key flyspell-mode-map flyspell-auto-correct-binding | |
403 (function flyspell-auto-correct-word))) | |
404 ;; mouse bindings | |
405 (if (eq flyspell-emacs 'xemacs) | |
406 (define-key flyspell-mouse-map [(button2)] | |
407 (function flyspell-correct-word/mouse-keymap)) | |
408 (define-key flyspell-mode-map [(mouse-2)] | |
409 (function flyspell-correct-word/local-keymap))) | |
410 | |
411 ;; the name of the overlay property that defines the keymap | |
412 (defvar flyspell-overlay-keymap-property-name | |
413 (if (string-match "19.*XEmacs" emacs-version) | |
414 'keymap | |
415 'local-map)) | |
416 | |
417 ;*---------------------------------------------------------------------*/ | |
418 ;* Highlighting */ | |
419 ;*---------------------------------------------------------------------*/ | |
420 (flyspell-font-lock-make-face (list 'flyspell-incorrect-face | |
421 flyspell-incorrect-color | |
422 nil | |
423 t | |
424 flyspell-underline-p)) | |
425 (flyspell-font-lock-make-face (list 'flyspell-duplicate-face | |
426 flyspell-duplicate-color | |
427 nil | |
428 t | |
429 flyspell-underline-p)) | |
430 | |
431 (defvar flyspell-overlay nil) | |
432 | |
433 ;*---------------------------------------------------------------------*/ | |
434 ;* flyspell-mode ... */ | |
435 ;*---------------------------------------------------------------------*/ | |
436 ;;;###autoload | |
437 (defun flyspell-mode (&optional arg) | |
438 "Minor mode performing on-the-fly spelling checking. | |
439 Ispell is automatically spawned on background for each entered words. | |
440 The default flyspells behavior is to highlight incorrect words. | |
441 With prefix ARG, turn Flyspell minor mode on iff ARG is positive. | |
442 | |
443 Bindings: | |
444 \\[ispell-word]: correct words (using Ispell). | |
445 \\[flyspell-auto-correct-word]: automatically correct word. | |
446 \\[flyspell-correct-word] (or mouse-2): popup correct words. | |
447 | |
448 Hooks: | |
449 flyspell-mode-hook is runner after flyspell is entered. | |
450 | |
451 Remark: | |
452 `flyspell-mode' uses `ispell-mode'. Thus all Ispell options are | |
453 valid. For instance, a personal dictionary can be used by | |
454 invoking `ispell-change-dictionary'. | |
455 | |
456 Consider using the `ispell-parser' to check your text. For instance | |
457 consider adding: | |
458 (add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) | |
459 in your .emacs file. | |
460 | |
461 flyspell-region checks all words inside a region. | |
462 | |
463 flyspell-buffer checks the whole buffer." | |
464 (interactive "P") | |
465 ;; we set the mode on or off | |
466 (setq flyspell-mode (not (or (and (null arg) flyspell-mode) | |
467 (<= (prefix-numeric-value arg) 0)))) | |
468 (if flyspell-mode | |
469 (flyspell-mode-on) | |
470 (flyspell-mode-off)) | |
471 ;; we force the modeline re-printing | |
472 (set-buffer-modified-p (buffer-modified-p))) | |
473 | |
474 ;*---------------------------------------------------------------------*/ | |
475 ;* flyspell-mode-on ... */ | |
476 ;*---------------------------------------------------------------------*/ | |
477 (defun flyspell-mode-on () | |
478 "Turn flyspell mode on. Do not use, use `flyspell-mode' instead." | |
479 (message "flyspell on: %S" (current-buffer)) | |
480 (setq ispell-highlight-face 'flyspell-incorrect-face) | |
481 ;; ispell initialization | |
482 (if flyspell-multi-language-p | |
483 (progn | |
484 (make-variable-buffer-local 'ispell-dictionary) | |
485 (make-variable-buffer-local 'ispell-process) | |
486 (make-variable-buffer-local 'ispell-filter) | |
487 (make-variable-buffer-local 'ispell-filter-continue) | |
488 (make-variable-buffer-local 'ispell-process-directory) | |
489 (make-variable-buffer-local 'ispell-parser))) | |
490 ;; we initialize delayed commands symbol | |
491 (flyspell-delay-commands) | |
492 ;; we bound flyspell action to post-command hook | |
493 (if flyspell-command-hook | |
494 (progn | |
495 (make-local-hook 'post-command-hook) | |
496 (add-hook 'post-command-hook | |
497 (function flyspell-post-command-hook) | |
498 t | |
499 t))) | |
500 ;; we bound flyspell action to pre-command hook | |
501 (if flyspell-command-hook | |
502 (progn | |
503 (make-local-hook 'pre-command-hook) | |
504 (add-hook 'pre-command-hook | |
505 (function flyspell-pre-command-hook) | |
506 t | |
507 t))) | |
508 ;; the welcome message | |
509 (if flyspell-issue-welcome-flag | |
510 (message | |
511 (if flyspell-auto-correct-binding | |
512 (format "Welcome to flyspell. Use %S or mouse-2 to correct words." | |
513 (key-description flyspell-auto-correct-binding)) | |
514 "Welcome to flyspell. Use mouse-2 to correct words."))) | |
515 ;; we have to kill the flyspell process when the buffer is deleted. | |
516 ;; (thanks to Jeff Miller and Roland Rosenfeld who sent me this | |
517 ;; improvement). | |
518 (add-hook 'kill-buffer-hook | |
519 '(lambda () | |
520 (if flyspell-mode | |
521 (flyspell-mode-off)))) | |
522 ;; we end with the flyspell hooks | |
523 (run-hooks 'flyspell-mode-hook)) | |
524 | |
525 ;*---------------------------------------------------------------------*/ | |
526 ;* flyspell-delay-commands ... */ | |
527 ;*---------------------------------------------------------------------*/ | |
528 (defun flyspell-delay-commands () | |
529 "Install the delayed command." | |
530 (mapcar 'flyspell-delay-command flyspell-default-delayed-commands) | |
531 (mapcar 'flyspell-delay-command flyspell-delayed-commands)) | |
532 | |
533 ;*---------------------------------------------------------------------*/ | |
534 ;* flyspell-delay-command ... */ | |
535 ;*---------------------------------------------------------------------*/ | |
536 (defun flyspell-delay-command (command) | |
537 "Set COMMAND to be delayed. | |
538 When flyspell `post-command-hook' is invoked because a delayed command | |
539 as been used the current word is not immediatly checked. | |
540 It will be checked only after flyspell-delay second." | |
541 (interactive "Scommand: ") | |
542 (put command 'flyspell-delayed t)) | |
543 | |
544 ;*---------------------------------------------------------------------*/ | |
545 ;* flyspell-ignore-commands ... */ | |
546 ;*---------------------------------------------------------------------*/ | |
547 (defun flyspell-ignore-commands () | |
548 "This is an obsolete function, use flyspell-delays command instead." | |
549 (flyspell-delay-commands)) | |
550 | |
551 ;*---------------------------------------------------------------------*/ | |
552 ;* flyspell-ignore-command ... */ | |
553 ;*---------------------------------------------------------------------*/ | |
554 (defun flyspell-ignore-command (command) | |
555 "This is an obsolete function, use flyspell-delay command instead. | |
556 COMMAND is the name of the command to be delayed." | |
557 (flyspell-delay-command command)) | |
558 | |
559 (make-obsolete 'flyspell-ignore-commands 'flyspell-delay-commands) | |
560 (make-obsolete 'flyspell-ignore-command 'flyspell-delay-command) | |
561 | |
562 ;*---------------------------------------------------------------------*/ | |
563 ;* flyspell-word-cache ... */ | |
564 ;*---------------------------------------------------------------------*/ | |
565 (defvar flyspell-word-cache-start nil) | |
566 (defvar flyspell-word-cache-end nil) | |
567 (defvar flyspell-word-cache-word nil) | |
568 (make-variable-buffer-local 'flyspell-word-cache-start) | |
569 (make-variable-buffer-local 'flyspell-word-cache-end) | |
570 (make-variable-buffer-local 'flyspell-word-cache-word) | |
571 | |
572 ;*---------------------------------------------------------------------*/ | |
573 ;* The flyspell pre-hook, store the current position. In the */ | |
574 ;* post command hook, we will check, if the word at this position */ | |
575 ;* has to be spell checked. */ | |
576 ;*---------------------------------------------------------------------*/ | |
577 (defvar flyspell-pre-buffer nil) | |
578 (defvar flyspell-pre-point nil) | |
579 | |
580 ;*---------------------------------------------------------------------*/ | |
581 ;* flyspell-pre-command-hook ... */ | |
582 ;*---------------------------------------------------------------------*/ | |
583 (defun flyspell-pre-command-hook () | |
584 "This function is internally used by Flyspell to get a cursor location | |
585 before a user command." | |
586 (interactive) | |
587 (setq flyspell-pre-buffer (current-buffer)) | |
588 (setq flyspell-pre-point (point))) | |
589 | |
590 ;*---------------------------------------------------------------------*/ | |
591 ;* flyspell-mode-off ... */ | |
592 ;*---------------------------------------------------------------------*/ | |
593 (defun flyspell-mode-off () | |
594 "Turn flyspell mode off. Do not use. Use `flyspell-mode' instead." | |
595 ;; the bye-bye message | |
596 (message "Quiting Flyspell...%S" (current-buffer)) | |
597 ;; we stop the running ispell | |
598 (ispell-kill-ispell t) | |
599 ;; we remove the hooks | |
600 (if flyspell-command-hook | |
601 (progn | |
602 (remove-hook 'post-command-hook | |
603 (function flyspell-post-command-hook) | |
604 t) | |
605 (remove-hook 'pre-command-hook | |
606 (function flyspell-pre-command-hook) | |
607 t))) | |
608 ;; we remove all the flyspell hilightings | |
609 (flyspell-delete-all-overlays) | |
610 ;; we have to erase pre cache variables | |
611 (setq flyspell-pre-buffer nil) | |
612 (setq flyspell-pre-point nil) | |
613 ;; we mark the mode as killed | |
614 (setq flyspell-mode nil)) | |
615 | |
616 ;*---------------------------------------------------------------------*/ | |
617 ;* flyspell-check-word-p ... */ | |
618 ;*---------------------------------------------------------------------*/ | |
619 (defun flyspell-check-word-p () | |
620 "This function returns t when the word at `point' has to be | |
621 checked. The answer depends of several criteria. Mostly we | |
622 check word delimiters." | |
623 (cond | |
624 ((<= (- (point-max) 1) (point-min)) | |
625 ;; the buffer is not filled enough | |
626 nil) | |
627 ((not (and (symbolp this-command) (get this-command 'flyspell-delayed))) | |
628 ;; the current command is not delayed, that | |
629 ;; is that we must check the word now | |
630 t) | |
631 ((and (> (point) (point-min)) | |
632 (save-excursion | |
633 (backward-char 1) | |
634 (and (looking-at (flyspell-get-not-casechars)) | |
635 (or flyspell-consider-dash-as-word-delimiter-flag | |
636 (not (looking-at "\\-")))))) | |
637 ;; yes because we have reached or typed a word delimiter | |
638 t) | |
639 ((not (integerp flyspell-delay)) | |
640 ;; yes because the user had settup a non delay configuration | |
641 t) | |
642 (t | |
643 (if (fboundp 'about-xemacs) | |
644 (sit-for flyspell-delay nil) | |
645 (sit-for flyspell-delay 0 nil))))) | |
646 | |
647 ;*---------------------------------------------------------------------*/ | |
648 ;* flyspell-check-pre-word-p ... */ | |
649 ;*---------------------------------------------------------------------*/ | |
650 (defun flyspell-check-pre-word-p () | |
651 "When to we have to check the word that was at point before | |
652 the current command?" | |
653 (cond | |
654 ((or (not (numberp flyspell-pre-point)) | |
655 (not (bufferp flyspell-pre-buffer)) | |
656 (not (buffer-live-p flyspell-pre-buffer))) | |
657 nil) | |
658 ((or (= flyspell-pre-point (- (point) 1)) | |
659 (= flyspell-pre-point (point)) | |
660 (= flyspell-pre-point (+ (point) 1))) | |
661 nil) | |
662 ((not (eq (current-buffer) flyspell-pre-buffer)) | |
663 t) | |
664 ((not (and (numberp flyspell-word-cache-start) | |
665 (numberp flyspell-word-cache-end))) | |
666 t) | |
667 (t | |
668 (or (< flyspell-pre-point flyspell-word-cache-start) | |
669 (> flyspell-pre-point flyspell-word-cache-end))))) | |
670 | |
671 ;*---------------------------------------------------------------------*/ | |
672 ;* flyspell-post-command-hook ... */ | |
673 ;*---------------------------------------------------------------------*/ | |
674 (defun flyspell-post-command-hook () | |
675 "The `post-command-hook' used by flyspell to check a word in-the-fly." | |
676 (interactive) | |
677 (if (flyspell-check-word-p) | |
678 (flyspell-word)) | |
679 (if (flyspell-check-pre-word-p) | |
680 (save-excursion | |
681 (set-buffer flyspell-pre-buffer) | |
682 (save-excursion | |
683 (goto-char flyspell-pre-point) | |
684 (flyspell-word))))) | |
685 | |
686 ;*---------------------------------------------------------------------*/ | |
687 ;* flyspell-word ... */ | |
688 ;*---------------------------------------------------------------------*/ | |
689 (defun flyspell-word (&optional following) | |
690 "Spell check a word." | |
691 (interactive (list current-prefix-arg)) | |
692 (if (interactive-p) | |
693 (setq following ispell-following-word)) | |
694 (save-excursion | |
695 (ispell-accept-buffer-local-defs) ; use the correct dictionary | |
696 (let ((cursor-location (point)) ; retain cursor location | |
697 (word (flyspell-get-word following)) | |
698 start end poss) | |
699 (if (or (eq word nil) | |
700 (and (fboundp flyspell-generic-check-word-p) | |
701 (not (funcall flyspell-generic-check-word-p)))) | |
702 t | |
703 (progn | |
704 ;; destructure return word info list. | |
705 (setq start (car (cdr word)) | |
706 end (car (cdr (cdr word))) | |
707 word (car word)) | |
708 ;; before checking in the directory, we check for doublons. | |
709 (cond | |
710 ((and flyspell-doublon-as-error-flag | |
711 (save-excursion | |
712 (goto-char start) | |
713 (word-search-backward word | |
714 (- start | |
715 (+ 1 (- end start))) | |
716 t))) | |
717 ;; yes, this is a doublon | |
718 (flyspell-highlight-incorrect-region start end)) | |
719 ((and (eq flyspell-word-cache-start start) | |
720 (eq flyspell-word-cache-end end) | |
721 (string-equal flyspell-word-cache-word word)) | |
722 ;; this word had been already checked, we skip | |
723 nil) | |
724 ((and (eq ispell-parser 'tex) | |
725 (flyspell-tex-command-p word)) | |
726 ;; this is a correct word (because a tex command) | |
727 (flyspell-unhighlight-at start) | |
728 (if (> end start) | |
729 (flyspell-unhighlight-at (- end 1))) | |
730 t) | |
731 (t | |
732 ;; we setup the cache | |
733 (setq flyspell-word-cache-start start) | |
734 (setq flyspell-word-cache-end end) | |
735 (setq flyspell-word-cache-word word) | |
736 ;; now check spelling of word. | |
737 (process-send-string ispell-process "%\n") | |
738 ;; put in verbose mode | |
739 (process-send-string ispell-process | |
740 (concat "^" word "\n")) | |
741 ;; wait until ispell has processed word | |
742 (while (progn | |
743 (accept-process-output ispell-process) | |
744 (not (string= "" (car ispell-filter))))) | |
745 ;; (process-send-string ispell-process "!\n") | |
746 ;; back to terse mode. | |
747 (setq ispell-filter (cdr ispell-filter)) | |
748 (if (listp ispell-filter) | |
749 (setq poss (ispell-parse-output (car ispell-filter)))) | |
750 (cond ((eq poss t) | |
751 ;; correct | |
752 (flyspell-unhighlight-at start) | |
753 (if (> end start) | |
754 (flyspell-unhighlight-at (- end 1))) | |
755 t) | |
756 ((and (stringp poss) flyspell-highlight-flag) | |
757 ;; correct | |
758 (flyspell-unhighlight-at start) | |
759 (if (> end start) | |
760 (flyspell-unhighlight-at (- end 1))) | |
761 t) | |
762 ((null poss) | |
763 (flyspell-unhighlight-at start) | |
764 (if (> end start) | |
765 (flyspell-unhighlight-at (- end 1))) | |
766 (message "Error in ispell process")) | |
767 ((or (and (< flyspell-duplicate-distance 0) | |
768 (or (save-excursion | |
769 (goto-char start) | |
770 (word-search-backward word | |
771 (point-min) | |
772 t)) | |
773 (save-excursion | |
774 (goto-char end) | |
775 (word-search-forward word | |
776 (point-max) | |
777 t)))) | |
778 (and (> flyspell-duplicate-distance 0) | |
779 (or (save-excursion | |
780 (goto-char start) | |
781 (word-search-backward | |
782 word | |
783 (- start | |
784 flyspell-duplicate-distance) | |
785 t)) | |
786 (save-excursion | |
787 (goto-char end) | |
788 (word-search-forward | |
789 word | |
790 (+ end | |
791 flyspell-duplicate-distance) | |
792 t))))) | |
793 (if flyspell-highlight-flag | |
794 (flyspell-highlight-duplicate-region start end) | |
795 (message (format "misspelling duplicate `%s'" | |
796 word)))) | |
797 (t | |
798 ;; incorrect highlight the location | |
799 (if flyspell-highlight-flag | |
800 (flyspell-highlight-incorrect-region start end) | |
801 (message (format "mispelling `%s'" word))))) | |
802 (goto-char cursor-location) ; return to original location | |
803 (if ispell-quit (setq ispell-quit nil))))))))) | |
804 | |
805 ;*---------------------------------------------------------------------*/ | |
806 ;* flyspell-tex-command-p ... */ | |
807 ;*---------------------------------------------------------------------*/ | |
808 (defun flyspell-tex-command-p (word) | |
809 "Is a word a TeX command?" | |
810 (eq (aref word 0) ?\\)) | |
811 | |
812 ;*---------------------------------------------------------------------*/ | |
813 ;* flyspell-casechars-cache ... */ | |
814 ;*---------------------------------------------------------------------*/ | |
815 (defvar flyspell-casechars-cache nil) | |
816 (defvar flyspell-ispell-casechars-cache nil) | |
817 (make-variable-buffer-local 'flyspell-casechars-cache) | |
818 (make-variable-buffer-local 'flyspell-ispell-casechars-cache) | |
819 | |
820 ;*---------------------------------------------------------------------*/ | |
821 ;* flyspell-get-casechars ... */ | |
822 ;*---------------------------------------------------------------------*/ | |
823 (defun flyspell-get-casechars () | |
824 "This function builds a string that is the regexp of word chars. | |
825 In order | |
826 to avoid one useless string construction, this function changes the last | |
827 char of the ispell-casechars string." | |
828 (let ((ispell-casechars (ispell-get-casechars))) | |
829 (cond | |
830 ((eq ispell-casechars flyspell-ispell-casechars-cache) | |
831 flyspell-casechars-cache) | |
832 ((not (eq ispell-parser 'tex)) | |
833 (setq flyspell-ispell-casechars-cache ispell-casechars) | |
834 (setq flyspell-casechars-cache | |
835 (concat (substring ispell-casechars | |
836 0 | |
837 (- (length ispell-casechars) 1)) | |
838 "{}]")) | |
839 flyspell-casechars-cache) | |
840 (t | |
841 (setq flyspell-ispell-casechars-cache ispell-casechars) | |
842 (setq flyspell-casechars-cache ispell-casechars) | |
843 flyspell-casechars-cache)))) | |
844 | |
845 ;*---------------------------------------------------------------------*/ | |
846 ;* flyspell-get-not-casechars-cache ... */ | |
847 ;*---------------------------------------------------------------------*/ | |
848 (defvar flyspell-not-casechars-cache nil) | |
849 (defvar flyspell-ispell-not-casechars-cache nil) | |
850 (make-variable-buffer-local 'flyspell-not-casechars-cache) | |
851 (make-variable-buffer-local 'flyspell-ispell-not-casechars-cache) | |
852 | |
853 ;*---------------------------------------------------------------------*/ | |
854 ;* flyspell-get-not-casechars ... */ | |
855 ;*---------------------------------------------------------------------*/ | |
856 (defun flyspell-get-not-casechars () | |
857 "This function builds a string that is the regexp of non-word chars." | |
858 (let ((ispell-not-casechars (ispell-get-not-casechars))) | |
859 (cond | |
860 ((eq ispell-not-casechars flyspell-ispell-not-casechars-cache) | |
861 flyspell-not-casechars-cache) | |
862 ((not (eq ispell-parser 'tex)) | |
863 (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) | |
864 (setq flyspell-not-casechars-cache | |
865 (concat (substring ispell-not-casechars | |
866 0 | |
867 (- (length ispell-not-casechars) 1)) | |
868 "{}]")) | |
869 flyspell-not-casechars-cache) | |
870 (t | |
871 (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) | |
872 (setq flyspell-not-casechars-cache ispell-not-casechars) | |
873 flyspell-not-casechars-cache)))) | |
874 | |
875 ;*---------------------------------------------------------------------*/ | |
876 ;* flyspell-get-word ... */ | |
877 ;*---------------------------------------------------------------------*/ | |
878 (defun flyspell-get-word (following) | |
879 "Return the word for spell-checking according to Ispell syntax. | |
880 If optional argument FOLLOWING is non-nil or if `ispell-following-word' | |
881 is non-nil when called interactively, then the following word | |
882 \(rather than preceding\) is checked when the cursor is not over a word. | |
883 Optional second argument contains otherchars that can be included in word | |
884 many times. | |
885 | |
886 Word syntax described by `ispell-dictionary-alist' (which see)." | |
887 (let* ((flyspell-casechars (flyspell-get-casechars)) | |
888 (flyspell-not-casechars (flyspell-get-not-casechars)) | |
889 (ispell-otherchars (ispell-get-otherchars)) | |
890 (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) | |
891 (word-regexp (concat flyspell-casechars | |
892 "+\\(" | |
893 ispell-otherchars | |
894 "?" | |
895 flyspell-casechars | |
896 "+\\)" | |
897 (if ispell-many-otherchars-p | |
898 "*" "?"))) | |
899 (tex-prelude "[\\\\{]") | |
900 (tex-regexp (if (eq ispell-parser 'tex) | |
901 (concat tex-prelude "?" word-regexp "}?") | |
902 word-regexp)) | |
903 | |
904 did-it-once | |
905 start end word) | |
906 ;; find the word | |
907 (if (not (or (looking-at flyspell-casechars) | |
908 (and (eq ispell-parser 'tex) | |
909 (looking-at tex-prelude)))) | |
910 (if following | |
911 (re-search-forward flyspell-casechars (point-max) t) | |
912 (re-search-backward flyspell-casechars (point-min) t))) | |
913 ;; move to front of word | |
914 (re-search-backward flyspell-not-casechars (point-min) 'start) | |
915 (let ((pos nil)) | |
916 (while (and (looking-at ispell-otherchars) | |
917 (not (bobp)) | |
918 (or (not did-it-once) | |
919 ispell-many-otherchars-p) | |
920 (not (eq pos (point)))) | |
921 (setq pos (point)) | |
922 (setq did-it-once t) | |
923 (backward-char 1) | |
924 (if (looking-at flyspell-casechars) | |
925 (re-search-backward flyspell-not-casechars (point-min) 'move) | |
926 (backward-char -1)))) | |
927 ;; Now mark the word and save to string. | |
928 (if (eq (re-search-forward tex-regexp (point-max) t) nil) | |
929 nil | |
930 (progn | |
931 (setq start (match-beginning 0) | |
932 end (point) | |
933 word (buffer-substring start end)) | |
934 (list word start end))))) | |
935 | |
936 ;*---------------------------------------------------------------------*/ | |
937 ;* flyspell-region ... */ | |
938 ;*---------------------------------------------------------------------*/ | |
939 (defun flyspell-region (beg end) | |
940 "Flyspell text between BEG and END." | |
941 (interactive "r") | |
942 (save-excursion | |
943 (goto-char beg) | |
944 (while (< (point) end) | |
945 (message "Spell Checking...%d%%" (* 100 (/ (float (point)) (- end beg)))) | |
946 (flyspell-word) | |
947 (let ((cur (point))) | |
948 (forward-word 1) | |
949 (if (and (< (point) end) (> (point) (+ cur 1))) | |
950 (backward-char 1)))) | |
951 (backward-char 1) | |
952 (message "Spell Checking...done") | |
953 (flyspell-word))) | |
954 | |
955 ;*---------------------------------------------------------------------*/ | |
956 ;* flyspell-buffer ... */ | |
957 ;*---------------------------------------------------------------------*/ | |
958 (defun flyspell-buffer () | |
959 "Flyspell whole buffer." | |
960 (interactive) | |
961 (flyspell-region (point-min) (point-max))) | |
962 | |
963 ;*---------------------------------------------------------------------*/ | |
964 ;* flyspell-overlay-p ... */ | |
965 ;*---------------------------------------------------------------------*/ | |
966 (defun flyspell-overlay-p (o) | |
967 "A predicate that return true iff O is an overlay used by flyspell." | |
968 (and (overlayp o) (overlay-get o 'flyspell-overlay))) | |
969 | |
970 ;*---------------------------------------------------------------------*/ | |
971 ;* flyspell-delete-all-overlays ... */ | |
972 ;* ------------------------------------------------------------- */ | |
973 ;* Remove all the overlays introduced by flyspell. */ | |
974 ;*---------------------------------------------------------------------*/ | |
975 (defun flyspell-delete-all-overlays () | |
976 "Delete all the overlays used by flyspell." | |
977 (let ((l (overlays-in (point-min) (point-max)))) | |
978 (while (consp l) | |
979 (progn | |
980 (if (flyspell-overlay-p (car l)) | |
981 (delete-overlay (car l))) | |
982 (setq l (cdr l)))))) | |
983 | |
984 ;*---------------------------------------------------------------------*/ | |
985 ;* flyspell-unhighlight-at ... */ | |
986 ;*---------------------------------------------------------------------*/ | |
987 (defun flyspell-unhighlight-at (pos) | |
988 "Remove the flyspell overlay that are located at POS." | |
989 (if flyspell-persistent-highlight | |
990 (let ((overlays (overlays-at pos))) | |
991 (while (consp overlays) | |
992 (if (flyspell-overlay-p (car overlays)) | |
993 (delete-overlay (car overlays))) | |
994 (setq overlays (cdr overlays)))) | |
995 (delete-overlay flyspell-overlay))) | |
996 | |
997 ;*---------------------------------------------------------------------*/ | |
998 ;* flyspell-properties-at-p ... */ | |
999 ;* ------------------------------------------------------------- */ | |
1000 ;* Is there an highlight properties at position pos? */ | |
1001 ;*---------------------------------------------------------------------*/ | |
1002 (defun flyspell-properties-at-p (beg) | |
1003 "Return the text property at position BEG." | |
1004 (let ((prop (text-properties-at beg)) | |
1005 (keep t)) | |
1006 (while (and keep (consp prop)) | |
1007 (if (and (eq (car prop) 'local-map) (consp (cdr prop))) | |
1008 (setq prop (cdr (cdr prop))) | |
1009 (setq keep nil))) | |
1010 (consp prop))) | |
1011 | |
1012 ;*---------------------------------------------------------------------*/ | |
1013 ;* make-flyspell-overlay ... */ | |
1014 ;*---------------------------------------------------------------------*/ | |
1015 (defun make-flyspell-overlay (beg end face mouse-face) | |
1016 "Allocate a new flyspell overlay that will be used to hilight | |
1017 an incorrect word." | |
1018 (let ((flyspell-overlay (make-overlay beg end))) | |
1019 (overlay-put flyspell-overlay 'face face) | |
1020 (overlay-put flyspell-overlay 'mouse-face mouse-face) | |
1021 (overlay-put flyspell-overlay 'flyspell-overlay t) | |
1022 (if (eq flyspell-emacs 'xemacs) | |
1023 (overlay-put flyspell-overlay | |
1024 flyspell-overlay-keymap-property-name | |
1025 flyspell-mouse-map)))) | |
1026 | |
1027 ;*---------------------------------------------------------------------*/ | |
1028 ;* flyspell-highlight-incorrect-region ... */ | |
1029 ;*---------------------------------------------------------------------*/ | |
1030 (defun flyspell-highlight-incorrect-region (beg end) | |
1031 "The setup of an overlay on a region (starting at BEG and ending at END) | |
1032 that corresponds to an incorrect word." | |
1033 (run-hook-with-args 'flyspell-incorrect-hook beg end) | |
1034 (if (or (not (flyspell-properties-at-p beg)) flyspell-highlight-properties) | |
1035 (progn | |
1036 ;; we cleanup current overlay at the same position | |
1037 (if (and (not flyspell-persistent-highlight) | |
1038 (overlayp flyspell-overlay)) | |
1039 (delete-overlay flyspell-overlay) | |
1040 (let ((overlays (overlays-at beg))) | |
1041 (while (consp overlays) | |
1042 (if (flyspell-overlay-p (car overlays)) | |
1043 (delete-overlay (car overlays))) | |
1044 (setq overlays (cdr overlays))))) | |
1045 ;; now we can use a new overlay | |
1046 (setq flyspell-overlay | |
1047 (make-flyspell-overlay beg end | |
1048 'flyspell-incorrect-face 'highlight))))) | |
1049 | |
1050 ;*---------------------------------------------------------------------*/ | |
1051 ;* flyspell-highlight-duplicate-region ... */ | |
1052 ;*---------------------------------------------------------------------*/ | |
1053 (defun flyspell-highlight-duplicate-region (beg end) | |
1054 "The setup of an overlay on a region (starting at BEG and ending at END) | |
1055 that corresponds to an duplicated word." | |
1056 (if (or (not (flyspell-properties-at-p beg)) flyspell-highlight-properties) | |
1057 (progn | |
1058 ;; we cleanup current overlay at the same position | |
1059 (if (and (not flyspell-persistent-highlight) | |
1060 (overlayp flyspell-overlay)) | |
1061 (delete-overlay flyspell-overlay) | |
1062 (let ((overlays (overlays-at beg))) | |
1063 (while (consp overlays) | |
1064 (if (flyspell-overlay-p (car overlays)) | |
1065 (delete-overlay (car overlays))) | |
1066 (setq overlays (cdr overlays))))) | |
1067 ;; now we can use a new overlay | |
1068 (setq flyspell-overlay | |
1069 (make-flyspell-overlay beg end | |
1070 'flyspell-duplicate-face 'highlight))))) | |
1071 | |
1072 ;*---------------------------------------------------------------------*/ | |
1073 ;* flyspell-auto-correct-cache ... */ | |
1074 ;*---------------------------------------------------------------------*/ | |
1075 (defvar flyspell-auto-correct-pos nil) | |
1076 (defvar flyspell-auto-correct-region nil) | |
1077 (defvar flyspell-auto-correct-ring nil) | |
1078 | |
1079 ;*---------------------------------------------------------------------*/ | |
1080 ;* flyspell-auto-correct-word ... */ | |
1081 ;*---------------------------------------------------------------------*/ | |
1082 (defun flyspell-auto-correct-word (pos) | |
1083 "Auto correct the word at position POS." | |
1084 (interactive "d") | |
1085 ;; use the correct dictionary | |
1086 (ispell-accept-buffer-local-defs) | |
1087 (if (eq flyspell-auto-correct-pos pos) | |
1088 ;; we have already been using the function at the same location | |
1089 (progn | |
1090 (save-excursion | |
1091 (let ((start (car flyspell-auto-correct-region)) | |
1092 (len (cdr flyspell-auto-correct-region))) | |
1093 (delete-region start (+ start len)) | |
1094 (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring)) | |
1095 (let* ((word (car flyspell-auto-correct-ring)) | |
1096 (len (length word))) | |
1097 (rplacd flyspell-auto-correct-region len) | |
1098 (goto-char start) | |
1099 (insert word)))) | |
1100 (setq flyspell-auto-correct-pos (point))) | |
1101 ;; retain cursor location | |
1102 (let ((cursor-location pos) | |
1103 (word (flyspell-get-word nil)) | |
1104 start end poss) | |
1105 ;; destructure return word info list. | |
1106 (setq start (car (cdr word)) | |
1107 end (car (cdr (cdr word))) | |
1108 word (car word)) | |
1109 ;; now check spelling of word. | |
1110 (process-send-string ispell-process "%\n") ;put in verbose mode | |
1111 (process-send-string ispell-process (concat "^" word "\n")) | |
1112 ;; wait until ispell has processed word | |
1113 (while (progn | |
1114 (accept-process-output ispell-process) | |
1115 (not (string= "" (car ispell-filter))))) | |
1116 (setq ispell-filter (cdr ispell-filter)) | |
1117 (if (listp ispell-filter) | |
1118 (setq poss (ispell-parse-output (car ispell-filter)))) | |
1119 (cond ((or (eq poss t) (stringp poss)) | |
1120 ;; don't correct word | |
1121 t) | |
1122 ((null poss) | |
1123 ;; ispell error | |
1124 (error "Ispell: error in Ispell process")) | |
1125 (t | |
1126 ;; the word is incorrect, we have to propose a replacement | |
1127 (let ((replacements (if flyspell-sort-corrections | |
1128 (sort (car (cdr (cdr poss))) 'string<) | |
1129 (car (cdr (cdr poss)))))) | |
1130 (if (consp replacements) | |
1131 (progn | |
1132 (let ((replace (car replacements))) | |
1133 (setq word replace) | |
1134 (setq cursor-location (+ (- (length word) (- end start)) | |
1135 cursor-location)) | |
1136 (if (not (equal word (car poss))) | |
1137 (progn | |
1138 ;; the save the current replacements | |
1139 (setq flyspell-auto-correct-pos cursor-location) | |
1140 (setq flyspell-auto-correct-region | |
1141 (cons start (length word))) | |
1142 (let ((l replacements)) | |
1143 (while (consp (cdr l)) | |
1144 (setq l (cdr l))) | |
1145 (rplacd l (cons (car poss) replacements))) | |
1146 (setq flyspell-auto-correct-ring | |
1147 (cdr replacements)) | |
1148 (delete-region start end) | |
1149 (insert word))))))))) | |
1150 ;; return to original location | |
1151 (goto-char cursor-location) | |
1152 (ispell-pdict-save t)))) | |
1153 | |
1154 ;*---------------------------------------------------------------------*/ | |
1155 ;* flyspell-correct-word ... */ | |
1156 ;*---------------------------------------------------------------------*/ | |
1157 (defun flyspell-correct-word (event) | |
1158 "Check spelling of word under or before the cursor. | |
1159 If the word is not found in dictionary, display possible corrections | |
1160 in a popup menu allowing you to choose one. | |
1161 | |
1162 Word syntax described by `ispell-dictionary-alist' (which see). | |
1163 | |
1164 This will check or reload the dictionary. Use \\[ispell-change-dictionary] | |
1165 or \\[ispell-region] to update the Ispell process." | |
1166 (interactive "e") | |
1167 (if (eq flyspell-emacs 'xemacs) | |
1168 (flyspell-correct-word/mouse-keymap event) | |
1169 (flyspell-correct-word/local-keymap event))) | |
1170 | |
1171 ;*---------------------------------------------------------------------*/ | |
1172 ;* flyspell-correct-word/local-keymap ... */ | |
1173 ;*---------------------------------------------------------------------*/ | |
1174 (defun flyspell-correct-word/local-keymap (event) | |
1175 "emacs 19.xx seems to be buggous. Overlay keymap does not seems | |
1176 to work correctly with local map. That is, if a key is not | |
1177 defined for the overlay keymap, the current local map, is not | |
1178 checked. The binding is resolved with the global map. The | |
1179 consequence is that we can not use overlay map with flyspell." | |
1180 (interactive "e") | |
1181 (save-window-excursion | |
1182 (let ((save (point))) | |
1183 (mouse-set-point event) | |
1184 ;; we look for a flyspell overlay here | |
1185 (let ((overlays (overlays-at (point))) | |
1186 (overlay nil)) | |
1187 (while (consp overlays) | |
1188 (if (flyspell-overlay-p (car overlays)) | |
1189 (progn | |
1190 (setq overlay (car overlays)) | |
1191 (setq overlays nil)) | |
1192 (setq overlays (cdr overlays)))) | |
1193 ;; we return to the correct location | |
1194 (goto-char save) | |
1195 ;; we check to see if button2 has been used overlay a | |
1196 ;; flyspell overlay | |
1197 (if overlay | |
1198 ;; yes, so we use the flyspell function | |
1199 (flyspell-correct-word/mouse-keymap event) | |
1200 ;; no so we have to use the non flyspell binding | |
1201 (let ((flyspell-mode nil)) | |
1202 (if (key-binding (this-command-keys)) | |
1203 (command-execute (key-binding (this-command-keys)))))))))) | |
1204 | |
1205 ;*---------------------------------------------------------------------*/ | |
1206 ;* flyspell-correct-word ... */ | |
1207 ;*---------------------------------------------------------------------*/ | |
1208 (defun flyspell-correct-word/mouse-keymap (event) | |
1209 "Popup a menu to present possible correction. The word checked is the | |
1210 word at the mouse position." | |
1211 (interactive "e") | |
1212 ;; use the correct dictionary | |
1213 (ispell-accept-buffer-local-defs) | |
1214 ;; retain cursor location (I don't know why but save-excursion here fails). | |
1215 (let ((save (point))) | |
1216 (mouse-set-point event) | |
1217 (let ((cursor-location (point)) | |
1218 (word (flyspell-get-word nil)) | |
1219 start end poss replace) | |
1220 ;; destructure return word info list. | |
1221 (setq start (car (cdr word)) | |
1222 end (car (cdr (cdr word))) | |
1223 word (car word)) | |
1224 ;; now check spelling of word. | |
1225 (process-send-string ispell-process "%\n") ;put in verbose mode | |
1226 (process-send-string ispell-process (concat "^" word "\n")) | |
1227 ;; wait until ispell has processed word | |
1228 (while (progn | |
1229 (accept-process-output ispell-process) | |
1230 (not (string= "" (car ispell-filter))))) | |
1231 (setq ispell-filter (cdr ispell-filter)) | |
1232 (if (listp ispell-filter) | |
1233 (setq poss (ispell-parse-output (car ispell-filter)))) | |
1234 (cond ((or (eq poss t) (stringp poss)) | |
1235 ;; don't correct word | |
1236 t) | |
1237 ((null poss) | |
1238 ;; ispell error | |
1239 (error "Ispell: error in Ispell process")) | |
1240 ((string-match "GNU" (emacs-version)) | |
1241 ;; the word is incorrect, we have to propose a replacement | |
1242 (setq replace (flyspell-gnuemacs-popup event poss word)) | |
1243 (cond ((eq replace 'ignore) | |
1244 nil) | |
1245 ((eq replace 'save) | |
1246 (process-send-string ispell-process (concat "*" word "\n")) | |
1247 (flyspell-unhighlight-at cursor-location) | |
1248 (setq ispell-pdict-modified-p '(t))) | |
1249 ((or (eq replace 'buffer) (eq replace 'session)) | |
1250 (process-send-string ispell-process (concat "@" word "\n")) | |
1251 (if (null ispell-pdict-modified-p) | |
1252 (setq ispell-pdict-modified-p | |
1253 (list ispell-pdict-modified-p))) | |
1254 (flyspell-unhighlight-at cursor-location) | |
1255 (if (eq replace 'buffer) | |
1256 (ispell-add-per-file-word-list word))) | |
1257 (replace | |
1258 (setq word (if (atom replace) replace (car replace)) | |
1259 cursor-location (+ (- (length word) (- end start)) | |
1260 cursor-location)) | |
1261 (if (not (equal word (car poss))) | |
1262 (progn | |
1263 (delete-region start end) | |
1264 (insert word)))))) | |
1265 ((string-match "XEmacs" (emacs-version)) | |
1266 (flyspell-xemacs-popup | |
1267 event poss word cursor-location start end))) | |
1268 (ispell-pdict-save t)) | |
1269 (if (< save (point-max)) | |
1270 (goto-char save) | |
1271 (goto-char (point-max))))) | |
1272 | |
1273 ;*---------------------------------------------------------------------*/ | |
1274 ;* flyspell-xemacs-correct ... */ | |
1275 ;*---------------------------------------------------------------------*/ | |
1276 (defun flyspell-xemacs-correct (replace poss word cursor-location start end) | |
1277 "The xemacs popup menu callback." | |
1278 (cond ((eq replace 'ignore) | |
1279 nil) | |
1280 ((eq replace 'save) | |
1281 (process-send-string ispell-process (concat "*" word "\n")) | |
1282 (flyspell-unhighlight-at cursor-location) | |
1283 (setq ispell-pdict-modified-p '(t))) | |
1284 ((or (eq replace 'buffer) (eq replace 'session)) | |
1285 (process-send-string ispell-process (concat "@" word "\n")) | |
1286 (flyspell-unhighlight-at cursor-location) | |
1287 (if (null ispell-pdict-modified-p) | |
1288 (setq ispell-pdict-modified-p | |
1289 (list ispell-pdict-modified-p))) | |
1290 (if (eq replace 'buffer) | |
1291 (ispell-add-per-file-word-list word))) | |
1292 (replace | |
1293 (setq word (if (atom replace) replace (car replace)) | |
1294 cursor-location (+ (- (length word) (- end start)) | |
1295 cursor-location)) | |
1296 (if (not (equal word (car poss))) | |
1297 (save-excursion | |
1298 (delete-region start end) | |
1299 (goto-char start) | |
1300 (insert word)))))) | |
1301 | |
1302 ;*---------------------------------------------------------------------*/ | |
1303 ;* flyspell-gnuemacs-popup */ | |
1304 ;*---------------------------------------------------------------------*/ | |
1305 (defun flyspell-gnuemacs-popup (event poss word) | |
1306 "The gnu-emacs popup menu." | |
1307 (if (not event) | |
1308 (let* ((mouse-pos (mouse-position)) | |
1309 (mouse-pos (if (nth 1 mouse-pos) | |
1310 mouse-pos | |
1311 (set-mouse-position (car mouse-pos) | |
1312 (/ (frame-width) 2) 2) | |
1313 (unfocus-frame) | |
1314 (mouse-position)))) | |
1315 (setq event (list (list (car (cdr mouse-pos)) | |
1316 (1+ (cdr (cdr mouse-pos)))) | |
1317 (car mouse-pos))))) | |
1318 (let* ((corrects (if flyspell-sort-corrections | |
1319 (sort (car (cdr (cdr poss))) 'string<) | |
1320 (car (cdr (cdr poss))))) | |
1321 (cor-menu (if (consp corrects) | |
1322 (mapcar (lambda (correct) | |
1323 (list correct correct)) | |
1324 corrects) | |
1325 '())) | |
1326 (affix (car (cdr (cdr (cdr poss))))) | |
1327 (base-menu (let ((save (if (consp affix) | |
1328 (list | |
1329 (list (concat "Save affix: " (car affix)) | |
1330 'save) | |
1331 '("Accept (session)" accept) | |
1332 '("Accept (buffer)" buffer)) | |
1333 '(("Save word" save) | |
1334 ("Accept (session)" session) | |
1335 ("Accept (buffer)" buffer))))) | |
1336 (if (consp cor-menu) | |
1337 (append cor-menu (cons "" save)) | |
1338 save))) | |
1339 (menu (cons "flyspell correction menu" base-menu))) | |
1340 (car (x-popup-menu event | |
1341 (list (format "%s [%s]" word (or ispell-local-dictionary | |
1342 ispell-dictionary)) | |
1343 menu))))) | |
1344 | |
1345 ;*---------------------------------------------------------------------*/ | |
1346 ;* flyspell-xemacs-popup */ | |
1347 ;*---------------------------------------------------------------------*/ | |
1348 (defun flyspell-xemacs-popup (event poss word cursor-location start end) | |
1349 "The xemacs popup menu." | |
1350 (let* ((corrects (if flyspell-sort-corrections | |
1351 (sort (car (cdr (cdr poss))) 'string<) | |
1352 (car (cdr (cdr poss))))) | |
1353 (cor-menu (if (consp corrects) | |
1354 (mapcar (lambda (correct) | |
1355 (vector correct | |
1356 (list 'flyspell-xemacs-correct | |
1357 correct | |
1358 (list 'quote poss) | |
1359 word | |
1360 cursor-location | |
1361 start | |
1362 end) | |
1363 t)) | |
1364 corrects) | |
1365 '())) | |
1366 (affix (car (cdr (cdr (cdr poss))))) | |
1367 (menu (let ((save (if (consp affix) | |
1368 (vector | |
1369 (concat "Save affix: " (car affix)) | |
1370 (list 'flyspell-xemacs-correct | |
1371 ''save | |
1372 (list 'quote poss) | |
1373 word | |
1374 cursor-location | |
1375 start | |
1376 end) | |
1377 t) | |
1378 (vector | |
1379 "Save word" | |
1380 (list 'flyspell-xemacs-correct | |
1381 ''save | |
1382 (list 'quote poss) | |
1383 word | |
1384 cursor-location | |
1385 start | |
1386 end) | |
1387 t))) | |
1388 (session (vector "Accept (session)" | |
1389 (list 'flyspell-xemacs-correct | |
1390 ''session | |
1391 (list 'quote poss) | |
1392 word | |
1393 cursor-location | |
1394 start | |
1395 end) | |
1396 t)) | |
1397 (buffer (vector "Accept (buffer)" | |
1398 (list 'flyspell-xemacs-correct | |
1399 ''buffer | |
1400 (list 'quote poss) | |
1401 word | |
1402 cursor-location | |
1403 start | |
1404 end) | |
1405 t))) | |
1406 (if (consp cor-menu) | |
1407 (append cor-menu (list "-" save session buffer)) | |
1408 (list save session buffer))))) | |
1409 (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary | |
1410 ispell-dictionary)) | |
1411 menu)))) | |
1412 | |
1413 (provide 'flyspell) | |
1414 | |
1415 ;;; flyspell.el ends here |