Mercurial > emacs
changeset 22611:38463342cd56
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 26 Jun 1998 01:24:05 +0000 |
parents | f5539d91e129 |
children | 6def3da74c7c |
files | lisp/textmodes/flyspell.el |
diffstat | 1 files changed, 1415 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/textmodes/flyspell.el Fri Jun 26 01:24:05 1998 +0000 @@ -0,0 +1,1415 @@ +;;; flyspell.el --- On-the-fly spell checker + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Manuel Serrano <Manuel.Serrano@unice.fr> +;; version 1.2h +;; new version may be found at: +;; +;; http://kaolin.unice.fr/~serrano + +;;; This file is part of GNU Emacs. + +;; 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) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; commentary: +;; +;; Flyspell is a minor Emacs mode performing on-the-fly spelling +;; checking. It requires `font-lock' and `ispell'. It has been +;; tested on gnu-emacs 19.29, 19.34 and Xemacs 19.15. +;; +;; To install it, copy the flyspell.el file in your Emacs path and +;; add to your .emacs file: +;; `(autoload 'flyspell-mode "flyspell" "On-the-fly Ispell." t)' +;; +;; To enter the flyspell minor mode, Meta-x flyspell-mode. +;; +;; Note: consider setting the variable ispell-parser to 'tex to +;; avoid TeX command checking (use `(setq ispell-parser 'tex)') +;; _before_ entering flyspell. +;; +;; 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) +;; ------------------------------------------------------------- +;; Release 1.2h: +;; - Fix a bug on mouse-2 (yank-at-click) for gnu-emacs. +;; Release 1.2g: +;; - Support for flyspell-generic-check-word-p (has suggested +;; by Eric M. Ludlam). +;; - Compliance to emacs-lisp comments. +;; Release 1.2f: +;; - Improved TeX handling. +;; - Improved word fetch implementation. +;; - flyspell-sort-corrections was not used inside +;; flyspell-auto-correct-word. The consequence was that auto +;; corrections where not sorted even if the variable was set +;; to non-nil. +;; - Support for flyspell-multi-language-p variable. Setting +;; this variable to nil will prevent flyspell to spawn a new +;; Ispell process per buffer. +;; Release 1.2e: +;; - Fix two popup bugs on Xemacs. If no replacement words are +;; proposed only the save option is available. Corrected words +;; were not inserted at the correct position in the buffer. +;; - Addition of flyspell-region and flyspell-buffer. +;; Release 1.2d: +;; - Make-face-... expressions are now enclosed in +;; condition-case expressions. +;; - Fix bugs when flyspell-auto-correct-binding is set to nil +;; (thanks to Eli Tziperman). +;; Release 1.2c: +;; - Fix the overlay keymap problem for Emacs (it was correctly +;; working with Xemacs). +;; - Thanks to Didier Remy, flyspell now uses a cache in order +;; to improve efficiency and make uses of a pre-command-hook +;; in order to check a word when living it. +;; - Remaned flyspell-ignore-command into +;; flyspell-delay-command. +;; - Add the flyspell-issue-welcome (as suggested by Joshua +;; Guttman). +;; - Ispell process are now killed when the buffer they are +;; running in is deleted (thanks to Jeff Miller and Roland +;; Rosenfled). +;; - When used on a B&W terminal flyspell used boldness instead +;; of color for incorrect words. +;; Release 1.2: +;; - Breaks (space or newline) inside incorrect words are now +;; better handled. +;; - Flyspell sorts the proposed replacement words (thanks to +;; Carsten Dominik). See new variable +;; `flyspell-sort-corrections'. +;; - The mouse binding to correct mispelled word is now mouse-2 +;; on an highlighted region. This enhancement (as well as a +;; lot of code cleaning) has been acheived by Carsten Dominik. +;; - flyspell-mode arg is now optional. +;; - flyspell bindings are better displayed. +;; - flyspell nows is able to handle concurent and different +;; dictionaries (that each buffer running flyspell uses its +;; own (buffer local) Ispell process). +;; - default value for flyspell-highlight-property has been +;; turned to t. +;; - flyspell popup menus now support session and buffer +;; dictionaries. +;; - corrected words are now correctly unhighlighted (no +;; highlighted characters left). +;; Note: I think emacs-19.34 has a bug on the overlay event +;; handling. When an overlay (or a text property) has uses a +;; local-map, if this map does not include a key binding, +;; instead of looking at the enclosing local-map emacs-19.34 +;; uses the global-map. I have not tested this with emacs-20. +;; I have checked with Xemacs that does contain this error. +;; Release 1.1: +;; - Add an automatic replacement for incorrect word. +;; Release 1.0: +;; - Add popup menu for fast correction. +;; Release 0.9: +;; - Add an Ispell bug workaround. Now, in french mode, word +;; starting by the '-' character does not, any longer, make +;; Ispell to fall in infinite loops. +;; Release 0.8: +;; - Better Xemacs support +;; Release 0.7: +;; - Rather than hard-coding the ignored commend I now uses a +;; property field to check if a command is ignored. The +;; advantage is that user may now add its own ignored +;; commands. +;; Release 0.6: +;; - Fix flyspell mode name (in modeline bar) bug. +;; - Fix the bug on flyspell quitting. Overlays are now really +;; removed. +;; Release 0.5: +;; - Persistent hilightings. +;; - Refresh of the modeline on flyspell ending +;; - Do not hilight text with properties (e.g. font lock text) + +;;; Code: +(require 'font-lock) +(require 'ispell) + +;*---------------------------------------------------------------------*/ +;* defcustom stuff. This ensure that we have the correct custom */ +;* library. */ +;*---------------------------------------------------------------------*/ +(eval-and-compile + (condition-case () (require 'custom) (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + ;; We have got what we need + (if (not (string-match "XEmacs" emacs-version)) + ;; suppress warnings + (progn + ;; This is part of bytecomp.el in 19.35: + (put 'custom-declare-variable 'byte-hunk-handler + 'byte-compile-file-form-custom-declare-variable) + (defun byte-compile-file-form-custom-declare-variable (form) + (if (memq 'free-vars byte-compile-warnings) + (setq byte-compile-bound-variables + (cons (nth 1 (nth 1 form)) + byte-compile-bound-variables))) + form))) + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup flyspell nil + "Spellchecking on the fly." + :tag "FlySpell" + :prefix "flyspell-" + :group 'processes) + +;*---------------------------------------------------------------------*/ +;* User variables ... */ +;*---------------------------------------------------------------------*/ +(defcustom flyspell-highlight-flag t + "*Non-nil means use highlight, nil means use mini-buffer messages." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-doublon-as-error-flag t + "*Non-nil means consider doublon as misspelling." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-sort-corrections t + "*Non-nil means, sort the corrections alphabetically before popping them." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-incorrect-color "OrangeRed" + "*The color used for highlighting incorrect words." + :group 'flyspell + :type 'string) + +(defcustom flyspell-duplicate-color "Gold3" + "*The color used for highlighting incorrect words but appearing at least twice." + :group 'flyspell + :type 'string) + +(defcustom flyspell-underline-p t + "*Non-nil means, incorrect words are underlined." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-auto-correct-binding + "\M-\t" + "*Non-nil means that its value (a binding) will bound to the flyspell +auto-correct." + :group 'flyspell + :type '(choice (const nil string))) + +(defcustom flyspell-command-hook t + "*Non-nil means that `post-command-hook' is used to check +already typed words." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-duplicate-distance -1 + "*The distance from duplication. +-1 means no limit. +0 means no window." + :group 'flyspell + :type 'number) + +(defcustom flyspell-delay 3 + "*The number of second before checking words on post-command-hook if +the current command is a delay command." + :group 'flyspell + :type 'number) + +(defcustom flyspell-persistent-highlight t + "*T means that hilighted words are not removed until the word are corrected." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-highlight-properties t + "*T means highlight incorrect words even if a property exists for this word." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-default-delayed-commands + '(self-insert-command + delete-backward-char + delete-char) + "The list of always delayed command (that is flyspell is not activated +after any of these commands." + :group 'flyspell + :type '(repeat (symbol))) + +(defcustom flyspell-delayed-commands + nil + "*If non nil, this variable must hold a list a symbol. Each symbol is +the name of an delayed command (that is a command that does not activate +flyspell checking." + :group 'flyspell + :type '(repeat (symbol))) + +(defcustom flyspell-issue-welcome-flag t + "*Non-nil means that flyspell issues 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." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-incorrect-hook nil + "*Non-nil means a list of hooks to be executed when incorrect +words are encountered. Each hook is a function of two arguments that are +location of the beginning and the end of the incorrect region." + :group 'flyspell) + +(defcustom flyspell-multi-language-p t + "*Non-nil means that flyspell could be use with several buffers checking +several languages. Non-nil means that a new ispell process will be spawned +per buffer. If nil, only one unique ispell process will be running." + :group 'flyspell + :type 'boolean) + +;*---------------------------------------------------------------------*/ +;* Mode specific options */ +;* ------------------------------------------------------------- */ +;* Mode specific options enable users to disable flyspell on */ +;* certain word depending of the emacs mode. For instance, when */ +;* 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))) */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-generic-check-word-p nil + "Function providing per-mode customization over which words are flyspelled. +Returns t to continue checking, nil otherwise.") +(make-variable-buffer-local 'flyspell-generic-check-word-p) + +(defun mail-mode-flyspell-verify () + "Return t if we want flyspell to check the word under point." + (save-excursion + (not (or (re-search-forward mail-header-separator nil t) + (re-search-backward message-signature-separator nil t) + (progn + (beginning-of-line) + (looking-at "[>}|]")))))) + +(defun texinfo-mode-flyspell-verify () + "Return t if we want flyspell to check the word under point." + (save-excursion + (forward-word -1) + (not (looking-at "@")))) + +;*---------------------------------------------------------------------*/ +;* 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) + +(defun flyspell-font-lock-make-face (l) + "Because emacs and xemacs does not behave the same I uses my owe +font-lock-make-face function. This function is similar to the gnu-emacs +font-lock-make-face function." + (let ((fname (car l)) + (color (car (cdr l))) + (italic (car (cdr (cdr l)))) + (bold (car (cdr (cdr (cdr l))))) + (underline (car (cdr (cdr (cdr (cdr l))))))) + (let ((face (copy-face 'default fname))) + (if color + (set-face-foreground face color)) + (if (and italic bold) + (condition-case nil + (make-face-bold-italic face) + (error nil)) + (progn + (if italic + (condition-case nil + (make-face-italic face) + (error nil))) + (if bold + (condition-case nil + (make-face-bold face) + (error nil))))) + (if underline + (condition-case nil + (set-face-underline-p face t) + (error nil))) + (if (not (x-display-color-p)) + (condition-case nil + (make-face-bold face) + (error nil))) + face))) + +;*---------------------------------------------------------------------*/ +;* Which emacs are we currently running */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-emacs + (cond + ((string-match "XEmacs" emacs-version) + 'xemacs) + (t + 'emacs)) + "The Emacs we are currently running.") + +;*---------------------------------------------------------------------*/ +;* cl compatibility */ +;*---------------------------------------------------------------------*/ +(defmacro push (x place) + "(push X PLACE): insert X at the head of the list stored in PLACE. +Analogous to (setf PLACE (cons X PLACE)), though more careful about +evaluating each argument only once and in the right order. PLACE has +to be a symbol." + (list 'setq place (list 'cons x place))) + +;*---------------------------------------------------------------------*/ +;* The minor mode declaration. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-mode nil) +(make-variable-buffer-local 'flyspell-mode) + +(defvar flyspell-mode-map (make-sparse-keymap)) +(defvar flyspell-mouse-map (make-sparse-keymap)) + +(or (assoc 'flyspell-mode minor-mode-alist) + (push '(flyspell-mode " Fly") minor-mode-alist)) + +(or (assoc 'flyspell-mode minor-mode-map-alist) + (push (cons 'flyspell-mode flyspell-mode-map) minor-mode-map-alist)) + +(if flyspell-auto-correct-binding + (define-key flyspell-mode-map flyspell-auto-correct-binding + (function flyspell-auto-correct-word))) +;; mouse bindings +(if (eq flyspell-emacs 'xemacs) + (define-key flyspell-mouse-map [(button2)] + (function flyspell-correct-word/mouse-keymap)) + (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)) + +;*---------------------------------------------------------------------*/ +;* Highlighting */ +;*---------------------------------------------------------------------*/ +(flyspell-font-lock-make-face (list 'flyspell-incorrect-face + flyspell-incorrect-color + nil + t + flyspell-underline-p)) +(flyspell-font-lock-make-face (list 'flyspell-duplicate-face + flyspell-duplicate-color + nil + t + flyspell-underline-p)) + +(defvar flyspell-overlay nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-mode (&optional arg) + "Minor mode performing on-the-fly spelling checking. +Ispell is automatically spawned on background for each entered words. +The default flyspells behavior is to highlight incorrect words. +With prefix ARG, turn Flyspell minor mode on iff ARG is positive. + +Bindings: +\\[ispell-word]: correct words (using Ispell). +\\[flyspell-auto-correct-word]: automatically correct word. +\\[flyspell-correct-word] (or mouse-2): popup correct words. + +Hooks: +flyspell-mode-hook is runner after flyspell is entered. + +Remark: +`flyspell-mode' uses `ispell-mode'. Thus all Ispell options are +valid. For instance, a personal dictionary can be used by +invoking `ispell-change-dictionary'. + +Consider using the `ispell-parser' to check your text. For instance +consider adding: +(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) +in your .emacs file. + +flyspell-region checks all words inside a region. + +flyspell-buffer checks the whole buffer." + (interactive "P") + ;; we set the mode on or off + (setq flyspell-mode (not (or (and (null arg) flyspell-mode) + (<= (prefix-numeric-value arg) 0)))) + (if flyspell-mode + (flyspell-mode-on) + (flyspell-mode-off)) + ;; we force the modeline re-printing + (set-buffer-modified-p (buffer-modified-p))) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode-on ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-mode-on () + "Turn flyspell mode on. Do not use, use `flyspell-mode' instead." + (message "flyspell on: %S" (current-buffer)) + (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))) + ;; we initialize delayed commands symbol + (flyspell-delay-commands) + ;; we bound flyspell action to post-command hook + (if flyspell-command-hook + (progn + (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 + (if flyspell-command-hook + (progn + (make-local-hook 'pre-command-hook) + (add-hook 'pre-command-hook + (function flyspell-pre-command-hook) + t + t))) + ;; the welcome message + (if flyspell-issue-welcome-flag + (message + (if flyspell-auto-correct-binding + (format "Welcome to flyspell. Use %S or mouse-2 to correct words." + (key-description flyspell-auto-correct-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 flyspell-mode + (flyspell-mode-off)))) + ;; we end with the flyspell hooks + (run-hooks 'flyspell-mode-hook)) + +;*---------------------------------------------------------------------*/ +;* flyspell-delay-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delay-commands () + "Install the delayed command." + (mapcar 'flyspell-delay-command flyspell-default-delayed-commands) + (mapcar 'flyspell-delay-command flyspell-delayed-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-delay-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delay-command (command) + "Set COMMAND to be delayed. +When flyspell `post-command-hook' is invoked because a delayed command +as been used the current word is not immediatly checked. +It will be checked only after flyspell-delay second." + (interactive "Scommand: ") + (put command 'flyspell-delayed t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-ignore-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ignore-commands () + "This is an obsolete function, use flyspell-delays command instead." + (flyspell-delay-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-ignore-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) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-word-cache-start nil) +(defvar flyspell-word-cache-end nil) +(defvar flyspell-word-cache-word nil) +(make-variable-buffer-local 'flyspell-word-cache-start) +(make-variable-buffer-local 'flyspell-word-cache-end) +(make-variable-buffer-local 'flyspell-word-cache-word) + +;*---------------------------------------------------------------------*/ +;* The flyspell pre-hook, store the current position. In the */ +;* post command hook, we will check, if the word at this position */ +;* has to be spell checked. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-pre-buffer nil) +(defvar flyspell-pre-point nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-pre-command-hook ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-pre-command-hook () + "This function is internally used by Flyspell to get a cursor location +before a user command." + (interactive) + (setq flyspell-pre-buffer (current-buffer)) + (setq flyspell-pre-point (point))) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode-off ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-mode-off () + "Turn flyspell mode off. Do not use. Use `flyspell-mode' instead." + ;; the bye-bye message + (message "Quiting Flyspell...%S" (current-buffer)) + ;; we stop the running ispell + (ispell-kill-ispell t) + ;; we remove the hooks + (if flyspell-command-hook + (progn + (remove-hook 'post-command-hook + (function flyspell-post-command-hook) + t) + (remove-hook 'pre-command-hook + (function flyspell-pre-command-hook) + t))) + ;; we remove all the flyspell hilightings + (flyspell-delete-all-overlays) + ;; we have to erase pre cache variables + (setq flyspell-pre-buffer nil) + (setq flyspell-pre-point nil) + ;; we mark the mode as killed + (setq flyspell-mode nil)) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-word-p () + "This function returns 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 settup a non delay configuration + t) + (t + (if (fboundp 'about-xemacs) + (sit-for flyspell-delay nil) + (sit-for flyspell-delay 0 nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-pre-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-pre-word-p () + "When to we have to check the word that was at point before +the current command?" + (cond + ((or (not (numberp flyspell-pre-point)) + (not (bufferp flyspell-pre-buffer)) + (not (buffer-live-p flyspell-pre-buffer))) + nil) + ((or (= flyspell-pre-point (- (point) 1)) + (= flyspell-pre-point (point)) + (= flyspell-pre-point (+ (point) 1))) + nil) + ((not (eq (current-buffer) flyspell-pre-buffer)) + t) + ((not (and (numberp flyspell-word-cache-start) + (numberp flyspell-word-cache-end))) + t) + (t + (or (< flyspell-pre-point flyspell-word-cache-start) + (> flyspell-pre-point flyspell-word-cache-end))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-post-command-hook ... */ +;*---------------------------------------------------------------------*/ +(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) + (save-excursion + (goto-char flyspell-pre-point) + (flyspell-word))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word (&optional following) + "Spell check a word." + (interactive (list current-prefix-arg)) + (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) + (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)) + ;; before checking in the directory, we check for doublons. + (cond + ((and flyspell-doublon-as-error-flag + (save-excursion + (goto-char start) + (word-search-backward word + (- start + (+ 1 (- end start))) + t))) + ;; yes, this is a doublon + (flyspell-highlight-incorrect-region start end)) + ((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)) + ;; this is a correct word (because a tex command) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + (t + ;; we setup the cache + (setq flyspell-word-cache-start start) + (setq flyspell-word-cache-end end) + (setq flyspell-word-cache-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))))) + ;; (process-send-string ispell-process "!\n") + ;; back to terse mode. + (setq ispell-filter (cdr ispell-filter)) + (if (listp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond ((eq poss t) + ;; correct + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((and (stringp poss) flyspell-highlight-flag) + ;; correct + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((null poss) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + (message "Error in ispell process")) + ((or (and (< flyspell-duplicate-distance 0) + (or (save-excursion + (goto-char start) + (word-search-backward word + (point-min) + t)) + (save-excursion + (goto-char end) + (word-search-forward word + (point-max) + t)))) + (and (> flyspell-duplicate-distance 0) + (or (save-excursion + (goto-char start) + (word-search-backward + word + (- start + flyspell-duplicate-distance) + t)) + (save-excursion + (goto-char end) + (word-search-forward + word + (+ end + flyspell-duplicate-distance) + t))))) + (if flyspell-highlight-flag + (flyspell-highlight-duplicate-region start end) + (message (format "misspelling duplicate `%s'" + word)))) + (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 + (if ispell-quit (setq ispell-quit nil))))))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-tex-command-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-tex-command-p (word) + "Is a word a TeX command?" + (eq (aref word 0) ?\\)) + +;*---------------------------------------------------------------------*/ +;* flyspell-casechars-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-casechars-cache nil) +(defvar flyspell-ispell-casechars-cache nil) +(make-variable-buffer-local 'flyspell-casechars-cache) +(make-variable-buffer-local 'flyspell-ispell-casechars-cache) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-casechars ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-casechars () + "This function builds a string that is the regexp of word chars. +In order +to avoid one useless string construction, 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)) + (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) + (setq flyspell-casechars-cache ispell-casechars) + flyspell-casechars-cache)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-not-casechars-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-not-casechars-cache nil) +(defvar flyspell-ispell-not-casechars-cache nil) +(make-variable-buffer-local 'flyspell-not-casechars-cache) +(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-not-casechars ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-not-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)) + (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) + (setq flyspell-not-casechars-cache ispell-not-casechars) + flyspell-not-casechars-cache)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-word ... */ +;*---------------------------------------------------------------------*/ +(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' +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 +many times. + +Word syntax described by `ispell-dictionary-alist' (which see)." + (let* ((flyspell-casechars (flyspell-get-casechars)) + (flyspell-not-casechars (flyspell-get-not-casechars)) + (ispell-otherchars (ispell-get-otherchars)) + (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) + (word-regexp (concat flyspell-casechars + "+\\(" + ispell-otherchars + "?" + flyspell-casechars + "+\\)" + (if ispell-many-otherchars-p + "*" "?"))) + (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 following + (re-search-forward flyspell-casechars (point-max) t) + (re-search-backward flyspell-casechars (point-min) t))) + ;; move to front of word + (re-search-backward flyspell-not-casechars (point-min) 'start) + (let ((pos nil)) + (while (and (looking-at ispell-otherchars) + (not (bobp)) + (or (not did-it-once) + ispell-many-otherchars-p) + (not (eq pos (point)))) + (setq pos (point)) + (setq did-it-once t) + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move) + (backward-char -1)))) + ;; Now mark the word and save to string. + (if (eq (re-search-forward tex-regexp (point-max) t) nil) + nil + (progn + (setq start (match-beginning 0) + end (point) + word (buffer-substring start end)) + (list word start end))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-region (beg end) + "Flyspell text between BEG and END." + (interactive "r") + (save-excursion + (goto-char beg) + (while (< (point) end) + (message "Spell Checking...%d%%" (* 100 (/ (float (point)) (- end beg)))) + (flyspell-word) + (let ((cur (point))) + (forward-word 1) + (if (and (< (point) end) (> (point) (+ cur 1))) + (backward-char 1)))) + (backward-char 1) + (message "Spell Checking...done") + (flyspell-word))) + +;*---------------------------------------------------------------------*/ +;* flyspell-buffer ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-buffer () + "Flyspell whole buffer." + (interactive) + (flyspell-region (point-min) (point-max))) + +;*---------------------------------------------------------------------*/ +;* flyspell-overlay-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-overlay-p (o) + "A predicate that return true iff O is an overlay used by flyspell." + (and (overlayp o) (overlay-get o 'flyspell-overlay))) + +;*---------------------------------------------------------------------*/ +;* flyspell-delete-all-overlays ... */ +;* ------------------------------------------------------------- */ +;* Remove all the overlays introduced by flyspell. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delete-all-overlays () + "Delete all the overlays used by flyspell." + (let ((l (overlays-in (point-min) (point-max)))) + (while (consp l) + (progn + (if (flyspell-overlay-p (car l)) + (delete-overlay (car l))) + (setq l (cdr l)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-unhighlight-at ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-unhighlight-at (pos) + "Remove the flyspell overlay that are located at POS." + (if flyspell-persistent-highlight + (let ((overlays (overlays-at pos))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays)))) + (delete-overlay flyspell-overlay))) + +;*---------------------------------------------------------------------*/ +;* flyspell-properties-at-p ... */ +;* ------------------------------------------------------------- */ +;* Is there an highlight properties at position pos? */ +;*---------------------------------------------------------------------*/ +(defun flyspell-properties-at-p (beg) + "Return the text property at position BEG." + (let ((prop (text-properties-at beg)) + (keep t)) + (while (and keep (consp prop)) + (if (and (eq (car prop) 'local-map) (consp (cdr prop))) + (setq prop (cdr (cdr prop))) + (setq keep nil))) + (consp prop))) + +;*---------------------------------------------------------------------*/ +;* make-flyspell-overlay ... */ +;*---------------------------------------------------------------------*/ +(defun make-flyspell-overlay (beg end face mouse-face) + "Allocate a new flyspell overlay that will be used to hilight +an incorrect word." + (let ((flyspell-overlay (make-overlay beg end))) + (overlay-put flyspell-overlay 'face face) + (overlay-put flyspell-overlay 'mouse-face mouse-face) + (overlay-put flyspell-overlay 'flyspell-overlay t) + (if (eq flyspell-emacs 'xemacs) + (overlay-put flyspell-overlay + flyspell-overlay-keymap-property-name + flyspell-mouse-map)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-highlight-incorrect-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-highlight-incorrect-region (beg end) + "The setup of an overlay on a region (starting at BEG and ending at END) +that corresponds to an incorrect word." + (run-hook-with-args 'flyspell-incorrect-hook beg end) + (if (or (not (flyspell-properties-at-p beg)) flyspell-highlight-properties) + (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 ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-highlight-duplicate-region (beg end) + "The setup of an overlay on a region (starting at BEG and ending at END) +that corresponds to an duplicated word." + (if (or (not (flyspell-properties-at-p beg)) flyspell-highlight-properties) + (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-duplicate-face 'highlight))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-auto-correct-pos nil) +(defvar flyspell-auto-correct-region nil) +(defvar flyspell-auto-correct-ring nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-word (pos) + "Auto correct the word at position POS." + (interactive "d") + ;; use the correct dictionary + (ispell-accept-buffer-local-defs) + (if (eq flyspell-auto-correct-pos pos) + ;; we have already been using the function at the same location + (progn + (save-excursion + (let ((start (car flyspell-auto-correct-region)) + (len (cdr flyspell-auto-correct-region))) + (delete-region start (+ start len)) + (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring)) + (let* ((word (car flyspell-auto-correct-ring)) + (len (length word))) + (rplacd flyspell-auto-correct-region len) + (goto-char start) + (insert word)))) + (setq flyspell-auto-correct-pos (point))) + ;; retain cursor location + (let ((cursor-location pos) + (word (flyspell-get-word nil)) + start end poss) + ;; destructure return word info list. + (setq start (car (cdr word)) + end (car (cdr (cdr word))) + word (car word)) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") ;put in verbose mode + (process-send-string ispell-process (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + (setq ispell-filter (cdr ispell-filter)) + (if (listp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + (t + ;; the word is incorrect, we have to propose a replacement + (let ((replacements (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss)))))) + (if (consp replacements) + (progn + (let ((replace (car replacements))) + (setq word replace) + (setq cursor-location (+ (- (length word) (- end start)) + cursor-location)) + (if (not (equal word (car poss))) + (progn + ;; the save the current replacements + (setq flyspell-auto-correct-pos cursor-location) + (setq flyspell-auto-correct-region + (cons start (length word))) + (let ((l replacements)) + (while (consp (cdr l)) + (setq l (cdr l))) + (rplacd l (cons (car poss) replacements))) + (setq flyspell-auto-correct-ring + (cdr replacements)) + (delete-region start end) + (insert word))))))))) + ;; return to original location + (goto-char cursor-location) + (ispell-pdict-save t)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-correct-word (event) + "Check spelling of word under or before the cursor. +If the word is not found in dictionary, display possible corrections +in a popup menu allowing you to choose one. + +Word syntax described by `ispell-dictionary-alist' (which see). + +This will check or reload the dictionary. Use \\[ispell-change-dictionary] +or \\[ispell-region] to update the Ispell process." + (interactive "e") + (if (eq flyspell-emacs 'xemacs) + (flyspell-correct-word/mouse-keymap event) + (flyspell-correct-word/local-keymap event))) + +;*---------------------------------------------------------------------*/ +;* flyspell-correct-word/local-keymap ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-correct-word/local-keymap (event) + "emacs 19.xx seems to be buggous. Overlay keymap does not seems +to work correctly with local map. That is, if a key is not +defined for the overlay keymap, the current local map, is not +checked. The binding is resolved with the global map. The +consequence is that we can not use overlay map with flyspell." + (interactive "e") + (save-window-excursion + (let ((save (point))) + (mouse-set-point event) + ;; we look for a flyspell overlay here + (let ((overlays (overlays-at (point))) + (overlay nil)) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (progn + (setq overlay (car overlays)) + (setq overlays nil)) + (setq overlays (cdr overlays)))) + ;; we return to the correct location + (goto-char save) + ;; we check to see if button2 has been used overlay a + ;; flyspell overlay + (if overlay + ;; yes, so we use the flyspell function + (flyspell-correct-word/mouse-keymap event) + ;; no so we have to use the non flyspell binding + (let ((flyspell-mode nil)) + (if (key-binding (this-command-keys)) + (command-execute (key-binding (this-command-keys)))))))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-correct-word/mouse-keymap (event) + "Popup a menu to present possible correction. The word checked is the +word at the mouse position." + (interactive "e") + ;; use the correct dictionary + (ispell-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)) + start end poss replace) + ;; 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")) + ((string-match "GNU" (emacs-version)) + ;; the word is incorrect, we have to propose a replacement + (setq replace (flyspell-gnuemacs-popup event poss word)) + (cond ((eq replace 'ignore) + nil) + ((eq replace 'save) + (process-send-string ispell-process (concat "*" word "\n")) + (flyspell-unhighlight-at cursor-location) + (setq ispell-pdict-modified-p '(t))) + ((or (eq replace 'buffer) (eq replace 'session)) + (process-send-string ispell-process (concat "@" word "\n")) + (if (null ispell-pdict-modified-p) + (setq ispell-pdict-modified-p + (list ispell-pdict-modified-p))) + (flyspell-unhighlight-at cursor-location) + (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)))))) + ((string-match "XEmacs" (emacs-version)) + (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))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-xemacs-correct ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-correct (replace poss word cursor-location start end) + "The xemacs popup menu callback." + (cond ((eq replace 'ignore) + nil) + ((eq replace 'save) + (process-send-string ispell-process (concat "*" word "\n")) + (flyspell-unhighlight-at cursor-location) + (setq ispell-pdict-modified-p '(t))) + ((or (eq replace 'buffer) (eq replace 'session)) + (process-send-string ispell-process (concat "@" word "\n")) + (flyspell-unhighlight-at cursor-location) + (if (null ispell-pdict-modified-p) + (setq ispell-pdict-modified-p + (list ispell-pdict-modified-p))) + (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)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-gnuemacs-popup */ +;*---------------------------------------------------------------------*/ +(defun flyspell-gnuemacs-popup (event poss word) + "The gnu-emacs popup menu." + (if (not event) + (let* ((mouse-pos (mouse-position)) + (mouse-pos (if (nth 1 mouse-pos) + mouse-pos + (set-mouse-position (car mouse-pos) + (/ (frame-width) 2) 2) + (unfocus-frame) + (mouse-position)))) + (setq event (list (list (car (cdr mouse-pos)) + (1+ (cdr (cdr mouse-pos)))) + (car mouse-pos))))) + (let* ((corrects (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))) + (cor-menu (if (consp corrects) + (mapcar (lambda (correct) + (list correct correct)) + corrects) + '())) + (affix (car (cdr (cdr (cdr poss))))) + (base-menu (let ((save (if (consp affix) + (list + (list (concat "Save affix: " (car affix)) + 'save) + '("Accept (session)" accept) + '("Accept (buffer)" buffer)) + '(("Save word" save) + ("Accept (session)" session) + ("Accept (buffer)" buffer))))) + (if (consp cor-menu) + (append cor-menu (cons "" save)) + save))) + (menu (cons "flyspell correction menu" base-menu))) + (car (x-popup-menu event + (list (format "%s [%s]" word (or ispell-local-dictionary + ispell-dictionary)) + menu))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-xemacs-popup */ +;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-popup (event poss word cursor-location start end) + "The xemacs popup menu." + (let* ((corrects (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))) + (cor-menu (if (consp corrects) + (mapcar (lambda (correct) + (vector correct + (list 'flyspell-xemacs-correct + correct + (list 'quote poss) + word + cursor-location + start + end) + t)) + corrects) + '())) + (affix (car (cdr (cdr (cdr poss))))) + (menu (let ((save (if (consp affix) + (vector + (concat "Save affix: " (car affix)) + (list 'flyspell-xemacs-correct + ''save + (list 'quote poss) + word + cursor-location + start + end) + t) + (vector + "Save word" + (list 'flyspell-xemacs-correct + ''save + (list 'quote poss) + word + cursor-location + start + end) + t))) + (session (vector "Accept (session)" + (list 'flyspell-xemacs-correct + ''session + (list 'quote poss) + word + cursor-location + start + end) + t)) + (buffer (vector "Accept (buffer)" + (list 'flyspell-xemacs-correct + ''buffer + (list 'quote poss) + word + cursor-location + start + end) + t))) + (if (consp cor-menu) + (append cor-menu (list "-" save session buffer)) + (list save session buffer))))) + (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary + ispell-dictionary)) + menu)))) + +(provide 'flyspell) + +;;; flyspell.el ends here