emacs: lisp/textmodes/flyspell.el comparison

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

-:587ea1490d70
+:01137c1fdbe9
 ;;; flyspell.el --- on-the-fly spell checker
-;; Copyright (C) 1998, 2000, 2001, 2002, 2004  Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2003, 2004, 2005 Free Software Foundation, Inc.
 ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
 ;; Maintainer: FSF
 ;; Keywords: convenience
 :prefix "flyspell-"
 :group 'ispell
 :group 'processes)
 ;*---------------------------------------------------------------------*/
+;*    Which emacs are we currently running                             */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-emacs
+(cond
+((string-match "XEmacs" emacs-version)
+'xemacs)
+(t
+'emacs))
+"The type of Emacs we are currently running.")
+(defvar flyspell-use-local-map
+(or (eq flyspell-emacs 'xemacs)
+(not (string< emacs-version "20"))))
+;*---------------------------------------------------------------------*/
 ;*    User configuration ...                                           */
 ;*---------------------------------------------------------------------*/
 (defcustom flyspell-highlight-flag t
 "*How Flyspell should indicate misspelled words.
 Non-nil means use highlight, nil means use minibuffer messages."
 (defcustom flyspell-default-delayed-commands
 '(self-insert-command
 delete-backward-char
 backward-or-forward-delete-char
 delete-char
-scrollbar-vertical-drag)
+scrollbar-vertical-drag
+backward-delete-char-untabify)
 "The standard list of delayed commands for Flyspell.
 See `flyspell-delayed-commands'."
 :group 'flyspell
 :version "21.1"
 :type '(repeat (symbol)))
 :group 'flyspell
 :version "21.1"
 :type '(repeat (string)))
 (defcustom flyspell-abbrev-p
-t
+nil
-"*If true, add correction to abbreviation table."
+"*If non-nil, add correction to abbreviation table."
 :group 'flyspell
 :version "21.1"
 :type 'boolean)
 (defcustom flyspell-use-global-abbrev-table-p
 nil
-"*If true, prefer global abbrev table to local abbrev table."
+"*If non-nil, prefer global abbrev table to local abbrev table."
 :group 'flyspell
 :version "21.1"
 :type 'boolean)
 ;;;###autoload
 (defcustom flyspell-large-region 1000
 "*The threshold that determines if a region is small.
 If the region is smaller than this number of characters,
 `flyspell-region' checks the words sequentially using regular
 flyspell methods.  Else, if the region is large, a new Ispell process is
-spawned for speed."
+spawned for speed.
+If `flyspell-large-region' is nil, all regions are treated as small."
 :group 'flyspell
 :version "21.1"
-:type 'number)
+:type '(choice number boolean))
 (defcustom flyspell-insert-function (function insert)
 "*Function for inserting word by flyspell upon correction."
 :group 'flyspell
 :type 'function)
 (defcustom flyspell-after-incorrect-word-string nil
 "String used to indicate an incorrect word ending."
 :group 'flyspell
 :type '(choice string (const nil)))
+(defcustom flyspell-use-meta-tab t
+"*Non-nil means that flyspell uses META-TAB to correct word."
+:group 'flyspell
+:type 'boolean)
+(defcustom flyspell-auto-correct-binding
+(cond
+((eq flyspell-emacs 'xemacs)
+[(control \;)])
+(t
+[?\C-\;]))
+"The key binding for flyspell auto correction."
+:group 'flyspell)
 ;*---------------------------------------------------------------------*/
 ;*    Mode specific options                                            */
 ;*    -------------------------------------------------------------    */
 ;*    Mode specific options enable users to disable flyspell on        */
 ;*--- 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."
-(let ((in-headers (save-excursion
+(let ((header-end (save-excursion
-		      ;; When mail-header-separator is "",
+		      (goto-char (point-min))
-		      ;; it is likely to be found in both directions.
+		      (re-search-forward
-		      (not (re-search-backward (concat "^" (regexp-quote mail-header-separator) "$") nil t))))
+		       (concat "^"
-	(in-signature (save-excursion
+			       (regexp-quote mail-header-separator)
-			(re-search-backward message-signature-separator nil t))))
+			       "$")
-(cond (in-headers
+		       nil t)
+		      (point)))
+	(signature-begin (save-excursion
+			   (goto-char (point-max))
+			   (re-search-backward message-signature-separator
+					       nil t)
+			   (point))))
+(cond ((< (point) header-end)
 	   (and (save-excursion (beginning-of-line)
 				(looking-at "^Subject:"))
 		(> (point) (match-end 0))))
-	  (in-signature
+	  ((> (point) signature-begin)
 	   nil)
 	  (t
 	   (save-excursion
 	     (beginning-of-line)
 	     (not (looking-at "[>}|]\\|To:")))))))
 ;;;###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))
+(flyspell-mode 1)
+(run-hooks 'flyspell-prog-mode-hook))
 ;*---------------------------------------------------------------------*/
 ;*    Overlay compatibility                                            */
 ;*---------------------------------------------------------------------*/
 (autoload 'make-overlay            "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                             */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-emacs
-(cond
-((string-match "XEmacs" emacs-version)
-'xemacs)
-(t
-'emacs))
-"The type of Emacs we are currently running.")
-(defvar flyspell-use-local-map
-(or (eq flyspell-emacs 'xemacs)
-(not (string< emacs-version "20"))))
-;*---------------------------------------------------------------------*/
 ;*    The minor mode declaration.                                      */
 ;*---------------------------------------------------------------------*/
 (eval-when-compile (defvar flyspell-local-mouse-map))
 ;;;###autoload
 (defvar flyspell-mode nil)
 (make-variable-buffer-local 'flyspell-mode)
 (defvar flyspell-mouse-map
 (let ((map (make-sparse-keymap)))
+(if flyspell-use-meta-tab
+	(define-key map "\M-\t" #'flyspell-auto-correct-word))
 (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2])
 #'flyspell-correct-word)
-(define-key map "\M-\t" #'flyspell-auto-correct-word)
+(define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+(define-key map [(control \,)] 'flyspell-goto-next-error)
+(define-key map [(control \.)] 'flyspell-auto-correct-word)
 map))
 ;;;###autoload
 (defvar flyspell-mode-map (make-sparse-keymap))
 ;; 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))
+(if flyspell-use-meta-tab
+(define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word))
+(cond
+((eq flyspell-emacs 'xemacs)
+(define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+(define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error)
+(define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word))
+(flyspell-use-local-map
+(define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+(define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error)
+(define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word))))
 ;; the name of the overlay property that defines the keymap
 (defvar flyspell-overlay-keymap-property-name 'keymap)
 ;; dash character machinery
 With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
 Bindings:
 \\[ispell-word]: correct words (using Ispell).
 \\[flyspell-auto-correct-word]: automatically correct word.
-\\[flyspell-correct-word] (or mouse-2): popup correct words.
+\\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word.
+\\[flyspell-correct-word] (or down-mouse-2): popup correct words.
 Hooks:
 This runs `flyspell-mode-hook' after flyspell is entered.
 Remark:
 "Is BUFFER a minibuffer?"
 (let ((ws (get-buffer-window-list buffer t)))
 (and (consp ws) (window-minibuffer-p (car ws)))))
 ;*---------------------------------------------------------------------*/
-;*    flyspell-version ...                                             */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(defun flyspell-version ()
-"The flyspell version"
-(interactive)
-"1.6h")
-;*---------------------------------------------------------------------*/
 ;*    flyspell-accept-buffer-local-defs ...                            */
 ;*---------------------------------------------------------------------*/
 (defun flyspell-accept-buffer-local-defs ()
-(ispell-accept-buffer-local-defs)
+;; strange problem.  If buffer in current window has font-lock turned on,
+;; but SET-BUFFER was called to point to an invisible buffer, this ispell
+;; call will reset the buffer to the buffer in the current window.  However,
+;; it only happens at startup (fix by Albert L. Ting).
+(let ((buf (current-buffer)))
+(ispell-accept-buffer-local-defs)
+(set-buffer buf))
 (if (not (and (eq flyspell-dash-dictionary ispell-dictionary)
 		(eq flyspell-dash-local-dictionary ispell-local-dictionary)))
-;; the dictionary has changed
+;; The dictionary has 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)
 	(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))
+	 (if (and (eq flyspell-emacs 'emacs)
+		  (not (string< emacs-version "20")))
+	     (define-key map '[tool-bar] nil))
+	 map))
+(set (make-local-variable 'flyspell-mode-map)
+(let ((map (copy-keymap flyspell-mode-map)))
+	 (set-keymap-parent map (current-local-map))
+	 (if (and (eq flyspell-emacs 'emacs)
+		  (not (string< emacs-version "20")))
+	     (define-key map '[tool-bar] nil))
+	 map))
 ;; the welcome message
 (if (and flyspell-issue-message-flag
 	   flyspell-issue-welcome-flag
 	   (interactive-p))
 (let ((binding (where-is-internal 'flyspell-auto-correct-word
 ;*    flyspell-word-cache ...                                          */
 ;*---------------------------------------------------------------------*/
 (defvar flyspell-word-cache-start  nil)
 (defvar flyspell-word-cache-end    nil)
 (defvar flyspell-word-cache-word   nil)
+(defvar flyspell-word-cache-result '_)
 (make-variable-buffer-local 'flyspell-word-cache-start)
 (make-variable-buffer-local 'flyspell-word-cache-end)
 (make-variable-buffer-local 'flyspell-word-cache-word)
+(make-variable-buffer-local 'flyspell-word-cache-result)
 ;*---------------------------------------------------------------------*/
 ;*    The flyspell pre-hook, store the current position. In the        */
 ;*    post command hook, we will check, if the word at this position   */
 ;*    has to be spell checked.                                         */
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-check-pre-word-p ...                                    */
 ;*---------------------------------------------------------------------*/
 (defun flyspell-check-pre-word-p ()
-"Return non-nil if we should to check the word before point.
+"Return non-nil if we should check the word before point.
 More precisely, it applies to the word that was before point
 before the current command."
 (cond
 ((or (not (numberp flyspell-pre-point))
 	(not (bufferp flyspell-pre-buffer))
 (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))
+((and (memq (char-after start) '(?\n ? )) (> stop start))
 t)
 ((not (numberp flyspell-pre-point))
 t)
 ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
 nil)
 ((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))
-	  (sit-for flyspell-delay nil)
-	(sit-for flyspell-delay 0 nil)))
 (t t)))
 (t t)))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-debug-signal-no-check ...                               */
 	(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))))
+	    (progn
+	      (setq flyspell-word-cache-end -1)
+	      (setq flyspell-word-cache-result '_)))))
 (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
 			    (sort (car (cdr (cdr poss))) 'string<)
 			  (car (cdr (cdr poss)))))))
 (if flyspell-issue-message-flag
 	(message (format "mispelling `%s'  %S" word replacements)))))
+;*---------------------------------------------------------------------*/
+;*    flyspell-word-search-backward ...                                */
+;*---------------------------------------------------------------------*/
+(defun flyspell-word-search-backward (word bound)
+(save-excursion
+(let ((r '())
+	  p)
+(while (and (not r) (setq p (search-backward word bound t)))
+	(let ((lw (flyspell-get-word '())))
+	  (if (and (consp lw) (string-equal (car lw) word))
+	      (setq r p)
+	    (goto-char p))))
+r)))
+;*---------------------------------------------------------------------*/
+;*    flyspell-word-search-forward ...                                 */
+;*---------------------------------------------------------------------*/
+(defun flyspell-word-search-forward (word bound)
+(save-excursion
+(let ((r '())
+	  p)
+(while (and (not r) (setq p (search-forward word bound t)))
+	(let ((lw (flyspell-get-word '())))
+	  (if (and (consp lw) (string-equal (car lw) word))
+	      (setq r p)
+	    (goto-char (1+ p)))))
+r)))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-word ...                                                */
 ;*---------------------------------------------------------------------*/
 (defun flyspell-word (&optional following)
 "Spell check a word."
 	  (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 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 (or (not (eq ispell-parser 'tex))
-		     (not (eq (char-after start) ?\\)))
+		     (and (> start (point-min))
+			  (not (eq (char-after (1- start)) ?}))
+			  (not (eq (char-after (1- start)) ?\\))))
 		 flyspell-mark-duplications-flag
 		 (save-excursion
-		   (goto-char start)
+		   (goto-char (1- start))
-		   (word-search-backward word
+		   (let ((p (flyspell-word-search-backward
-					 (- start
+			     word
-					    (+ 1 (- end start)))
+			     (- start (1+ (- end start))))))
-					 t)))
+		     (and p (/= p (1- start))))))
 	    ;; yes, this is a doublon
-	    (flyspell-highlight-incorrect-region start end 'doublon))
+	    (flyspell-highlight-incorrect-region start end 'doublon)
+	    nil)
 	   ((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)
+	    flyspell-word-cache-result)
 	   ((and (eq ispell-parser 'tex)
 		 (flyspell-tex-command-p flyspell-word))
 	    ;; this is a correct word (because a tex command)
 	    (flyspell-unhighlight-at start)
 	    (if (> end start)
 	    ;; (process-send-string ispell-process "!\n")
 	    ;; back to terse mode.
 	    (setq ispell-filter (cdr ispell-filter))
 	    (if (consp ispell-filter)
 		(setq poss (ispell-parse-output (car ispell-filter))))
-	    (cond ((eq poss t)
+	    (let ((res (cond ((eq poss t)
-		   ;; correct
+			      ;; correct
-		   (flyspell-unhighlight-at start)
+			      (setq flyspell-word-cache-result t)
-		   (if (> end start)
+			      (flyspell-unhighlight-at start)
-		       (flyspell-unhighlight-at (- end 1)))
+			      (if (> end start)
-		   t)
+				  (flyspell-unhighlight-at (- end 1)))
-		  ((and (stringp poss) flyspell-highlight-flag)
+			      t)
-		   ;; correct
+			     ((and (stringp poss) flyspell-highlight-flag)
-		   (flyspell-unhighlight-at start)
+			      ;; correct
-		   (if (> end start)
+			      (setq flyspell-word-cache-result t)
-		       (flyspell-unhighlight-at (- end 1)))
+			      (flyspell-unhighlight-at start)
-		   t)
+			      (if (> end start)
-		  ((null poss)
+				  (flyspell-unhighlight-at (- end 1)))
-		   (flyspell-unhighlight-at start)
+			      t)
-		   (if (> end start)
+			     ((null poss)
-		       (flyspell-unhighlight-at (- end 1))))
+			      (setq flyspell-word-cache-result t)
-		  ((or (and (< flyspell-duplicate-distance 0)
+			      (flyspell-unhighlight-at start)
-			    (or (save-excursion
+			      (if (> end start)
-				  (goto-char start)
+				  (flyspell-unhighlight-at (- end 1)))
-				  (word-search-backward word
+			      t)
-							(point-min)
+			     ((or (and (< flyspell-duplicate-distance 0)
-							t))
+				       (or (save-excursion
-				(save-excursion
+					     (goto-char start)
-				  (goto-char end)
+					     (flyspell-word-search-backward
-				  (word-search-forward word
+					      word
-						       (point-max)
+					      (point-min)))
-						       t))))
+					   (save-excursion
-		       (and (> flyspell-duplicate-distance 0)
+					     (goto-char end)
-			    (or (save-excursion
+					     (flyspell-word-search-forward
-				  (goto-char start)
+					      word
-				  (word-search-backward
+					      (point-max)))))
-				   word
+				  (and (> flyspell-duplicate-distance 0)
-				   (- start
+				       (or (save-excursion
-				      flyspell-duplicate-distance)
+					     (goto-char start)
-				   t))
+					     (flyspell-word-search-backward
-				(save-excursion
+					      word
-				  (goto-char end)
+					      (- start
-				  (word-search-forward
+						 flyspell-duplicate-distance)))
-				   word
+					   (save-excursion
-				   (+ end
+					     (goto-char end)
-				      flyspell-duplicate-distance)
+					     (flyspell-word-search-forward
-				   t)))))
+					      word
-		   (if flyspell-highlight-flag
+					      (+ end
-		       (flyspell-highlight-duplicate-region start end poss)
+						 flyspell-duplicate-distance))))))
-		     (message (format "duplicate `%s'" word))))
+			      (setq flyspell-word-cache-result nil)
-		  (t
+			      (if flyspell-highlight-flag
-		   ;; incorrect highlight the location
+				  (flyspell-highlight-duplicate-region
-		   (if flyspell-highlight-flag
+				   start end poss)
-		       (flyspell-highlight-incorrect-region start end poss)
+				(message (format "duplicate `%s'" word)))
-		     (flyspell-notify-misspell start end word poss))))
+			      nil)
-	    ;; return to original location
+			     (t
-	    (goto-char cursor-location)
+			      (setq flyspell-word-cache-result nil)
-	    (if ispell-quit (setq ispell-quit nil)))))))))
+			      ;; incorrect highlight the location
+			      (if flyspell-highlight-flag
+				  (flyspell-highlight-incorrect-region
+				   start end poss)
+				(flyspell-notify-misspell start end word poss))
+			      nil))))
+	      ;; return to original location
+	      (goto-char cursor-location)
+	      (if ispell-quit (setq ispell-quit nil))
+	      res))))))))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-tex-math-initialized ...                                */
 ;*---------------------------------------------------------------------*/
 (defvar flyspell-tex-math-initialized nil)
 flyspell-not-casechars-cache))))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-get-word ...                                            */
 ;*---------------------------------------------------------------------*/
-(defun flyspell-get-word (following)
+(defun flyspell-get-word (following &optional extra-otherchars)
 "Return the word for spell-checking according to Ispell syntax.
-If argument FOLLOWING is non-nil or if `ispell-following-word'
+If optional argument FOLLOWING is non-nil or if `flyspell-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 other chars that can be included in word
+Optional second argument contains otherchars that can be included in word
 many times.
-Word syntax described by `ispell-dictionary-alist' (which see)."
+Word syntax described by `flyspell-dictionary-alist' (which see)."
 (let* ((flyspell-casechars (flyspell-get-casechars))
 	 (flyspell-not-casechars (flyspell-get-not-casechars))
 	 (ispell-otherchars (ispell-get-otherchars))
 	 (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
-	 (word-regexp (if (string< "" ispell-otherchars)
+	 (word-regexp (concat flyspell-casechars
-			  (concat flyspell-casechars
+			      "+\\("
-				  "+\\("
+			      (if (not (string= "" ispell-otherchars))
-				  ispell-otherchars
+				  (concat ispell-otherchars "?"))
-				  "?"
+			      (if extra-otherchars
-				  flyspell-casechars
+				  (concat extra-otherchars "?"))
-				  "+\\)"
+			      flyspell-casechars
-				  (if ispell-many-otherchars-p
+			      "+\\)"
-				      "*" "?"))
+			      (if (or ispell-many-otherchars-p
-			(concat flyspell-casechars "+")))
+				      extra-otherchars)
-	 did-it-once
+				  "*" "?")))
+	 did-it-once prevpt
 	 start end word)
 ;; find the word
 (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)
-(let ((pos nil))
+(while (and (or (and (not (string= "" ispell-otherchars))
-(if (string< "" ispell-otherchars)
+			 (looking-at ispell-otherchars))
-	  (while (and (looking-at ispell-otherchars)
+		    (and extra-otherchars (looking-at extra-otherchars)))
-		      (not (bobp))
+		(not (bobp))
-		      (or (not did-it-once)
+		(or (not did-it-once)
-			  ispell-many-otherchars-p)
+		    ispell-many-otherchars-p)
-		      (not (eq pos (point))))
+		(not (eq prevpt (point))))
-	    (setq pos (point))
+(if (and extra-otherchars (looking-at extra-otherchars))
-	    (setq did-it-once t)
+	  (progn
 	    (backward-char 1)
 	    (if (looking-at flyspell-casechars)
-		(re-search-backward flyspell-not-casechars (point-min) 'move)
+		(re-search-backward flyspell-not-casechars (point-min) 'move)))
-	      (backward-char -1)))))
+	(setq did-it-once t
+	      prevpt (point))
+	(backward-char 1)
+	(if (looking-at flyspell-casechars)
+	    (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 word-regexp (point-max) t) nil)
+(if (not (re-search-forward word-regexp (point-max) t))
 	nil
 (progn
 	(setq start (match-beginning 0)
 	      end (point)
 	      word (buffer-substring-no-properties start end))
 (defun flyspell-external-point-words ()
 (let ((buffer flyspell-external-ispell-buffer))
 (set-buffer buffer)
 (goto-char (point-min))
 (let ((size (- flyspell-large-region-end flyspell-large-region-beg))
-	  (start flyspell-large-region-beg))
+	  (start flyspell-large-region-beg)
+	  (pword "")
+	  (pcount 1))
 ;; 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)))
+	      (if (string= word pword)
+		  (setq pcount (1+ pcount))
+		(progn
+		  (setq pword word)
+		  (setq pcount 1)))
 	      (goto-char (match-end 0))
+	      (if flyspell-issue-message-flag
+		  (message "Spell Checking...%d%% [%s]"
+			   (* 100 (/ (float (point)) (point-max)))
+			   word))
 	      (set-buffer flyspell-large-region-buffer)
 	      (goto-char flyspell-large-region-beg)
-	      (if flyspell-issue-message-flag
+	      (let ((keep t)
-		  (message "Spell Checking...%d%% [%s]"
+		    (n 0))
-			   (* 100 (/ (float (- (point) start)) size))
+		(while (and (or (< n pcount) keep)
-			   word))
+			    (search-forward word flyspell-large-region-end t))
-	      (if (search-forward word flyspell-large-region-end t)
 		  (progn
-		    (setq flyspell-large-region-beg (point))
 		    (goto-char (- (point) 1))
-		    (flyspell-word)))
+		    (setq n (1+ n))
+		    (setq keep (flyspell-word))))
+		(if (= n pcount)
+		    (setq flyspell-large-region-beg (point))))
 	      (set-buffer buffer))
 	  (goto-char (point-max)))))
 ;; we are done
 (if flyspell-issue-message-flag (message "Spell Checking completed."))
 ;; ok, we are done with pointing out incorrect words, we just
 (save-excursion
 (if (> beg end)
 	  (let ((old beg))
 	    (setq beg end)
 	    (setq end old)))
-(if (> (- end beg) flyspell-large-region)
+(if (and flyspell-large-region (> (- end beg) flyspell-large-region))
 	  (flyspell-large-region beg end)
 	(flyspell-small-region beg end)))))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-buffer ...                                              */
 (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 all the overlay that are in the region, not
+	    ;; beginning at the word start position
+	    (if (< (1+ beg) end)
+		(let ((os (overlays-in (1+ beg) end)))
+		  (while (consp os)
+		    (if (flyspell-overlay-p (car os))
+			(delete-overlay (car os)))
+		    (setq os (cdr os)))))
 	    ;; 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)))
+	      (let ((os (overlays-at beg)))
-		(while (consp overlays)
+		(while (consp os)
-		  (if (flyspell-overlay-p (car overlays))
+		  (if (flyspell-overlay-p (car os))
-		      (delete-overlay (car overlays)))
+		      (delete-overlay (car os)))
-		  (setq overlays (cdr overlays)))))
+		  (setq os (cdr os)))))
 	    ;; now we can use a new overlay
 	    (setq flyspell-overlay
 		  (make-flyspell-overlay
 		   beg end 'flyspell-incorrect-face 'highlight)))))))
 	    (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))
