;; 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)
"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.
: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,
(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
: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 */
;* ------------------------------------------------------------- */
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."
(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 */
(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))
-(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)))
+;;;###autoload
+(defvar flyspell-mode-map (make-sparse-keymap))
-;; 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 */
;*---------------------------------------------------------------------*/
;; Force modeline redisplay.
(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 ... */
;*---------------------------------------------------------------------*/
(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').
(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))
(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 ... */
;* 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 ... */
"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 ... */
;;;###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
;; we mark the mode as killed
(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 ... */
;*---------------------------------------------------------------------*/
(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)
(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 ... */
(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
(+ 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)
;; (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
((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)
(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 ... */
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)
"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)
;*---------------------------------------------------------------------*/
(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
(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)
(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)
(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)
(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 ... */
;*---------------------------------------------------------------------*/
(interactive)
(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 ... */
;*---------------------------------------------------------------------*/
(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 ... */
(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 ... */
(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-auto-correct-word ... */
+;* flyspell-check-previous-highlighted-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
+(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
- (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))))
+ (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 ()
+ "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 ... */
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 ... */
(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)
(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
;; 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)))
(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))
(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 ... */
(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))
;*---------------------------------------------------------------------*/
;* 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<)
word
cursor-location
start
- end)
+ end
+ save)
t))
corrects)
'()))
word
cursor-location
start
- end)
+ end
+ save)
t)
(vector
"Save word"
word
cursor-location
start
- end)
+ end
+ save)
t)))
(session (vector "Accept (session)"
(list 'flyspell-xemacs-correct
word
cursor-location
start
- end)
+ end
+ save)
t))
(buffer (vector "Accept (buffer)"
(list 'flyspell-xemacs-correct
word
cursor-location
start
- end)
+ end
+ save)
t)))
(if (consp cor-menu)
(append cor-menu (list "-" save session buffer))
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
HCoop / bpt / emacs.git / commitdiff