;;; flyspell.el --- on-the-fly spell checker
;; Copyright (C) 1998, 2000, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
;; Maintainer: FSF
: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"
;;* 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
;;*--- 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 "@"))))
;;*--- 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" (point-min) t)))
+ (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t)))
(not (save-excursion
(let ((this (point-marker))
(e (progn (end-of-line) (point-marker))))
(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)))
"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)))
(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))
(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.")
(defface flyspell-incorrect
'((((class color)) (:foreground "OrangeRed" :bold t :underline t))
(t (:bold t)))
- "Face used for marking a misspelled word in Flyspell."
+ "Face used to display a misspelled word in Flyspell."
:group 'flyspell)
;; backward-compatibility alias
(put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect)
(defface flyspell-duplicate
'((((class color)) (:foreground "Gold3" :bold t :underline t))
(t (:bold t)))
- "Face used for marking a misspelled word that appears twice in the buffer.
+ "Face used to display subsequent occurrences of a misspelled word.
See also `flyspell-duplicate-distance'."
:group 'flyspell)
;; backward-compatibility alias
(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 ... */
;;* ------------------------------------------------------------- */
(defvar flyspell-last-buffer nil
"The buffer in which the last flyspell operation took place.")
-(defun flyspell-accept-buffer-local-defs ()
+(defun flyspell-accept-buffer-local-defs (&optional force)
;; When flyspell-word is used inside a loop (e.g. when processing
;; flyspell-changes), the calls to `ispell-accept-buffer-local-defs' end
;; up dwarfing everything else, so only do it when the buffer has changed.
- (unless (eq flyspell-last-buffer (current-buffer))
+ (when (or force (not (eq flyspell-last-buffer (current-buffer))))
(setq flyspell-last-buffer (current-buffer))
;; 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
(member (or ispell-local-dictionary ispell-dictionary)
flyspell-dictionaries-that-consider-dash-as-word-delimiter)))))
+(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 ... */
;;*---------------------------------------------------------------------*/
;; 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)
+ ;; Pass the `force' argument for the case where flyspell was active already
+ ;; but the buffer's local-defs have been edited.
+ (flyspell-accept-buffer-local-defs 'force)
;; we put the `flyspell-delayed' property on some commands
(flyspell-delay-commands)
;; we put the `flyspell-deplacement' property on some commands
(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
+ ;; 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
(backward-char 1)
(and (looking-at (flyspell-get-not-casechars))
(or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "\\-"))))))
+ (not (looking-at "-"))))))
;; yes because we have reached or typed a word delimiter.
t)
((symbolp this-command)
(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 '())))
(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 '())))
(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.
(not (memq (char-after (1- start)) '(?\} ?\\)))))
flyspell-mark-duplications-flag
(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)
(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)
;; 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)))
+ (re-search-forward flyspell-casechars nil t)
+ (re-search-backward flyspell-casechars nil t)))
;; move to front of word
- (re-search-backward flyspell-not-casechars (point-min) 'start)
+ (re-search-backward flyspell-not-casechars nil 'start)
(while (and (or (and (not (string= "" ispell-otherchars))
(looking-at ispell-otherchars))
(and extra-otherchars (looking-at extra-otherchars)))
(progn
(backward-char 1)
(if (looking-at flyspell-casechars)
- (re-search-backward flyspell-not-casechars (point-min) 'move)))
+ (re-search-backward flyspell-not-casechars nil 'move)))
(setq did-it-once t
prevpt (point))
(backward-char 1)
(if (looking-at flyspell-casechars)
- (re-search-backward flyspell-not-casechars (point-min) 'move)
+ (re-search-backward flyspell-not-casechars nil 'move)
(backward-char -1))))
;; Now mark the word and save to string.
- (if (not (re-search-forward word-regexp (point-max) t))
+ (if (not (re-search-forward word-regexp nil t))
nil
(progn
(setq start (match-beginning 0)
\(We finish by killing that buffer and setting the variable to nil.)
The buffer to mark them in is `flyspell-large-region-buffer'."
(let (words-not-found
- (ispell-otherchars (ispell-get-otherchars)))
+ (ispell-otherchars (ispell-get-otherchars))
+ (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.
- (while (re-search-forward "\\([^\n]+\\)\n" (point-max) t)
+ ;; Loop over incorrect words, in the order they were reported,
+ ;; which is also the order they appear in the buffer being checked.
+ (while (re-search-forward "\\([^\n]+\\)\n" nil t)
;; Bind WORD to the next one.
(let ((word (match-string 1)) (wordpos (point)))
;; Here there used to be code to see if WORD is the same
(* 100 (/ (float (point)) (point-max)))
word))
(with-current-buffer flyspell-large-region-buffer
- (goto-char flyspell-large-region-beg)
+ (goto-char buffer-scan-pos)
(let ((keep t))
;; Iterate on string search until string is found as word,
;; not as substring
(while keep
(if (search-forward word
flyspell-large-region-end t)
- (save-excursion
- (goto-char (- (point) 1))
- (let* ((flyword-prev-l (flyspell-get-word nil))
- (flyword-prev (car flyword-prev-l))
- (size-match (= (length flyword-prev) (length word))))
- (when (or
- ;; size matches, we are done
- size-match
- ;; Matches as part of a boundary-char separated word
- (member word
- (split-string flyword-prev ispell-otherchars))
- ;; ispell treats beginning of some TeX
- ;; commands as nroff control sequences
- ;; and strips them in the list of
- ;; misspelled words thus giving a
- ;; non-existent word. Skip if ispell
- ;; is used, string is a TeX command
- ;; (char before beginning of word is
- ;; backslash) and none of the previous
- ;; contitions match
- (and (not ispell-really-aspell)
- (save-excursion
- (goto-char (- (nth 1 flyword-prev-l) 1))
- (if (looking-at "[\\]" )
- t
- nil))))
- (setq keep nil)
- (flyspell-word)
- ;; Next search will begin from end of last match
- )))
+ (let* ((found-list
+ (save-excursion
+ ;; Move back into the match
+ ;; so flyspell-get-word will find it.
+ (forward-char -1)
+ (flyspell-get-word nil)))
+ (found (car found-list))
+ (found-length (length found))
+ (misspell-length (length word)))
+ (when (or
+ ;; Size matches, we really found it.
+ (= found-length misspell-length)
+ ;; Matches as part of a boundary-char separated word
+ (member word
+ (split-string found ispell-otherchars))
+ ;; Misspelling has higher length than
+ ;; what flyspell considers the
+ ;; word. Caused by boundary-chars
+ ;; mismatch. Validating seems safe.
+ (< found-length misspell-length)
+ ;; ispell treats beginning of some TeX
+ ;; commands as nroff control sequences
+ ;; and strips them in the list of
+ ;; misspelled words thus giving a
+ ;; non-existent word. Skip if ispell
+ ;; is used, string is a TeX command
+ ;; (char before beginning of word is
+ ;; backslash) and none of the previous
+ ;; contitions match
+ (and (not ispell-really-aspell)
+ (save-excursion
+ (goto-char (- (nth 1 found-list) 1))
+ (if (looking-at "[\\]" )
+ t
+ nil))))
+ (setq keep nil)
+ (flyspell-word)
+ ;; Search for next misspelled word will begin from
+ ;; end of last validated match.
+ (setq buffer-scan-pos (point))))
;; Record if misspelling is not found and try new one
(add-to-list 'words-not-found
(concat " -> " word " - "
;;* 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
(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 ... */
;;*---------------------------------------------------------------------*/
(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...")))))
;; 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 ... */
(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
(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
;;*---------------------------------------------------------------------*/
;;* 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)
+ (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 ... */
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)
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