Mercurial > emacs
comparison lisp/textmodes/flyspell.el @ 90188:01137c1fdbe9
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-57
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 324-352)
- Merge from gnus--rel--5.10
- Update from CVS
- etc/emacs-buffer.gdb: Remove RCS keywords
* gnus--rel--5.10 (patch 70-79)
- Update from CVS
- Merge from emacs--cvs-trunk--0
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 06 Jun 2005 02:39:45 +0000 |
parents | 02f1dbc4a199 efec57cea7c7 |
children | 173dee4e2611 |
comparison
equal
deleted
inserted
replaced
90187:587ea1490d70 | 90188:01137c1fdbe9 |
---|---|
1 ;;; flyspell.el --- on-the-fly spell checker | 1 ;;; flyspell.el --- on-the-fly spell checker |
2 | 2 |
3 ;; Copyright (C) 1998, 2000, 2001, 2002, 2004 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1998, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr> | 5 ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr> |
6 ;; Maintainer: FSF | 6 ;; Maintainer: FSF |
7 ;; Keywords: convenience | 7 ;; Keywords: convenience |
8 | 8 |
54 :prefix "flyspell-" | 54 :prefix "flyspell-" |
55 :group 'ispell | 55 :group 'ispell |
56 :group 'processes) | 56 :group 'processes) |
57 | 57 |
58 ;*---------------------------------------------------------------------*/ | 58 ;*---------------------------------------------------------------------*/ |
59 ;* Which emacs are we currently running */ | |
60 ;*---------------------------------------------------------------------*/ | |
61 (defvar flyspell-emacs | |
62 (cond | |
63 ((string-match "XEmacs" emacs-version) | |
64 'xemacs) | |
65 (t | |
66 'emacs)) | |
67 "The type of Emacs we are currently running.") | |
68 | |
69 (defvar flyspell-use-local-map | |
70 (or (eq flyspell-emacs 'xemacs) | |
71 (not (string< emacs-version "20")))) | |
72 | |
73 ;*---------------------------------------------------------------------*/ | |
59 ;* User configuration ... */ | 74 ;* User configuration ... */ |
60 ;*---------------------------------------------------------------------*/ | 75 ;*---------------------------------------------------------------------*/ |
61 (defcustom flyspell-highlight-flag t | 76 (defcustom flyspell-highlight-flag t |
62 "*How Flyspell should indicate misspelled words. | 77 "*How Flyspell should indicate misspelled words. |
63 Non-nil means use highlight, nil means use minibuffer messages." | 78 Non-nil means use highlight, nil means use minibuffer messages." |
107 (defcustom flyspell-default-delayed-commands | 122 (defcustom flyspell-default-delayed-commands |
108 '(self-insert-command | 123 '(self-insert-command |
109 delete-backward-char | 124 delete-backward-char |
110 backward-or-forward-delete-char | 125 backward-or-forward-delete-char |
111 delete-char | 126 delete-char |
112 scrollbar-vertical-drag) | 127 scrollbar-vertical-drag |
128 backward-delete-char-untabify) | |
113 "The standard list of delayed commands for Flyspell. | 129 "The standard list of delayed commands for Flyspell. |
114 See `flyspell-delayed-commands'." | 130 See `flyspell-delayed-commands'." |
115 :group 'flyspell | 131 :group 'flyspell |
116 :version "21.1" | 132 :version "21.1" |
117 :type '(repeat (symbol))) | 133 :type '(repeat (symbol))) |
197 :group 'flyspell | 213 :group 'flyspell |
198 :version "21.1" | 214 :version "21.1" |
199 :type '(repeat (string))) | 215 :type '(repeat (string))) |
200 | 216 |
201 (defcustom flyspell-abbrev-p | 217 (defcustom flyspell-abbrev-p |
202 t | 218 nil |
203 "*If true, add correction to abbreviation table." | 219 "*If non-nil, add correction to abbreviation table." |
204 :group 'flyspell | 220 :group 'flyspell |
205 :version "21.1" | 221 :version "21.1" |
206 :type 'boolean) | 222 :type 'boolean) |
207 | 223 |
208 (defcustom flyspell-use-global-abbrev-table-p | 224 (defcustom flyspell-use-global-abbrev-table-p |
209 nil | 225 nil |
210 "*If true, prefer global abbrev table to local abbrev table." | 226 "*If non-nil, prefer global abbrev table to local abbrev table." |
211 :group 'flyspell | 227 :group 'flyspell |
212 :version "21.1" | 228 :version "21.1" |
213 :type 'boolean) | 229 :type 'boolean) |
214 | 230 |
215 ;;;###autoload | 231 ;;;###autoload |
222 (defcustom flyspell-large-region 1000 | 238 (defcustom flyspell-large-region 1000 |
223 "*The threshold that determines if a region is small. | 239 "*The threshold that determines if a region is small. |
224 If the region is smaller than this number of characters, | 240 If the region is smaller than this number of characters, |
225 `flyspell-region' checks the words sequentially using regular | 241 `flyspell-region' checks the words sequentially using regular |
226 flyspell methods. Else, if the region is large, a new Ispell process is | 242 flyspell methods. Else, if the region is large, a new Ispell process is |
227 spawned for speed." | 243 spawned for speed. |
244 | |
245 If `flyspell-large-region' is nil, all regions are treated as small." | |
228 :group 'flyspell | 246 :group 'flyspell |
229 :version "21.1" | 247 :version "21.1" |
230 :type 'number) | 248 :type '(choice number boolean)) |
231 | 249 |
232 (defcustom flyspell-insert-function (function insert) | 250 (defcustom flyspell-insert-function (function insert) |
233 "*Function for inserting word by flyspell upon correction." | 251 "*Function for inserting word by flyspell upon correction." |
234 :group 'flyspell | 252 :group 'flyspell |
235 :type 'function) | 253 :type 'function) |
241 | 259 |
242 (defcustom flyspell-after-incorrect-word-string nil | 260 (defcustom flyspell-after-incorrect-word-string nil |
243 "String used to indicate an incorrect word ending." | 261 "String used to indicate an incorrect word ending." |
244 :group 'flyspell | 262 :group 'flyspell |
245 :type '(choice string (const nil))) | 263 :type '(choice string (const nil))) |
264 | |
265 (defcustom flyspell-use-meta-tab t | |
266 "*Non-nil means that flyspell uses META-TAB to correct word." | |
267 :group 'flyspell | |
268 :type 'boolean) | |
269 | |
270 (defcustom flyspell-auto-correct-binding | |
271 (cond | |
272 ((eq flyspell-emacs 'xemacs) | |
273 [(control \;)]) | |
274 (t | |
275 [?\C-\;])) | |
276 "The key binding for flyspell auto correction." | |
277 :group 'flyspell) | |
246 | 278 |
247 ;*---------------------------------------------------------------------*/ | 279 ;*---------------------------------------------------------------------*/ |
248 ;* Mode specific options */ | 280 ;* Mode specific options */ |
249 ;* ------------------------------------------------------------- */ | 281 ;* ------------------------------------------------------------- */ |
250 ;* Mode specific options enable users to disable flyspell on */ | 282 ;* Mode specific options enable users to disable flyspell on */ |
265 ;*--- mail mode -------------------------------------------------------*/ | 297 ;*--- mail mode -------------------------------------------------------*/ |
266 (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) | 298 (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) |
267 (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) | 299 (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) |
268 (defun mail-mode-flyspell-verify () | 300 (defun mail-mode-flyspell-verify () |
269 "This function is used for `flyspell-generic-check-word-p' in Mail mode." | 301 "This function is used for `flyspell-generic-check-word-p' in Mail mode." |
270 (let ((in-headers (save-excursion | 302 (let ((header-end (save-excursion |
271 ;; When mail-header-separator is "", | 303 (goto-char (point-min)) |
272 ;; it is likely to be found in both directions. | 304 (re-search-forward |
273 (not (re-search-backward (concat "^" (regexp-quote mail-header-separator) "$") nil t)))) | 305 (concat "^" |
274 (in-signature (save-excursion | 306 (regexp-quote mail-header-separator) |
275 (re-search-backward message-signature-separator nil t)))) | 307 "$") |
276 (cond (in-headers | 308 nil t) |
309 (point))) | |
310 (signature-begin (save-excursion | |
311 (goto-char (point-max)) | |
312 (re-search-backward message-signature-separator | |
313 nil t) | |
314 (point)))) | |
315 (cond ((< (point) header-end) | |
277 (and (save-excursion (beginning-of-line) | 316 (and (save-excursion (beginning-of-line) |
278 (looking-at "^Subject:")) | 317 (looking-at "^Subject:")) |
279 (> (point) (match-end 0)))) | 318 (> (point) (match-end 0)))) |
280 (in-signature | 319 ((> (point) signature-begin) |
281 nil) | 320 nil) |
282 (t | 321 (t |
283 (save-excursion | 322 (save-excursion |
284 (beginning-of-line) | 323 (beginning-of-line) |
285 (not (looking-at "[>}|]\\|To:"))))))) | 324 (not (looking-at "[>}|]\\|To:"))))))) |
349 ;;;###autoload | 388 ;;;###autoload |
350 (defun flyspell-prog-mode () | 389 (defun flyspell-prog-mode () |
351 "Turn on `flyspell-mode' for comments and strings." | 390 "Turn on `flyspell-mode' for comments and strings." |
352 (interactive) | 391 (interactive) |
353 (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) | 392 (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) |
354 (flyspell-mode 1)) | 393 (flyspell-mode 1) |
394 (run-hooks 'flyspell-prog-mode-hook)) | |
355 | 395 |
356 ;*---------------------------------------------------------------------*/ | 396 ;*---------------------------------------------------------------------*/ |
357 ;* Overlay compatibility */ | 397 ;* Overlay compatibility */ |
358 ;*---------------------------------------------------------------------*/ | 398 ;*---------------------------------------------------------------------*/ |
359 (autoload 'make-overlay "overlay" "Overlay compatibility kit." t) | 399 (autoload 'make-overlay "overlay" "Overlay compatibility kit." t) |
364 (autoload 'overlay-put "overlay" "Overlay compatibility kit." t) | 404 (autoload 'overlay-put "overlay" "Overlay compatibility kit." t) |
365 (autoload 'overlay-get "overlay" "Overlay compatibility kit." t) | 405 (autoload 'overlay-get "overlay" "Overlay compatibility kit." t) |
366 (autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t) | 406 (autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t) |
367 | 407 |
368 ;*---------------------------------------------------------------------*/ | 408 ;*---------------------------------------------------------------------*/ |
369 ;* Which emacs are we currently running */ | |
370 ;*---------------------------------------------------------------------*/ | |
371 (defvar flyspell-emacs | |
372 (cond | |
373 ((string-match "XEmacs" emacs-version) | |
374 'xemacs) | |
375 (t | |
376 'emacs)) | |
377 "The type of Emacs we are currently running.") | |
378 | |
379 (defvar flyspell-use-local-map | |
380 (or (eq flyspell-emacs 'xemacs) | |
381 (not (string< emacs-version "20")))) | |
382 | |
383 ;*---------------------------------------------------------------------*/ | |
384 ;* The minor mode declaration. */ | 409 ;* The minor mode declaration. */ |
385 ;*---------------------------------------------------------------------*/ | 410 ;*---------------------------------------------------------------------*/ |
386 (eval-when-compile (defvar flyspell-local-mouse-map)) | 411 (eval-when-compile (defvar flyspell-local-mouse-map)) |
387 | 412 |
388 ;;;###autoload | 413 ;;;###autoload |
389 (defvar flyspell-mode nil) | 414 (defvar flyspell-mode nil) |
390 (make-variable-buffer-local 'flyspell-mode) | 415 (make-variable-buffer-local 'flyspell-mode) |
391 | 416 |
392 (defvar flyspell-mouse-map | 417 (defvar flyspell-mouse-map |
393 (let ((map (make-sparse-keymap))) | 418 (let ((map (make-sparse-keymap))) |
419 (if flyspell-use-meta-tab | |
420 (define-key map "\M-\t" #'flyspell-auto-correct-word)) | |
394 (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2]) | 421 (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2]) |
395 #'flyspell-correct-word) | 422 #'flyspell-correct-word) |
396 (define-key map "\M-\t" #'flyspell-auto-correct-word) | 423 (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) |
424 (define-key map [(control \,)] 'flyspell-goto-next-error) | |
425 (define-key map [(control \.)] 'flyspell-auto-correct-word) | |
397 map)) | 426 map)) |
398 | 427 |
399 ;;;###autoload | 428 ;;;###autoload |
400 (defvar flyspell-mode-map (make-sparse-keymap)) | 429 (defvar flyspell-mode-map (make-sparse-keymap)) |
401 | 430 |
402 ;; mouse, keyboard bindings and misc definition | 431 ;; mouse, keyboard bindings and misc definition |
403 (when (or (assoc 'flyspell-mode minor-mode-map-alist) | 432 (when (or (assoc 'flyspell-mode minor-mode-map-alist) |
404 (setq minor-mode-map-alist | 433 (setq minor-mode-map-alist |
405 (cons (cons 'flyspell-mode flyspell-mode-map) | 434 (cons (cons 'flyspell-mode flyspell-mode-map) |
406 minor-mode-map-alist))) | 435 minor-mode-map-alist))) |
407 (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word)) | 436 (if flyspell-use-meta-tab |
437 (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word)) | |
438 (cond | |
439 ((eq flyspell-emacs 'xemacs) | |
440 (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) | |
441 (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error) | |
442 (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word)) | |
443 (flyspell-use-local-map | |
444 (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) | |
445 (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error) | |
446 (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word)))) | |
447 | |
408 | 448 |
409 ;; the name of the overlay property that defines the keymap | 449 ;; the name of the overlay property that defines the keymap |
410 (defvar flyspell-overlay-keymap-property-name 'keymap) | 450 (defvar flyspell-overlay-keymap-property-name 'keymap) |
411 | 451 |
412 ;; dash character machinery | 452 ;; dash character machinery |
454 With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive. | 494 With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive. |
455 | 495 |
456 Bindings: | 496 Bindings: |
457 \\[ispell-word]: correct words (using Ispell). | 497 \\[ispell-word]: correct words (using Ispell). |
458 \\[flyspell-auto-correct-word]: automatically correct word. | 498 \\[flyspell-auto-correct-word]: automatically correct word. |
459 \\[flyspell-correct-word] (or mouse-2): popup correct words. | 499 \\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word. |
500 \\[flyspell-correct-word] (or down-mouse-2): popup correct words. | |
460 | 501 |
461 Hooks: | 502 Hooks: |
462 This runs `flyspell-mode-hook' after flyspell is entered. | 503 This runs `flyspell-mode-hook' after flyspell is entered. |
463 | 504 |
464 Remark: | 505 Remark: |
510 "Is BUFFER a minibuffer?" | 551 "Is BUFFER a minibuffer?" |
511 (let ((ws (get-buffer-window-list buffer t))) | 552 (let ((ws (get-buffer-window-list buffer t))) |
512 (and (consp ws) (window-minibuffer-p (car ws))))) | 553 (and (consp ws) (window-minibuffer-p (car ws))))) |
513 | 554 |
514 ;*---------------------------------------------------------------------*/ | 555 ;*---------------------------------------------------------------------*/ |
515 ;* flyspell-version ... */ | |
516 ;*---------------------------------------------------------------------*/ | |
517 ;;;###autoload | |
518 (defun flyspell-version () | |
519 "The flyspell version" | |
520 (interactive) | |
521 "1.6h") | |
522 | |
523 ;*---------------------------------------------------------------------*/ | |
524 ;* flyspell-accept-buffer-local-defs ... */ | 556 ;* flyspell-accept-buffer-local-defs ... */ |
525 ;*---------------------------------------------------------------------*/ | 557 ;*---------------------------------------------------------------------*/ |
526 (defun flyspell-accept-buffer-local-defs () | 558 (defun flyspell-accept-buffer-local-defs () |
527 (ispell-accept-buffer-local-defs) | 559 ;; strange problem. If buffer in current window has font-lock turned on, |
560 ;; but SET-BUFFER was called to point to an invisible buffer, this ispell | |
561 ;; call will reset the buffer to the buffer in the current window. However, | |
562 ;; it only happens at startup (fix by Albert L. Ting). | |
563 (let ((buf (current-buffer))) | |
564 (ispell-accept-buffer-local-defs) | |
565 (set-buffer buf)) | |
528 (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) | 566 (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) |
529 (eq flyspell-dash-local-dictionary ispell-local-dictionary))) | 567 (eq flyspell-dash-local-dictionary ispell-local-dictionary))) |
530 ;; the dictionary has changed | 568 ;; The dictionary has changed |
531 (progn | 569 (progn |
532 (setq flyspell-dash-dictionary ispell-dictionary) | 570 (setq flyspell-dash-dictionary ispell-dictionary) |
533 (setq flyspell-dash-local-dictionary ispell-local-dictionary) | 571 (setq flyspell-dash-local-dictionary ispell-local-dictionary) |
534 (if (member (or ispell-local-dictionary ispell-dictionary) | 572 (if (member (or ispell-local-dictionary ispell-dictionary) |
535 flyspell-dictionaries-that-consider-dash-as-word-delimiter) | 573 flyspell-dictionaries-that-consider-dash-as-word-delimiter) |
564 (cons 'flyspell-after-change-function after-change-functions)) | 602 (cons 'flyspell-after-change-function after-change-functions)) |
565 ;; set flyspell-generic-check-word-p based on the major mode | 603 ;; set flyspell-generic-check-word-p based on the major mode |
566 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) | 604 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) |
567 (if mode-predicate | 605 (if mode-predicate |
568 (setq flyspell-generic-check-word-p mode-predicate))) | 606 (setq flyspell-generic-check-word-p mode-predicate))) |
607 ;; work around the fact that the `local-map' text-property replaces the | |
608 ;; buffer's local map rather than shadowing it. | |
609 (set (make-local-variable 'flyspell-mouse-map) | |
610 (let ((map (copy-keymap flyspell-mouse-map))) | |
611 (set-keymap-parent map (current-local-map)) | |
612 (if (and (eq flyspell-emacs 'emacs) | |
613 (not (string< emacs-version "20"))) | |
614 (define-key map '[tool-bar] nil)) | |
615 map)) | |
616 (set (make-local-variable 'flyspell-mode-map) | |
617 (let ((map (copy-keymap flyspell-mode-map))) | |
618 (set-keymap-parent map (current-local-map)) | |
619 (if (and (eq flyspell-emacs 'emacs) | |
620 (not (string< emacs-version "20"))) | |
621 (define-key map '[tool-bar] nil)) | |
622 map)) | |
569 ;; the welcome message | 623 ;; the welcome message |
570 (if (and flyspell-issue-message-flag | 624 (if (and flyspell-issue-message-flag |
571 flyspell-issue-welcome-flag | 625 flyspell-issue-welcome-flag |
572 (interactive-p)) | 626 (interactive-p)) |
573 (let ((binding (where-is-internal 'flyspell-auto-correct-word | 627 (let ((binding (where-is-internal 'flyspell-auto-correct-word |
622 ;* flyspell-word-cache ... */ | 676 ;* flyspell-word-cache ... */ |
623 ;*---------------------------------------------------------------------*/ | 677 ;*---------------------------------------------------------------------*/ |
624 (defvar flyspell-word-cache-start nil) | 678 (defvar flyspell-word-cache-start nil) |
625 (defvar flyspell-word-cache-end nil) | 679 (defvar flyspell-word-cache-end nil) |
626 (defvar flyspell-word-cache-word nil) | 680 (defvar flyspell-word-cache-word nil) |
681 (defvar flyspell-word-cache-result '_) | |
627 (make-variable-buffer-local 'flyspell-word-cache-start) | 682 (make-variable-buffer-local 'flyspell-word-cache-start) |
628 (make-variable-buffer-local 'flyspell-word-cache-end) | 683 (make-variable-buffer-local 'flyspell-word-cache-end) |
629 (make-variable-buffer-local 'flyspell-word-cache-word) | 684 (make-variable-buffer-local 'flyspell-word-cache-word) |
685 (make-variable-buffer-local 'flyspell-word-cache-result) | |
630 | 686 |
631 ;*---------------------------------------------------------------------*/ | 687 ;*---------------------------------------------------------------------*/ |
632 ;* The flyspell pre-hook, store the current position. In the */ | 688 ;* The flyspell pre-hook, store the current position. In the */ |
633 ;* post command hook, we will check, if the word at this position */ | 689 ;* post command hook, we will check, if the word at this position */ |
634 ;* has to be spell checked. */ | 690 ;* has to be spell checked. */ |
676 | 732 |
677 ;*---------------------------------------------------------------------*/ | 733 ;*---------------------------------------------------------------------*/ |
678 ;* flyspell-check-pre-word-p ... */ | 734 ;* flyspell-check-pre-word-p ... */ |
679 ;*---------------------------------------------------------------------*/ | 735 ;*---------------------------------------------------------------------*/ |
680 (defun flyspell-check-pre-word-p () | 736 (defun flyspell-check-pre-word-p () |
681 "Return non-nil if we should to check the word before point. | 737 "Return non-nil if we should check the word before point. |
682 More precisely, it applies to the word that was before point | 738 More precisely, it applies to the word that was before point |
683 before the current command." | 739 before the current command." |
684 (cond | 740 (cond |
685 ((or (not (numberp flyspell-pre-point)) | 741 ((or (not (numberp flyspell-pre-point)) |
686 (not (bufferp flyspell-pre-buffer)) | 742 (not (bufferp flyspell-pre-buffer)) |
733 (defun flyspell-check-changed-word-p (start stop) | 789 (defun flyspell-check-changed-word-p (start stop) |
734 "Return t when the changed word has to be checked. | 790 "Return t when the changed word has to be checked. |
735 The answer depends of several criteria. | 791 The answer depends of several criteria. |
736 Mostly we check word delimiters." | 792 Mostly we check word delimiters." |
737 (cond | 793 (cond |
738 ((and (eq (char-after start) ?\n) (> stop start)) | 794 ((and (memq (char-after start) '(?\n ? )) (> stop start)) |
739 t) | 795 t) |
740 ((not (numberp flyspell-pre-point)) | 796 ((not (numberp flyspell-pre-point)) |
741 t) | 797 t) |
742 ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop)) | 798 ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop)) |
743 nil) | 799 nil) |
772 ((get this-command 'flyspell-deplacement) | 828 ((get this-command 'flyspell-deplacement) |
773 (not (eq flyspell-previous-command this-command))) | 829 (not (eq flyspell-previous-command this-command))) |
774 ((get this-command 'flyspell-delayed) | 830 ((get this-command 'flyspell-delayed) |
775 ;; the current command is not delayed, that | 831 ;; the current command is not delayed, that |
776 ;; is that we must check the word now | 832 ;; is that we must check the word now |
777 (if (fboundp 'about-xemacs) | 833 (sit-for flyspell-delay)) |
778 (sit-for flyspell-delay nil) | |
779 (sit-for flyspell-delay 0 nil))) | |
780 (t t))) | 834 (t t))) |
781 (t t))) | 835 (t t))) |
782 | 836 |
783 ;*---------------------------------------------------------------------*/ | 837 ;*---------------------------------------------------------------------*/ |
784 ;* flyspell-debug-signal-no-check ... */ | 838 ;* flyspell-debug-signal-no-check ... */ |
922 (setq flyspell-pre-pre-buffer nil) | 976 (setq flyspell-pre-pre-buffer nil) |
923 (setq flyspell-pre-pre-point nil) | 977 (setq flyspell-pre-pre-point nil) |
924 ;; when a word is not checked because of a delayed command | 978 ;; when a word is not checked because of a delayed command |
925 ;; we do not disable the ispell cache. | 979 ;; we do not disable the ispell cache. |
926 (if (and (symbolp this-command) (get this-command 'flyspell-delayed)) | 980 (if (and (symbolp this-command) (get this-command 'flyspell-delayed)) |
927 (setq flyspell-word-cache-end -1)))) | 981 (progn |
982 (setq flyspell-word-cache-end -1) | |
983 (setq flyspell-word-cache-result '_))))) | |
928 (while (consp flyspell-changes) | 984 (while (consp flyspell-changes) |
929 (let ((start (car (car flyspell-changes))) | 985 (let ((start (car (car flyspell-changes))) |
930 (stop (cdr (car flyspell-changes)))) | 986 (stop (cdr (car flyspell-changes)))) |
931 (if (flyspell-check-changed-word-p start stop) | 987 (if (flyspell-check-changed-word-p start stop) |
932 (save-excursion | 988 (save-excursion |
946 (sort (car (cdr (cdr poss))) 'string<) | 1002 (sort (car (cdr (cdr poss))) 'string<) |
947 (car (cdr (cdr poss))))))) | 1003 (car (cdr (cdr poss))))))) |
948 (if flyspell-issue-message-flag | 1004 (if flyspell-issue-message-flag |
949 (message (format "mispelling `%s' %S" word replacements))))) | 1005 (message (format "mispelling `%s' %S" word replacements))))) |
950 | 1006 |
1007 ;*---------------------------------------------------------------------*/ | |
1008 ;* flyspell-word-search-backward ... */ | |
1009 ;*---------------------------------------------------------------------*/ | |
1010 (defun flyspell-word-search-backward (word bound) | |
1011 (save-excursion | |
1012 (let ((r '()) | |
1013 p) | |
1014 (while (and (not r) (setq p (search-backward word bound t))) | |
1015 (let ((lw (flyspell-get-word '()))) | |
1016 (if (and (consp lw) (string-equal (car lw) word)) | |
1017 (setq r p) | |
1018 (goto-char p)))) | |
1019 r))) | |
1020 | |
1021 ;*---------------------------------------------------------------------*/ | |
1022 ;* flyspell-word-search-forward ... */ | |
1023 ;*---------------------------------------------------------------------*/ | |
1024 (defun flyspell-word-search-forward (word bound) | |
1025 (save-excursion | |
1026 (let ((r '()) | |
1027 p) | |
1028 (while (and (not r) (setq p (search-forward word bound t))) | |
1029 (let ((lw (flyspell-get-word '()))) | |
1030 (if (and (consp lw) (string-equal (car lw) word)) | |
1031 (setq r p) | |
1032 (goto-char (1+ p))))) | |
1033 r))) | |
1034 | |
951 ;*---------------------------------------------------------------------*/ | 1035 ;*---------------------------------------------------------------------*/ |
952 ;* flyspell-word ... */ | 1036 ;* flyspell-word ... */ |
953 ;*---------------------------------------------------------------------*/ | 1037 ;*---------------------------------------------------------------------*/ |
954 (defun flyspell-word (&optional following) | 1038 (defun flyspell-word (&optional following) |
955 "Spell check a word." | 1039 "Spell check a word." |
961 (flyspell-word (flyspell-get-word following)) | 1045 (flyspell-word (flyspell-get-word following)) |
962 start end poss word) | 1046 start end poss word) |
963 (if (or (eq flyspell-word nil) | 1047 (if (or (eq flyspell-word nil) |
964 (and (fboundp flyspell-generic-check-word-p) | 1048 (and (fboundp flyspell-generic-check-word-p) |
965 (not (funcall flyspell-generic-check-word-p)))) | 1049 (not (funcall flyspell-generic-check-word-p)))) |
966 '() | 1050 t |
967 (progn | 1051 (progn |
968 ;; destructure return flyspell-word info list. | 1052 ;; destructure return flyspell-word info list. |
969 (setq start (car (cdr flyspell-word)) | 1053 (setq start (car (cdr flyspell-word)) |
970 end (car (cdr (cdr flyspell-word))) | 1054 end (car (cdr (cdr flyspell-word))) |
971 word (car flyspell-word)) | 1055 word (car flyspell-word)) |
972 ;; before checking in the directory, we check for doublons. | 1056 ;; before checking in the directory, we check for doublons. |
973 (cond | 1057 (cond |
974 ((and (or (not (eq ispell-parser 'tex)) | 1058 ((and (or (not (eq ispell-parser 'tex)) |
975 (not (eq (char-after start) ?\\))) | 1059 (and (> start (point-min)) |
1060 (not (eq (char-after (1- start)) ?})) | |
1061 (not (eq (char-after (1- start)) ?\\)))) | |
976 flyspell-mark-duplications-flag | 1062 flyspell-mark-duplications-flag |
977 (save-excursion | 1063 (save-excursion |
978 (goto-char start) | 1064 (goto-char (1- start)) |
979 (word-search-backward word | 1065 (let ((p (flyspell-word-search-backward |
980 (- start | 1066 word |
981 (+ 1 (- end start))) | 1067 (- start (1+ (- end start)))))) |
982 t))) | 1068 (and p (/= p (1- start)))))) |
983 ;; yes, this is a doublon | 1069 ;; yes, this is a doublon |
984 (flyspell-highlight-incorrect-region start end 'doublon)) | 1070 (flyspell-highlight-incorrect-region start end 'doublon) |
1071 nil) | |
985 ((and (eq flyspell-word-cache-start start) | 1072 ((and (eq flyspell-word-cache-start start) |
986 (eq flyspell-word-cache-end end) | 1073 (eq flyspell-word-cache-end end) |
987 (string-equal flyspell-word-cache-word word)) | 1074 (string-equal flyspell-word-cache-word word)) |
988 ;; this word had been already checked, we skip | 1075 ;; this word had been already checked, we skip |
989 nil) | 1076 flyspell-word-cache-result) |
990 ((and (eq ispell-parser 'tex) | 1077 ((and (eq ispell-parser 'tex) |
991 (flyspell-tex-command-p flyspell-word)) | 1078 (flyspell-tex-command-p flyspell-word)) |
992 ;; this is a correct word (because a tex command) | 1079 ;; this is a correct word (because a tex command) |
993 (flyspell-unhighlight-at start) | 1080 (flyspell-unhighlight-at start) |
994 (if (> end start) | 1081 (if (> end start) |
1014 ;; (process-send-string ispell-process "!\n") | 1101 ;; (process-send-string ispell-process "!\n") |
1015 ;; back to terse mode. | 1102 ;; back to terse mode. |
1016 (setq ispell-filter (cdr ispell-filter)) | 1103 (setq ispell-filter (cdr ispell-filter)) |
1017 (if (consp ispell-filter) | 1104 (if (consp ispell-filter) |
1018 (setq poss (ispell-parse-output (car ispell-filter)))) | 1105 (setq poss (ispell-parse-output (car ispell-filter)))) |
1019 (cond ((eq poss t) | 1106 (let ((res (cond ((eq poss t) |
1020 ;; correct | 1107 ;; correct |
1021 (flyspell-unhighlight-at start) | 1108 (setq flyspell-word-cache-result t) |
1022 (if (> end start) | 1109 (flyspell-unhighlight-at start) |
1023 (flyspell-unhighlight-at (- end 1))) | 1110 (if (> end start) |
1024 t) | 1111 (flyspell-unhighlight-at (- end 1))) |
1025 ((and (stringp poss) flyspell-highlight-flag) | 1112 t) |
1026 ;; correct | 1113 ((and (stringp poss) flyspell-highlight-flag) |
1027 (flyspell-unhighlight-at start) | 1114 ;; correct |
1028 (if (> end start) | 1115 (setq flyspell-word-cache-result t) |
1029 (flyspell-unhighlight-at (- end 1))) | 1116 (flyspell-unhighlight-at start) |
1030 t) | 1117 (if (> end start) |
1031 ((null poss) | 1118 (flyspell-unhighlight-at (- end 1))) |
1032 (flyspell-unhighlight-at start) | 1119 t) |
1033 (if (> end start) | 1120 ((null poss) |
1034 (flyspell-unhighlight-at (- end 1)))) | 1121 (setq flyspell-word-cache-result t) |
1035 ((or (and (< flyspell-duplicate-distance 0) | 1122 (flyspell-unhighlight-at start) |
1036 (or (save-excursion | 1123 (if (> end start) |
1037 (goto-char start) | 1124 (flyspell-unhighlight-at (- end 1))) |
1038 (word-search-backward word | 1125 t) |
1039 (point-min) | 1126 ((or (and (< flyspell-duplicate-distance 0) |
1040 t)) | 1127 (or (save-excursion |
1041 (save-excursion | 1128 (goto-char start) |
1042 (goto-char end) | 1129 (flyspell-word-search-backward |
1043 (word-search-forward word | 1130 word |
1044 (point-max) | 1131 (point-min))) |
1045 t)))) | 1132 (save-excursion |
1046 (and (> flyspell-duplicate-distance 0) | 1133 (goto-char end) |
1047 (or (save-excursion | 1134 (flyspell-word-search-forward |
1048 (goto-char start) | 1135 word |
1049 (word-search-backward | 1136 (point-max))))) |
1050 word | 1137 (and (> flyspell-duplicate-distance 0) |
1051 (- start | 1138 (or (save-excursion |
1052 flyspell-duplicate-distance) | 1139 (goto-char start) |
1053 t)) | 1140 (flyspell-word-search-backward |
1054 (save-excursion | 1141 word |
1055 (goto-char end) | 1142 (- start |
1056 (word-search-forward | 1143 flyspell-duplicate-distance))) |
1057 word | 1144 (save-excursion |
1058 (+ end | 1145 (goto-char end) |
1059 flyspell-duplicate-distance) | 1146 (flyspell-word-search-forward |
1060 t))))) | 1147 word |
1061 (if flyspell-highlight-flag | 1148 (+ end |
1062 (flyspell-highlight-duplicate-region start end poss) | 1149 flyspell-duplicate-distance)))))) |
1063 (message (format "duplicate `%s'" word)))) | 1150 (setq flyspell-word-cache-result nil) |
1064 (t | 1151 (if flyspell-highlight-flag |
1065 ;; incorrect highlight the location | 1152 (flyspell-highlight-duplicate-region |
1066 (if flyspell-highlight-flag | 1153 start end poss) |
1067 (flyspell-highlight-incorrect-region start end poss) | 1154 (message (format "duplicate `%s'" word))) |
1068 (flyspell-notify-misspell start end word poss)))) | 1155 nil) |
1069 ;; return to original location | 1156 (t |
1070 (goto-char cursor-location) | 1157 (setq flyspell-word-cache-result nil) |
1071 (if ispell-quit (setq ispell-quit nil))))))))) | 1158 ;; incorrect highlight the location |
1159 (if flyspell-highlight-flag | |
1160 (flyspell-highlight-incorrect-region | |
1161 start end poss) | |
1162 (flyspell-notify-misspell start end word poss)) | |
1163 nil)))) | |
1164 ;; return to original location | |
1165 (goto-char cursor-location) | |
1166 (if ispell-quit (setq ispell-quit nil)) | |
1167 res)))))))) | |
1072 | 1168 |
1073 ;*---------------------------------------------------------------------*/ | 1169 ;*---------------------------------------------------------------------*/ |
1074 ;* flyspell-tex-math-initialized ... */ | 1170 ;* flyspell-tex-math-initialized ... */ |
1075 ;*---------------------------------------------------------------------*/ | 1171 ;*---------------------------------------------------------------------*/ |
1076 (defvar flyspell-tex-math-initialized nil) | 1172 (defvar flyspell-tex-math-initialized nil) |
1173 flyspell-not-casechars-cache)))) | 1269 flyspell-not-casechars-cache)))) |
1174 | 1270 |
1175 ;*---------------------------------------------------------------------*/ | 1271 ;*---------------------------------------------------------------------*/ |
1176 ;* flyspell-get-word ... */ | 1272 ;* flyspell-get-word ... */ |
1177 ;*---------------------------------------------------------------------*/ | 1273 ;*---------------------------------------------------------------------*/ |
1178 (defun flyspell-get-word (following) | 1274 (defun flyspell-get-word (following &optional extra-otherchars) |
1179 "Return the word for spell-checking according to Ispell syntax. | 1275 "Return the word for spell-checking according to Ispell syntax. |
1180 If argument FOLLOWING is non-nil or if `ispell-following-word' | 1276 If optional argument FOLLOWING is non-nil or if `flyspell-following-word' |
1181 is non-nil when called interactively, then the following word | 1277 is non-nil when called interactively, then the following word |
1182 \(rather than preceding\) is checked when the cursor is not over a word. | 1278 \(rather than preceding\) is checked when the cursor is not over a word. |
1183 Optional second argument contains other chars that can be included in word | 1279 Optional second argument contains otherchars that can be included in word |
1184 many times. | 1280 many times. |
1185 | 1281 |
1186 Word syntax described by `ispell-dictionary-alist' (which see)." | 1282 Word syntax described by `flyspell-dictionary-alist' (which see)." |
1187 (let* ((flyspell-casechars (flyspell-get-casechars)) | 1283 (let* ((flyspell-casechars (flyspell-get-casechars)) |
1188 (flyspell-not-casechars (flyspell-get-not-casechars)) | 1284 (flyspell-not-casechars (flyspell-get-not-casechars)) |
1189 (ispell-otherchars (ispell-get-otherchars)) | 1285 (ispell-otherchars (ispell-get-otherchars)) |
1190 (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) | 1286 (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) |
1191 (word-regexp (if (string< "" ispell-otherchars) | 1287 (word-regexp (concat flyspell-casechars |
1192 (concat flyspell-casechars | 1288 "+\\(" |
1193 "+\\(" | 1289 (if (not (string= "" ispell-otherchars)) |
1194 ispell-otherchars | 1290 (concat ispell-otherchars "?")) |
1195 "?" | 1291 (if extra-otherchars |
1196 flyspell-casechars | 1292 (concat extra-otherchars "?")) |
1197 "+\\)" | 1293 flyspell-casechars |
1198 (if ispell-many-otherchars-p | 1294 "+\\)" |
1199 "*" "?")) | 1295 (if (or ispell-many-otherchars-p |
1200 (concat flyspell-casechars "+"))) | 1296 extra-otherchars) |
1201 did-it-once | 1297 "*" "?"))) |
1298 did-it-once prevpt | |
1202 start end word) | 1299 start end word) |
1203 ;; find the word | 1300 ;; find the word |
1204 (if (not (looking-at flyspell-casechars)) | 1301 (if (not (looking-at flyspell-casechars)) |
1205 (if following | 1302 (if following |
1206 (re-search-forward flyspell-casechars (point-max) t) | 1303 (re-search-forward flyspell-casechars (point-max) t) |
1207 (re-search-backward flyspell-casechars (point-min) t))) | 1304 (re-search-backward flyspell-casechars (point-min) t))) |
1208 ;; move to front of word | 1305 ;; move to front of word |
1209 (re-search-backward flyspell-not-casechars (point-min) 'start) | 1306 (re-search-backward flyspell-not-casechars (point-min) 'start) |
1210 (let ((pos nil)) | 1307 (while (and (or (and (not (string= "" ispell-otherchars)) |
1211 (if (string< "" ispell-otherchars) | 1308 (looking-at ispell-otherchars)) |
1212 (while (and (looking-at ispell-otherchars) | 1309 (and extra-otherchars (looking-at extra-otherchars))) |
1213 (not (bobp)) | 1310 (not (bobp)) |
1214 (or (not did-it-once) | 1311 (or (not did-it-once) |
1215 ispell-many-otherchars-p) | 1312 ispell-many-otherchars-p) |
1216 (not (eq pos (point)))) | 1313 (not (eq prevpt (point)))) |
1217 (setq pos (point)) | 1314 (if (and extra-otherchars (looking-at extra-otherchars)) |
1218 (setq did-it-once t) | 1315 (progn |
1219 (backward-char 1) | 1316 (backward-char 1) |
1220 (if (looking-at flyspell-casechars) | 1317 (if (looking-at flyspell-casechars) |
1221 (re-search-backward flyspell-not-casechars (point-min) 'move) | 1318 (re-search-backward flyspell-not-casechars (point-min) 'move))) |
1222 (backward-char -1))))) | 1319 (setq did-it-once t |
1320 prevpt (point)) | |
1321 (backward-char 1) | |
1322 (if (looking-at flyspell-casechars) | |
1323 (re-search-backward flyspell-not-casechars (point-min) 'move) | |
1324 (backward-char -1)))) | |
1223 ;; Now mark the word and save to string. | 1325 ;; Now mark the word and save to string. |
1224 (if (eq (re-search-forward word-regexp (point-max) t) nil) | 1326 (if (not (re-search-forward word-regexp (point-max) t)) |
1225 nil | 1327 nil |
1226 (progn | 1328 (progn |
1227 (setq start (match-beginning 0) | 1329 (setq start (match-beginning 0) |
1228 end (point) | 1330 end (point) |
1229 word (buffer-substring-no-properties start end)) | 1331 word (buffer-substring-no-properties start end)) |
1278 (defun flyspell-external-point-words () | 1380 (defun flyspell-external-point-words () |
1279 (let ((buffer flyspell-external-ispell-buffer)) | 1381 (let ((buffer flyspell-external-ispell-buffer)) |
1280 (set-buffer buffer) | 1382 (set-buffer buffer) |
1281 (goto-char (point-min)) | 1383 (goto-char (point-min)) |
1282 (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) | 1384 (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) |
1283 (start flyspell-large-region-beg)) | 1385 (start flyspell-large-region-beg) |
1386 (pword "") | |
1387 (pcount 1)) | |
1284 ;; now we are done with ispell, we have to find the word in | 1388 ;; now we are done with ispell, we have to find the word in |
1285 ;; the initial buffer | 1389 ;; the initial buffer |
1286 (while (< (point) (- (point-max) 1)) | 1390 (while (< (point) (- (point-max) 1)) |
1287 ;; we have to fetch the incorrect word | 1391 ;; we have to fetch the incorrect word |
1288 (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t) | 1392 (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t) |
1289 (let ((word (match-string 1))) | 1393 (let ((word (match-string 1))) |
1394 (if (string= word pword) | |
1395 (setq pcount (1+ pcount)) | |
1396 (progn | |
1397 (setq pword word) | |
1398 (setq pcount 1))) | |
1290 (goto-char (match-end 0)) | 1399 (goto-char (match-end 0)) |
1400 (if flyspell-issue-message-flag | |
1401 (message "Spell Checking...%d%% [%s]" | |
1402 (* 100 (/ (float (point)) (point-max))) | |
1403 word)) | |
1291 (set-buffer flyspell-large-region-buffer) | 1404 (set-buffer flyspell-large-region-buffer) |
1292 (goto-char flyspell-large-region-beg) | 1405 (goto-char flyspell-large-region-beg) |
1293 (if flyspell-issue-message-flag | 1406 (let ((keep t) |
1294 (message "Spell Checking...%d%% [%s]" | 1407 (n 0)) |
1295 (* 100 (/ (float (- (point) start)) size)) | 1408 (while (and (or (< n pcount) keep) |
1296 word)) | 1409 (search-forward word flyspell-large-region-end t)) |
1297 (if (search-forward word flyspell-large-region-end t) | |
1298 (progn | 1410 (progn |
1299 (setq flyspell-large-region-beg (point)) | |
1300 (goto-char (- (point) 1)) | 1411 (goto-char (- (point) 1)) |
1301 (flyspell-word))) | 1412 (setq n (1+ n)) |
1413 (setq keep (flyspell-word)))) | |
1414 (if (= n pcount) | |
1415 (setq flyspell-large-region-beg (point)))) | |
1302 (set-buffer buffer)) | 1416 (set-buffer buffer)) |
1303 (goto-char (point-max))))) | 1417 (goto-char (point-max))))) |
1304 ;; we are done | 1418 ;; we are done |
1305 (if flyspell-issue-message-flag (message "Spell Checking completed.")) | 1419 (if flyspell-issue-message-flag (message "Spell Checking completed.")) |
1306 ;; ok, we are done with pointing out incorrect words, we just | 1420 ;; ok, we are done with pointing out incorrect words, we just |
1368 (save-excursion | 1482 (save-excursion |
1369 (if (> beg end) | 1483 (if (> beg end) |
1370 (let ((old beg)) | 1484 (let ((old beg)) |
1371 (setq beg end) | 1485 (setq beg end) |
1372 (setq end old))) | 1486 (setq end old))) |
1373 (if (> (- end beg) flyspell-large-region) | 1487 (if (and flyspell-large-region (> (- end beg) flyspell-large-region)) |
1374 (flyspell-large-region beg end) | 1488 (flyspell-large-region beg end) |
1375 (flyspell-small-region beg end))))) | 1489 (flyspell-small-region beg end))))) |
1376 | 1490 |
1377 ;*---------------------------------------------------------------------*/ | 1491 ;*---------------------------------------------------------------------*/ |
1378 ;* flyspell-buffer ... */ | 1492 ;* flyspell-buffer ... */ |
1515 (unless (run-hook-with-args-until-success | 1629 (unless (run-hook-with-args-until-success |
1516 'flyspell-incorrect-hook beg end poss) | 1630 'flyspell-incorrect-hook beg end poss) |
1517 (if (or flyspell-highlight-properties | 1631 (if (or flyspell-highlight-properties |
1518 (not (flyspell-properties-at-p beg))) | 1632 (not (flyspell-properties-at-p beg))) |
1519 (progn | 1633 (progn |
1634 ;; we cleanup all the overlay that are in the region, not | |
1635 ;; beginning at the word start position | |
1636 (if (< (1+ beg) end) | |
1637 (let ((os (overlays-in (1+ beg) end))) | |
1638 (while (consp os) | |
1639 (if (flyspell-overlay-p (car os)) | |
1640 (delete-overlay (car os))) | |
1641 (setq os (cdr os))))) | |
1520 ;; we cleanup current overlay at the same position | 1642 ;; we cleanup current overlay at the same position |
1521 (if (and (not flyspell-persistent-highlight) | 1643 (if (and (not flyspell-persistent-highlight) |
1522 (overlayp flyspell-overlay)) | 1644 (overlayp flyspell-overlay)) |
1523 (delete-overlay flyspell-overlay) | 1645 (delete-overlay flyspell-overlay) |
1524 (let ((overlays (overlays-at beg))) | 1646 (let ((os (overlays-at beg))) |
1525 (while (consp overlays) | 1647 (while (consp os) |
1526 (if (flyspell-overlay-p (car overlays)) | 1648 (if (flyspell-overlay-p (car os)) |
1527 (delete-overlay (car overlays))) | 1649 (delete-overlay (car os))) |
1528 (setq overlays (cdr overlays))))) | 1650 (setq os (cdr os))))) |
1529 ;; now we can use a new overlay | 1651 ;; now we can use a new overlay |
1530 (setq flyspell-overlay | 1652 (setq flyspell-overlay |
1531 (make-flyspell-overlay | 1653 (make-flyspell-overlay |
1532 beg end 'flyspell-incorrect-face 'highlight))))))) | 1654 beg end 'flyspell-incorrect-face 'highlight))))))) |
1533 | 1655 |
1675 (flyspell-word) | 1797 (flyspell-word) |
1676 (flyspell-display-next-corrections flyspell-auto-correct-ring)) | 1798 (flyspell-display-next-corrections flyspell-auto-correct-ring)) |
1677 (flyspell-ajust-cursor-point pos (point) old-max) | 1799 (flyspell-ajust-cursor-point pos (point) old-max) |
1678 (setq flyspell-auto-correct-pos (point))) | 1800 (setq flyspell-auto-correct-pos (point))) |
1679 ;; fetch the word to be checked | 1801 ;; fetch the word to be checked |
1680 (let ((word (flyspell-get-word nil)) | 1802 (let ((word (flyspell-get-word nil))) |
1681 start end poss) | 1803 (if (consp word) |
1682 ;; destructure return word info list. | 1804 (let ((start (car (cdr word))) |
1683 (setq start (car (cdr word)) | 1805 (end (car (cdr (cdr word)))) |
1684 end (car (cdr (cdr word))) | 1806 (word (car word)) |
1685 word (car word)) | 1807 poss) |
1686 (setq flyspell-auto-correct-word word) | 1808 (setq flyspell-auto-correct-word word) |
1687 ;; now check spelling of word. | 1809 ;; now check spelling of word. |
1688 (process-send-string ispell-process "%\n") ;put in verbose mode | 1810 (process-send-string ispell-process "%\n") ;put in verbose mode |
1689 (process-send-string ispell-process (concat "^" word "\n")) | 1811 (process-send-string ispell-process (concat "^" word "\n")) |
1690 ;; wait until ispell has processed word | 1812 ;; wait until ispell has processed word |
1691 (while (progn | 1813 (while (progn |
1692 (accept-process-output ispell-process) | 1814 (accept-process-output ispell-process) |
1693 (not (string= "" (car ispell-filter))))) | 1815 (not (string= "" (car ispell-filter))))) |
1694 (setq ispell-filter (cdr ispell-filter)) | 1816 (setq ispell-filter (cdr ispell-filter)) |
1695 (if (consp ispell-filter) | 1817 (if (consp ispell-filter) |
1696 (setq poss (ispell-parse-output (car ispell-filter)))) | 1818 (setq poss (ispell-parse-output (car ispell-filter)))) |
1697 (cond ((or (eq poss t) (stringp poss)) | 1819 (cond |
1698 ;; don't correct word | 1820 ((or (eq poss t) (stringp poss)) |
1699 t) | 1821 ;; don't correct word |
1700 ((null poss) | 1822 t) |
1701 ;; ispell error | 1823 ((null poss) |
1702 (error "Ispell: error in Ispell process")) | 1824 ;; ispell error |
1703 (t | 1825 (error "Ispell: error in Ispell process")) |
1704 ;; the word is incorrect, we have to propose a replacement | 1826 (t |
1705 (let ((replacements (if flyspell-sort-corrections | 1827 ;; the word is incorrect, we have to propose a replacement |
1706 (sort (car (cdr (cdr poss))) 'string<) | 1828 (let ((replacements (if flyspell-sort-corrections |
1707 (car (cdr (cdr poss)))))) | 1829 (sort (car (cdr (cdr poss))) 'string<) |
1708 (setq flyspell-auto-correct-region nil) | 1830 (car (cdr (cdr poss)))))) |
1709 (if (consp replacements) | 1831 (setq flyspell-auto-correct-region nil) |
1710 (progn | 1832 (if (consp replacements) |
1711 (let ((replace (car replacements))) | 1833 (progn |
1712 (let ((new-word replace)) | 1834 (let ((replace (car replacements))) |
1713 (if (not (equal new-word (car poss))) | 1835 (let ((new-word replace)) |
1714 (progn | 1836 (if (not (equal new-word (car poss))) |
1715 ;; the save the current replacements | 1837 (progn |
1716 (setq flyspell-auto-correct-region | 1838 ;; the save the current replacements |
1717 (cons start (length new-word))) | 1839 (setq flyspell-auto-correct-region |
1718 (let ((l replacements)) | 1840 (cons start (length new-word))) |
1719 (while (consp (cdr l)) | 1841 (let ((l replacements)) |
1720 (setq l (cdr l))) | 1842 (while (consp (cdr l)) |
1721 (rplacd l (cons (car poss) replacements))) | 1843 (setq l (cdr l))) |
1722 (setq flyspell-auto-correct-ring | 1844 (rplacd l (cons (car poss) replacements))) |
1723 replacements) | 1845 (setq flyspell-auto-correct-ring |
1724 (flyspell-unhighlight-at start) | 1846 replacements) |
1725 (delete-region start end) | 1847 (flyspell-unhighlight-at start) |
1726 (funcall flyspell-insert-function new-word) | 1848 (delete-region start end) |
1727 (if flyspell-abbrev-p | 1849 (funcall flyspell-insert-function new-word) |
1728 (if (flyspell-already-abbrevp | 1850 (if flyspell-abbrev-p |
1729 (flyspell-abbrev-table) word) | 1851 (if (flyspell-already-abbrevp |
1730 (flyspell-change-abbrev | 1852 (flyspell-abbrev-table) word) |
1731 (flyspell-abbrev-table) | 1853 (flyspell-change-abbrev |
1732 word | 1854 (flyspell-abbrev-table) |
1733 new-word) | 1855 word |
1734 (flyspell-define-abbrev word new-word))) | 1856 new-word) |
1735 (flyspell-word) | 1857 (flyspell-define-abbrev word |
1736 (flyspell-display-next-corrections | 1858 new-word))) |
1737 (cons new-word flyspell-auto-correct-ring)) | 1859 (flyspell-word) |
1738 (flyspell-ajust-cursor-point pos | 1860 (flyspell-display-next-corrections |
1739 (point) | 1861 (cons new-word flyspell-auto-correct-ring)) |
1740 old-max)))))))))) | 1862 (flyspell-ajust-cursor-point pos |
1741 (setq flyspell-auto-correct-pos (point)) | 1863 (point) |
1742 (ispell-pdict-save t))))) | 1864 old-max)))))))))) |
1865 (setq flyspell-auto-correct-pos (point)) | |
1866 (ispell-pdict-save t))))))) | |
1743 | 1867 |
1744 ;*---------------------------------------------------------------------*/ | 1868 ;*---------------------------------------------------------------------*/ |
1745 ;* flyspell-auto-correct-previous-pos ... */ | 1869 ;* flyspell-auto-correct-previous-pos ... */ |
1746 ;*---------------------------------------------------------------------*/ | 1870 ;*---------------------------------------------------------------------*/ |
1747 (defvar flyspell-auto-correct-previous-pos nil | 1871 (defvar flyspell-auto-correct-previous-pos nil |
1750 ;*---------------------------------------------------------------------*/ | 1874 ;*---------------------------------------------------------------------*/ |
1751 ;* flyspell-auto-correct-previous-hook ... */ | 1875 ;* flyspell-auto-correct-previous-hook ... */ |
1752 ;*---------------------------------------------------------------------*/ | 1876 ;*---------------------------------------------------------------------*/ |
1753 (defun flyspell-auto-correct-previous-hook () | 1877 (defun flyspell-auto-correct-previous-hook () |
1754 "Hook to track successive calls to `flyspell-auto-correct-previous-word'. | 1878 "Hook to track successive calls to `flyspell-auto-correct-previous-word'. |
1755 Sets flyspell-auto-correct-previous-pos to nil" | 1879 Sets `flyspell-auto-correct-previous-pos' to nil" |
1756 (interactive) | 1880 (interactive) |
1757 (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t) | 1881 (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t) |
1758 (unless (eq this-command (function flyspell-auto-correct-previous-word)) | 1882 (unless (eq this-command (function flyspell-auto-correct-previous-word)) |
1759 (setq flyspell-auto-correct-previous-pos nil))) | 1883 (setq flyspell-auto-correct-previous-pos nil))) |
1760 | 1884 |
1761 ;*---------------------------------------------------------------------*/ | 1885 ;*---------------------------------------------------------------------*/ |
1762 ;* flyspell-auto-correct-previous-word ... */ | 1886 ;* flyspell-auto-correct-previous-word ... */ |
1763 ;*---------------------------------------------------------------------*/ | 1887 ;*---------------------------------------------------------------------*/ |
1764 (defun flyspell-auto-correct-previous-word (position) | 1888 (defun flyspell-auto-correct-previous-word (position) |
1765 "*Auto correct the first mispelled word that occurs before point." | 1889 "*Auto correct the first mispelled word that occurs before point. |
1890 But don't look beyond what's visible on the screen." | |
1766 (interactive "d") | 1891 (interactive "d") |
1767 | 1892 |
1768 (add-hook 'pre-command-hook | 1893 (let (top bot) |
1769 (function flyspell-auto-correct-previous-hook) t t) | 1894 (save-excursion |
1770 | 1895 (move-to-window-line 0) |
1771 (save-excursion | 1896 (setq top (point)) |
1772 (unless flyspell-auto-correct-previous-pos | 1897 (move-to-window-line -1) |
1773 ;; only reset if a new overlay exists | 1898 (setq bot (point))) |
1774 (setq flyspell-auto-correct-previous-pos nil) | 1899 (save-excursion |
1775 | 1900 (save-restriction |
1776 (let ((overlay-list (overlays-in (point-min) position)) | 1901 (narrow-to-region top bot) |
1777 (new-overlay 'dummy-value)) | 1902 (overlay-recenter (point)) |
1778 | 1903 |
1779 ;; search for previous (new) flyspell overlay | 1904 (add-hook 'pre-command-hook |
1780 (while (and new-overlay | 1905 (function flyspell-auto-correct-previous-hook) t t) |
1781 (or (not (flyspell-overlay-p new-overlay)) | 1906 |
1782 ;; check if its face has changed | 1907 (unless flyspell-auto-correct-previous-pos |
1783 (not (eq (get-char-property | 1908 ;; only reset if a new overlay exists |
1784 (overlay-start new-overlay) 'face) | 1909 (setq flyspell-auto-correct-previous-pos nil) |
1785 'flyspell-incorrect-face)))) | 1910 |
1786 (setq new-overlay (car-safe overlay-list)) | 1911 (let ((overlay-list (overlays-in (point-min) position)) |
1787 (setq overlay-list (cdr-safe overlay-list))) | 1912 (new-overlay 'dummy-value)) |
1788 | 1913 |
1789 ;; if nothing new exits new-overlay should be nil | 1914 ;; search for previous (new) flyspell overlay |
1790 (if new-overlay;; the length of the word may change so go to the start | 1915 (while (and new-overlay |
1791 (setq flyspell-auto-correct-previous-pos | 1916 (or (not (flyspell-overlay-p new-overlay)) |
1792 (overlay-start new-overlay))))) | 1917 ;; check if its face has changed |
1793 | 1918 (not (eq (get-char-property |
1794 (when flyspell-auto-correct-previous-pos | 1919 (overlay-start new-overlay) 'face) |
1795 (save-excursion | 1920 'flyspell-incorrect-face)))) |
1796 (goto-char flyspell-auto-correct-previous-pos) | 1921 (setq new-overlay (car-safe overlay-list)) |
1797 (let ((ispell-following-word t));; point is at start | 1922 (setq overlay-list (cdr-safe overlay-list))) |
1798 (if (numberp flyspell-auto-correct-previous-pos) | 1923 |
1799 (goto-char flyspell-auto-correct-previous-pos)) | 1924 ;; if nothing new exits new-overlay should be nil |
1800 (flyspell-auto-correct-word)) | 1925 (if new-overlay ;; the length of the word may change so go to the start |
1801 ;; the point may have moved so reset this | 1926 (setq flyspell-auto-correct-previous-pos |
1802 (setq flyspell-auto-correct-previous-pos (point)))))) | 1927 (overlay-start new-overlay))))) |
1928 | |
1929 (when flyspell-auto-correct-previous-pos | |
1930 (save-excursion | |
1931 (goto-char flyspell-auto-correct-previous-pos) | |
1932 (let ((ispell-following-word t)) ;; point is at start | |
1933 (if (numberp flyspell-auto-correct-previous-pos) | |
1934 (goto-char flyspell-auto-correct-previous-pos)) | |
1935 (flyspell-auto-correct-word)) | |
1936 ;; the point may have moved so reset this | |
1937 (setq flyspell-auto-correct-previous-pos (point)))))))) | |
1803 | 1938 |
1804 ;*---------------------------------------------------------------------*/ | 1939 ;*---------------------------------------------------------------------*/ |
1805 ;* flyspell-correct-word ... */ | 1940 ;* flyspell-correct-word ... */ |
1806 ;*---------------------------------------------------------------------*/ | 1941 ;*---------------------------------------------------------------------*/ |
1807 (defun flyspell-correct-word (event) | 1942 (defun flyspell-correct-word (event) |
1812 (flyspell-accept-buffer-local-defs) | 1947 (flyspell-accept-buffer-local-defs) |
1813 ;; retain cursor location (I don't know why but save-excursion here fails). | 1948 ;; retain cursor location (I don't know why but save-excursion here fails). |
1814 (let ((save (point))) | 1949 (let ((save (point))) |
1815 (mouse-set-point event) | 1950 (mouse-set-point event) |
1816 (let ((cursor-location (point)) | 1951 (let ((cursor-location (point)) |
1817 (word (flyspell-get-word nil)) | 1952 (word (flyspell-get-word nil))) |
1818 start end poss replace) | 1953 (if (consp word) |
1819 ;; destructure return word info list. | 1954 (let ((start (car (cdr word))) |
1820 (setq start (car (cdr word)) | 1955 (end (car (cdr (cdr word)))) |
1821 end (car (cdr (cdr word))) | 1956 (word (car word)) |
1822 word (car word)) | 1957 poss replace) |
1823 ;; now check spelling of word. | 1958 ;; now check spelling of word. |
1824 (process-send-string ispell-process "%\n") ;put in verbose mode | 1959 (process-send-string ispell-process "%\n") ;put in verbose mode |
1825 (process-send-string ispell-process (concat "^" word "\n")) | 1960 (process-send-string ispell-process (concat "^" word "\n")) |
1826 ;; wait until ispell has processed word | 1961 ;; wait until ispell has processed word |
1827 (while (progn | 1962 (while (progn |
1828 (accept-process-output ispell-process) | 1963 (accept-process-output ispell-process) |
1829 (not (string= "" (car ispell-filter))))) | 1964 (not (string= "" (car ispell-filter))))) |
1830 (setq ispell-filter (cdr ispell-filter)) | 1965 (setq ispell-filter (cdr ispell-filter)) |
1831 (if (consp ispell-filter) | 1966 (if (consp ispell-filter) |
1832 (setq poss (ispell-parse-output (car ispell-filter)))) | 1967 (setq poss (ispell-parse-output (car ispell-filter)))) |
1833 (cond ((or (eq poss t) (stringp poss)) | 1968 (cond |
1834 ;; don't correct word | 1969 ((or (eq poss t) (stringp poss)) |
1835 t) | 1970 ;; don't correct word |
1836 ((null poss) | 1971 t) |
1837 ;; ispell error | 1972 ((null poss) |
1838 (error "Ispell: error in Ispell process")) | 1973 ;; ispell error |
1839 ((string-match "GNU" (emacs-version)) | 1974 (error "Ispell: error in Ispell process")) |
1840 ;; the word is incorrect, we have to propose a replacement | 1975 ((string-match "GNU" (emacs-version)) |
1841 (setq replace (flyspell-emacs-popup event poss word)) | 1976 ;; the word is incorrect, we have to propose a replacement |
1842 (cond ((eq replace 'ignore) | 1977 (setq replace (flyspell-emacs-popup event poss word)) |
1843 (goto-char save) | 1978 (cond ((eq replace 'ignore) |
1844 nil) | 1979 (goto-char save) |
1845 ((eq replace 'save) | 1980 nil) |
1846 (goto-char save) | 1981 ((eq replace 'save) |
1847 (process-send-string ispell-process (concat "*" word "\n")) | 1982 (goto-char save) |
1848 (flyspell-unhighlight-at cursor-location) | 1983 (process-send-string ispell-process |
1849 (setq ispell-pdict-modified-p '(t))) | 1984 (concat "*" word "\n")) |
1850 ((or (eq replace 'buffer) (eq replace 'session)) | 1985 (flyspell-unhighlight-at cursor-location) |
1851 (process-send-string ispell-process (concat "@" word "\n")) | 1986 (setq ispell-pdict-modified-p '(t))) |
1852 (if (null ispell-pdict-modified-p) | 1987 ((or (eq replace 'buffer) (eq replace 'session)) |
1853 (setq ispell-pdict-modified-p | 1988 (process-send-string ispell-process |
1854 (list ispell-pdict-modified-p))) | 1989 (concat "@" word "\n")) |
1855 (flyspell-unhighlight-at cursor-location) | 1990 (if (null ispell-pdict-modified-p) |
1856 (goto-char save) | 1991 (setq ispell-pdict-modified-p |
1857 (if (eq replace 'buffer) | 1992 (list ispell-pdict-modified-p))) |
1858 (ispell-add-per-file-word-list word))) | 1993 (flyspell-unhighlight-at cursor-location) |
1859 (replace | 1994 (goto-char save) |
1860 (flyspell-unhighlight-at cursor-location) | 1995 (if (eq replace 'buffer) |
1861 (let ((new-word (if (atom replace) | 1996 (ispell-add-per-file-word-list word))) |
1862 replace | 1997 (replace |
1863 (car replace))) | 1998 (flyspell-unhighlight-at cursor-location) |
1864 (cursor-location (+ (- (length word) (- end start)) | 1999 (let ((new-word (if (atom replace) |
1865 cursor-location))) | 2000 replace |
1866 (if (not (equal new-word (car poss))) | 2001 (car replace))) |
1867 (let ((old-max (point-max))) | 2002 (cursor-location |
1868 (delete-region start end) | 2003 (+ (- (length word) (- end start)) |
1869 (funcall flyspell-insert-function new-word) | 2004 cursor-location))) |
1870 (if flyspell-abbrev-p | 2005 (if (not (equal new-word (car poss))) |
1871 (flyspell-define-abbrev word new-word)) | 2006 (let ((old-max (point-max))) |
1872 (flyspell-ajust-cursor-point save | 2007 (delete-region start end) |
1873 cursor-location | 2008 (funcall flyspell-insert-function new-word) |
1874 old-max))))) | 2009 (if flyspell-abbrev-p |
1875 (t | 2010 (flyspell-define-abbrev word new-word)) |
1876 (goto-char save) | 2011 (flyspell-ajust-cursor-point save |
1877 nil))) | 2012 cursor-location |
1878 ((eq flyspell-emacs 'xemacs) | 2013 old-max))))) |
1879 (flyspell-xemacs-popup | 2014 (t |
1880 event poss word cursor-location start end save) | 2015 (goto-char save) |
1881 (goto-char save))) | 2016 nil))) |
1882 (ispell-pdict-save t)))) | 2017 ((eq flyspell-emacs 'xemacs) |
2018 (flyspell-xemacs-popup | |
2019 event poss word cursor-location start end save) | |
2020 (goto-char save))) | |
2021 (ispell-pdict-save t)))))) | |
1883 | 2022 |
1884 ;*---------------------------------------------------------------------*/ | 2023 ;*---------------------------------------------------------------------*/ |
1885 ;* flyspell-xemacs-correct ... */ | 2024 ;* flyspell-xemacs-correct ... */ |
1886 ;*---------------------------------------------------------------------*/ | 2025 ;*---------------------------------------------------------------------*/ |
1887 (defun flyspell-xemacs-correct (replace poss word cursor-location start end save) | 2026 (defun flyspell-xemacs-correct (replace poss word cursor-location start end save) |