+(let ((word (flyspell-get-word nil)))
-	    start end poss)
+	(if (consp word)
-	;; destructure return word info list.
+	    (let ((start (car (cdr word)))
-	(setq start (car (cdr word))
+		  (end (car (cdr (cdr word))))
-	      end (car (cdr (cdr word)))
+		  (word (car word))
-	      word (car word))
+		  poss)
-	(setq flyspell-auto-correct-word word)
+	      (setq flyspell-auto-correct-word word)
-	;; now check spelling of word.
+	      ;; now check spelling of word.
-	(process-send-string ispell-process "%\n") ;put in verbose mode
+	      (process-send-string ispell-process "%\n") ;put in verbose mode
-	(process-send-string ispell-process (concat "^" word "\n"))
+	      (process-send-string ispell-process (concat "^" word "\n"))
-	;; wait until ispell has processed word
+	      ;; wait until ispell has processed word
-	(while (progn
+	      (while (progn
-		 (accept-process-output ispell-process)
+		       (accept-process-output ispell-process)
-		 (not (string= "" (car ispell-filter)))))
+		       (not (string= "" (car ispell-filter)))))
-	(setq ispell-filter (cdr ispell-filter))
+	      (setq ispell-filter (cdr ispell-filter))
-	(if (consp ispell-filter)
+	      (if (consp ispell-filter)
-	    (setq poss (ispell-parse-output (car ispell-filter))))
+		  (setq poss (ispell-parse-output (car ispell-filter))))
-	(cond ((or (eq poss t) (stringp poss))
+	      (cond
-	       ;; don't correct word
+	       ((or (eq poss t) (stringp poss))
-	       t)
+		;; don't correct word
-	      ((null poss)
+		t)
-	       ;; ispell error
+	       ((null poss)
-	       (error "Ispell: error in Ispell process"))
+		;; ispell error
-	      (t
+		(error "Ispell: error in Ispell process"))
-	       ;; the word is incorrect, we have to propose a replacement
+	       (t
-	       (let ((replacements (if flyspell-sort-corrections
+		;; the word is incorrect, we have to propose a replacement
-				       (sort (car (cdr (cdr poss))) 'string<)
+		(let ((replacements (if flyspell-sort-corrections
-				     (car (cdr (cdr poss))))))
+					(sort (car (cdr (cdr poss))) 'string<)
-		 (setq flyspell-auto-correct-region nil)
+				      (car (cdr (cdr poss))))))
-		 (if (consp replacements)
+		  (setq flyspell-auto-correct-region nil)
-		     (progn
+		  (if (consp replacements)
-		       (let ((replace (car replacements)))
+		      (progn
-			 (let ((new-word replace))
+			(let ((replace (car replacements)))
-			   (if (not (equal new-word (car poss)))
+			  (let ((new-word replace))
-			       (progn
+			    (if (not (equal new-word (car poss)))
-				 ;; the save the current replacements
+				(progn
-				 (setq flyspell-auto-correct-region
+				  ;; the save the current replacements
-				       (cons start (length new-word)))
+				  (setq flyspell-auto-correct-region
-				 (let ((l replacements))
+					(cons start (length new-word)))
-				   (while (consp (cdr l))
+				  (let ((l replacements))
-				     (setq l (cdr l)))
+				    (while (consp (cdr l))
-				   (rplacd l (cons (car poss) replacements)))
+				      (setq l (cdr l)))
-				 (setq flyspell-auto-correct-ring
+				    (rplacd l (cons (car poss) replacements)))
-				       replacements)
+				  (setq flyspell-auto-correct-ring
-				 (flyspell-unhighlight-at start)
+					replacements)
-				 (delete-region start end)
+				  (flyspell-unhighlight-at start)
-				 (funcall flyspell-insert-function new-word)
+				  (delete-region start end)
-				 (if flyspell-abbrev-p
+				  (funcall flyspell-insert-function new-word)
-				     (if (flyspell-already-abbrevp
+				  (if flyspell-abbrev-p
-					  (flyspell-abbrev-table) word)
+				      (if (flyspell-already-abbrevp
-					 (flyspell-change-abbrev
+					   (flyspell-abbrev-table) word)
-					  (flyspell-abbrev-table)
+					  (flyspell-change-abbrev
-					  word
+					   (flyspell-abbrev-table)
-					  new-word)
+					   word
-				       (flyspell-define-abbrev word new-word)))
+					   new-word)
-				 (flyspell-word)
+					(flyspell-define-abbrev word
-				 (flyspell-display-next-corrections
+								new-word)))
-				  (cons new-word flyspell-auto-correct-ring))
+				  (flyspell-word)
-				 (flyspell-ajust-cursor-point pos
+				  (flyspell-display-next-corrections
-							      (point)
+				   (cons new-word flyspell-auto-correct-ring))
-							      old-max))))))))))
+				  (flyspell-ajust-cursor-point pos
-	(setq flyspell-auto-correct-pos (point))
+							       (point)
-	(ispell-pdict-save t)))))
+							       old-max))))))))))
+	      (setq flyspell-auto-correct-pos (point))
+	      (ispell-pdict-save t)))))))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-auto-correct-previous-pos ...                           */
 ;*---------------------------------------------------------------------*/
 (defvar flyspell-auto-correct-previous-pos nil
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-auto-correct-previous-hook ...                          */
 ;*---------------------------------------------------------------------*/
 (defun flyspell-auto-correct-previous-hook ()
 "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
-Sets flyspell-auto-correct-previous-pos to nil"
+Sets `flyspell-auto-correct-previous-pos' to nil"
 (interactive)
 (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t)
 (unless (eq this-command (function flyspell-auto-correct-previous-word))
 (setq flyspell-auto-correct-previous-pos nil)))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-auto-correct-previous-word ...                          */
 ;*---------------------------------------------------------------------*/
 (defun flyspell-auto-correct-previous-word (position)
-"*Auto correct the first mispelled word that occurs before point."
+"*Auto correct the first mispelled word that occurs before point.
+But don't look beyond what's visible on the screen."
 (interactive "d")
-(add-hook 'pre-command-hook
+(let (top bot)
-	    (function flyspell-auto-correct-previous-hook) t t)
+(save-excursion
+(move-to-window-line 0)
-(save-excursion
+(setq top (point))
-(unless flyspell-auto-correct-previous-pos
+(move-to-window-line -1)
-;; only reset if a new overlay exists
+(setq bot (point)))
-(setq flyspell-auto-correct-previous-pos nil)
+(save-excursion
+(save-restriction
-(let ((overlay-list (overlays-in (point-min) position))
+	(narrow-to-region top bot)
-	    (new-overlay 'dummy-value))
+	(overlay-recenter (point))
-	;; search for previous (new) flyspell overlay
+	(add-hook 'pre-command-hook
-	(while (and new-overlay
+		  (function flyspell-auto-correct-previous-hook) t t)
-		    (or (not (flyspell-overlay-p new-overlay))
-			;; check if its face has changed
+	(unless flyspell-auto-correct-previous-pos
-			(not (eq (get-char-property
+	  ;; only reset if a new overlay exists
-				  (overlay-start new-overlay) 'face)
+	  (setq flyspell-auto-correct-previous-pos nil)
-				 'flyspell-incorrect-face))))
-	  (setq new-overlay (car-safe overlay-list))
+	  (let ((overlay-list (overlays-in (point-min) position))
-	  (setq overlay-list (cdr-safe overlay-list)))
+		(new-overlay 'dummy-value))
-	;; if nothing new exits new-overlay should be nil
+	    ;; search for previous (new) flyspell overlay
-	(if new-overlay;; the length of the word may change so go to the start
+	    (while (and new-overlay
-	    (setq flyspell-auto-correct-previous-pos
+			(or (not (flyspell-overlay-p new-overlay))
-		  (overlay-start new-overlay)))))
+			    ;; check if its face has changed
+			    (not (eq (get-char-property
-(when flyspell-auto-correct-previous-pos
+				      (overlay-start new-overlay) 'face)
-(save-excursion
+				     'flyspell-incorrect-face))))
-	(goto-char flyspell-auto-correct-previous-pos)
+	      (setq new-overlay (car-safe overlay-list))
-	(let ((ispell-following-word t));; point is at start
+	      (setq overlay-list (cdr-safe overlay-list)))
-	  (if (numberp flyspell-auto-correct-previous-pos)
-	      (goto-char flyspell-auto-correct-previous-pos))
+	    ;; if nothing new exits new-overlay should be nil
-	  (flyspell-auto-correct-word))
+	    (if new-overlay ;; the length of the word may change so go to the start
-	;; the point may have moved so reset this
+		(setq flyspell-auto-correct-previous-pos
-	(setq flyspell-auto-correct-previous-pos (point))))))
+		      (overlay-start new-overlay)))))
+	(when flyspell-auto-correct-previous-pos
+	  (save-excursion
+	    (goto-char flyspell-auto-correct-previous-pos)
+	    (let ((ispell-following-word t)) ;; point is at start
+	      (if (numberp flyspell-auto-correct-previous-pos)
+		  (goto-char flyspell-auto-correct-previous-pos))
+	      (flyspell-auto-correct-word))
+	    ;; the point may have moved so reset this
+	    (setq flyspell-auto-correct-previous-pos (point))))))))
 ;*---------------------------------------------------------------------*/
 ;*    flyspell-correct-word ...                                        */
 ;*---------------------------------------------------------------------*/
 (defun flyspell-correct-word (event)
 (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)
 (let ((cursor-location (point))
-	  (word (flyspell-get-word nil))
+	  (word (flyspell-get-word nil)))
-	  start end poss replace)
+(if (consp word)
-;; destructure return word info list.
+	  (let ((start (car (cdr word)))
-(setq start (car (cdr word))
+		(end (car (cdr (cdr word))))
-	    end (car (cdr (cdr word)))
+		(word (car word))
-	    word (car word))
+		poss replace)
-;; now check spelling of word.
+	    ;; now check spelling of word.
-(process-send-string ispell-process "%\n") ;put in verbose mode
+	    (process-send-string ispell-process "%\n") ;put in verbose mode
-(process-send-string ispell-process (concat "^" word "\n"))
+	    (process-send-string ispell-process (concat "^" word "\n"))
-;; wait until ispell has processed word
+	    ;; wait until ispell has processed word
-(while (progn
+	    (while (progn
-	       (accept-process-output ispell-process)
+		     (accept-process-output ispell-process)
-	       (not (string= "" (car ispell-filter)))))
+		     (not (string= "" (car ispell-filter)))))
-(setq ispell-filter (cdr ispell-filter))
+	    (setq ispell-filter (cdr ispell-filter))
-(if (consp ispell-filter)
+	    (if (consp ispell-filter)
-	  (setq poss (ispell-parse-output (car ispell-filter))))
+		(setq poss (ispell-parse-output (car ispell-filter))))
-(cond ((or (eq poss t) (stringp poss))
+	    (cond
-	     ;; don't correct word
+	     ((or (eq poss t) (stringp poss))
-	     t)
+	      ;; don't correct word
-	    ((null poss)
+	      t)
-	     ;; ispell error
+	     ((null poss)
-	     (error "Ispell: error in Ispell process"))
+	      ;; ispell error
-	    ((string-match "GNU" (emacs-version))
+	      (error "Ispell: error in Ispell process"))
-	     ;; the word is incorrect, we have to propose a replacement
+	     ((string-match "GNU" (emacs-version))
-	     (setq replace (flyspell-emacs-popup event poss word))
+	      ;; the word is incorrect, we have to propose a replacement
-	     (cond ((eq replace 'ignore)
+	      (setq replace (flyspell-emacs-popup event poss word))
-		    (goto-char save)
+	      (cond ((eq replace 'ignore)
-		    nil)
+		     (goto-char save)
-		   ((eq replace 'save)
+		     nil)
-		    (goto-char save)
+		    ((eq replace 'save)
-		    (process-send-string ispell-process (concat "*" word "\n"))
+		     (goto-char save)
-		    (flyspell-unhighlight-at cursor-location)
+		     (process-send-string ispell-process
-		    (setq ispell-pdict-modified-p '(t)))
+					  (concat "*" word "\n"))
-		   ((or (eq replace 'buffer) (eq replace 'session))
+		     (flyspell-unhighlight-at cursor-location)
-		    (process-send-string ispell-process (concat "@" word "\n"))
+		     (setq ispell-pdict-modified-p '(t)))
-		    (if (null ispell-pdict-modified-p)
+		    ((or (eq replace 'buffer) (eq replace 'session))
-			(setq ispell-pdict-modified-p
+		     (process-send-string ispell-process
-			      (list ispell-pdict-modified-p)))
+					  (concat "@" word "\n"))
-		    (flyspell-unhighlight-at cursor-location)
+		     (if (null ispell-pdict-modified-p)
-		    (goto-char save)
+			 (setq ispell-pdict-modified-p
-		    (if (eq replace 'buffer)
+			       (list ispell-pdict-modified-p)))
-			(ispell-add-per-file-word-list word)))
+		     (flyspell-unhighlight-at cursor-location)
-		   (replace
+		     (goto-char save)
-		    (flyspell-unhighlight-at cursor-location)
+		     (if (eq replace 'buffer)
-		    (let ((new-word (if (atom replace)
+			 (ispell-add-per-file-word-list word)))
-					replace
+		    (replace
-				      (car replace)))
+		     (flyspell-unhighlight-at cursor-location)
-			  (cursor-location (+ (- (length word) (- end start))
+		     (let ((new-word (if (atom replace)
-					      cursor-location)))
+					 replace
-		      (if (not (equal new-word (car poss)))
+				       (car replace)))
-			  (let ((old-max (point-max)))
+			   (cursor-location
-			    (delete-region start end)
+			    (+ (- (length word) (- end start))
-			    (funcall flyspell-insert-function new-word)
+			       cursor-location)))
-			    (if flyspell-abbrev-p
+		       (if (not (equal new-word (car poss)))
-				(flyspell-define-abbrev word new-word))
+			   (let ((old-max (point-max)))
-			    (flyspell-ajust-cursor-point save
+			     (delete-region start end)
-							 cursor-location
+			     (funcall flyspell-insert-function new-word)
-							 old-max)))))
+			     (if flyspell-abbrev-p
-		   (t
+				 (flyspell-define-abbrev word new-word))
-		    (goto-char save)
+			     (flyspell-ajust-cursor-point save
-		    nil)))
+							  cursor-location
-	    ((eq flyspell-emacs 'xemacs)
+							  old-max)))))
-	     (flyspell-xemacs-popup
+		    (t
-	      event poss word cursor-location start end save)
+		     (goto-char save)
-	     (goto-char save)))
+		     nil)))
-(ispell-pdict-save t))))
+	     ((eq flyspell-emacs 'xemacs)
+	      (flyspell-xemacs-popup
+	       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 save)

Mercurial > emacs

comparison lisp/textmodes/flyspell.el @ 90188:01137c1fdbe9