Mercurial > emacs
diff 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 |
line wrap: on
line diff
--- a/lisp/textmodes/flyspell.el Mon Jul 24 18:30:41 2000 +0000 +++ b/lisp/textmodes/flyspell.el Mon Jul 24 18:36:17 2000 +0000 @@ -22,24 +22,23 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; commentary: +;;; Commentary: ;; ;; Flyspell is a minor Emacs mode performing on-the-fly spelling ;; checking. -;; +;; ;; To enable Flyspell minor mode, type Meta-x flyspell-mode. ;; This applies only to the current buffer. +;; +;; To enable Flyspell in text representing computer programs, type +;; Meta-x flyspell-prog-mode. +;; In that mode only text inside comments are checked. ;; ;; Note: consider setting the variable ispell-parser to `tex' to -;; avoid TeX command checking; use `(setq ispell-parser 'tex)' -;; _before_ entering flyspell. +;; avoid TeX command checking; use `(setq ispell-parser 'tex)'. ;; ;; Some user variables control the behavior of flyspell. They are ;; those defined under the `User variables' comment. -;; -;; Note: as suggested by Yaron M. Minsky, if you use flyspell when -;; sending mails, you should add the following: -;; (add-hook 'mail-send-hook 'flyspell-mode-off) ;;; Code: (require 'ispell) @@ -51,11 +50,10 @@ "Spellchecking on the fly." :tag "FlySpell" :prefix "flyspell-" - :group 'processes - :version "20.3") + :group 'processes) ;*---------------------------------------------------------------------*/ -;* User variables ... */ +;* User configuration ... */ ;*---------------------------------------------------------------------*/ (defcustom flyspell-highlight-flag t "*How Flyspell should indicate misspelled words. @@ -68,12 +66,12 @@ :group 'flyspell :type 'boolean) -(defcustom flyspell-sort-corrections t +(defcustom flyspell-sort-corrections nil "*Non-nil means, sort the corrections alphabetically before popping them." :group 'flyspell :type 'boolean) -(defcustom flyspell-duplicate-distance 10000 +(defcustom flyspell-duplicate-distance -1 "*The maximum distance for finding duplicates of unrecognized words. This applies to the feature that when a word is not found in the dictionary, if the same spelling occurs elsewhere in the buffer, @@ -104,7 +102,9 @@ (defcustom flyspell-default-delayed-commands '(self-insert-command delete-backward-char - delete-char) + backward-or-forward-delete-char + delete-char + scrollbar-vertical-drag) "The standard list of delayed commands for Flyspell. See `flyspell-delayed-commands'." :group 'flyspell @@ -117,29 +117,95 @@ :group 'flyspell :type '(repeat (symbol))) +(defcustom flyspell-default-deplacement-commands + '(next-line + previous-line + scroll-up + scroll-down) + "The standard list of deplacement commands for Flyspell. +See `flyspell-deplacement-commands'." + :group 'flyspell + :type '(repeat (symbol))) + +(defcustom flyspell-deplacement-commands nil + "List of commands that are \"deplacement\" for Flyspell mode. +After these commands, Flyspell checking is performed only if the previous +command was not the very same command." + :group 'flyspell + :type '(repeat (symbol))) + (defcustom flyspell-issue-welcome-flag t "*Non-nil means that Flyspell should display a welcome message when started." :group 'flyspell :type 'boolean) -(defcustom flyspell-consider-dash-as-word-delimiter-flag nil - "*Non-nil means that the `-' char is considered as a word delimiter." +(defcustom flyspell-incorrect-hook nil + "*List of functions to be called when incorrect words are encountered. +Each function is given three arguments: the beginning and the end +of the incorrect region. The third is either the symbol 'doublon' or the list +of possible corrections returned as returned by 'ispell-parse-output'. + +If any of the functions return non-Nil, the word is not highligted as +incorrect." + :group 'flyspell + :type 'hook) + +(defcustom flyspell-default-dictionary "american" + "A string that is the name of the default dictionary. +This is passed to the ispell-change-dictionary when flyspell is started. +If the variables ispell-local-dictionary or ispell-dictionary are non nil +when flyspell is started, the value of that variables is used instead +of flyspell-default-dictionary to select the default dictionary." + :group 'flyspell + :type 'string) + +(defcustom flyspell-tex-command-regexp + "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)" + "A string that is the regular expression that matches TeX commands." + :group 'flyspell + :type 'string) + +(defcustom flyspell-check-tex-math-command nil + "*Non nils means check even inside TeX math environement. TeX math +environement are discovered byt eh TEXMATHP that is implemented inside +the eponyme emacs package. That package may be found at: +http://strw.leidenuniv.nl/~dominik/Tools" :group 'flyspell :type 'boolean) -(defcustom flyspell-incorrect-hook nil - "*List of functions to be called when incorrect words are encountered. -Each function is given two arguments: the beginning and the end -of the incorrect region." - :group 'flyspell) +(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter + '("francais" "deutsch8" "norsk") + "List of dictionary names that consider `-' as word delimiter." + :group 'flyspell + :type '(repeat (string))) -(defcustom flyspell-multi-language-p nil - "*Non-nil means that Flyspell can be used with multiple languages. -This mode works by starting a separate Ispell process for each buffer, -so that each buffer can use its own language." +(defcustom flyspell-abbrev-p + t + "*If true, add correction to abbreviation table." :group 'flyspell :type 'boolean) +(defcustom flyspell-use-global-abbrev-table-p + nil + "*If true, prefer global abbrev table to local abbrev table." + :group 'flyspell + :type 'boolean) + +;;;###autoload +(defcustom flyspell-mode-line-string " Fly" + "*String displayed on the modeline when flyspell is active. +Set this to nil if you don't want a modeline indicator." + :group 'flyspell + :type 'string) + +(defcustom flyspell-large-region 1000 + "*The threshold that determines if an region is small. The flyspell-region +is invoked, if the region is small, the word are checked one after the +other using regular flyspell check means. If the region is large, a new +ispell process is spawned to get speed." + :group 'flyspell + :type 'number) + ;*---------------------------------------------------------------------*/ ;* Mode specific options */ ;* ------------------------------------------------------------- */ @@ -158,20 +224,19 @@ property of the major mode name.") (make-variable-buffer-local 'flyspell-generic-check-word-p) +;*--- mail mode -------------------------------------------------------*/ (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (defun mail-mode-flyspell-verify () "This function is used for `flyspell-generic-check-word-p' in Mail mode." (save-excursion - (or (progn - (beginning-of-line) - (looking-at "Subject:")) - (not (or (re-search-forward mail-header-separator nil t) - (re-search-backward message-signature-separator nil t) - (progn - (beginning-of-line) - (looking-at "[>}|]"))))))) + (not (or (re-search-forward mail-header-separator nil t) + (re-search-backward message-signature-separator nil t) + (progn + (beginning-of-line) + (looking-at "[>}|]\\To:")))))) +;*--- texinfo mode ----------------------------------------------------*/ (put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) (defun texinfo-mode-flyspell-verify () "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." @@ -179,18 +244,74 @@ (forward-word -1) (not (looking-at "@")))) +;*--- tex mode --------------------------------------------------------*/ +(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) +(defun tex-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." + (and + (not (save-excursion + (re-search-backward "^[ \t]*%%%[ \t]+Local" (point-min) t))) + (not (save-excursion + (let ((this (point-marker)) + (e (progn (end-of-line) (point-marker)))) + (beginning-of-line) + (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t) + (and (>= this (match-beginning 0)) + (<= this (match-end 0)) ))))))) + +;*--- sgml mode -------------------------------------------------------*/ +(put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) +(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) + +(defun sgml-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in SGML mode." + (not (save-excursion + (let ((this (point-marker)) + (s (progn (beginning-of-line) (point-marker))) + (e (progn (end-of-line) (point-marker)))) + (or (progn + (goto-char this) + (and (re-search-forward "[^<]*>" e t) + (= (match-beginning 0) this))) + (progn + (goto-char this) + (and (re-search-backward "<[^>]*" s t) + (= (match-end 0) this))) + (and (progn + (goto-char this) + (and (re-search-forward "[^&]*;" e t) + (= (match-beginning 0) this))) + (progn + (goto-char this) + (and (re-search-backward "&[^;]*" s t) + (= (match-end 0) this))))))))) + +;*---------------------------------------------------------------------*/ +;* Programming mode */ +;*---------------------------------------------------------------------*/ +(defun flyspell-generic-progmode-verify () + "Used for `flyspell-generic-check-word-p' in programming modes." + (let ((f (get-text-property (point) 'face))) + (memq f '(font-lock-comment-face font-lock-string-face)))) + +;;;###autoload +(defun flyspell-prog-mode () + "Turn on `flyspell-mode' for comments and strings." + (interactive) + (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) + (flyspell-mode 1)) + ;*---------------------------------------------------------------------*/ ;* Overlay compatibility */ ;*---------------------------------------------------------------------*/ -(autoload 'make-overlay "overlay" "" t) -(autoload 'move-overlay "overlay" "" t) -(autoload 'overlayp "overlay" "" t) -(autoload 'overlay-properties "overlay" "" t) -(autoload 'overlays-in "overlay" "" t) -(autoload 'delete-overlay "overlay" "" t) -(autoload 'overlays-at "overlay" "" t) -(autoload 'overlay-put "overlay" "" t) -(autoload 'overlay-get "overlay" "" t) +(autoload 'make-overlay "overlay" "Overlay compatibility kit." t) +(autoload 'overlayp "overlay" "Overlay compatibility kit." t) +(autoload 'overlays-in "overlay" "Overlay compatibility kit." t) +(autoload 'delete-overlay "overlay" "Overlay compatibility kit." t) +(autoload 'overlays-at "overlay" "Overlay compatibility kit." t) +(autoload 'overlay-put "overlay" "Overlay compatibility kit." t) +(autoload 'overlay-get "overlay" "Overlay compatibility kit." t) +(autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t) ;*---------------------------------------------------------------------*/ ;* Which emacs are we currently running */ @@ -218,33 +339,41 @@ (cond ((eq flyspell-emacs 'xemacs) (define-key map [(button2)] - #'flyspell-correct-word/mouse-keymap) + #'flyspell-correct-word/mouse-keymap) (define-key flyspell-mouse-map "\M-\t" #'flyspell-auto-correct-word)) (flyspell-use-local-map (define-key map [(mouse-2)] #'flyspell-correct-word/mouse-keymap) (define-key map "\M-\t" #'flyspell-auto-correct-word))) map)) + +;;;###autoload (defvar flyspell-mode-map (make-sparse-keymap)) -(or (assoc 'flyspell-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(flyspell-mode " Fly") minor-mode-alist))) - -;; mouse or local-map bindings +;; mouse, keyboard bindings and misc definition (when (or (assoc 'flyspell-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'flyspell-mode flyspell-mode-map) - minor-mode-map-alist))) - (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word) - (define-key flyspell-mode-map [(mouse-2)] - (function flyspell-correct-word/local-keymap))) + (setq minor-mode-map-alist + (cons (cons 'flyspell-mode flyspell-mode-map) + minor-mode-map-alist))) + (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word) + (define-key flyspell-mode-map [(mouse-2)] + (function flyspell-correct-word/local-keymap))) + ;; the name of the overlay property that defines the keymap (defvar flyspell-overlay-keymap-property-name (if (string-match "19.*XEmacs" emacs-version) 'keymap 'local-map)) - + +;; dash character machinery +(defvar flyspell-consider-dash-as-word-delimiter-flag nil + "*Non-nil means that the `-' char is considered as a word delimiter.") +(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag) +(defvar flyspell-dash-dictionary nil) +(make-variable-buffer-local 'flyspell-dash-dictionary) +(defvar flyspell-dash-local-dictionary nil) +(make-variable-buffer-local 'flyspell-dash-local-dictionary) + ;*---------------------------------------------------------------------*/ ;* Highlighting */ ;*---------------------------------------------------------------------*/ @@ -309,6 +438,58 @@ (set-buffer-modified-p (buffer-modified-p))))) ;*---------------------------------------------------------------------*/ +;* Autoloading */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(if (fboundp 'add-minor-mode) + (add-minor-mode 'flyspell-mode + 'flyspell-mode-line-string + flyspell-mode-map + nil + 'flyspell-mode) + (or (assoc 'flyspell-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(flyspell-mode flyspell-mode-line-string) + minor-mode-alist))) + + (or (assoc 'flyspell-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'flyspell-mode flyspell-mode-map) + minor-mode-map-alist)))) + + +;*---------------------------------------------------------------------*/ +;* flyspell-buffers ... */ +;* ------------------------------------------------------------- */ +;* For remembering buffers running flyspell */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-buffers nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-minibuffer-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-minibuffer-p (buffer) + "Is BUFFER a minibuffer?" + (let ((ws (get-buffer-window-list buffer t))) + (and (consp ws) (window-minibuffer-p (car ws))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-accept-buffer-local-defs ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-accept-buffer-local-defs () + (ispell-accept-buffer-local-defs) + (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) + (eq flyspell-dash-local-dictionary ispell-local-dictionary))) + ;; the dictionary as changed + (progn + (setq flyspell-dash-dictionary ispell-dictionary) + (setq flyspell-dash-local-dictionary ispell-local-dictionary) + (if (member (or ispell-local-dictionary ispell-dictionary) + flyspell-dictionaries-that-consider-dash-as-word-delimiter) + (setq flyspell-consider-dash-as-word-delimiter-flag t) + (setq flyspell-consider-dash-as-word-delimiter-flag nil))))) + +;*---------------------------------------------------------------------*/ ;* flyspell-mode-on ... */ ;*---------------------------------------------------------------------*/ (eval-when-compile (defvar flyspell-local-mouse-map)) @@ -316,53 +497,47 @@ (defun flyspell-mode-on () "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead." (setq ispell-highlight-face 'flyspell-incorrect-face) - ;; ispell initialization - (if flyspell-multi-language-p - (progn - (make-variable-buffer-local 'ispell-dictionary) - (make-variable-buffer-local 'ispell-process) - (make-variable-buffer-local 'ispell-filter) - (make-variable-buffer-local 'ispell-filter-continue) - (make-variable-buffer-local 'ispell-process-directory) - (make-variable-buffer-local 'ispell-parser) - (put 'ispell-dictionary 'permanent-local t) - (put 'ispell-process 'permanent-local t) - (put 'ispell-filter 'permanent-local t) - (put 'ispell-filter-continue 'permanent-local t) - (put 'ispell-process-directory 'permanent-local t) - (put 'ispell-parser 'permanent-local t))) - ;; We put the `flyspell-delayed' property on some commands. + ;; local dictionaries setup + (ispell-change-dictionary + (or ispell-local-dictionary ispell-dictionary flyspell-default-dictionary)) + ;; we have to force ispell to accept the local definition or + ;; otherwise it could be too late, the local dictionary may + ;; be forgotten! + (flyspell-accept-buffer-local-defs) + ;; we put the `flyspel-delayed' property on some commands (flyspell-delay-commands) + ;; we put the `flyspel-deplacement' property on some commands + (flyspell-deplacement-commands) ;; we bound flyspell action to post-command hook (make-local-hook 'post-command-hook) (add-hook 'post-command-hook (function flyspell-post-command-hook) t t) ;; we bound flyspell action to pre-command hook (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) - - ;; Set flyspell-generic-check-word-p based on the major mode. + ;; we bound flyspell action to after-change hook + (make-local-variable 'after-change-functions) + (setq after-change-functions + (cons 'flyspell-after-change-function after-change-functions)) + ;; set flyspell-generic-check-word-p based on the major mode (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) (if mode-predicate (setq flyspell-generic-check-word-p mode-predicate))) - + ;; work around the fact that the `local-map' text-property replaces the + ;; buffer's local map rather than shadowing it. + (set (make-local-variable 'flyspell-mouse-map) + (let ((map (copy-keymap flyspell-mouse-map))) + (set-keymap-parent map (current-local-map)) + map)) ;; the welcome message (if flyspell-issue-welcome-flag (let ((binding (where-is-internal 'flyspell-auto-correct-word nil 'non-ascii))) (message (if binding - (format "Welcome to flyspell. Use %s or Mouse-2 to correct words." + (format "Welcome to flyspell. Use %s or Mouse-2 to correct words." (key-description binding)) - "Welcome to flyspell. Use Mouse-2 to correct words.")))) - ;; we have to kill the flyspell process when the buffer is deleted. - ;; (thanks to Jeff Miller and Roland Rosenfeld who sent me this - ;; improvement). - (add-hook 'kill-buffer-hook - (lambda () - (if (and flyspell-multi-language-p ispell-process) - (ispell-kill-ispell t)))) - (make-local-hook 'change-major-mode-hook) - (add-hook 'change-major-mode-hook 'flyspell-mode-off) + "Welcome to flyspell. Use Mouse-2 to correct words.")))) + ;; Use this so that we can still get major mode bindings at a ;; misspelled word (unless they're overridden by ;; `flyspell-mouse-map'). @@ -372,6 +547,7 @@ (set-keymap-parents (list (current-local-map))) (set-keymap-parent map (current-local-map))) map)) + ;; we end with the flyspell hooks (run-hooks 'flyspell-mode-hook)) @@ -395,22 +571,23 @@ (put command 'flyspell-delayed t)) ;*---------------------------------------------------------------------*/ -;* flyspell-ignore-commands ... */ +;* flyspell-deplacement-commands ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-ignore-commands () - "This is an obsolete function, use `flyspell-delay-commands' instead." - (flyspell-delay-commands)) +(defun flyspell-deplacement-commands () + "Install the standard set of Flyspell deplacement commands." + (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands) + (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands)) ;*---------------------------------------------------------------------*/ -;* flyspell-ignore-command ... */ +;* flyspell-deplacement-command ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-ignore-command (command) - "This is an obsolete function, use `flyspell-delay-command' instead. -COMMAND is the name of the command to be delayed." - (flyspell-delay-command command)) - -(make-obsolete 'flyspell-ignore-commands 'flyspell-delay-commands) -(make-obsolete 'flyspell-ignore-command 'flyspell-delay-command) +(defun flyspell-deplacement-command (command) + "Set COMMAND that implement cursor movements, for Flyspell. +When flyspell `post-command-hook' is invoked because of a deplacement command +as been used the current word is checked only if the previous command was +not the very same deplacement command." + (interactive "SDeplacement Flyspell after Command: ") + (put command 'flyspell-deplacement t)) ;*---------------------------------------------------------------------*/ ;* flyspell-word-cache ... */ @@ -427,8 +604,17 @@ ;* post command hook, we will check, if the word at this position */ ;* has to be spell checked. */ ;*---------------------------------------------------------------------*/ -(defvar flyspell-pre-buffer nil) -(defvar flyspell-pre-point nil) +(defvar flyspell-pre-buffer nil) +(defvar flyspell-pre-point nil) +(defvar flyspell-pre-column nil) +(defvar flyspell-pre-pre-buffer nil) +(defvar flyspell-pre-pre-point nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-previous-command ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-previous-command nil + "The last interactive command checked by Flyspell.") ;*---------------------------------------------------------------------*/ ;* flyspell-pre-command-hook ... */ @@ -437,7 +623,8 @@ "Save the current buffer and point for Flyspell's post-command hook." (interactive) (setq flyspell-pre-buffer (current-buffer)) - (setq flyspell-pre-point (point))) + (setq flyspell-pre-point (point)) + (setq flyspell-pre-column (current-column))) ;*---------------------------------------------------------------------*/ ;* flyspell-mode-off ... */ @@ -445,13 +632,11 @@ ;;;###autoload (defun flyspell-mode-off () "Turn Flyspell mode off." - ;; If we have an Ispell process for each buffer, - ;; kill the one for this buffer. - (if flyspell-multi-language-p - (ispell-kill-ispell t)) ;; we remove the hooks (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) + (setq after-change-functions (delq 'flyspell-after-change-function + after-change-functions)) ;; we remove all the flyspell hilightings (flyspell-delete-all-overlays) ;; we have to erase pre cache variables @@ -461,40 +646,6 @@ (setq flyspell-mode nil)) ;*---------------------------------------------------------------------*/ -;* flyspell-check-word-p ... */ -;*---------------------------------------------------------------------*/ -(defun flyspell-check-word-p () - "Return t when the word at `point' has to be checked. -The answer depends of several criteria. -Mostly we check word delimiters." - (cond - ((<= (- (point-max) 1) (point-min)) - ;; the buffer is not filled enough - nil) - ((not (and (symbolp this-command) (get this-command 'flyspell-delayed))) - ;; the current command is not delayed, that - ;; is that we must check the word now - t) - ((and (> (point) (point-min)) - (save-excursion - (backward-char 1) - (and (looking-at (flyspell-get-not-casechars)) - (or flyspell-consider-dash-as-word-delimiter-flag - (not (looking-at "\\-")))))) - ;; yes because we have reached or typed a word delimiter. - t) - ((not (integerp flyspell-delay)) - ;; yes because the user had set up a no-delay configuration. - t) - (executing-kbd-macro - ;; Don't delay inside a keyboard macro. - t) - (t - (if (fboundp 'about-xemacs) - (sit-for flyspell-delay nil) - (sit-for flyspell-delay 0 nil))))) - -;*---------------------------------------------------------------------*/ ;* flyspell-check-pre-word-p ... */ ;*---------------------------------------------------------------------*/ (defun flyspell-check-pre-word-p () @@ -506,11 +657,22 @@ (not (bufferp flyspell-pre-buffer)) (not (buffer-live-p flyspell-pre-buffer))) nil) + ((and (eq flyspell-pre-pre-point flyspell-pre-point) + (eq flyspell-pre-pre-buffer flyspell-pre-buffer)) + nil) ((or (and (= flyspell-pre-point (- (point) 1)) (eq (char-syntax (char-after flyspell-pre-point)) ?w)) (= flyspell-pre-point (point)) (= flyspell-pre-point (+ (point) 1))) nil) + ((and (symbolp this-command) + (or (get this-command 'flyspell-delayed) + (and (get this-command 'flyspell-deplacement) + (eq flyspell-previous-command this-command))) + (or (= (current-column) 0) + (= (current-column) flyspell-pre-column) + (eq (char-syntax (char-after flyspell-pre-point)) ?w))) + nil) ((not (eq (current-buffer) flyspell-pre-buffer)) t) ((not (and (numberp flyspell-word-cache-start) @@ -519,21 +681,241 @@ (t (or (< flyspell-pre-point flyspell-word-cache-start) (> flyspell-pre-point flyspell-word-cache-end))))) - + +;*---------------------------------------------------------------------*/ +;* The flyspell after-change-hook, store the change position. In */ +;* the post command hook, we will check, if the word at this */ +;* position has to be spell checked. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-changes nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-after-change-function ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-after-change-function (start stop len) + "Save the current buffer and point for Flyspell's post-command hook." + (interactive) + (setq flyspell-changes (cons (cons start stop) flyspell-changes))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-changed-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-changed-word-p (start stop) + "Return t when the changed word has to be checked. +The answer depends of several criteria. +Mostly we check word delimiters." + (cond + ((and (eq (char-after start) ?\n) (> stop start)) + t) + ((not (numberp flyspell-pre-point)) + t) + ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop)) + nil) + ((let ((pos (point))) + (or (>= pos start) (<= pos stop) (= pos (1+ stop)))) + nil) + (t + t))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-word-p () + "Return t when the word at `point' has to be checked. +The answer depends of several criteria. +Mostly we check word delimiters." + (cond + ((<= (- (point-max) 1) (point-min)) + ;; the buffer is not filled enough + nil) + ((and (and (> (current-column) 0) + (not (eq (current-column) flyspell-pre-column))) + (save-excursion + (backward-char 1) + (and (looking-at (flyspell-get-not-casechars)) + (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-")))))) + ;; yes because we have reached or typed a word delimiter. + t) + ((symbolp this-command) + (cond + ((get this-command 'flyspell-deplacement) + (not (eq flyspell-previous-command this-command))) + ((get this-command 'flyspell-delayed) + ;; the current command is not delayed, that + ;; is that we must check the word now + (if (fboundp 'about-xemacs) + (sit-for flyspell-delay nil) + (sit-for flyspell-delay 0 nil))) + (t t))) + (t t))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-no-check ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-no-check (msg obj) + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*"))) + (set-buffer buffer) + (erase-buffer) + (insert "NO-CHECK:\n") + (insert (format " %S : %S\n" msg obj))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-pre-word-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-pre-word-checked () + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*"))) + (set-buffer buffer) + (insert "PRE-WORD:\n") + (insert (format " pre-point : %S\n" flyspell-pre-point)) + (insert (format " pre-buffer : %S\n" flyspell-pre-buffer)) + (insert (format " cache-start: %S\n" flyspell-word-cache-start)) + (insert (format " cache-end : %S\n" flyspell-word-cache-end)) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-word-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-word-checked () + (setq debug-on-error t) + (save-excursion + (let ((oldbuf (current-buffer)) + (buffer (get-buffer-create "*flyspell-debug*")) + (point (point))) + (set-buffer buffer) + (insert "WORD:\n") + (insert (format " this-cmd : %S\n" this-command)) + (insert (format " delayed : %S\n" (and (symbolp this-command) + (get this-command 'flyspell-delayed)))) + (insert (format " point : %S\n" point)) + (insert (format " prev-char : [%c] %S\n" + (progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (char-after (point))) + ? ))) + (set-buffer buffer) + c)) + (progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (and (and (looking-at (flyspell-get-not-casechars)) 1) + (and (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-"))) 2)))))) + (set-buffer buffer) + c)))) + (insert (format " because : %S\n" + (cond + ((not (and (symbolp this-command) + (get this-command 'flyspell-delayed))) + ;; the current command is not delayed, that + ;; is that we must check the word now + 'not-delayed) + ((progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (and (looking-at (flyspell-get-not-casechars)) + (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-")))))))) + (set-buffer buffer) + c)) + ;; yes because we have reached or typed a word delimiter. + 'separator) + ((not (integerp flyspell-delay)) + ;; yes because the user had set up a no-delay configuration. + 'no-delay) + (t + 'sit-for)))) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-changed-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-changed-checked () + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*")) + (point (point))) + (set-buffer buffer) + (insert "CHANGED WORD:\n") + (insert (format " point : %S\n" point)) + (goto-char (point-max))))) + ;*---------------------------------------------------------------------*/ ;* flyspell-post-command-hook ... */ +;* ------------------------------------------------------------- */ +;* It is possible that we check several words: */ +;* 1- the current word is checked if the predicate */ +;* FLYSPELL-CHECK-WORD-P is true */ +;* 2- the word that used to be the current word before the */ +;* THIS-COMMAND is checked if: */ +;* a- the previous word is different from the current word */ +;* b- the previous word as not just been checked by the */ +;* previous FLYSPELL-POST-COMMAND-HOOK */ +;* 3- the words changed by the THIS-COMMAND that are neither the */ +;* previous word nor the current word */ ;*---------------------------------------------------------------------*/ (defun flyspell-post-command-hook () "The `post-command-hook' used by flyspell to check a word in-the-fly." (interactive) - (if (flyspell-check-word-p) - (flyspell-word)) - (if (flyspell-check-pre-word-p) - (save-excursion - (set-buffer flyspell-pre-buffer) + (let ((command this-command)) + (if (flyspell-check-pre-word-p) (save-excursion - (goto-char flyspell-pre-point) - (flyspell-word))))) + '(flyspell-debug-signal-pre-word-checked) + (set-buffer flyspell-pre-buffer) + (save-excursion + (goto-char flyspell-pre-point) + (flyspell-word)))) + (if (flyspell-check-word-p) + (progn + '(flyspell-debug-signal-word-checked) + (flyspell-word) + ;; we remember which word we have just checked. + ;; this will be used next time we will check a word + ;; to compare the next current word with the word + ;; that as been registered in the pre-command-hook + ;; that is these variables are used within the predicate + ;; FLYSPELL-CHECK-PRE-WORD-P + (setq flyspell-pre-pre-buffer (current-buffer)) + (setq flyspell-pre-pre-point (point))) + (progn + (setq flyspell-pre-pre-buffer nil) + (setq flyspell-pre-pre-point nil) + ;; when a word is not checked because of a delayed command + ;; we do not disable the ispell cache. + (if (and (symbolp this-command) (get this-command 'flyspell-delayed)) + (setq flyspell-word-cache-end -1)))) + (while (consp flyspell-changes) + (let ((start (car (car flyspell-changes))) + (stop (cdr (car flyspell-changes)))) + (if (flyspell-check-changed-word-p start stop) + (save-excursion + '(flyspell-debug-signal-changed-checked) + (goto-char start) + (flyspell-word))) + (setq flyspell-changes (cdr flyspell-changes)))) + (setq flyspell-previous-command command))) + +;*---------------------------------------------------------------------*/ +;* flyspell-notify-misspell ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-notify-misspell (start end word poss) + (let ((replacements (if (stringp poss) + poss + (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))))) + (message (format "mispelling `%s' %S" word replacements)))) ;*---------------------------------------------------------------------*/ ;* flyspell-word ... */ @@ -544,22 +926,25 @@ (if (interactive-p) (setq following ispell-following-word)) (save-excursion - (ispell-accept-buffer-local-defs) ; use the correct dictionary - (let ((cursor-location (point)) ; retain cursor location - (word (flyspell-get-word following)) - start end poss) - (if (or (eq word nil) + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (let* ((cursor-location (point)) + (flyspell-word (flyspell-get-word following)) + start end poss word) + (if (or (eq flyspell-word nil) (and (fboundp flyspell-generic-check-word-p) (not (funcall flyspell-generic-check-word-p)))) - t + '() (progn - ;; destructure return word info list. - (setq start (car (cdr word)) - end (car (cdr (cdr word))) - word (car word)) + ;; destructure return flyspell-word info list. + (setq start (car (cdr flyspell-word)) + end (car (cdr (cdr flyspell-word))) + word (car flyspell-word)) ;; before checking in the directory, we check for doublons. (cond - ((and flyspell-mark-duplications-flag + ((and (or (not (eq ispell-parser 'tex)) + (not (eq (char-after start) ?\\))) + flyspell-mark-duplications-flag (save-excursion (goto-char start) (word-search-backward word @@ -567,14 +952,14 @@ (+ 1 (- end start))) t))) ;; yes, this is a doublon - (flyspell-highlight-incorrect-region start end)) + (flyspell-highlight-incorrect-region start end 'doublon)) ((and (eq flyspell-word-cache-start start) (eq flyspell-word-cache-end end) (string-equal flyspell-word-cache-word word)) ;; this word had been already checked, we skip nil) ((and (eq ispell-parser 'tex) - (flyspell-tex-command-p word)) + (flyspell-tex-command-p flyspell-word)) ;; this is a correct word (because a tex command) (flyspell-unhighlight-at start) (if (> end start) @@ -601,7 +986,7 @@ ;; (process-send-string ispell-process "!\n") ;; back to terse mode. (setq ispell-filter (cdr ispell-filter)) - (if (listp ispell-filter) + (if (consp ispell-filter) (setq poss (ispell-parse-output (car ispell-filter)))) (cond ((eq poss t) ;; correct @@ -618,8 +1003,7 @@ ((null poss) (flyspell-unhighlight-at start) (if (> end start) - (flyspell-unhighlight-at (- end 1))) - (message "Error in ispell process")) + (flyspell-unhighlight-at (- end 1)))) ((or (and (< flyspell-duplicate-distance 0) (or (save-excursion (goto-char start) @@ -652,17 +1036,55 @@ (t ;; incorrect highlight the location (if flyspell-highlight-flag - (flyspell-highlight-incorrect-region start end) - (message (format "mispelling `%s'" word))))) - (goto-char cursor-location) ; return to original location + (flyspell-highlight-incorrect-region start end poss) + (flyspell-notify-misspell start end word poss)))) + ;; return to original location + (goto-char cursor-location) (if ispell-quit (setq ispell-quit nil))))))))) ;*---------------------------------------------------------------------*/ +;* flyspell-tex-math-initialized ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-tex-math-initialized nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-math-tex-command-p ... */ +;* ------------------------------------------------------------- */ +;* This function uses the texmathp package to check if (point) */ +;* is within a tex command. In order to avoid using */ +;* condition-case each time we use the variable */ +;* flyspell-tex-math-initialized to make a special case the first */ +;* time that function is called. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-math-tex-command-p () + (cond + (flyspell-check-tex-math-command + nil) + ((eq flyspell-tex-math-initialized t) + (texmathp)) + ((eq flyspell-tex-math-initialized 'error) + nil) + (t + (setq flyspell-tex-math-initialized t) + (condition-case nil + (texmathp) + (error (progn + (setq flyspell-tex-math-initialized 'error) + nil)))))) + +;*---------------------------------------------------------------------*/ ;* flyspell-tex-command-p ... */ ;*---------------------------------------------------------------------*/ (defun flyspell-tex-command-p (word) "Return t if WORD is a TeX command." - (eq (aref word 0) ?\\)) + (or (save-excursion + (let ((b (car (cdr word)))) + (and (re-search-backward "\\\\" (- (point) 100) t) + (or (= (match-end 0) b) + (and (goto-char (match-end 0)) + (looking-at flyspell-tex-command-regexp) + (>= (match-end 0) b)))))) + (flyspell-math-tex-command-p))) ;*---------------------------------------------------------------------*/ ;* flyspell-casechars-cache ... */ @@ -681,15 +1103,13 @@ this function changes the last char of the `ispell-casechars' string." (let ((ispell-casechars (ispell-get-casechars))) (cond - ((eq ispell-casechars flyspell-ispell-casechars-cache) - flyspell-casechars-cache) - ((not (eq ispell-parser 'tex)) + ((eq ispell-parser 'tex) (setq flyspell-ispell-casechars-cache ispell-casechars) (setq flyspell-casechars-cache (concat (substring ispell-casechars 0 (- (length ispell-casechars) 1)) - "{}]")) + "]")) flyspell-casechars-cache) (t (setq flyspell-ispell-casechars-cache ispell-casechars) @@ -711,15 +1131,13 @@ "This function builds a string that is the regexp of non-word chars." (let ((ispell-not-casechars (ispell-get-not-casechars))) (cond - ((eq ispell-not-casechars flyspell-ispell-not-casechars-cache) - flyspell-not-casechars-cache) - ((not (eq ispell-parser 'tex)) + ((eq ispell-parser 'tex) (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) (setq flyspell-not-casechars-cache (concat (substring ispell-not-casechars 0 (- (length ispell-not-casechars) 1)) - "{}]")) + "]")) flyspell-not-casechars-cache) (t (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) @@ -731,7 +1149,7 @@ ;*---------------------------------------------------------------------*/ (defun flyspell-get-word (following) "Return the word for spell-checking according to Ispell syntax. -If optional argument FOLLOWING is non-nil or if `ispell-following-word' +If argument FOLLOWING is non-nil or if `ispell-following-word' is non-nil when called interactively, then the following word \(rather than preceding\) is checked when the cursor is not over a word. Optional second argument contains otherchars that can be included in word @@ -742,35 +1160,27 @@ (flyspell-not-casechars (flyspell-get-not-casechars)) (ispell-otherchars (ispell-get-otherchars)) (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) - (word-regexp (if (not (string= "" ispell-otherchars)) - (concat - flyspell-casechars - "+\\(" - ispell-otherchars - "?" - flyspell-casechars - "+\\)" - (if ispell-many-otherchars-p - "*" "?")) + (word-regexp (if (string< "" ispell-otherchars) + (concat flyspell-casechars + "+\\(" + ispell-otherchars + "?" + flyspell-casechars + "+\\)" + (if ispell-many-otherchars-p + "*" "?")) (concat flyspell-casechars "+"))) - (tex-prelude "[\\\\{]") - (tex-regexp (if (eq ispell-parser 'tex) - (concat tex-prelude "?" word-regexp "}?") - word-regexp)) - did-it-once start end word) ;; find the word - (if (not (or (looking-at flyspell-casechars) - (and (eq ispell-parser 'tex) - (looking-at tex-prelude)))) + (if (not (looking-at flyspell-casechars)) (if following (re-search-forward flyspell-casechars (point-max) t) (re-search-backward flyspell-casechars (point-min) t))) ;; move to front of word (re-search-backward flyspell-not-casechars (point-min) 'start) - (if (not (string= "" ispell-otherchars)) - (let ((pos nil)) + (let ((pos nil)) + (if (string< "" ispell-otherchars) (while (and (looking-at ispell-otherchars) (not (bobp)) (or (not did-it-once) @@ -783,7 +1193,7 @@ (re-search-backward flyspell-not-casechars (point-min) 'move) (backward-char -1))))) ;; Now mark the word and save to string. - (if (eq (re-search-forward tex-regexp (point-max) t) nil) + (if (eq (re-search-forward word-regexp (point-max) t) nil) nil (progn (setq start (match-beginning 0) @@ -792,16 +1202,15 @@ (list word start end))))) ;*---------------------------------------------------------------------*/ -;* flyspell-region ... */ +;* flyspell-small-region ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-region (beg end) +(defun flyspell-small-region (beg end) "Flyspell text between BEG and END." - (interactive "r") (save-excursion - (if (> beg end) - (let ((old beg)) - (setq beg end) - (setq end old))) + (if (> beg end) + (let ((old beg)) + (setq beg end) + (setq end old))) (goto-char beg) (let ((count 0)) (while (< (point) end) @@ -812,15 +1221,130 @@ (setq count 0)) (setq count (+ 1 count))) (flyspell-word) + (sit-for 0) (let ((cur (point))) (forward-word 1) (if (and (< (point) end) (> (point) (+ cur 1))) (backward-char 1))))) (backward-char 1) - (message "Spell Checking...done") + (message "Spell Checking completed.") (flyspell-word))) ;*---------------------------------------------------------------------*/ +;* flyspell-external-ispell-process ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-external-ispell-process '() + "The external Flyspell ispell process") + +;*---------------------------------------------------------------------*/ +;* flyspell-external-ispell-buffer ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-external-ispell-buffer '()) +(defvar flyspell-large-region-buffer '()) +(defvar flyspell-large-region-beg (point-min)) +(defvar flyspell-large-region-end (point-max)) + +;*---------------------------------------------------------------------*/ +;* flyspell-external-point-words ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-external-point-words () + (let ((buffer flyspell-external-ispell-buffer)) + (set-buffer buffer) + (beginning-of-buffer) + (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) + (start flyspell-large-region-beg)) + ;; now we are done with ispell, we have to find the word in + ;; the initial buffer + (while (< (point) (- (point-max) 1)) + ;; we have to fetch the incorrect word + (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t) + (let ((word (match-string 1))) + (goto-char (match-end 0)) + (set-buffer flyspell-large-region-buffer) + (goto-char flyspell-large-region-beg) + (message "Spell Checking...%d%% [%s]" + (* 100 (/ (float (- (point) start)) size)) + word) + (if (search-forward word flyspell-large-region-end t) + (progn + (setq flyspell-large-region-beg (point)) + (goto-char (- (point) 1)) + (flyspell-word))) + (set-buffer buffer)) + (goto-char (point-max))))) + ;; we are done + (message "Spell Checking completed.") + ;; ok, we are done with pointing out incorrect words, we just + ;; have to kill the temporary buffer + (kill-buffer flyspell-external-ispell-buffer) + (setq flyspell-external-ispell-buffer nil))) + +;*---------------------------------------------------------------------*/ +;* flyspell-large-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-large-region (beg end) + (let* ((curbuf (current-buffer)) + (buffer (get-buffer-create "*flyspell-region*"))) + (setq flyspell-external-ispell-buffer buffer) + (setq flyspell-large-region-buffer curbuf) + (setq flyspell-large-region-beg beg) + (setq flyspell-large-region-end end) + (set-buffer buffer) + (erase-buffer) + ;; this is done, we can start ckecking... + (message "Checking region...") + (set-buffer curbuf) + (let ((c (apply 'call-process-region beg + end + ispell-program-name + nil + buffer + nil + "-l" + (let (args) + ;; Local dictionary becomes the global dictionary in use. + (if ispell-local-dictionary + (setq ispell-dictionary ispell-local-dictionary)) + (setq args (ispell-get-ispell-args)) + (if ispell-dictionary ; use specified dictionary + (setq args + (append (list "-d" ispell-dictionary) args))) + (if ispell-personal-dictionary ; use specified pers dict + (setq args + (append args + (list "-p" + (expand-file-name + ispell-personal-dictionary))))) + (setq args (append args ispell-extra-args)) + args)))) + (if (= c 0) + (flyspell-external-point-words) + (error "Can't check region..."))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-region ... */ +;* ------------------------------------------------------------- */ +;* Because `ispell -a' is too slow, it is not possible to use */ +;* it on large region. Then, when ispell is invoked on a large */ +;* text region, a new `ispell -l' process is spawned. The */ +;* pointed out words are then searched in the region a checked with */ +;* regular flyspell means. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-region (beg end) + "Flyspell text between BEG and END." + (interactive "r") + (if (= beg end) + () + (save-excursion + (if (> beg end) + (let ((old beg)) + (setq beg end) + (setq end old))) + (if (> (- end beg) flyspell-large-region) + (flyspell-large-region beg end) + (flyspell-small-region beg end))))) + +;*---------------------------------------------------------------------*/ ;* flyspell-buffer ... */ ;*---------------------------------------------------------------------*/ (defun flyspell-buffer () @@ -829,6 +1353,49 @@ (flyspell-region (point-min) (point-max))) ;*---------------------------------------------------------------------*/ +;* old next error position ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-old-buffer-error nil) +(defvar flyspell-old-pos-error nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-goto-next-error ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-goto-next-error () + "Go to the next previously detected error. +In general FLYSPELL-GOTO-NEXT-ERROR must be used after +FLYSPELL-BUFFER." + (interactive) + (let ((pos (point)) + (max (point-max))) + (if (and (eq (current-buffer) flyspell-old-buffer-error) + (eq pos flyspell-old-pos-error)) + (progn + (if (= flyspell-old-pos-error max) + ;; goto beginning of buffer + (progn + (message "Restarting from beginning of buffer") + (goto-char (point-min))) + (forward-word 1)) + (setq pos (point)))) + ;; seek the next error + (while (and (< pos max) + (let ((ovs (overlays-at pos)) + (r '())) + (while (and (not r) (consp ovs)) + (if (flyspell-overlay-p (car ovs)) + (setq r t) + (setq ovs (cdr ovs)))) + (not r))) + (setq pos (1+ pos))) + ;; save the current location for next invokation + (setq flyspell-old-pos-error pos) + (setq flyspell-old-buffer-error (current-buffer)) + (goto-char pos) + (if (= pos max) + (message "No more miss-spelled word!")))) + +;*---------------------------------------------------------------------*/ ;* flyspell-overlay-p ... */ ;*---------------------------------------------------------------------*/ (defun flyspell-overlay-p (o) @@ -860,7 +1427,8 @@ (if (flyspell-overlay-p (car overlays)) (delete-overlay (car overlays))) (setq overlays (cdr overlays)))) - (delete-overlay flyspell-overlay))) + (if (flyspell-overlay-p flyspell-overlay) + (delete-overlay flyspell-overlay)))) ;*---------------------------------------------------------------------*/ ;* flyspell-properties-at-p ... */ @@ -895,29 +1463,31 @@ (if flyspell-use-local-map (overlay-put flyspell-overlay flyspell-overlay-keymap-property-name - flyspell-local-mouse-map)))) + flyspell-local-mouse-map)) + flyspell-overlay)) ;*---------------------------------------------------------------------*/ ;* flyspell-highlight-incorrect-region ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-highlight-incorrect-region (beg end) +(defun flyspell-highlight-incorrect-region (beg end poss) "Set up an overlay on a misspelled word, in the buffer from BEG to END." - (run-hook-with-args 'flyspell-incorrect-hook beg end) - (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) - (progn - ;; we cleanup current overlay at the same position - (if (and (not flyspell-persistent-highlight) - (overlayp flyspell-overlay)) - (delete-overlay flyspell-overlay) - (let ((overlays (overlays-at beg))) - (while (consp overlays) - (if (flyspell-overlay-p (car overlays)) - (delete-overlay (car overlays))) - (setq overlays (cdr overlays))))) - ;; now we can use a new overlay - (setq flyspell-overlay - (make-flyspell-overlay beg end - 'flyspell-incorrect-face 'highlight))))) + (unless (run-hook-with-args-until-success + 'flyspell-incorrect-hook beg end poss) + (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((overlays (overlays-at beg))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay beg end + 'flyspell-incorrect-face 'highlight)))))) ;*---------------------------------------------------------------------*/ ;* flyspell-highlight-duplicate-region ... */ @@ -946,84 +1516,174 @@ (defvar flyspell-auto-correct-pos nil) (defvar flyspell-auto-correct-region nil) (defvar flyspell-auto-correct-ring nil) +(defvar flyspell-auto-correct-word nil) +(make-variable-buffer-local 'flyspell-auto-correct-pos) +(make-variable-buffer-local 'flyspell-auto-correct-region) +(make-variable-buffer-local 'flyspell-auto-correct-ring) +(make-variable-buffer-local 'flyspell-auto-correct-word) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-previous-highlighted-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-previous-highlighted-word (&optional arg) + "Correct the closer mispelled word. +This function scans a mis-spelled word before the cursor. If it finds one +it proposes replacement for that word. With prefix arg, count that many +misspelled words backwards." + (interactive) + (let ((pos1 (point)) + (pos (point)) + (arg (if (or (not (numberp arg)) (< arg 1)) 1 arg)) + ov ovs) + (if (catch 'exit + (while (and (setq pos (previous-overlay-change pos)) + (not (= pos pos1))) + (setq pos1 pos) + (if (> pos (point-min)) + (progn + (setq ovs (overlays-at (1- pos))) + (while (consp ovs) + (setq ov (car ovs)) + (setq ovs (cdr ovs)) + (if (and (overlay-get ov 'flyspell-overlay) + (= 0 (setq arg (1- arg)))) + (throw 'exit t))))))) + (save-excursion + (goto-char pos) + (ispell-word)) + (error "No word to correct before point.")))) + +;*---------------------------------------------------------------------*/ +;* flyspell-display-next-corrections ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-display-next-corrections (corrections) + (let ((string "Corrections:") + (l corrections) + (pos '())) + (while (< (length string) 80) + (if (equal (car l) flyspell-auto-correct-word) + (setq pos (cons (+ 1 (length string)) pos))) + (setq string (concat string " " (car l))) + (setq l (cdr l))) + (while (consp pos) + (let ((num (car pos))) + (put-text-property num + (+ num (length flyspell-auto-correct-word)) + 'face + 'flyspell-incorrect-face + string)) + (setq pos (cdr pos))) + (if (fboundp 'display-message) + (display-message 'no-log string) + (message string)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-abbrev-table ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-abbrev-table () + (if flyspell-use-global-abbrev-table-p + global-abbrev-table + local-abbrev-table)) ;*---------------------------------------------------------------------*/ ;* flyspell-auto-correct-word ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-auto-correct-word (pos) - "Correct the word at POS. -This command proposes various successive corrections for the word at POS. -The variable `flyspell-auto-correct-binding' specifies the key to bind -to this command." - (interactive "d") - ;; use the correct dictionary - (ispell-accept-buffer-local-defs) - (if (eq flyspell-auto-correct-pos pos) - ;; we have already been using the function at the same location - (progn - (save-excursion - (let ((start (car flyspell-auto-correct-region)) - (len (cdr flyspell-auto-correct-region))) - (delete-region start (+ start len)) - (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring)) - (let* ((word (car flyspell-auto-correct-ring)) - (len (length word))) - (rplacd flyspell-auto-correct-region len) - (goto-char start) - (insert word)))) - (setq flyspell-auto-correct-pos (point))) - ;; retain cursor location - (let ((cursor-location pos) - (word (flyspell-get-word nil)) - start end poss) - ;; destructure return word info list. - (setq start (car (cdr word)) - end (car (cdr (cdr word))) - word (car word)) - ;; now check spelling of word. - (process-send-string ispell-process "%\n") ;put in verbose mode - (process-send-string ispell-process (concat "^" word "\n")) - ;; wait until ispell has processed word - (while (progn - (accept-process-output ispell-process) - (not (string= "" (car ispell-filter))))) - (setq ispell-filter (cdr ispell-filter)) - (if (listp ispell-filter) - (setq poss (ispell-parse-output (car ispell-filter)))) - (cond ((or (eq poss t) (stringp poss)) - ;; don't correct word - t) - ((null poss) - ;; ispell error - (error "Ispell: error in Ispell process")) - (t - ;; the word is incorrect, we have to propose a replacement - (let ((replacements (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss)))))) - (if (consp replacements) - (progn - (let ((replace (car replacements))) - (setq word replace) - (setq cursor-location (+ (- (length word) (- end start)) - cursor-location)) - (if (not (equal word (car poss))) - (progn - ;; the save the current replacements - (setq flyspell-auto-correct-pos cursor-location) - (setq flyspell-auto-correct-region - (cons start (length word))) - (let ((l replacements)) - (while (consp (cdr l)) - (setq l (cdr l))) - (rplacd l (cons (car poss) replacements))) - (setq flyspell-auto-correct-ring - (cdr replacements)) - (delete-region start end) - (insert word))))))))) - ;; return to original location - (goto-char cursor-location) - (ispell-pdict-save t)))) +(defun flyspell-auto-correct-word () + "Correct the current word. +This command proposes various successive corrections for the current word." + (interactive) + (let ((pos (point)) + (old-max (point-max))) + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (if (and (eq flyspell-auto-correct-pos pos) + (consp flyspell-auto-correct-region)) + ;; we have already been using the function at the same location + (let* ((start (car flyspell-auto-correct-region)) + (len (cdr flyspell-auto-correct-region))) + (delete-region start (+ start len)) + (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring)) + (let* ((word (car flyspell-auto-correct-ring)) + (len (length word))) + (rplacd flyspell-auto-correct-region len) + (goto-char start) + (if flyspell-abbrev-p + (if (flyspell-already-abbrevp (flyspell-abbrev-table) + flyspell-auto-correct-word) + (flyspell-change-abbrev (flyspell-abbrev-table) + flyspell-auto-correct-word + word) + (define-abbrev (flyspell-abbrev-table) + flyspell-auto-correct-word word))) + (insert word) + (flyspell-word) + (flyspell-display-next-corrections flyspell-auto-correct-ring)) + (flyspell-ajust-cursor-point pos (point) old-max) + (setq flyspell-auto-correct-pos (point))) + ;; fetch the word to be checked + (let ((word (flyspell-get-word nil)) + start end poss) + ;; destructure return word info list. + (setq start (car (cdr word)) + end (car (cdr (cdr word))) + word (car word)) + (setq flyspell-auto-correct-word word) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") ;put in verbose mode + (process-send-string ispell-process (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + (t + ;; the word is incorrect, we have to propose a replacement + (let ((replacements (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss)))))) + (setq flyspell-auto-correct-region nil) + (if (consp replacements) + (progn + (let ((replace (car replacements))) + (let ((new-word replace)) + (if (not (equal new-word (car poss))) + (progn + ;; the save the current replacements + (setq flyspell-auto-correct-region + (cons start (length new-word))) + (let ((l replacements)) + (while (consp (cdr l)) + (setq l (cdr l))) + (rplacd l (cons (car poss) replacements))) + (setq flyspell-auto-correct-ring + replacements) + (delete-region start end) + (insert new-word) + (if flyspell-abbrev-p + (if (flyspell-already-abbrevp + (flyspell-abbrev-table) word) + (flyspell-change-abbrev + (flyspell-abbrev-table) + word + new-word) + (define-abbrev (flyspell-abbrev-table) + word new-word))) + (flyspell-word) + (flyspell-display-next-corrections + (cons new-word flyspell-auto-correct-ring)) + (flyspell-ajust-cursor-point pos + (point) + old-max)))))))))) + (setq flyspell-auto-correct-pos (point)) + (ispell-pdict-save t))))) ;*---------------------------------------------------------------------*/ ;* flyspell-correct-word ... */ @@ -1038,9 +1698,9 @@ This will check or reload the dictionary. Use \\[ispell-change-dictionary] or \\[ispell-region] to update the Ispell process." (interactive "e") - (if flyspell-use-local-map + (if (eq flyspell-emacs 'xemacs) (flyspell-correct-word/mouse-keymap event) - (flyspell-correct-word/local-keymap event))) + (flyspell-correct-word/local-keymap event))) ;*---------------------------------------------------------------------*/ ;* flyspell-correct-word/local-keymap ... */ @@ -1077,14 +1737,14 @@ (command-execute (key-binding (this-command-keys)))))))))) ;*---------------------------------------------------------------------*/ -;* flyspell-correct-word ... */ +;* flyspell-correct-word/mouse-keymap ... */ ;*---------------------------------------------------------------------*/ (defun flyspell-correct-word/mouse-keymap (event) "Pop up a menu of possible corrections for a misspelled word. The word checked is the word at the mouse position." (interactive "e") ;; use the correct dictionary - (ispell-accept-buffer-local-defs) + (flyspell-accept-buffer-local-defs) ;; retain cursor location (I don't know why but save-excursion here fails). (let ((save (point))) (mouse-set-point event) @@ -1103,7 +1763,7 @@ (accept-process-output ispell-process) (not (string= "" (car ispell-filter))))) (setq ispell-filter (cdr ispell-filter)) - (if (listp ispell-filter) + (if (consp ispell-filter) (setq poss (ispell-parse-output (car ispell-filter)))) (cond ((or (eq poss t) (stringp poss)) ;; don't correct word @@ -1115,8 +1775,10 @@ ;; the word is incorrect, we have to propose a replacement (setq replace (flyspell-emacs-popup event poss word)) (cond ((eq replace 'ignore) + (goto-char save) nil) ((eq replace 'save) + (goto-char save) (process-send-string ispell-process (concat "*" word "\n")) (flyspell-unhighlight-at cursor-location) (setq ispell-pdict-modified-p '(t))) @@ -1126,33 +1788,45 @@ (setq ispell-pdict-modified-p (list ispell-pdict-modified-p))) (flyspell-unhighlight-at cursor-location) + (goto-char save) (if (eq replace 'buffer) (ispell-add-per-file-word-list word))) (replace - (setq word (if (atom replace) replace (car replace)) - cursor-location (+ (- (length word) (- end start)) - cursor-location)) - (if (not (equal word (car poss))) - (progn - (delete-region start end) - (insert word)))))) + (let ((new-word (if (atom replace) + replace + (car replace))) + (cursor-location (+ (- (length word) (- end start)) + cursor-location))) + (if (not (equal new-word (car poss))) + (let ((old-max (point-max))) + (delete-region start end) + (insert new-word) + (if flyspell-abbrev-p + (define-abbrev (flyspell-abbrev-table) + word + new-word)) + (flyspell-ajust-cursor-point save + cursor-location + old-max))))) + (t + (goto-char save) + nil))) ((eq flyspell-emacs 'xemacs) (flyspell-xemacs-popup - event poss word cursor-location start end))) - (ispell-pdict-save t)) - (if (< save (point-max)) - (goto-char save) - (goto-char (point-max))))) + event poss word cursor-location start end save) + (goto-char save))) + (ispell-pdict-save t)))) ;*---------------------------------------------------------------------*/ ;* flyspell-xemacs-correct ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-xemacs-correct (replace poss word cursor-location start end) +(defun flyspell-xemacs-correct (replace poss word cursor-location start end save) "The xemacs popup menu callback." (cond ((eq replace 'ignore) nil) ((eq replace 'save) (process-send-string ispell-process (concat "*" word "\n")) + (process-send-string ispell-process "#\n") (flyspell-unhighlight-at cursor-location) (setq ispell-pdict-modified-p '(t))) ((or (eq replace 'buffer) (eq replace 'session)) @@ -1164,14 +1838,36 @@ (if (eq replace 'buffer) (ispell-add-per-file-word-list word))) (replace - (setq word (if (atom replace) replace (car replace)) - cursor-location (+ (- (length word) (- end start)) - cursor-location)) - (if (not (equal word (car poss))) - (save-excursion - (delete-region start end) - (goto-char start) - (insert word)))))) + (let ((old-max (point-max)) + (new-word (if (atom replace) + replace + (car replace))) + (cursor-location (+ (- (length word) (- end start)) + cursor-location))) + (if (not (equal new-word (car poss))) + (progn + (delete-region start end) + (goto-char start) + (insert new-word) + (if flyspell-abbrev-p + (define-abbrev (flyspell-abbrev-table) + word + new-word)))) + (flyspell-ajust-cursor-point save cursor-location old-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-ajust-cursor-point ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ajust-cursor-point (save cursor-location old-max) + (if (>= save cursor-location) + (let ((new-pos (+ save (- (point-max) old-max)))) + (goto-char (cond + ((< new-pos (point-min)) + (point-min)) + ((> new-pos (point-max)) + (point-max)) + (t new-pos)))) + (goto-char save))) ;*---------------------------------------------------------------------*/ ;* flyspell-emacs-popup ... */ @@ -1183,7 +1879,7 @@ (mouse-pos (if (nth 1 mouse-pos) mouse-pos (set-mouse-position (car mouse-pos) - (/ (frame-width) 2) 2) + (/ (frame-width) 2) 2) (unfocus-frame) (mouse-position)))) (setq event (list (list (car (cdr mouse-pos)) @@ -1219,7 +1915,7 @@ ;*---------------------------------------------------------------------*/ ;* flyspell-xemacs-popup ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-xemacs-popup (event poss word cursor-location start end) +(defun flyspell-xemacs-popup (event poss word cursor-location start end save) "The xemacs popup menu." (let* ((corrects (if flyspell-sort-corrections (sort (car (cdr (cdr poss))) 'string<) @@ -1233,7 +1929,8 @@ word cursor-location start - end) + end + save) t)) corrects) '())) @@ -1247,7 +1944,8 @@ word cursor-location start - end) + end + save) t) (vector "Save word" @@ -1257,7 +1955,8 @@ word cursor-location start - end) + end + save) t))) (session (vector "Accept (session)" (list 'flyspell-xemacs-correct @@ -1266,7 +1965,8 @@ word cursor-location start - end) + end + save) t)) (buffer (vector "Accept (buffer)" (list 'flyspell-xemacs-correct @@ -1275,7 +1975,8 @@ word cursor-location start - end) + end + save) t))) (if (consp cor-menu) (append cor-menu (list "-" save session buffer)) @@ -1284,6 +1985,63 @@ ispell-dictionary)) menu)))) -(provide 'flyspell) +;*---------------------------------------------------------------------*/ +;* Some example functions for real autocrrecting */ +;*---------------------------------------------------------------------*/ +(defun flyspell-maybe-correct-transposition (beg end poss) + "Apply 'transpose-chars' to all points in the region BEG to END and +return t if any those result in a possible replacement suggested by ispell +in POSS. Otherwise the change is undone. + +This function is meant to be added to 'flyspell-incorrect-hook'." + (when (consp poss) + (catch 'done + (save-excursion + (goto-char (1+ beg)) + (while (< (point) end) + (transpose-chars 1) + (when (member (buffer-substring beg end) (nth 2 poss)) + (throw 'done t)) + (transpose-chars -1) + (forward-char)) + nil)))) + +(defun flyspell-maybe-correct-doubling (beg end poss) + "For each doubled charachter in the region BEG to END, remove one and +return t if any those result in a possible replacement suggested by ispell +in POSS. Otherwise the change is undone. +This function is meant to be added to 'flyspell-incorrect-hook'." + (when (consp poss) + (catch 'done + (save-excursion + (let ((last (char-after beg)) + this) + (goto-char (1+ beg)) + (while (< (point) end) + (setq this (char-after)) + (if (not (char-equal this last)) + (forward-char) + (delete-char 1) + (when (member (buffer-substring beg (1- end)) (nth 2 poss)) + (throw 'done t)) + ;; undo + (insert-char this 1)) + (setq last this)) + nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-already-abbrevp ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-already-abbrevp (table word) + (let ((sym (abbrev-symbol word table))) + (and sym (symbolp sym)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-change-abbrev ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-change-abbrev (table old new) + (set (abbrev-symbol old table) new)) + +(provide 'flyspell) ;;; flyspell.el ends here