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