|
22611
|
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
|
