]> code.delx.au - gnu-emacs/blobdiff - lisp/textmodes/flyspell.el
(flyspell-mark-duplications-exceptions): New variable. List of
[gnu-emacs] / lisp / textmodes / flyspell.el
index 39d4b1f7b698083c0199456e5247e47d9b8bfae7..9d5c7868d13bf917132ad9127b324a4d87c369a3 100644 (file)
@@ -1,7 +1,7 @@
 ;;; flyspell.el --- on-the-fly spell checker
 
-;; Copyright (C) 1998, 2000, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
 ;; Maintainer: FSF
@@ -11,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -67,11 +67,21 @@ Non-nil means use highlight, nil means use minibuffer messages."
 
 (defcustom flyspell-mark-duplications-flag t
   "Non-nil means Flyspell reports a repeated word as an error.
+See `flyspell-mark-duplications-exceptions' to add exceptions to this rule.
 Detection of repeated words is not implemented in
 \"large\" regions; see `flyspell-large-region'."
   :group 'flyspell
   :type 'boolean)
 
+(defcustom flyspell-mark-duplications-exceptions
+  '(("francais" . ("nous" "vous")))
+  "A list of exceptions for duplicated words.
+It should be a list of (LANGUAGE . EXCEPTION-LIST).  LANGUAGE is matched
+against the current dictionary and EXCEPTION-LIST is a list of strings.
+The duplicated word is downcased before it is compared with the exceptions."
+  :group 'flyspell
+  :type '(alist :key-type string :value-type (repeat string)))
+
 (defcustom flyspell-sort-corrections nil
   "Non-nil means, sort the corrections alphabetically before popping them."
   :group 'flyspell
@@ -189,7 +199,7 @@ Ispell's ultimate default dictionary."
   :type 'string)
 
 (defcustom flyspell-check-tex-math-command nil
-  "Non nil means check even inside TeX math environment.
+  "Non-nil means check even inside TeX math environment.
 TeX math environments are discovered by the TEXMATHP that implemented
 inside the texmathp.el Emacs package.  That package may be found at:
 http://strw.leidenuniv.nl/~dominik/Tools"
@@ -271,21 +281,23 @@ If `flyspell-large-region' is nil, all regions are treated as small."
 ;;*    using flyspell with mail-mode add the following expression       */
 ;;*    in your .emacs file:                                             */
 ;;*       (add-hook 'mail-mode                                          */
-;;*                 '(lambda () (setq flyspell-generic-check-word-p           */
-;;*                                   'mail-mode-flyspell-verify)))           */
+;;*                 '(lambda () (setq flyspell-generic-check-word-predicate    */
+;;*                                   'mail-mode-flyspell-verify)))            */
 ;;*---------------------------------------------------------------------*/
-(defvar flyspell-generic-check-word-p nil
+(defvar flyspell-generic-check-word-predicate nil
   "Function providing per-mode customization over which words are flyspelled.
 Returns t to continue checking, nil otherwise.
 Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
 property of the major mode name.")
-(make-variable-buffer-local 'flyspell-generic-check-word-p)
+(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
+(defvaralias 'flyspell-generic-check-word-p
+  'flyspell-generic-check-word-predicate)
 
 ;;*--- 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."
+  "Function used for `flyspell-generic-check-word-predicate' in Mail mode."
   (let ((header-end (save-excursion
                      (goto-char (point-min))
                      (re-search-forward
@@ -313,7 +325,7 @@ property of the major mode name.")
 ;;*--- 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."
+  "Function used for `flyspell-generic-check-word-predicate' in Texinfo mode."
   (save-excursion
     (forward-word -1)
     (not (looking-at "@"))))
@@ -321,7 +333,7 @@ property of the major mode name.")
 ;;*--- 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."
+  "Function used for `flyspell-generic-check-word-predicate' in LaTeX mode."
   (and
    (not (save-excursion
          (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t)))
@@ -338,7 +350,7 @@ property of the major mode name.")
 (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."
+  "Function used for `flyspell-generic-check-word-predicate' in SGML mode."
   (not (save-excursion
         (let ((this (point-marker))
               (s (progn (beginning-of-line) (point-marker)))
@@ -368,7 +380,7 @@ property of the major mode name.")
   "Faces corresponding to text in programming-mode buffers.")
 
 (defun flyspell-generic-progmode-verify ()
-  "Used for `flyspell-generic-check-word-p' in programming modes."
+  "Used for `flyspell-generic-check-word-predicate' in programming modes."
   (let ((f (get-text-property (point) 'face)))
     (memq f flyspell-prog-text-faces)))
 
@@ -376,7 +388,8 @@ property of the major mode name.")
 (defun flyspell-prog-mode ()
   "Turn on `flyspell-mode' for comments and strings."
   (interactive)
-  (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify)
+  (setq flyspell-generic-check-word-predicate
+        'flyspell-generic-progmode-verify)
   (flyspell-mode 1)
   (run-hooks 'flyspell-prog-mode-hook))
 
@@ -409,6 +422,7 @@ property of the major mode name.")
     (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)
+    (define-key map [?\C-c ?$] 'flyspell-correct-word-before-point)
     map)
   "Minor mode keymap for Flyspell mode--for the whole buffer.")
 
@@ -453,7 +467,8 @@ See also `flyspell-duplicate-distance'."
 This spawns a single Ispell process and checks each word.
 The default flyspell behavior is to highlight incorrect words.
 With no argument, this command toggles Flyspell mode.
-With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
+With a prefix argument ARG, turn Flyspell minor mode on if ARG is positive,
+otherwise turn it off.
 
 Bindings:
 \\[ispell-word]: correct words (using Ispell).
@@ -483,6 +498,18 @@ in your .emacs file.
       (flyspell-mode-on)
     (flyspell-mode-off)))
 
+;;;###autoload
+(defun turn-on-flyspell ()
+  "Unconditionally turn on Flyspell mode."
+  (flyspell-mode 1))
+
+;;;###autoload
+(defun turn-off-flyspell ()
+  "Unconditionally turn off Flyspell mode."
+  (flyspell-mode -1))
+
+(custom-add-option 'text-mode-hook 'turn-on-flyspell)
+
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-buffers ...                                             */
 ;;*    -------------------------------------------------------------    */
@@ -525,6 +552,22 @@ in your .emacs file.
             (member (or ispell-local-dictionary ispell-dictionary)
                     flyspell-dictionaries-that-consider-dash-as-word-delimiter)))))
 
+(defun flyspell-hack-local-variables-hook ()
+  ;; When local variables are loaded, see if the dictionary context
+  ;; has changed.
+  (flyspell-accept-buffer-local-defs 'force))
+
+(defun flyspell-kill-ispell-hook ()
+  (setq flyspell-last-buffer nil)
+  (dolist (buf (buffer-list))
+    (with-current-buffer buf
+      (kill-local-variable 'flyspell-word-cache-word))))
+
+;; Make sure we flush our caches when needed.  Do it here rather than in
+;; flyspell-mode-on, since flyspell-region may be used without ever turning
+;; on flyspell-mode.
+(add-hook 'ispell-kill-ispell-hook 'flyspell-kill-ispell-hook)
+
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-mode-on ...                                             */
 ;;*---------------------------------------------------------------------*/
@@ -552,10 +595,13 @@ in your .emacs file.
   (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
   ;; we bound flyspell action to after-change hook
   (add-hook 'after-change-functions 'flyspell-after-change-function nil t)
-  ;; set flyspell-generic-check-word-p based on the major mode
+  ;; we bound flyspell action to hack-local-variables-hook
+  (add-hook 'hack-local-variables-hook
+           (function flyspell-hack-local-variables-hook) t t)
+  ;; set flyspell-generic-check-word-predicate 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)))
+       (setq flyspell-generic-check-word-predicate mode-predicate)))
   ;; the welcome message
   (if (and flyspell-issue-message-flag
           flyspell-issue-welcome-flag
@@ -657,6 +703,8 @@ not the very same deplacement command."
   (remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
   (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
   (remove-hook 'after-change-functions 'flyspell-after-change-function t)
+  (remove-hook 'hack-local-variables-hook
+              (function flyspell-hack-local-variables-hook) t)
   ;; we remove all the flyspell hilightings
   (flyspell-delete-all-overlays)
   ;; we have to erase pre cache variables
@@ -933,6 +981,7 @@ Mostly we check word delimiters."
 (defun flyspell-word-search-backward (word bound)
   (save-excursion
     (let ((r '())
+         (inhibit-point-motion-hooks t)
          p)
       (while (and (not r) (setq p (search-backward word bound t)))
        (let ((lw (flyspell-get-word '())))
@@ -947,6 +996,7 @@ Mostly we check word delimiters."
 (defun flyspell-word-search-forward (word bound)
   (save-excursion
     (let ((r '())
+         (inhibit-point-motion-hooks t)
          p)
       (while (and (not r) (setq p (search-forward word bound t)))
        (let ((lw (flyspell-get-word '())))
@@ -966,10 +1016,10 @@ Mostly we check word delimiters."
     (flyspell-accept-buffer-local-defs)
     (let* ((cursor-location (point))
            (flyspell-word (flyspell-get-word following))
-           start end poss word)
+           start end poss word ispell-filter)
       (if (or (eq flyspell-word nil)
-             (and (fboundp flyspell-generic-check-word-p)
-                  (not (funcall flyspell-generic-check-word-p))))
+             (and (fboundp flyspell-generic-check-word-predicate)
+                  (not (funcall flyspell-generic-check-word-predicate))))
          t
        (progn
          ;; destructure return flyspell-word info list.
@@ -982,12 +1032,22 @@ Mostly we check word delimiters."
                     (and (> start (point-min))
                          (not (memq (char-after (1- start)) '(?\} ?\\)))))
                 flyspell-mark-duplications-flag
+                (not (catch 'exception
+                       (dolist (except flyspell-mark-duplications-exceptions)
+                         (and (string= (or ispell-local-dictionary
+                                           ispell-dictionary)
+                                       (car except))
+                              (member (downcase word) (cdr except))
+                              (throw 'exception t)))))
                 (save-excursion
-                  (goto-char (1- start))
-                  (let ((p (flyspell-word-search-backward
-                            word
-                            (- start (1+ (- end start))))))
-                    (and p (/= p (1- start))))))
+                  (goto-char start)
+                  (let* ((bound
+                          (- start
+                             (- end start)
+                             (- (skip-chars-backward " \t\n\f"))))
+                         (p (when (>= bound (point-min))
+                              (flyspell-word-search-backward word bound))))
+                    (and p (/= p start)))))
            ;; yes, this is a doublon
            (flyspell-highlight-incorrect-region start end 'doublon)
            nil)
@@ -1024,7 +1084,12 @@ Mostly we check word delimiters."
                       (not (string= "" (car ispell-filter))))))
            ;; (ispell-send-string "!\n")
            ;; back to terse mode.
+           ;; Remove leading empty element
            (setq ispell-filter (cdr ispell-filter))
+           ;; ispell process should return something after word is sent.
+           ;; Tag word as valid (i.e., skip) otherwise
+           (or ispell-filter
+               (setq ispell-filter '(*)))
            (if (consp ispell-filter)
                (setq poss (ispell-parse-output (car ispell-filter))))
            (let ((res (cond ((eq poss t)
@@ -1311,7 +1376,8 @@ The list of incorrect words should be in `flyspell-external-ispell-buffer'.
 The buffer to mark them in is `flyspell-large-region-buffer'."
   (let (words-not-found
        (ispell-otherchars (ispell-get-otherchars))
-       (buffer-scan-pos flyspell-large-region-beg))
+       (buffer-scan-pos flyspell-large-region-beg)
+       case-fold-search)
     (with-current-buffer flyspell-external-ispell-buffer
       (goto-char (point-min))
       ;; Loop over incorrect words, in the order they were reported,
@@ -1397,7 +1463,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
 ;;*    declared correct.                                                */
 ;;*---------------------------------------------------------------------*/
 (defun flyspell-process-localwords (misspellings-buffer)
-  (let (localwords
+  (let (localwords case-fold-search
        (ispell-casechars (ispell-get-casechars)))
     ;; Get localwords from the original buffer
     (save-excursion
@@ -1428,6 +1494,22 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
            (while (re-search-forward regexp nil t)
              (delete-region (match-beginning 0) (match-end 0)))))))))
 
+;;* ---------------------------------------------------------------
+;;*     flyspell-check-region-doublons
+;;* ---------------------------------------------------------------
+(defun flyspell-check-region-doublons (beg end)
+  "Check for adjacent duplicated words (doublons) in the given region."
+  (save-excursion
+    (goto-char beg)
+    (flyspell-word)     ; Make sure current word is checked
+    (backward-word 1)
+    (while (and (< (point) end)
+               (re-search-forward "\\<\\(\\w+\\)\\>[ \n\t\f]+\\1\\>"
+                                  end 'move))
+      (flyspell-word)
+      (backward-word 1))
+    (flyspell-word)))
+
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-large-region ...                                        */
 ;;*---------------------------------------------------------------------*/
@@ -1445,7 +1527,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
     (if flyspell-issue-message-flag (message "Checking region..."))
     (set-buffer curbuf)
     (ispell-check-version)
-    (let ((c (apply 'call-process-region beg
+    (let ((c (apply 'ispell-call-process-region beg
                    end
                    ispell-program-name
                    nil
@@ -1472,7 +1554,8 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
          (progn
            (flyspell-process-localwords buffer)
            (with-current-buffer curbuf
-             (flyspell-delete-region-overlays beg end))
+             (flyspell-delete-region-overlays beg end)
+             (flyspell-check-region-doublons beg end))
            (flyspell-external-point-words))
        (error "Can't check region...")))))
 
@@ -1556,7 +1639,7 @@ FLYSPELL-BUFFER."
 ;;*    flyspell-overlay-p ...                                           */
 ;;*---------------------------------------------------------------------*/
 (defun flyspell-overlay-p (o)
-  "A predicate that return true iff O is an overlay used by flyspell."
+  "Return true if O is an overlay used by flyspell."
   (and (overlayp o) (overlay-get o 'flyspell-overlay)))
 
 ;;*---------------------------------------------------------------------*/
@@ -1657,7 +1740,9 @@ is itself incorrect, but suspiciously repeated."
            ;; now we can use a new overlay
            (setq flyspell-overlay
                  (make-flyspell-overlay
-                  beg end 'flyspell-incorrect 'highlight)))))))
+                  beg end
+                  (if (eq poss 'doublon) 'flyspell-duplicate 'flyspell-incorrect)
+                  'highlight)))))))
 
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-highlight-duplicate-region ...                          */
@@ -1760,7 +1845,7 @@ misspelled words backwards."
 (defun flyspell-define-abbrev (name expansion)
   (let ((table (flyspell-abbrev-table)))
     (when table
-      (define-abbrev table name expansion))))
+      (define-abbrev table (downcase name) expansion))))
 
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-auto-correct-word ...                                   */
@@ -1803,7 +1888,7 @@ This command proposes various successive corrections for the current word."
            (let ((start (car (cdr word)))
                  (end (car (cdr (cdr word))))
                  (word (car word))
-                 poss)
+                 poss ispell-filter)
              (setq flyspell-auto-correct-word word)
              ;; now check spelling of word.
              (ispell-send-string "%\n") ;put in verbose mode
@@ -1812,7 +1897,12 @@ This command proposes various successive corrections for the current word."
               (while (progn
                        (accept-process-output ispell-process)
                        (not (string= "" (car ispell-filter)))))
+             ;; Remove leading empty element
              (setq ispell-filter (cdr ispell-filter))
+             ;; ispell process should return something after word is sent.
+             ;; Tag word as valid (i.e., skip) otherwise
+             (or ispell-filter
+                 (setq ispell-filter '(*)))
              (if (consp ispell-filter)
                  (setq poss (ispell-parse-output (car ispell-filter))))
              (cond
@@ -1889,12 +1979,8 @@ Sets `flyspell-auto-correct-previous-pos' to nil"
 But don't look beyond what's visible on the screen."
   (interactive "d")
 
-  (let (top bot)
-    (save-excursion
-      (move-to-window-line 0)
-      (setq top (point))
-      (move-to-window-line -1)
-      (setq bot (point)))
+  (let ((top (window-start))
+       (bot (window-end)))
     (save-excursion
       (save-restriction
        (narrow-to-region top bot)
@@ -1938,47 +2024,63 @@ But don't look beyond what's visible on the screen."
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-correct-word ...                                        */
 ;;*---------------------------------------------------------------------*/
+
 (defun flyspell-correct-word (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
-  (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)))
-      (if (consp word)
-         (let ((start (car (cdr word)))
-               (end (car (cdr (cdr word))))
-               (word (car word))
-               poss)
-           ;; now check spelling of word.
-           (ispell-send-string "%\n") ;put in verbose mode
-           (ispell-send-string (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"))
-            ((featurep 'xemacs)
-             (flyspell-xemacs-popup
-               poss word cursor-location start end save))
-            (t
-             ;; The word is incorrect, we have to propose a replacement.
-              (flyspell-do-correct (flyspell-emacs-popup event poss word)
-                                   poss word cursor-location start end save)))
-           (ispell-pdict-save t))))))
+    (flyspell-correct-word-before-point event save)))
+
+(defun flyspell-correct-word-before-point (&optional event opoint)
+  "Pop up a menu of possible corrections for misspelled word before point.
+If EVENT is non-nil, it is the mouse event that invoked this operation;
+that controls where to put the menu.
+If OPOINT is non-nil, restore point there after adjusting it for replacement."
+  (interactive)
+  (unless (mouse-position)
+    (error "Pop-up menus do not work on this terminal"))
+  ;; use the correct dictionary
+  (flyspell-accept-buffer-local-defs)
+  (or opoint (setq opoint (point-marker)))
+  (let ((cursor-location (point))
+       (word (flyspell-get-word nil)))
+    (if (consp word)
+       (let ((start (car (cdr word)))
+             (end (car (cdr (cdr word))))
+             (word (car word))
+             poss ispell-filter)
+         ;; now check spelling of word.
+         (ispell-send-string "%\n")    ;put in verbose mode
+         (ispell-send-string (concat "^" word "\n"))
+         ;; wait until ispell has processed word
+         (while (progn
+                  (accept-process-output ispell-process)
+                  (not (string= "" (car ispell-filter)))))
+         ;; Remove leading empty element
+         (setq ispell-filter (cdr ispell-filter))
+         ;; ispell process should return something after word is sent.
+         ;; Tag word as valid (i.e., skip) otherwise
+         (or ispell-filter
+             (setq 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"))
+          ((featurep 'xemacs)
+           (flyspell-xemacs-popup
+            poss word cursor-location start end opoint))
+          (t
+           ;; The word is incorrect, we have to propose a replacement.
+           (flyspell-do-correct (flyspell-emacs-popup event poss word)
+                                poss word cursor-location start end opoint)))
+         (ispell-pdict-save t)))))
 
 ;;*---------------------------------------------------------------------*/
 ;;*    flyspell-do-correct ...                                      */
@@ -2050,6 +2152,8 @@ The word checked is the word at the mouse position."
 ;;*---------------------------------------------------------------------*/
 (defun flyspell-emacs-popup (event poss word)
   "The Emacs popup menu."
+  (unless window-system
+    (error "This command requires pop-up dialogs"))
   (if (not event)
       (let* ((mouse-pos  (mouse-position))
             (mouse-pos  (if (nth 1 mouse-pos)
@@ -2069,7 +2173,8 @@ The word checked is the word at the mouse position."
                                 corrects)
                       '()))
         (affix      (car (cdr (cdr (cdr poss)))))
-        (base-menu  (let ((save (if (consp affix)
+        show-affix-info
+        (base-menu  (let ((save (if (and (consp affix) show-affix-info)
                                     (list
                                      (list (concat "Save affix: " (car affix))
                                            'save)
@@ -2110,7 +2215,8 @@ The word checked is the word at the mouse position."
                                 corrects)
                       '()))
         (affix      (car (cdr (cdr (cdr poss)))))
-        (menu       (let ((save (if (consp affix)
+        show-affix-info
+        (menu       (let ((save (if (and (consp affix) show-affix-info)
                                     (vector
                                      (concat "Save affix: " (car affix))
                                      (list 'flyspell-do-correct