emacs/flyspell.el

   1 ;;; <pre>
   2 ;;; flyspell.el --- on-the-fly spell checker
   3
   4 ;; Copyright (C) 1998, 2000, 2003, 2004, 2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
   7 ;; Version: 1.7o
   8 ;; Keywords: convenience
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; Flyspell is a minor Emacs mode performing on-the-fly spelling
  30 ;; checking.
  31 ;;
  32 ;; To enable Flyspell minor mode, type M-x flyspell-mode.
  33 ;; This applies only to the current buffer.
  34 ;;
  35 ;; To enable Flyspell in text representing computer programs, type
  36 ;; M-x flyspell-prog-mode.
  37 ;; In that mode only text inside comments is checked.
  38 ;;
  39 ;; Note: consider setting the variable ispell-parser to `tex' to
  40 ;; avoid TeX command checking; use `(setq ispell-parser 'tex)'.
  41 ;;
  42 ;; Some user variables control the behavior of flyspell.  They are
  43 ;; those defined under the `User variables' comment.
  44
  45 ;;; Code:
  46 (require 'ispell)
  47
  48 ;*---------------------------------------------------------------------*/
  49 ;*    Group ...                                                        */
  50 ;*---------------------------------------------------------------------*/
  51 (defgroup flyspell nil
  52   "Spell checking on the fly."
  53   :tag "FlySpell"
  54   :prefix "flyspell-"
  55   :group 'ispell
  56   :group 'processes)
  57
  58 ;*---------------------------------------------------------------------*/
  59 ;*    Which emacs are we currently running                             */
  60 ;*---------------------------------------------------------------------*/
  61 (defvar flyspell-emacs
  62   (cond
  63    ((string-match "XEmacs" emacs-version)
  64     'xemacs)
  65    (t
  66     'emacs))
  67   "The type of Emacs we are currently running.")
  68
  69 (defvar flyspell-use-local-map
  70   (or (eq flyspell-emacs 'xemacs)
  71       (not (string< emacs-version "20"))))
  72
  73 ;*---------------------------------------------------------------------*/
  74 ;*    User configuration ...                                           */
  75 ;*---------------------------------------------------------------------*/
  76 (defcustom flyspell-highlight-flag t
  77   "*How Flyspell should indicate misspelled words.
  78 Non-nil means use highlight, nil means use minibuffer messages."
  79   :group 'flyspell
  80   :type 'boolean)
  81
  82 (defcustom flyspell-mark-duplications-flag t
  83   "*Non-nil means Flyspell reports a repeated word as an error."
  84   :group 'flyspell
  85   :type 'boolean)
  86
  87 (defcustom flyspell-sort-corrections nil
  88   "*Non-nil means, sort the corrections alphabetically before popping them."
  89   :group 'flyspell
  90   :version "21.1"
  91   :type 'boolean)
  92
  93 (defcustom flyspell-duplicate-distance -1
  94   "*The maximum distance for finding duplicates of unrecognized words.
  95 This applies to the feature that when a word is not found in the dictionary,
  96 if the same spelling occurs elsewhere in the buffer,
  97 Flyspell uses a different face (`flyspell-duplicate-face') to highlight it.
  98 This variable specifies how far to search to find such a duplicate.
  99 -1 means no limit (search the whole buffer).
 100 0 means do not search for duplicate unrecognized spellings."
 101   :group 'flyspell
 102   :version "21.1"
 103   :type 'number)
 104
 105 (defcustom flyspell-delay 3
 106   "*The number of seconds to wait before checking, after a \"delayed\" command."
 107   :group 'flyspell
 108   :type 'number)
 109
 110 (defcustom flyspell-persistent-highlight t
 111   "*Non-nil means misspelled words remain highlighted until corrected.
 112 If this variable is nil, only the most recently detected misspelled word
 113 is highlighted."
 114   :group 'flyspell
 115   :type 'boolean)
 116
 117 (defcustom flyspell-highlight-properties t
 118   "*Non-nil means highlight incorrect words even if a property exists for this word."
 119   :group 'flyspell
 120   :type 'boolean)
 121
 122 (defcustom flyspell-default-delayed-commands
 123   '(self-insert-command
 124     delete-backward-char
 125     backward-or-forward-delete-char
 126     delete-char
 127     scrollbar-vertical-drag
 128     backward-delete-char-untabify)
 129   "The standard list of delayed commands for Flyspell.
 130 See `flyspell-delayed-commands'."
 131   :group 'flyspell
 132   :version "21.1"
 133   :type '(repeat (symbol)))
 134
 135 (defcustom flyspell-delayed-commands nil
 136   "List of commands that are \"delayed\" for Flyspell mode.
 137 After these commands, Flyspell checking is delayed for a short time,
 138 whose length is specified by `flyspell-delay'."
 139   :group 'flyspell
 140   :type '(repeat (symbol)))
 141
 142 (defcustom flyspell-default-deplacement-commands
 143   '(next-line
 144     previous-line
 145     scroll-up
 146     scroll-down)
 147   "The standard list of deplacement commands for Flyspell.
 148 See `flyspell-deplacement-commands'."
 149   :group 'flyspell
 150   :version "21.1"
 151   :type '(repeat (symbol)))
 152
 153 (defcustom flyspell-default-ignored-commands
 154   '(fill-paragraph)
 155   "The standard list of ignored commands for Flyspell.
 156  See `flyspell-delayed-commands'."
 157   :group 'flyspell
 158   :version "21.3"
 159   :type '(repeat (symbol)))
 160
 161  (defcustom flyspell-ignored-commands nil
 162    "List of commands that are \"ignored\" for Flyspell mode.
 163  The changes in the text made by these commands are ignored.  This list is meant for commands that change text in a way that does not affect individual words, such as `fill-paragraph'."
 164    :group 'flyspell
 165    :version "21.3"
 166    :type '(repeat (symbol)))
 167
 168 (defcustom flyspell-deplacement-commands nil
 169   "List of commands that are \"deplacement\" for Flyspell mode.
 170 After these commands, Flyspell checking is performed only if the previous
 171 command was not the very same command."
 172   :group 'flyspell
 173   :version "21.1"
 174   :type '(repeat (symbol)))
 175
 176 (defcustom flyspell-issue-welcome-flag t
 177   "*Non-nil means that Flyspell should display a welcome message when started."
 178   :group 'flyspell
 179   :type 'boolean)
 180
 181 (defcustom flyspell-issue-message-flag t
 182   "*Non-nil means that Flyspell emits messages when checking words."
 183   :group 'flyspell
 184   :type 'boolean)
 185
 186 (defcustom flyspell-incorrect-hook nil
 187   "*List of functions to be called when incorrect words are encountered.
 188 Each function is given three arguments: the beginning and the end
 189 of the incorrect region.  The third is either the symbol 'doublon' or the list
 190 of possible corrections as returned by 'ispell-parse-output'.
 191
 192 If any of the functions return non-Nil, the word is not highlighted as
 193 incorrect."
 194   :group 'flyspell
 195   :version "21.1"
 196   :type 'hook)
 197
 198 (defcustom flyspell-default-dictionary nil
 199   "A string that is the name of the default dictionary.
 200 This is passed to the `ispell-change-dictionary' when flyspell is started.
 201 If the variable `ispell-local-dictionary' or `ispell-dictionary' is non-nil
 202 when flyspell is started, the value of that variable is used instead
 203 of `flyspell-default-dictionary' to select the default dictionary.
 204 Otherwise, if `flyspell-default-dictionary' is nil, it means to use
 205 Ispell's ultimate default dictionary."
 206   :group 'flyspell
 207   :version "21.1"
 208   :type '(choice string (const :tag "Default" nil)))
 209
 210 (defcustom flyspell-tex-command-regexp
 211   "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
 212   "A string that is the regular expression that matches TeX commands."
 213   :group 'flyspell
 214   :version "21.1"
 215   :type 'string)
 216
 217 (defcustom flyspell-check-tex-math-command nil
 218   "*Non nil means check even inside TeX math environment.
 219 TeX math environments are discovered by the TEXMATHP that implemented
 220 inside the texmathp.el Emacs package.  That package may be found at:
 221 http://strw.leidenuniv.nl/~dominik/Tools"
 222   :group 'flyspell
 223   :type 'boolean)
 224
 225 (defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
 226   '("francais" "deutsch8" "norsk")
 227   "List of dictionary names that consider `-' as word delimiter."
 228   :group 'flyspell
 229   :version "21.1"
 230   :type '(repeat (string)))
 231
 232 (defcustom flyspell-abbrev-p
 233   nil
 234   "*If non-nil, add correction to abbreviation table."
 235   :group 'flyspell
 236   :version "21.1"
 237   :type 'boolean)
 238
 239 (defcustom flyspell-use-global-abbrev-table-p
 240   nil
 241   "*If non-nil, prefer global abbrev table to local abbrev table."
 242   :group 'flyspell
 243   :version "21.1"
 244   :type 'boolean)
 245
 246 ;;;###autoload
 247 (defcustom flyspell-mode-line-string " Fly"
 248   "*String displayed on the modeline when flyspell is active.
 249 Set this to nil if you don't want a modeline indicator."
 250   :group 'flyspell
 251   :type '(choice string (const :tag "None" nil)))
 252
 253 (defcustom flyspell-large-region 1000
 254   "*The threshold that determines if a region is small.
 255 The `flyspell-region' function is invoked if the region is small, the
 256 word are checked one after the other using regular flyspell check
 257 means.  If the region is large, a new Ispell process is spawned to get
 258 speed.
 259
 260 if flyspell-large-region is nil, regions are treated as small."
 261   :group 'flyspell
 262   :version "21.1"
 263   :type '(choice number boolean))
 264
 265 (defcustom flyspell-insert-function (function insert)
 266   "*Function for inserting word by flyspell upon correction."
 267   :group 'flyspell
 268   :type 'function)
 269
 270 (defcustom flyspell-before-incorrect-word-string nil
 271   "String used to indicate an incorrect word starting."
 272   :group 'flyspell
 273   :type '(choice string (const nil)))
 274
 275 (defcustom flyspell-after-incorrect-word-string nil
 276   "String used to indicate an incorrect word ending."
 277   :group 'flyspell
 278   :type '(choice string (const nil)))
 279
 280 (defcustom flyspell-use-meta-tab t
 281   "*Non-nil means that flyspell uses META-TAB to correct word."
 282   :group 'flyspell
 283   :type 'boolean)
 284
 285 (defcustom flyspell-auto-correct-binding
 286   (cond
 287    ((eq flyspell-emacs 'xemacs)
 288     [(control \;)])
 289    (t
 290     [?\C-\;]))
 291   "The key binding for flyspell auto correction."
 292   :group 'flyspell)
 293
 294 ;*---------------------------------------------------------------------*/
 295 ;*    Mode specific options                                            */
 296 ;*    -------------------------------------------------------------    */
 297 ;*    Mode specific options enable users to disable flyspell on        */
 298 ;*    certain word depending of the emacs mode. For instance, when     */
 299 ;*    using flyspell with mail-mode add the following expression       */
 300 ;*    in your .emacs file:                                             */
 301 ;*       (add-hook 'mail-mode                                          */
 302 ;*           '(lambda () (setq flyspell-generic-check-word-p           */
 303 ;*                             'mail-mode-flyspell-verify)))           */
 304 ;*---------------------------------------------------------------------*/
 305 (defvar flyspell-generic-check-word-p nil
 306   "Function providing per-mode customization over which words are flyspelled.
 307 Returns t to continue checking, nil otherwise.
 308 Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
 309 property of the major mode name.")
 310 (make-variable-buffer-local 'flyspell-generic-check-word-p)
 311
 312 ;*--- mail mode -------------------------------------------------------*/
 313 (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
 314 (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
 315 (defun mail-mode-flyspell-verify ()
 316   "This function is used for `flyspell-generic-check-word-p' in Mail mode."
 317   (let ((header-end (save-excursion
 318                       (goto-char (point-min))
 319                       (re-search-forward
 320                        (concat "^"
 321                                (regexp-quote mail-header-separator)
 322                                "$")
 323                        nil t)
 324                       (point)))
 325         (signature-begin (save-excursion
 326                            (goto-char (point-max))
 327                            (re-search-backward message-signature-separator
 328                                                nil t)
 329                            (point))))
 330     (cond ((< (point) header-end)
 331            (and (save-excursion (beginning-of-line)
 332                                 (looking-at "^Subject:"))
 333                 (> (point) (match-end 0))))
 334           ((> (point) signature-begin)
 335            nil)
 336           (t
 337            (save-excursion
 338              (beginning-of-line)
 339              (not (looking-at "[>}|]\\|To:")))))))
 340
 341 ;*--- texinfo mode ----------------------------------------------------*/
 342 (put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify)
 343 (defun texinfo-mode-flyspell-verify ()
 344   "This function is used for `flyspell-generic-check-word-p' in Texinfo mode."
 345   (save-excursion
 346     (forward-word -1)
 347     (not (looking-at "@"))))
 348
 349 ;*--- tex mode --------------------------------------------------------*/
 350 (put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify)
 351 (defun tex-mode-flyspell-verify ()
 352   "This function is used for `flyspell-generic-check-word-p' in LaTeX mode."
 353   (and
 354    (not (save-excursion
 355           (re-search-backward "^[ \t]*%%%[ \t]+Local" (point-min) t)))
 356    (not (save-excursion
 357           (let ((this (point-marker))
 358                 (e (progn (end-of-line) (point-marker))))
 359             (beginning-of-line)
 360             (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t)
 361                 (and (>= this (match-beginning 0))
 362                      (<= this (match-end 0)) )))))))
 363
 364 ;*--- sgml mode -------------------------------------------------------*/
 365 (put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
 366 (put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
 367
 368 (defun sgml-mode-flyspell-verify ()
 369   "This function is used for `flyspell-generic-check-word-p' in SGML mode."
 370   (not (save-excursion
 371          (let ((this (point-marker))
 372                (s (progn (beginning-of-line) (point-marker)))
 373                (e (progn (end-of-line) (point-marker))))
 374            (or (progn
 375                  (goto-char this)
 376                  (and (re-search-forward  "[^<]*>" e t)
 377                       (= (match-beginning 0) this)))
 378                (progn
 379                  (goto-char this)
 380                  (and (re-search-backward "<[^>]*" s t)
 381                       (= (match-end 0) this)))
 382                (and (progn
 383                       (goto-char this)
 384                       (and (re-search-forward  "[^&]*;" e t)
 385                            (= (match-beginning 0) this)))
 386                     (progn
 387                       (goto-char this)
 388                       (and (re-search-backward "&[^;]*" s t)
 389                            (= (match-end 0) this)))))))))
 390
 391 ;*---------------------------------------------------------------------*/
 392 ;*    Programming mode                                                 */
 393 ;*---------------------------------------------------------------------*/
 394 (defvar flyspell-prog-text-faces
 395   '(font-lock-string-face font-lock-comment-face font-lock-doc-face)
 396   "Faces corresponding to text in programming-mode buffers.")
 397
 398 (defun flyspell-generic-progmode-verify ()
 399   "Used for `flyspell-generic-check-word-p' in programming modes."
 400   (let ((f (get-text-property (point) 'face)))
 401     (memq f flyspell-prog-text-faces)))
 402
 403 ;;;###autoload
 404 (defun flyspell-prog-mode ()
 405   "Turn on `flyspell-mode' for comments and strings."
 406   (interactive)
 407   (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify)
 408   (flyspell-mode 1)
 409   (run-hooks 'flyspell-prog-mode-hook))
 410
 411 ;*---------------------------------------------------------------------*/
 412 ;*    Overlay compatibility                                            */
 413 ;*---------------------------------------------------------------------*/
 414 (autoload 'make-overlay            "overlay" "Overlay compatibility kit." t)
 415 (autoload 'overlayp                "overlay" "Overlay compatibility kit." t)
 416 (autoload 'overlays-in             "overlay" "Overlay compatibility kit." t)
 417 (autoload 'delete-overlay          "overlay" "Overlay compatibility kit." t)
 418 (autoload 'overlays-at             "overlay" "Overlay compatibility kit." t)
 419 (autoload 'overlay-put             "overlay" "Overlay compatibility kit." t)
 420 (autoload 'overlay-get             "overlay" "Overlay compatibility kit." t)
 421 (autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t)
 422
 423 ;*---------------------------------------------------------------------*/
 424 ;*    The minor mode declaration.                                      */
 425 ;*---------------------------------------------------------------------*/
 426 (eval-when-compile (defvar flyspell-local-mouse-map))
 427
 428 ;;;###autoload
 429 (defvar flyspell-mode nil)
 430 (make-variable-buffer-local 'flyspell-mode)
 431
 432 (defvar flyspell-mouse-map
 433   (let ((map (make-sparse-keymap)))
 434     (if flyspell-use-meta-tab
 435         (define-key map "\M-\t" #'flyspell-auto-correct-word))
 436     (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2])
 437       #'flyspell-correct-word)
 438     (if (not (featurep 'xemacs))
 439         (define-key map [(shift down-mouse-2)] #'flyspell-correct-word))
 440     (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
 441     (define-key map [(control \,)] 'flyspell-goto-next-error)
 442     (define-key map [(control \.)] 'flyspell-auto-correct-word)
 443     map))
 444
 445 ;;;###autoload
 446 (defvar flyspell-mode-map (make-sparse-keymap))
 447
 448 ;; mouse, keyboard bindings and misc definition
 449 (when (or (assoc 'flyspell-mode minor-mode-map-alist)
 450           (setq minor-mode-map-alist
 451                 (cons (cons 'flyspell-mode flyspell-mode-map)
 452                       minor-mode-map-alist)))
 453   (if flyspell-use-meta-tab
 454       (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word))
 455   (cond
 456    ((eq flyspell-emacs 'xemacs)
 457     (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
 458     (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error)
 459     (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word))
 460    (flyspell-use-local-map
 461     (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
 462     (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error)
 463     (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word))))
 464
 465
 466 ;; the name of the overlay property that defines the keymap
 467 (defvar flyspell-overlay-keymap-property-name 'keymap)
 468
 469 ;; dash character machinery
 470 (defvar flyspell-consider-dash-as-word-delimiter-flag nil
 471    "*Non-nil means that the `-' char is considered as a word delimiter.")
 472 (make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
 473 (defvar flyspell-dash-dictionary nil)
 474 (make-variable-buffer-local 'flyspell-dash-dictionary)
 475 (defvar flyspell-dash-local-dictionary nil)
 476 (make-variable-buffer-local 'flyspell-dash-local-dictionary)
 477
 478 ;*---------------------------------------------------------------------*/
 479 ;*    Highlighting                                                     */
 480 ;*---------------------------------------------------------------------*/
 481 (defface flyspell-incorrect-face
 482   (if (eq flyspell-emacs 'xemacs)
 483       '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
 484         (t (:bold t)))
 485     '((((class color)) (:foreground "OrangeRed" :weight bold :underline t))
 486       (t (:weight bold))))
 487   "Face used for marking a misspelled word in Flyspell."
 488   :group 'flyspell)
 489
 490 (defface flyspell-duplicate-face
 491   (if (eq flyspell-emacs 'xemacs)
 492       '((((class color)) (:foreground "Gold3" :bold t :underline t))
 493         (t (:bold t)))
 494     '((((class color)) (:foreground "Gold3" :weight bold :underline t))
 495       (t (:weight bold))))
 496   "Face used for marking a misspelled word that appears twice in the buffer.
 497 See also `flyspell-duplicate-distance'."
 498   :group 'flyspell)
 499
 500 (defvar flyspell-overlay nil)
 501
 502 ;*---------------------------------------------------------------------*/
 503 ;*    flyspell-mode ...                                                */
 504 ;*---------------------------------------------------------------------*/
 505 ;;;###autoload
 506 (defun flyspell-mode (&optional arg)
 507   "Minor mode performing on-the-fly spelling checking.
 508 Ispell is automatically spawned on background for each entered words.
 509 The default flyspell behavior is to highlight incorrect words.
 510 With no argument, this command toggles Flyspell mode.
 511 With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
 512
 513 Bindings:
 514 \\[ispell-word]: correct words (using Ispell).
 515 \\[flyspell-auto-correct-word]: automatically correct word.
 516 \\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word.
 517 \\[flyspell-correct-word] (or down-mouse-2): popup correct words.
 518
 519 Hooks:
 520 This runs `flyspell-mode-hook' after flyspell is entered.
 521
 522 Remark:
 523 `flyspell-mode' uses `ispell-mode'.  Thus all Ispell options are
 524 valid.  For instance, a personal dictionary can be used by
 525 invoking `ispell-change-dictionary'.
 526
 527 Consider using the `ispell-parser' to check your text.  For instance
 528 consider adding:
 529 \(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
 530 in your .emacs file.
 531
 532 \\[flyspell-region] checks all words inside a region.
 533 \\[flyspell-buffer] checks the whole buffer."
 534   (interactive "P")
 535   (let ((old-flyspell-mode flyspell-mode))
 536     ;; Mark the mode as on or off.
 537     (setq flyspell-mode (not (or (and (null arg) flyspell-mode)
 538                                  (<= (prefix-numeric-value arg) 0))))
 539     ;; Do the real work.
 540     (unless (eq flyspell-mode old-flyspell-mode)
 541       (if flyspell-mode
 542           (flyspell-mode-on)
 543         (flyspell-mode-off))
 544       ;; Force modeline redisplay.
 545       (set-buffer-modified-p (buffer-modified-p)))))
 546
 547 ;*---------------------------------------------------------------------*/
 548 ;*    Autoloading                                                      */
 549 ;*---------------------------------------------------------------------*/
 550 ;;;###autoload
 551 (if (fboundp 'add-minor-mode)
 552     (add-minor-mode 'flyspell-mode
 553                     'flyspell-mode-line-string
 554                     flyspell-mode-map
 555                     nil
 556                     'flyspell-mode)
 557   (or (assoc 'flyspell-mode minor-mode-alist)
 558       (setq minor-mode-alist
 559             (cons '(flyspell-mode flyspell-mode-line-string)
 560                   minor-mode-alist)))
 561
 562   (or (assoc 'flyspell-mode minor-mode-map-alist)
 563       (setq minor-mode-map-alist
 564             (cons (cons 'flyspell-mode flyspell-mode-map)
 565                   minor-mode-map-alist))))
 566
 567 ;*---------------------------------------------------------------------*/
 568 ;*    flyspell-buffers ...                                             */
 569 ;*    -------------------------------------------------------------    */
 570 ;*    For remembering buffers running flyspell                         */
 571 ;*---------------------------------------------------------------------*/
 572 (defvar flyspell-buffers nil)
 573
 574 ;*---------------------------------------------------------------------*/
 575 ;*    flyspell-minibuffer-p ...                                        */
 576 ;*---------------------------------------------------------------------*/
 577 (defun flyspell-minibuffer-p (buffer)
 578   "Is BUFFER a minibuffer?"
 579   (let ((ws (get-buffer-window-list buffer t)))
 580     (and (consp ws) (window-minibuffer-p (car ws)))))
 581
 582 ;*---------------------------------------------------------------------*/
 583 ;*    flyspell-version ...                                             */
 584 ;*---------------------------------------------------------------------*/
 585 ;;;###autoload
 586 (defun flyspell-version ()
 587   "The flyspell version"
 588   (interactive)
 589   "1.7o")
 590
 591 ;*---------------------------------------------------------------------*/
 592 ;*    flyspell-accept-buffer-local-defs ...                            */
 593 ;*---------------------------------------------------------------------*/
 594 (defun flyspell-accept-buffer-local-defs ()
 595   ;; strange problem.  If buffer in current window has font-lock turned on,
 596   ;; but SET-BUFFER was called to point to an invisible buffer, this ispell
 597   ;; call will reset the buffer to the buffer in the current window.  However,
 598   ;; it only happens at startup (fix by Albert L. Ting).
 599   (let ((buf (current-buffer)))
 600     (ispell-accept-buffer-local-defs)
 601     (set-buffer buf))
 602   (if (not (and (eq flyspell-dash-dictionary ispell-dictionary)
 603                 (eq flyspell-dash-local-dictionary ispell-local-dictionary)))
 604       ;; the dictionary has changed
 605       (progn
 606         (setq flyspell-dash-dictionary ispell-dictionary)
 607         (setq flyspell-dash-local-dictionary ispell-local-dictionary)
 608         (if (member (or ispell-local-dictionary ispell-dictionary)
 609                     flyspell-dictionaries-that-consider-dash-as-word-delimiter)
 610             (setq flyspell-consider-dash-as-word-delimiter-flag t)
 611           (setq flyspell-consider-dash-as-word-delimiter-flag nil)))))
 612
 613 ;*---------------------------------------------------------------------*/
 614 ;*    flyspell-mode-on ...                                             */
 615 ;*---------------------------------------------------------------------*/
 616 (defun flyspell-mode-on ()
 617   "Turn Flyspell mode on.  Do not use this; use `flyspell-mode' instead."
 618   (setq ispell-highlight-face 'flyspell-incorrect-face)
 619   ;; local dictionaries setup
 620   (ispell-change-dictionary
 621    (or ispell-local-dictionary ispell-dictionary flyspell-default-dictionary))
 622   ;; we have to force ispell to accept the local definition or
 623   ;; otherwise it could be too late, the local dictionary may
 624   ;; be forgotten!
 625   (flyspell-accept-buffer-local-defs)
 626   ;; we put the `flyspell-delayed' property on some commands
 627   (flyspell-delay-commands)
 628   ;; we put the `flyspell-deplacement' property on some commands
 629   (flyspell-deplacement-commands)
 630   ;; we put the `flyspell-ignored' property on some commands
 631   (flyspell-ignore-commands)
 632   ;; we bound flyspell action to post-command hook
 633   (if (eq flyspell-emacs 'xemacs)
 634       (make-local-hook 'post-command-hook))
 635   (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)
 636   ;; we bound flyspell action to pre-command hook
 637   (if (eq flyspell-emacs 'xemacs)
 638       (make-local-hook 'pre-command-hook))
 639   (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
 640   ;; we bound flyspell action to after-change hook
 641   (make-local-variable 'after-change-functions)
 642   (setq after-change-functions
 643         (cons 'flyspell-after-change-function after-change-functions))
 644   ;; set flyspell-generic-check-word-p based on the major mode
 645   (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
 646     (if mode-predicate
 647         (setq flyspell-generic-check-word-p mode-predicate)))
 648   ;; work around the fact that the `local-map' text-property replaces the
 649   ;; buffer's local map rather than shadowing it.
 650   (set (make-local-variable 'flyspell-mouse-map)
 651        (let ((map (copy-keymap flyspell-mouse-map)))
 652          (set-keymap-parent map (current-local-map))
 653          (if (and (eq flyspell-emacs 'emacs)
 654                   (not (string< emacs-version "20")))
 655              (define-key map '[tool-bar] nil))
 656          map))
 657   (set (make-local-variable 'flyspell-mode-map)
 658        (let ((map (copy-keymap flyspell-mode-map)))
 659          (set-keymap-parent map (current-local-map))
 660          (if (and (eq flyspell-emacs 'emacs)
 661                   (not (string< emacs-version "20")))
 662              (define-key map '[tool-bar] nil))
 663          map))
 664   ;; the welcome message
 665   (if (and flyspell-issue-message-flag
 666            flyspell-issue-welcome-flag
 667            (interactive-p))
 668       (let ((binding (where-is-internal 'flyspell-auto-correct-word
 669                                         nil 'non-ascii)))
 670         (message
 671          (if binding
 672              (format "Welcome to flyspell. Use %s or Mouse-2 to correct words."
 673                      (key-description binding))
 674            "Welcome to flyspell. Use Mouse-2 to correct words."))))
 675   ;; we end with the flyspell hooks
 676   (run-hooks 'flyspell-mode-hook))
 677
 678 ;*---------------------------------------------------------------------*/
 679 ;*    flyspell-delay-commands ...                                      */
 680 ;*---------------------------------------------------------------------*/
 681 (defun flyspell-delay-commands ()
 682   "Install the standard set of Flyspell delayed commands."
 683   (mapcar 'flyspell-delay-command flyspell-default-delayed-commands)
 684   (mapcar 'flyspell-delay-command flyspell-delayed-commands))
 685
 686 ;*---------------------------------------------------------------------*/
 687 ;*    flyspell-delay-command ...                                       */
 688 ;*---------------------------------------------------------------------*/
 689 (defun flyspell-delay-command (command)
 690   "Set COMMAND to be delayed, for Flyspell.
 691 When flyspell `post-command-hook' is invoked because a delayed command
 692 as been used the current word is not immediately checked.
 693 It will be checked only after `flyspell-delay' seconds."
 694   (interactive "SDelay Flyspell after Command: ")
 695   (put command 'flyspell-delayed t))
 696
 697 ;*---------------------------------------------------------------------*/
 698 ;*    flyspell-deplacement-commands ...                                */
 699 ;*---------------------------------------------------------------------*/
 700 (defun flyspell-deplacement-commands ()
 701   "Install the standard set of Flyspell deplacement commands."
 702   (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands)
 703   (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands))
 704
 705 ;*---------------------------------------------------------------------*/
 706 ;*    flyspell-deplacement-command ...                                 */
 707 ;*---------------------------------------------------------------------*/
 708 (defun flyspell-deplacement-command (command)
 709   "Set COMMAND that implement cursor movements, for Flyspell.
 710 When flyspell `post-command-hook' is invoked because of a deplacement command
 711 as been used the current word is checked only if the previous command was
 712 not the very same deplacement command."
 713   (interactive "SDeplacement Flyspell after Command: ")
 714   (put command 'flyspell-deplacement t))
 715
 716 ;*---------------------------------------------------------------------*/
 717 ;*    flyspell-ignore-commands ...                                     */
 718 ;*---------------------------------------------------------------------*/
 719 (defun flyspell-ignore-commands ()
 720   "Install the standard set of Flyspell ignored commands."
 721   (mapcar 'flyspell-ignore-command flyspell-default-ignored-commands)
 722   (mapcar 'flyspell-ignore-command flyspell-ignored-commands))
 723
 724 ;*---------------------------------------------------------------------*/
 725 ;*    flyspell-ignore-command ...                                      */
 726 ;*---------------------------------------------------------------------*/
 727 (defun flyspell-ignore-command (command)
 728   "Set COMMAND to be ignored, for Flyspell.
 729 When flyspell `post-command-hook' is invoked because of an
 730 ignored command having been used, the changes in the text made by
 731 that command are ignored.  This feature is meant for commands that
 732 change text in a way that does not affect individual words, such
 733 as `fill-paragraph'."
 734   (interactive "SMake Flyspell ignore changes made by Command: ")
 735   (put command 'flyspell-ignored t))
 736
 737 ;*---------------------------------------------------------------------*/
 738 ;*    flyspell-word-cache ...                                          */
 739 ;*---------------------------------------------------------------------*/
 740 (defvar flyspell-word-cache-start  nil)
 741 (defvar flyspell-word-cache-end    nil)
 742 (defvar flyspell-word-cache-word   nil)
 743 (defvar flyspell-word-cache-result '_)
 744 (make-variable-buffer-local 'flyspell-word-cache-start)
 745 (make-variable-buffer-local 'flyspell-word-cache-end)
 746 (make-variable-buffer-local 'flyspell-word-cache-word)
 747 (make-variable-buffer-local 'flyspell-word-cache-result)
 748
 749 ;*---------------------------------------------------------------------*/
 750 ;*    The flyspell pre-hook, store the current position. In the        */
 751 ;*    post command hook, we will check, if the word at this position   */
 752 ;*    has to be spell checked.                                         */
 753 ;*---------------------------------------------------------------------*/
 754 (defvar flyspell-pre-buffer     nil)
 755 (defvar flyspell-pre-point      nil)
 756 (defvar flyspell-pre-column     nil)
 757 (defvar flyspell-pre-pre-buffer nil)
 758 (defvar flyspell-pre-pre-point  nil)
 759
 760 ;*---------------------------------------------------------------------*/
 761 ;*    flyspell-previous-command ...                                    */
 762 ;*---------------------------------------------------------------------*/
 763 (defvar flyspell-previous-command nil
 764   "The last interactive command checked by Flyspell.")
 765
 766 ;*---------------------------------------------------------------------*/
 767 ;*    flyspell-pre-command-hook ...                                    */
 768 ;*---------------------------------------------------------------------*/
 769 (defun flyspell-pre-command-hook ()
 770   "Save the current buffer and point for Flyspell's post-command hook."
 771   (interactive)
 772   (setq flyspell-pre-buffer (current-buffer))
 773   (setq flyspell-pre-point  (point))
 774   (setq flyspell-pre-column (current-column)))
 775
 776 ;*---------------------------------------------------------------------*/
 777 ;*    flyspell-mode-off ...                                            */
 778 ;*---------------------------------------------------------------------*/
 779 ;;;###autoload
 780 (defun flyspell-mode-off ()
 781   "Turn Flyspell mode off."
 782   ;; we remove the hooks
 783   (remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
 784   (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
 785   (setq after-change-functions (delq 'flyspell-after-change-function
 786                                      after-change-functions))
 787   ;; we remove all the flyspell hilightings
 788   (flyspell-delete-all-overlays)
 789   ;; we have to erase pre cache variables
 790   (setq flyspell-pre-buffer nil)
 791   (setq flyspell-pre-point  nil)
 792   ;; we mark the mode as killed
 793   (setq flyspell-mode nil))
 794
 795 ;*---------------------------------------------------------------------*/
 796 ;*    flyspell-check-pre-word-p ...                                    */
 797 ;*---------------------------------------------------------------------*/
 798 (defun flyspell-check-pre-word-p ()
 799   "Return non-nil if we should check the word before point.
 800 More precisely, it applies to the word that was before point
 801 before the current command."
 802   (cond
 803    ((or (not (numberp flyspell-pre-point))
 804         (not (bufferp flyspell-pre-buffer))
 805         (not (buffer-live-p flyspell-pre-buffer)))
 806     nil)
 807    ((and (eq flyspell-pre-pre-point flyspell-pre-point)
 808          (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
 809     nil)
 810    ((or (and (= flyspell-pre-point (- (point) 1))
 811              (eq (char-syntax (char-after flyspell-pre-point)) ?w))
 812         (= flyspell-pre-point (point))
 813         (= flyspell-pre-point (+ (point) 1)))
 814     nil)
 815    ((and (symbolp this-command)
 816          (not executing-kbd-macro)
 817          (or (get this-command 'flyspell-delayed)
 818              (and (get this-command 'flyspell-deplacement)
 819                   (eq flyspell-previous-command this-command)))
 820          (or (= (current-column) 0)
 821              (= (current-column) flyspell-pre-column)
 822              (eq (char-syntax (char-after flyspell-pre-point)) ?w)))
 823     nil)
 824    ((not (eq (current-buffer) flyspell-pre-buffer))
 825     t)
 826    ((not (and (numberp flyspell-word-cache-start)
 827               (numberp flyspell-word-cache-end)))
 828     t)
 829    (t
 830     (or (< flyspell-pre-point flyspell-word-cache-start)
 831         (> flyspell-pre-point flyspell-word-cache-end)))))
 832
 833 ;*---------------------------------------------------------------------*/
 834 ;*    The flyspell after-change-hook, store the change position. In    */
 835 ;*    the post command hook, we will check, if the word at this        */
 836 ;*    position has to be spell checked.                                */
 837 ;*---------------------------------------------------------------------*/
 838 (defvar flyspell-changes nil)
 839
 840 ;*---------------------------------------------------------------------*/
 841 ;*    flyspell-after-change-function ...                               */
 842 ;*---------------------------------------------------------------------*/
 843 (defun flyspell-after-change-function (start stop len)
 844   "Save the current buffer and point for Flyspell's post-command hook."
 845   (interactive)
 846   (unless (and (symbolp this-command) (get this-command 'flyspell-ignored))
 847     (setq flyspell-changes (cons (cons start stop) flyspell-changes))))
 848
 849 ;*---------------------------------------------------------------------*/
 850 ;*    flyspell-check-changed-word-p ...                                */
 851 ;*---------------------------------------------------------------------*/
 852 (defun flyspell-check-changed-word-p (start stop)
 853   "Return t when the changed word has to be checked.
 854 The answer depends of several criteria.
 855 Mostly we check word delimiters."
 856   (cond
 857    ((and (memq (char-after start) '(?\n ? )) (> stop start))
 858     t)
 859    ((not (numberp flyspell-pre-point))
 860     t)
 861    ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
 862     nil)
 863    ((let ((pos (point)))
 864       (or (>= pos start) (<= pos stop) (= pos (1+ stop))))
 865     nil)
 866    (t
 867     t)))
 868
 869 ;*---------------------------------------------------------------------*/
 870 ;*    flyspell-check-word-p ...                                        */
 871 ;*---------------------------------------------------------------------*/
 872 (defun flyspell-check-word-p ()
 873   "Return t when the word at `point' has to be checked.
 874 The answer depends of several criteria.
 875 Mostly we check word delimiters."
 876   (cond
 877    ((<= (- (point-max) 1) (point-min))
 878     ;; the buffer is not filled enough
 879     nil)
 880    ((and (and (> (current-column) 0)
 881               (not (eq (current-column) flyspell-pre-column)))
 882          (save-excursion
 883            (backward-char 1)
 884            (and (looking-at (flyspell-get-not-casechars))
 885                 (or flyspell-consider-dash-as-word-delimiter-flag
 886                     (not (looking-at "\\-"))))))
 887     ;; yes because we have reached or typed a word delimiter.
 888     t)
 889    ((symbolp this-command)
 890     (cond
 891      ((get this-command 'flyspell-deplacement)
 892       (not (eq flyspell-previous-command this-command)))
 893      ((get this-command 'flyspell-delayed)
 894       ;; the current command is not delayed, that
 895       ;; is that we must check the word now
 896       (if (or (fboundp 'about-xemacs) (featurep 'xemacs))
 897           (sit-for flyspell-delay nil)
 898         (sit-for flyspell-delay 0 nil)))
 899      (t t)))
 900    (t t)))
 901
 902 ;*---------------------------------------------------------------------*/
 903 ;*    flyspell-debug-signal-no-check ...                               */
 904 ;*---------------------------------------------------------------------*/
 905 (defun flyspell-debug-signal-no-check (msg obj)
 906   (setq debug-on-error t)
 907   (save-excursion
 908     (let ((buffer (get-buffer-create "*flyspell-debug*")))
 909       (set-buffer buffer)
 910       (erase-buffer)
 911       (insert "NO-CHECK:\n")
 912       (insert (format "    %S : %S\n" msg obj)))))
 913
 914 ;*---------------------------------------------------------------------*/
 915 ;*    flyspell-debug-signal-pre-word-checked ...                       */
 916 ;*---------------------------------------------------------------------*/
 917 (defun flyspell-debug-signal-pre-word-checked ()
 918   (setq debug-on-error t)
 919   (save-excursion
 920     (let ((buffer (get-buffer-create "*flyspell-debug*")))
 921       (set-buffer buffer)
 922       (insert "PRE-WORD:\n")
 923       (insert (format "  pre-point  : %S\n" flyspell-pre-point))
 924       (insert (format "  pre-buffer : %S\n" flyspell-pre-buffer))
 925       (insert (format "  cache-start: %S\n" flyspell-word-cache-start))
 926       (insert (format "  cache-end  : %S\n" flyspell-word-cache-end))
 927       (goto-char (point-max)))))
 928
 929 ;*---------------------------------------------------------------------*/
 930 ;*    flyspell-debug-signal-word-checked ...                           */
 931 ;*---------------------------------------------------------------------*/
 932 (defun flyspell-debug-signal-word-checked ()
 933   (setq debug-on-error t)
 934   (save-excursion
 935     (let ((oldbuf (current-buffer))
 936           (buffer (get-buffer-create "*flyspell-debug*"))
 937           (point  (point)))
 938       (set-buffer buffer)
 939       (insert "WORD:\n")
 940       (insert (format "  this-cmd   : %S\n" this-command))
 941       (insert (format "  delayed    : %S\n" (and (symbolp this-command)
 942                                                  (get this-command 'flyspell-delayed))))
 943       (insert (format "  ignored    : %S\n" (and (symbolp this-command)
 944                                                  (get this-command 'flyspell-ignored))))
 945       (insert (format "  point      : %S\n" point))
 946       (insert (format "  prev-char  : [%c] %S\n"
 947                       (progn
 948                         (set-buffer oldbuf)
 949                         (let ((c (if (> (point) (point-min))
 950                                      (save-excursion
 951                                        (backward-char 1)
 952                                        (char-after (point)))
 953                                    ? )))
 954                           (set-buffer buffer)
 955                           c))
 956                       (progn
 957                         (set-buffer oldbuf)
 958                         (let ((c (if (> (point) (point-min))
 959                                      (save-excursion
 960                                        (backward-char 1)
 961                                        (and (and (looking-at (flyspell-get-not-casechars)) 1)
 962                                             (and (or flyspell-consider-dash-as-word-delimiter-flag
 963                                                      (not (looking-at "\\-"))) 2))))))
 964                           (set-buffer buffer)
 965                           c))))
 966       (insert (format "  because    : %S\n"
 967                       (cond
 968                        ((not (and (symbolp this-command)
 969                                   (get this-command 'flyspell-delayed)))
 970                         ;; the current command is not delayed, that
 971                         ;; is that we must check the word now
 972                         'not-delayed)
 973                        ((progn
 974                           (set-buffer oldbuf)
 975                           (let ((c (if (> (point) (point-min))
 976                                        (save-excursion
 977                                          (backward-char 1)
 978                                          (and (looking-at (flyspell-get-not-casechars))
 979                                               (or flyspell-consider-dash-as-word-delimiter-flag
 980                                                   (not (looking-at "\\-"))))))))
 981                             (set-buffer buffer)
 982                             c))
 983                         ;; yes because we have reached or typed a word delimiter.
 984                         'separator)
 985                        ((not (integerp flyspell-delay))
 986                         ;; yes because the user had set up a no-delay configuration.
 987                         'no-delay)
 988                        (t
 989                         'sit-for))))
 990       (goto-char (point-max)))))
 991
 992 ;*---------------------------------------------------------------------*/
 993 ;*    flyspell-debug-signal-changed-checked ...                        */
 994 ;*---------------------------------------------------------------------*/
 995 (defun flyspell-debug-signal-changed-checked ()
 996   (setq debug-on-error t)
 997   (save-excursion
 998     (let ((buffer (get-buffer-create "*flyspell-debug*"))
 999           (point  (point)))
1000       (set-buffer buffer)
1001       (insert "CHANGED WORD:\n")
1002       (insert (format "  point   : %S\n" point))
1003       (goto-char (point-max)))))
1004
1005 ;*---------------------------------------------------------------------*/
1006 ;*    flyspell-post-command-hook ...                                   */
1007 ;*    -------------------------------------------------------------    */
1008 ;*    It is possible that we check several words:                      */
1009 ;*    1- the current word is checked if the predicate                  */
1010 ;*       FLYSPELL-CHECK-WORD-P is true                                 */
1011 ;*    2- the word that used to be the current word before the          */
1012 ;*       THIS-COMMAND is checked if:                                   */
1013 ;*        a- the previous word is different from the current word      */
1014 ;*        b- the previous word as not just been checked by the         */
1015 ;*           previous FLYSPELL-POST-COMMAND-HOOK                       */
1016 ;*    3- the words changed by the THIS-COMMAND that are neither the    */
1017 ;*       previous word nor the current word                            */
1018 ;*---------------------------------------------------------------------*/
1019 (defun flyspell-post-command-hook ()
1020   "The `post-command-hook' used by flyspell to check a word in-the-fly."
1021   (interactive)
1022   (let ((command this-command))
1023     (if (flyspell-check-pre-word-p)
1024         (save-excursion
1025           '(flyspell-debug-signal-pre-word-checked)
1026           (set-buffer flyspell-pre-buffer)
1027           (save-excursion
1028             (goto-char flyspell-pre-point)
1029             (flyspell-word))))
1030     (if (flyspell-check-word-p)
1031         (progn
1032           '(flyspell-debug-signal-word-checked)
1033           (flyspell-word)
1034           ;; we remember which word we have just checked.
1035           ;; this will be used next time we will check a word
1036           ;; to compare the next current word with the word
1037           ;; that as been registered in the pre-command-hook
1038           ;; that is these variables are used within the predicate
1039           ;; FLYSPELL-CHECK-PRE-WORD-P
1040           (setq flyspell-pre-pre-buffer (current-buffer))
1041           (setq flyspell-pre-pre-point  (point)))
1042       (progn
1043         (setq flyspell-pre-pre-buffer nil)
1044         (setq flyspell-pre-pre-point  nil)
1045         ;; when a word is not checked because of a delayed command
1046         ;; we do not disable the ispell cache.
1047         (if (and (symbolp this-command) (get this-command 'flyspell-delayed))
1048             (progn
1049               (setq flyspell-word-cache-end -1)
1050               (setq flyspell-word-cache-result '_)))))
1051     (while (consp flyspell-changes)
1052       (let ((start (car (car flyspell-changes)))
1053             (stop  (cdr (car flyspell-changes))))
1054         (if (flyspell-check-changed-word-p start stop)
1055             (save-excursion
1056               '(flyspell-debug-signal-changed-checked)
1057               (goto-char start)
1058               (flyspell-word)))
1059         (setq flyspell-changes (cdr flyspell-changes))))
1060     (setq flyspell-previous-command command)))
1061
1062 ;*---------------------------------------------------------------------*/
1063 ;*    flyspell-notify-misspell ...                                     */
1064 ;*---------------------------------------------------------------------*/
1065 (defun flyspell-notify-misspell (start end word poss)
1066   (let ((replacements (if (stringp poss)
1067                           poss
1068                         (if flyspell-sort-corrections
1069                             (sort (car (cdr (cdr poss))) 'string<)
1070                           (car (cdr (cdr poss)))))))
1071     (if flyspell-issue-message-flag
1072         (message (format "mispelling `%s'  %S" word replacements)))))
1073
1074 ;*---------------------------------------------------------------------*/
1075 ;*    flyspell-word-search-backward ...                                */
1076 ;*---------------------------------------------------------------------*/
1077 (defun flyspell-word-search-backward (word bound)
1078   (save-excursion
1079     (let ((r '())
1080           p)
1081       (while (and (not r) (setq p (search-backward word bound t)))
1082         (let ((lw (flyspell-get-word '())))
1083           (if (and (consp lw) (string-equal (car lw) word))
1084               (setq r p)
1085             (goto-char p))))
1086       r)))
1087
1088 ;*---------------------------------------------------------------------*/
1089 ;*    flyspell-word-search-forward ...                                 */
1090 ;*---------------------------------------------------------------------*/
1091 (defun flyspell-word-search-forward (word bound)
1092   (save-excursion
1093     (let ((r '())
1094           p)
1095       (while (and (not r) (setq p (search-forward word bound t)))
1096         (let ((lw (flyspell-get-word '())))
1097           (if (and (consp lw) (string-equal (car lw) word))
1098               (setq r p)
1099             (goto-char (1+ p)))))
1100       r)))
1101
1102 ;*---------------------------------------------------------------------*/
1103 ;*    flyspell-word ...                                                */
1104 ;*---------------------------------------------------------------------*/
1105 (defun flyspell-word (&optional following)
1106   "Spell check a word."
1107   (interactive (list current-prefix-arg))
1108   (if (interactive-p)
1109       (setq following ispell-following-word))
1110   (save-excursion
1111     ;; use the correct dictionary
1112     (flyspell-accept-buffer-local-defs)
1113     (let* ((cursor-location (point))
1114           (flyspell-word (flyspell-get-word following))
1115           start end poss word)
1116       (if (or (eq flyspell-word nil)
1117               (and (fboundp flyspell-generic-check-word-p)
1118                    (not (funcall flyspell-generic-check-word-p))))
1119           t
1120         (progn
1121           ;; destructure return flyspell-word info list.
1122           (setq start (car (cdr flyspell-word))
1123                 end (car (cdr (cdr flyspell-word)))
1124                 word (car flyspell-word))
1125           ;; before checking in the directory, we check for doublons.
1126           (cond
1127            ((and (or (not (eq ispell-parser 'tex))
1128                      (and (> start (point-min))
1129                           (not (eq (char-after (1- start)) ?}))
1130                           (not (eq (char-after (1- start)) ?\\))))
1131                  flyspell-mark-duplications-flag
1132                  (save-excursion
1133                    (goto-char (1- start))
1134                    (let ((p (flyspell-word-search-backward
1135                              word
1136                              (- start (1+ (- end start))))))
1137                      (and p (/= p (1- start))))))
1138             ;; yes, this is a doublon
1139             (flyspell-highlight-incorrect-region start end 'doublon)
1140             nil)
1141            ((and (eq flyspell-word-cache-start start)
1142                  (eq flyspell-word-cache-end end)
1143                  (string-equal flyspell-word-cache-word word))
1144             ;; this word had been already checked, we skip
1145             flyspell-word-cache-result)
1146            ((and (eq ispell-parser 'tex)
1147                  (flyspell-tex-command-p flyspell-word))
1148             ;; this is a correct word (because a tex command)
1149             (flyspell-unhighlight-at start)
1150             (if (> end start)
1151                 (flyspell-unhighlight-at (- end 1)))
1152             t)
1153            (t
1154             ;; we setup the cache
1155             (setq flyspell-word-cache-start start)
1156             (setq flyspell-word-cache-end end)
1157             (setq flyspell-word-cache-word word)
1158             ;; now check spelling of word.
1159             (process-send-string ispell-process "%\n")
1160             ;; put in verbose mode
1161             (process-send-string ispell-process
1162                                  (concat "^" word "\n"))
1163             ;; we mark the ispell process so it can be killed
1164             ;; when emacs is exited without query
1165             (if (fboundp 'process-kill-without-query)
1166                 (process-kill-without-query ispell-process))
1167             ;; wait until ispell has processed word
1168             (while (progn
1169                      (accept-process-output ispell-process)
1170                      (not (string= "" (car ispell-filter)))))
1171             ;; (process-send-string ispell-process "!\n")
1172             ;; back to terse mode.
1173             (setq ispell-filter (cdr ispell-filter))
1174             (if (consp ispell-filter)
1175                 (setq poss (ispell-parse-output (car ispell-filter))))
1176             (let ((res (cond ((eq poss t)
1177                               ;; correct
1178                               (setq flyspell-word-cache-result t)
1179                               (flyspell-unhighlight-at start)
1180                               (if (> end start)
1181                                   (flyspell-unhighlight-at (- end 1)))
1182                               t)
1183                              ((and (stringp poss) flyspell-highlight-flag)
1184                               ;; correct
1185                               (setq flyspell-word-cache-result t)
1186                               (flyspell-unhighlight-at start)
1187                               (if (> end start)
1188                                   (flyspell-unhighlight-at (- end 1)))
1189                               t)
1190                              ((null poss)
1191                               (setq flyspell-word-cache-result t)
1192                               (flyspell-unhighlight-at start)
1193                               (if (> end start)
1194                                   (flyspell-unhighlight-at (- end 1)))
1195                               t)
1196                              ((or (and (< flyspell-duplicate-distance 0)
1197                                        (or (save-excursion
1198                                              (goto-char start)
1199                                              (flyspell-word-search-backward
1200                                               word
1201                                               (point-min)))
1202                                            (save-excursion
1203                                              (goto-char end)
1204                                              (flyspell-word-search-forward
1205                                               word
1206                                               (point-max)))))
1207                                   (and (> flyspell-duplicate-distance 0)
1208                                        (or (save-excursion
1209                                              (goto-char start)
1210                                              (flyspell-word-search-backward
1211                                               word
1212                                               (- start
1213                                                  flyspell-duplicate-distance)))
1214                                            (save-excursion
1215                                              (goto-char end)
1216                                              (flyspell-word-search-forward
1217                                               word
1218                                               (+ end
1219                                                  flyspell-duplicate-distance))))))
1220                               (setq flyspell-word-cache-result nil)
1221                               (if flyspell-highlight-flag
1222                                   (flyspell-highlight-duplicate-region
1223                                    start end)
1224                                 (message (format "duplicate `%s'" word)))
1225                               nil)
1226                              (t
1227                               (setq flyspell-word-cache-result nil)
1228                               ;; incorrect highlight the location
1229                               (if flyspell-highlight-flag
1230                                   (flyspell-highlight-incorrect-region
1231                                    start end poss)
1232                                 (flyspell-notify-misspell start end word poss))
1233                               nil))))
1234               ;; return to original location
1235               (goto-char cursor-location)
1236               (if ispell-quit (setq ispell-quit nil))
1237               res))))))))
1238
1239 ;* {*---------------------------------------------------------------------*} */
1240 ;* {*    flyspell-tex-math-initialized ...                                *} */
1241 ;* {*---------------------------------------------------------------------*} */
1242 ;* (defvar flyspell-tex-math-initialized nil)                          */
1243 ;*                                                                     */
1244 ;* {*---------------------------------------------------------------------*} */
1245 ;* {*    flyspell-math-tex-command-p ...                                  *} */
1246 ;* {*    -------------------------------------------------------------    *} */
1247 ;* {*    This function uses the texmathp package to check if (point)      *} */
1248 ;* {*    is within a tex command. In order to avoid using                 *} */
1249 ;* {*    condition-case each time we use the variable                     *} */
1250 ;* {*    flyspell-tex-math-initialized to make a special case the first   *} */
1251 ;* {*    time that function is called.                                    *} */
1252 ;* {*---------------------------------------------------------------------*} */
1253 ;* (defun flyspell-math-tex-command-p ()                               */
1254 ;*   (cond                                                             */
1255 ;*    (flyspell-check-tex-math-command                                 */
1256 ;*     nil)                                                            */
1257 ;*    ((eq flyspell-tex-math-initialized t)                            */
1258 ;*     (texmathp))                                                     */
1259 ;*    ((eq flyspell-tex-math-initialized 'error)                       */
1260 ;*     nil)                                                            */
1261 ;*    (t                                                               */
1262 ;*     (setq flyspell-tex-math-initialized t)                          */
1263 ;*     (condition-case nil                                             */
1264 ;*      (texmathp)                                                     */
1265 ;*       (error (progn                                                 */
1266 ;*             (setq flyspell-tex-math-initialized 'error)             */
1267 ;*             nil))))))                                               */
1268
1269 ;*---------------------------------------------------------------------*/
1270 ;*    flyspell-math-tex-command-p ...                                  */
1271 ;*    -------------------------------------------------------------    */
1272 ;*    This function uses the texmathp package to check if point        */
1273 ;*    is within a TeX math environment. `texmathp' can yield errors    */
1274 ;*    if the document is currently not valid TeX syntax.               */
1275 ;*---------------------------------------------------------------------*/
1276 (defun flyspell-math-tex-command-p ()
1277   (when (fboundp 'texmathp)
1278     (if flyspell-check-tex-math-command
1279         nil
1280       (condition-case nil
1281           (texmathp)
1282         (error nil)))))
1283
1284 ;*---------------------------------------------------------------------*/
1285 ;*    flyspell-tex-command-p ...                                       */
1286 ;*---------------------------------------------------------------------*/
1287 (defun flyspell-tex-command-p (word)
1288   "Return t if WORD is a TeX command."
1289   (or (save-excursion
1290         (let ((b  (car (cdr word))))
1291           (and (re-search-backward "\\\\" (- (point) 100) t)
1292                (or (= (match-end 0) b)
1293                    (and (goto-char (match-end 0))
1294                         (looking-at flyspell-tex-command-regexp)
1295                         (>= (match-end 0) b))))))
1296       (flyspell-math-tex-command-p)))
1297
1298 ;*---------------------------------------------------------------------*/
1299 ;*    flyspell-casechars-cache ...                                     */
1300 ;*---------------------------------------------------------------------*/
1301 (defvar flyspell-casechars-cache nil)
1302 (defvar flyspell-ispell-casechars-cache nil)
1303 (make-variable-buffer-local 'flyspell-casechars-cache)
1304 (make-variable-buffer-local 'flyspell-ispell-casechars-cache)
1305
1306 ;*---------------------------------------------------------------------*/
1307 ;*    flyspell-get-casechars ...                                       */
1308 ;*---------------------------------------------------------------------*/
1309 (defun flyspell-get-casechars ()
1310   "This function builds a string that is the regexp of word chars.
1311 In order to avoid one useless string construction,
1312 this function changes the last char of the `ispell-casechars' string."
1313   (let ((ispell-casechars (ispell-get-casechars)))
1314     (cond
1315      ((eq ispell-parser 'tex)
1316       (setq flyspell-ispell-casechars-cache ispell-casechars)
1317       (setq flyspell-casechars-cache
1318             (concat (substring ispell-casechars
1319                                0
1320                                (- (length ispell-casechars) 1))
1321                     "]"))
1322       flyspell-casechars-cache)
1323      (t
1324       (setq flyspell-ispell-casechars-cache ispell-casechars)
1325       (setq flyspell-casechars-cache ispell-casechars)
1326       flyspell-casechars-cache))))
1327
1328 ;*---------------------------------------------------------------------*/
1329 ;*    flyspell-get-not-casechars-cache ...                             */
1330 ;*---------------------------------------------------------------------*/
1331 (defvar flyspell-not-casechars-cache nil)
1332 (defvar flyspell-ispell-not-casechars-cache nil)
1333 (make-variable-buffer-local 'flyspell-not-casechars-cache)
1334 (make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
1335
1336 ;*---------------------------------------------------------------------*/
1337 ;*    flyspell-get-not-casechars ...                                   */
1338 ;*---------------------------------------------------------------------*/
1339 (defun flyspell-get-not-casechars ()
1340   "This function builds a string that is the regexp of non-word chars."
1341   (let ((ispell-not-casechars (ispell-get-not-casechars)))
1342     (cond
1343      ((eq ispell-parser 'tex)
1344       (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
1345       (setq flyspell-not-casechars-cache
1346             (concat (substring ispell-not-casechars
1347                                0
1348                                (- (length ispell-not-casechars) 1))
1349                     "]"))
1350       flyspell-not-casechars-cache)
1351      (t
1352       (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
1353       (setq flyspell-not-casechars-cache ispell-not-casechars)
1354       flyspell-not-casechars-cache))))
1355
1356 ;*---------------------------------------------------------------------*/
1357 ;*    flyspell-get-word ...                                            */
1358 ;*---------------------------------------------------------------------*/
1359 (defun flyspell-get-word (following &optional extra-otherchars)
1360   "Return the word for spell-checking according to Ispell syntax.
1361 If optional argument FOLLOWING is non-nil or if `flyspell-following-word'
1362 is non-nil when called interactively, then the following word
1363 \(rather than preceding\) is checked when the cursor is not over a word.
1364 Optional second argument contains otherchars that can be included in word
1365 many times.
1366
1367 Word syntax described by `flyspell-dictionary-alist' (which see)."
1368   (let* ((flyspell-casechars (flyspell-get-casechars))
1369          (flyspell-not-casechars (flyspell-get-not-casechars))
1370          (ispell-otherchars (ispell-get-otherchars))
1371          (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
1372          (word-regexp (concat flyspell-casechars
1373                               "+\\("
1374                               (if (not (string= "" ispell-otherchars))
1375                                   (concat ispell-otherchars "?"))
1376                               (if extra-otherchars
1377                                   (concat extra-otherchars "?"))
1378                               flyspell-casechars
1379                               "+\\)"
1380                               (if (or ispell-many-otherchars-p
1381                                       extra-otherchars)
1382                                   "*" "?")))
1383          did-it-once prevpt
1384          start end word)
1385     ;; find the word
1386     (if (not (looking-at flyspell-casechars))
1387         (if following
1388             (re-search-forward flyspell-casechars (point-max) t)
1389           (re-search-backward flyspell-casechars (point-min) t)))
1390     ;; move to front of word
1391     (re-search-backward flyspell-not-casechars (point-min) 'start)
1392     (while (and (or (and (not (string= "" ispell-otherchars))
1393                          (looking-at ispell-otherchars))
1394                     (and extra-otherchars (looking-at extra-otherchars)))
1395                 (not (bobp))
1396                 (or (not did-it-once)
1397                     ispell-many-otherchars-p)
1398                 (not (eq prevpt (point))))
1399       (if (and extra-otherchars (looking-at extra-otherchars))
1400           (progn
1401             (backward-char 1)
1402             (if (looking-at flyspell-casechars)
1403                 (re-search-backward flyspell-not-casechars (point-min) 'move)))
1404         (setq did-it-once t
1405               prevpt (point))
1406         (backward-char 1)
1407         (if (looking-at flyspell-casechars)
1408             (re-search-backward flyspell-not-casechars (point-min) 'move)
1409           (backward-char -1))))
1410     ;; Now mark the word and save to string.
1411     (if (not (re-search-forward word-regexp (point-max) t))
1412         nil
1413       (progn
1414         (setq start (match-beginning 0)
1415               end (point)
1416               word (buffer-substring-no-properties start end))
1417         (list word start end)))))
1418
1419 (defun flyspell-get-word.old (following)
1420   "Return the word for spell-checking according to Ispell syntax.
1421 If argument FOLLOWING is non-nil or if `ispell-following-word'
1422 is non-nil when called interactively, then the following word
1423 \(rather than preceding\) is checked when the cursor is not over a word.
1424 Optional second argument contains other chars that can be included in word
1425 many times.
1426
1427 Word syntax described by `ispell-dictionary-alist' (which see)."
1428   (let* ((flyspell-casechars (flyspell-get-casechars))
1429          (flyspell-not-casechars (flyspell-get-not-casechars))
1430          (ispell-otherchars (ispell-get-otherchars))
1431          (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
1432          (word-regexp (if (string< "" ispell-otherchars)
1433                           (concat flyspell-casechars
1434                                   "+\\("
1435                                   ispell-otherchars
1436                                   (if (> (length ispell-otherchars) 0) "?")
1437                                   flyspell-casechars
1438                                   "+\\)"
1439                                   (if ispell-many-otherchars-p
1440                                       "*" "?"))
1441                         (concat flyspell-casechars "+")))
1442          did-it-once
1443          start end word)
1444     ;; find the word
1445     (if (not (looking-at flyspell-casechars))
1446         (if following
1447             (re-search-forward flyspell-casechars (point-max) t)
1448           (re-search-backward flyspell-casechars (point-min) t)))
1449     ;; move to front of word
1450     (re-search-backward flyspell-not-casechars (point-min) 'start)
1451     (let ((pos nil))
1452       (if (string< "" ispell-otherchars)
1453           (while (and (looking-at ispell-otherchars)
1454                       (not (bobp))
1455                       (or (not did-it-once)
1456                           ispell-many-otherchars-p)
1457                       (not (eq pos (point))))
1458             (setq pos (point))
1459             (setq did-it-once t)
1460             (backward-char 1)
1461             (if (looking-at flyspell-casechars)
1462                 (re-search-backward flyspell-not-casechars (point-min) 'move)
1463               (backward-char -1)))))
1464     ;; Now mark the word and save to string.
1465     (if (eq (re-search-forward word-regexp (point-max) t) nil)
1466         nil
1467       (progn
1468         (setq start (match-beginning 0)
1469               end (point)
1470               word (buffer-substring-no-properties start end))
1471         (list word start end)))))
1472
1473 ;*---------------------------------------------------------------------*/
1474 ;*    flyspell-small-region ...                                        */
1475 ;*---------------------------------------------------------------------*/
1476 (defun flyspell-small-region (beg end)
1477   "Flyspell text between BEG and END."
1478   (save-excursion
1479     (if (> beg end)
1480         (let ((old beg))
1481           (setq beg end)
1482           (setq end old)))
1483     (goto-char beg)
1484     (let ((count 0))
1485       (while (< (point) end)
1486         (if (and flyspell-issue-message-flag (= count 100))
1487             (progn
1488               (message "Spell Checking...%d%%"
1489                        (* 100 (/ (float (- (point) beg)) (- end beg))))
1490               (setq count 0))
1491           (setq count (+ 1 count)))
1492         (flyspell-word)
1493         (sit-for 0)
1494         (let ((cur (point)))
1495           (forward-word 1)
1496           (if (and (< (point) end) (> (point) (+ cur 1)))
1497               (backward-char 1)))))
1498     (backward-char 1)
1499     (if flyspell-issue-message-flag (message "Spell Checking completed."))
1500     (flyspell-word)))
1501
1502 ;*---------------------------------------------------------------------*/
1503 ;*    flyspell-external-ispell-process ...                             */
1504 ;*---------------------------------------------------------------------*/
1505 (defvar flyspell-external-ispell-process '()
1506   "The external Flyspell Ispell process.")
1507
1508 ;*---------------------------------------------------------------------*/
1509 ;*    flyspell-external-ispell-buffer ...                              */
1510 ;*---------------------------------------------------------------------*/
1511 (defvar flyspell-external-ispell-buffer '())
1512 (defvar flyspell-large-region-buffer '())
1513 (defvar flyspell-large-region-beg (point-min))
1514 (defvar flyspell-large-region-end (point-max))
1515
1516 ;*---------------------------------------------------------------------*/
1517 ;*    flyspell-external-point-words ...                                */
1518 ;*---------------------------------------------------------------------*/
1519 (defun flyspell-external-point-words ()
1520   (let ((buffer flyspell-external-ispell-buffer))
1521     (set-buffer buffer)
1522     (beginning-of-buffer)
1523     (let ((size (- flyspell-large-region-end flyspell-large-region-beg))
1524           (start flyspell-large-region-beg)
1525           (pword "")
1526           (pcount 1))
1527       ;; now we are done with ispell, we have to find the word in
1528       ;; the initial buffer
1529       (while (< (point) (- (point-max) 1))
1530         ;; we have to fetch the incorrect word
1531         (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t)
1532             (let ((word (match-string 1)))
1533               (if (string= word pword)
1534                   (setq pcount (1+ pcount))
1535                 (progn
1536                   (setq pword word)
1537                   (setq pcount 1)))
1538               (goto-char (match-end 0))
1539               (if flyspell-issue-message-flag
1540                   (message "Spell Checking...%d%% [%s]"
1541                            (* 100 (/ (float (point)) (point-max)))
1542                            word))
1543               (set-buffer flyspell-large-region-buffer)
1544               (goto-char flyspell-large-region-beg)
1545               (let ((keep t)
1546                     (n 0))
1547                 (while (and (or (< n pcount) keep)
1548                             (search-forward word flyspell-large-region-end t))
1549                   (progn
1550                     (goto-char (- (point) 1))
1551                     (setq n (1+ n))
1552                     (setq keep (flyspell-word))))
1553                 (if (= n pcount)
1554                     (setq flyspell-large-region-beg (point))))
1555               (set-buffer buffer))
1556           (goto-char (point-max)))))
1557     ;; we are done
1558     (if flyspell-issue-message-flag (message "Spell Checking completed."))
1559     ;; ok, we are done with pointing out incorrect words, we just
1560     ;; have to kill the temporary buffer
1561     (kill-buffer flyspell-external-ispell-buffer)
1562     (setq flyspell-external-ispell-buffer nil)))
1563
1564 ;*---------------------------------------------------------------------*/
1565 ;*    flyspell-process-localwords ...                                  */
1566 ;*    -------------------------------------------------------------    */
1567 ;*    This function is used to prevent checking words declared         */
1568 ;*    explictitly correct on large regions.                            */
1569 ;*---------------------------------------------------------------------*/
1570 (defun flyspell-process-localwords ()
1571   "Parse Localwords in the buffer and remove them from the mispellings
1572 buffer before flyspell attempts to check them."
1573   (let (localwords
1574         (current-buffer curbuf)
1575         (mispellings-buffer buffer)
1576         (ispell-casechars (ispell-get-casechars)))
1577     ;; Get localwords from the original buffer
1578     (save-excursion
1579       (set-buffer current-buffer)
1580 ;*       (flyspell-delete-all-overlays)                                */
1581       (beginning-of-buffer)
1582       ;; Localwords parsing stolen form ispell.el
1583       (while (search-forward ispell-words-keyword nil t)
1584         (let ((end (save-excursion (end-of-line) (point)))
1585               string)
1586           ;; buffer-local words separated by a space, and can contain
1587           ;; any character other than a space.  Not rigorous enough.
1588           (while (re-search-forward " *\\([^ ]+\\)" end t)
1589             (setq string (buffer-substring-no-properties (match-beginning 1)
1590                                                          (match-end 1)))
1591             ;; This can fail when string contains a word with illegal chars.
1592             ;; Error handling needs to be added between ispell and emacs.
1593             (if (and (< 1 (length string))
1594                      (equal 0 (string-match ispell-casechars string)))
1595                 (setq localwords (add-to-list 'localwords string)))))))
1596     ;; Remove localwords matches
1597     (set-buffer mispellings-buffer)
1598     (while localwords
1599       (beginning-of-buffer)
1600       (delete-matching-lines (concat "^" (car localwords) "$"))
1601       (setq localwords (cdr localwords)))
1602     (end-of-buffer)))
1603
1604 ;*---------------------------------------------------------------------*/
1605 ;*    flyspell-large-region ...                                        */
1606 ;*---------------------------------------------------------------------*/
1607 (defun flyspell-large-region (beg end)
1608   (let* ((curbuf  (current-buffer))
1609          (buffer  (get-buffer-create "*flyspell-region*")))
1610     (setq flyspell-external-ispell-buffer buffer)
1611     (setq flyspell-large-region-buffer curbuf)
1612     (setq flyspell-large-region-beg beg)
1613     (setq flyspell-large-region-end end)
1614     (set-buffer buffer)
1615     (erase-buffer)
1616     ;; this is done, we can start checking...
1617     (if flyspell-issue-message-flag (message "Checking region..."))
1618     (set-buffer curbuf)
1619     (let ((c (apply 'call-process-region beg
1620                     end
1621                     ispell-program-name
1622                     nil
1623                     buffer
1624                     nil
1625                     (if (boundp 'ispell-list-command)
1626                         ispell-list-command
1627                       "-l")
1628                     (let (args)
1629                       ;; Local dictionary becomes the global dictionary in use.
1630                       (if ispell-local-dictionary
1631                           (setq ispell-dictionary ispell-local-dictionary))
1632                       (setq args (ispell-get-ispell-args))
1633                       (if ispell-dictionary ; use specified dictionary
1634                           (setq args
1635                                 (append (list "-d" ispell-dictionary) args)))
1636                       (if ispell-personal-dictionary ; use specified pers dict
1637                           (setq args
1638                                 (append args
1639                                         (list "-p"
1640                                               (expand-file-name
1641                                                ispell-personal-dictionary)))))
1642                       (setq args (append args ispell-extra-args))
1643                       args))))
1644       (if (= c 0)
1645           (progn
1646             (flyspell-process-localwords)
1647             (with-current-buffer curbuf
1648               (flyspell-delete-region-overlays beg end))
1649             (flyspell-external-point-words))
1650         (error "Can't check region...")))))
1651
1652 ;*---------------------------------------------------------------------*/
1653 ;*    flyspell-region ...                                              */
1654 ;*    -------------------------------------------------------------    */
1655 ;*    Because `ispell -a' is too slow, it is not possible to use       */
1656 ;*    it on large region. Then, when ispell is invoked on a large      */
1657 ;*    text region, a new `ispell -l' process is spawned. The           */
1658 ;*    pointed out words are then searched in the region a checked with */
1659 ;*    regular flyspell means.                                          */
1660 ;*---------------------------------------------------------------------*/
1661 ;;;###autoload
1662 (defun flyspell-region (beg end)
1663   "Flyspell text between BEG and END."
1664   (interactive "r")
1665   (if (= beg end)
1666       ()
1667     (save-excursion
1668       (if (> beg end)
1669           (let ((old beg))
1670             (setq beg end)
1671             (setq end old)))
1672       (if (and flyspell-large-region (> (- end beg) flyspell-large-region))
1673           (flyspell-large-region beg end)
1674         (flyspell-small-region beg end)))))
1675
1676 ;*---------------------------------------------------------------------*/
1677 ;*    flyspell-buffer ...                                              */
1678 ;*---------------------------------------------------------------------*/
1679 ;;;###autoload
1680 (defun flyspell-buffer ()
1681   "Flyspell whole buffer."
1682   (interactive)
1683   (flyspell-region (point-min) (point-max)))
1684
1685 ;*---------------------------------------------------------------------*/
1686 ;*    old next error position ...                                      */
1687 ;*---------------------------------------------------------------------*/
1688 (defvar flyspell-old-buffer-error nil)
1689 (defvar flyspell-old-pos-error nil)
1690
1691 ;*---------------------------------------------------------------------*/
1692 ;*    flyspell-goto-next-error ...                                     */
1693 ;*---------------------------------------------------------------------*/
1694 (defun flyspell-goto-next-error ()
1695   "Go to the next previously detected error.
1696 In general FLYSPELL-GOTO-NEXT-ERROR must be used after
1697 FLYSPELL-BUFFER."
1698   (interactive)
1699   (let ((pos (point))
1700         (max (point-max)))
1701     (if (and (eq (current-buffer) flyspell-old-buffer-error)
1702              (eq pos flyspell-old-pos-error))
1703         (progn
1704           (if (= flyspell-old-pos-error max)
1705               ;; goto beginning of buffer
1706               (progn
1707                 (message "Restarting from beginning of buffer")
1708                 (goto-char (point-min)))
1709             (forward-word 1))
1710           (setq pos (point))))
1711     ;; seek the next error
1712     (while (and (< pos max)
1713                 (let ((ovs (overlays-at pos))
1714                       (r '()))
1715                   (while (and (not r) (consp ovs))
1716                     (if (flyspell-overlay-p (car ovs))
1717                         (setq r t)
1718                       (setq ovs (cdr ovs))))
1719                   (not r)))
1720       (setq pos (1+ pos)))
1721     ;; save the current location for next invocation
1722     (setq flyspell-old-pos-error pos)
1723     (setq flyspell-old-buffer-error (current-buffer))
1724     (goto-char pos)
1725     (if (= pos max)
1726         (message "No more miss-spelled word!"))))
1727
1728 ;*---------------------------------------------------------------------*/
1729 ;*    flyspell-overlay-p ...                                           */
1730 ;*---------------------------------------------------------------------*/
1731 (defun flyspell-overlay-p (o)
1732   "A predicate that return true iff O is an overlay used by flyspell."
1733   (and (overlayp o) (overlay-get o 'flyspell-overlay)))
1734
1735 ;*---------------------------------------------------------------------*/
1736 ;*    flyspell-delete-region-overlays ...                              */
1737 ;*---------------------------------------------------------------------*/
1738 (defun flyspell-delete-region-overlays (beg end)
1739   "Delete overlays used by flyspell in a given region."
1740   (let ((l (overlays-in beg end)))
1741     (while (consp l)
1742       (progn
1743         (if (flyspell-overlay-p (car l))
1744             (delete-overlay (car l)))
1745         (setq l (cdr l))))))
1746
1747 ;*---------------------------------------------------------------------*/
1748 ;*    flyspell-delete-all-overlays ...                                 */
1749 ;*    -------------------------------------------------------------    */
1750 ;*    Remove all the overlays introduced by flyspell.                  */
1751 ;*---------------------------------------------------------------------*/
1752 (defun flyspell-delete-all-overlays ()
1753   "Delete all the overlays used by flyspell."
1754   (flyspell-delete-region-overlays (point-min) (point-max)))
1755
1756 ;*---------------------------------------------------------------------*/
1757 ;*    flyspell-unhighlight-at ...                                      */
1758 ;*---------------------------------------------------------------------*/
1759 (defun flyspell-unhighlight-at (pos)
1760   "Remove the flyspell overlay that are located at POS."
1761   (if flyspell-persistent-highlight
1762       (let ((overlays (overlays-at pos)))
1763         (while (consp overlays)
1764           (if (flyspell-overlay-p (car overlays))
1765               (delete-overlay (car overlays)))
1766           (setq overlays (cdr overlays))))
1767     (if (flyspell-overlay-p flyspell-overlay)
1768         (delete-overlay flyspell-overlay))))
1769
1770 ;*---------------------------------------------------------------------*/
1771 ;*    flyspell-properties-at-p ...                                     */
1772 ;*    -------------------------------------------------------------    */
1773 ;*    Is there an highlight properties at position pos?                */
1774 ;*---------------------------------------------------------------------*/
1775 (defun flyspell-properties-at-p (pos)
1776   "Return t if there is a text property at POS, not counting `local-map'.
1777 If variable `flyspell-highlight-properties' is set to nil,
1778 text with properties are not checked.  This function is used to discover
1779 if the character at POS has any other property."
1780   (let ((prop (text-properties-at pos))
1781         (keep t))
1782     (while (and keep (consp prop))
1783       (if (and (eq (car prop) 'local-map) (consp (cdr prop)))
1784           (setq prop (cdr (cdr prop)))
1785         (setq keep nil)))
1786     (consp prop)))
1787
1788 ;*---------------------------------------------------------------------*/
1789 ;*    make-flyspell-overlay ...                                        */
1790 ;*---------------------------------------------------------------------*/
1791 (defun make-flyspell-overlay (beg end face mouse-face)
1792   "Allocate an overlay to highlight an incorrect word.
1793 BEG and END specify the range in the buffer of that word.
1794 FACE and MOUSE-FACE specify the `face' and `mouse-face' properties
1795 for the overlay."
1796   (let ((flyspell-overlay (make-overlay beg end nil t nil)))
1797     (overlay-put flyspell-overlay 'face face)
1798     (overlay-put flyspell-overlay 'mouse-face mouse-face)
1799     (overlay-put flyspell-overlay 'flyspell-overlay t)
1800     (overlay-put flyspell-overlay 'evaporate t)
1801     (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point")
1802     (if flyspell-use-local-map
1803         (overlay-put flyspell-overlay
1804                      flyspell-overlay-keymap-property-name
1805                      flyspell-mouse-map))
1806     (when (eq face 'flyspell-incorrect-face)
1807       (and (stringp flyspell-before-incorrect-word-string)
1808            (overlay-put flyspell-overlay 'before-string
1809                         flyspell-before-incorrect-word-string))
1810       (and (stringp flyspell-after-incorrect-word-string)
1811            (overlay-put flyspell-overlay 'after-string
1812                         flyspell-after-incorrect-word-string)))
1813     flyspell-overlay))
1814
1815 ;*---------------------------------------------------------------------*/
1816 ;*    flyspell-highlight-incorrect-region ...                          */
1817 ;*---------------------------------------------------------------------*/
1818 (defun flyspell-highlight-incorrect-region (beg end poss)
1819   "Set up an overlay on a misspelled word, in the buffer from BEG to END."
1820   (unless (run-hook-with-args-until-success
1821            'flyspell-incorrect-hook beg end poss)
1822     (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg)))
1823         (progn
1824           ;; we cleanup all the overlay that are in the region, not
1825           ;; beginning at the word start position
1826           (if (< (1+ beg) end)
1827               (let ((os (overlays-in (1+ beg) end)))
1828                 (while (consp os)
1829                   (if (flyspell-overlay-p (car os))
1830                       (delete-overlay (car os)))
1831                   (setq os (cdr os)))))
1832           ;; we cleanup current overlay at the same position
1833           (if (and (not flyspell-persistent-highlight)
1834                    (overlayp flyspell-overlay))
1835               (delete-overlay flyspell-overlay)
1836             (let ((os (overlays-at beg)))
1837               (while (consp os)
1838                 (if (flyspell-overlay-p (car os))
1839                     (delete-overlay (car os)))
1840                 (setq os (cdr os)))))
1841           ;; now we can use a new overlay
1842           (setq flyspell-overlay
1843                 (make-flyspell-overlay beg end
1844                                        'flyspell-incorrect-face
1845                                        'highlight))))))
1846
1847 ;*---------------------------------------------------------------------*/
1848 ;*    flyspell-highlight-duplicate-region ...                          */
1849 ;*---------------------------------------------------------------------*/
1850 (defun flyspell-highlight-duplicate-region (beg end)
1851   "Set up an overlay on a duplicated word, in the buffer from BEG to END."
1852   (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg)))
1853       (progn
1854         ;; we cleanup current overlay at the same position
1855         (if (and (not flyspell-persistent-highlight)
1856                  (overlayp flyspell-overlay))
1857             (delete-overlay flyspell-overlay)
1858           (let ((overlays (overlays-at beg)))
1859             (while (consp overlays)
1860               (if (flyspell-overlay-p (car overlays))
1861                   (delete-overlay (car overlays)))
1862               (setq overlays (cdr overlays)))))
1863         ;; now we can use a new overlay
1864         (setq flyspell-overlay
1865               (make-flyspell-overlay beg end
1866                                      'flyspell-duplicate-face
1867                                      'highlight)))))
1868
1869 ;*---------------------------------------------------------------------*/
1870 ;*    flyspell-auto-correct-cache ...                                  */
1871 ;*---------------------------------------------------------------------*/
1872 (defvar flyspell-auto-correct-pos nil)
1873 (defvar flyspell-auto-correct-region nil)
1874 (defvar flyspell-auto-correct-ring nil)
1875 (defvar flyspell-auto-correct-word nil)
1876 (make-variable-buffer-local 'flyspell-auto-correct-pos)
1877 (make-variable-buffer-local 'flyspell-auto-correct-region)
1878 (make-variable-buffer-local 'flyspell-auto-correct-ring)
1879 (make-variable-buffer-local 'flyspell-auto-correct-word)
1880
1881 ;*---------------------------------------------------------------------*/
1882 ;*    flyspell-check-previous-highlighted-word ...                     */
1883 ;*---------------------------------------------------------------------*/
1884 (defun flyspell-check-previous-highlighted-word (&optional arg)
1885   "Correct the closer misspelled word.
1886 This function scans a mis-spelled word before the cursor. If it finds one
1887 it proposes replacement for that word. With prefix arg, count that many
1888 misspelled words backwards."
1889   (interactive)
1890   (let ((pos1 (point))
1891         (pos  (point))
1892         (arg  (if (or (not (numberp arg)) (< arg 1)) 1 arg))
1893         ov ovs)
1894     (if (catch 'exit
1895           (while (and (setq pos (previous-overlay-change pos))
1896                       (not (= pos pos1)))
1897             (setq pos1 pos)
1898             (if (> pos (point-min))
1899                 (progn
1900                   (setq ovs (overlays-at (1- pos)))
1901                   (while (consp ovs)
1902                     (setq ov (car ovs))
1903                     (setq ovs (cdr ovs))
1904                     (if (and (overlay-get ov 'flyspell-overlay)
1905                              (= 0 (setq arg (1- arg))))
1906                         (throw 'exit t)))))))
1907         (save-excursion
1908           (goto-char pos)
1909           (ispell-word))
1910       (error "No word to correct before point"))))
1911
1912 ;*---------------------------------------------------------------------*/
1913 ;*    flyspell-display-next-corrections ...                            */
1914 ;*---------------------------------------------------------------------*/
1915 (defun flyspell-display-next-corrections (corrections)
1916   (let ((string "Corrections:")
1917         (l corrections)
1918         (pos '()))
1919     (while (< (length string) 80)
1920       (if (equal (car l) flyspell-auto-correct-word)
1921           (setq pos (cons (+ 1 (length string)) pos)))
1922       (setq string (concat string " " (car l)))
1923       (setq l (cdr l)))
1924     (while (consp pos)
1925       (let ((num (car pos)))
1926         (put-text-property num
1927                            (+ num (length flyspell-auto-correct-word))
1928                            'face
1929                            'flyspell-incorrect-face
1930                            string))
1931       (setq pos (cdr pos)))
1932     (if (fboundp 'display-message)
1933         (display-message 'no-log string)
1934       (message string))))
1935
1936 ;*---------------------------------------------------------------------*/
1937 ;*    flyspell-abbrev-table ...                                        */
1938 ;*---------------------------------------------------------------------*/
1939 (defun flyspell-abbrev-table ()
1940   (if flyspell-use-global-abbrev-table-p
1941       global-abbrev-table
1942     local-abbrev-table))
1943
1944 ;*---------------------------------------------------------------------*/
1945 ;*    flyspell-define-abbrev ...                                       */
1946 ;*---------------------------------------------------------------------*/
1947 (defun flyspell-define-abbrev (name expansion)
1948   (let ((table (flyspell-abbrev-table)))
1949     (when table
1950       (define-abbrev table name expansion))))
1951
1952 ;*---------------------------------------------------------------------*/
1953 ;*    flyspell-auto-correct-word ...                                   */
1954 ;*---------------------------------------------------------------------*/
1955 (defun flyspell-auto-correct-word ()
1956   "Correct the current word.
1957 This command proposes various successive corrections for the current word."
1958   (interactive)
1959   (let ((pos     (point))
1960         (old-max (point-max)))
1961     ;; use the correct dictionary
1962     (flyspell-accept-buffer-local-defs)
1963     (if (and (eq flyspell-auto-correct-pos pos)
1964              (consp flyspell-auto-correct-region))
1965         ;; we have already been using the function at the same location
1966         (let* ((start (car flyspell-auto-correct-region))
1967                (len   (cdr flyspell-auto-correct-region)))
1968           (flyspell-unhighlight-at start)
1969           (delete-region start (+ start len))
1970           (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring))
1971           (let* ((word (car flyspell-auto-correct-ring))
1972                  (len  (length word)))
1973             (rplacd flyspell-auto-correct-region len)
1974             (goto-char start)
1975             (if flyspell-abbrev-p
1976                 (if (flyspell-already-abbrevp (flyspell-abbrev-table)
1977                                               flyspell-auto-correct-word)
1978                     (flyspell-change-abbrev (flyspell-abbrev-table)
1979                                             flyspell-auto-correct-word
1980                                             word)
1981                   (flyspell-define-abbrev flyspell-auto-correct-word word)))
1982             (funcall flyspell-insert-function word)
1983             (flyspell-word)
1984             (flyspell-display-next-corrections flyspell-auto-correct-ring))
1985           (flyspell-ajust-cursor-point pos (point) old-max)
1986           (setq flyspell-auto-correct-pos (point)))
1987       ;; fetch the word to be checked
1988       (let ((word (flyspell-get-word nil)))
1989         (setq flyspell-auto-correct-region nil)
1990         (if (consp word)
1991             (let ((start (car (cdr word)))
1992                   (end (car (cdr (cdr word))))
1993                   (word (car word))
1994                   poss)
1995               (setq flyspell-auto-correct-word word)
1996               ;; now check spelling of word.
1997               (process-send-string ispell-process "%\n") ;put in verbose mode
1998               (process-send-string ispell-process (concat "^" word "\n"))
1999               ;; wait until ispell has processed word
2000               (while (progn
2001                        (accept-process-output ispell-process)
2002                        (not (string= "" (car ispell-filter)))))
2003               (setq ispell-filter (cdr ispell-filter))
2004               (if (consp ispell-filter)
2005                   (setq poss (ispell-parse-output (car ispell-filter))))
2006               (cond
2007                ((or (eq poss t) (stringp poss))
2008                 ;; don't correct word
2009                 t)
2010                ((null poss)
2011                 ;; ispell error
2012                 (error "Ispell: error in Ispell process"))
2013                (t
2014                 ;; the word is incorrect, we have to propose a replacement
2015                 (let ((replacements (if flyspell-sort-corrections
2016                                         (sort (car (cdr (cdr poss))) 'string<)
2017                                       (car (cdr (cdr poss))))))
2018                   (if (consp replacements)
2019                       (progn
2020                         (let ((replace (car replacements)))
2021                           (let ((new-word replace))
2022                             (if (not (equal new-word (car poss)))
2023                                 (progn
2024                                   ;; the save the current replacements
2025                                   (setq flyspell-auto-correct-region
2026                                         (cons start (length new-word)))
2027                                   (let ((l replacements))
2028                                     (while (consp (cdr l))
2029                                       (setq l (cdr l)))
2030                                     (rplacd l (cons (car poss) replacements)))
2031                                   (setq flyspell-auto-correct-ring
2032                                         replacements)
2033                                   (flyspell-unhighlight-at start)
2034                                   (delete-region start end)
2035                                   (funcall flyspell-insert-function new-word)
2036                                   (if flyspell-abbrev-p
2037                                       (if (flyspell-already-abbrevp
2038                                            (flyspell-abbrev-table) word)
2039                                           (flyspell-change-abbrev
2040                                            (flyspell-abbrev-table)
2041                                            word
2042                                            new-word)
2043                                         (flyspell-define-abbrev word
2044                                                                 new-word)))
2045                                   (flyspell-word)
2046                                   (flyspell-display-next-corrections
2047                                    (cons new-word flyspell-auto-correct-ring))
2048                                   (flyspell-ajust-cursor-point pos
2049                                                                (point)
2050                                                                old-max))))))))))
2051               (ispell-pdict-save t)))
2052         (setq flyspell-auto-correct-pos (point))))))
2053
2054 ;*---------------------------------------------------------------------*/
2055 ;*    flyspell-auto-correct-previous-pos ...                           */
2056 ;*---------------------------------------------------------------------*/
2057 (defvar flyspell-auto-correct-previous-pos nil
2058   "Holds the start of the first incorrect word before point.")
2059
2060 ;*---------------------------------------------------------------------*/
2061 ;*    flyspell-auto-correct-previous-hook ...                          */
2062 ;*---------------------------------------------------------------------*/
2063 (defun flyspell-auto-correct-previous-hook ()
2064   "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
2065 Sets flyspell-auto-correct-previous-pos to nil"
2066   (interactive)
2067   (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t)
2068   (unless (eq this-command (function flyspell-auto-correct-previous-word))
2069     (setq flyspell-auto-correct-previous-pos nil)))
2070
2071 ;*---------------------------------------------------------------------*/
2072 ;*    flyspell-auto-correct-previous-word ...                          */
2073 ;*---------------------------------------------------------------------*/
2074 (defun flyspell-auto-correct-previous-word (position)
2075   "*Auto correct the first mispelled word that occurs before point."
2076   (interactive "d")
2077
2078   (add-hook 'pre-command-hook
2079             (function flyspell-auto-correct-previous-hook) t t)
2080
2081   (save-excursion
2082     (unless flyspell-auto-correct-previous-pos
2083       ;; only reset if a new overlay exists
2084       (setq flyspell-auto-correct-previous-pos nil)
2085
2086       (let ((overlay-list (overlays-in (point-min) position))
2087             (new-overlay 'dummy-value))
2088
2089         ;; search for previous (new) flyspell overlay
2090         (while (and new-overlay
2091                     (or (not (flyspell-overlay-p new-overlay))
2092                         ;; check if its face has changed
2093                         (not (eq (get-char-property
2094                                   (overlay-start new-overlay) 'face)
2095                                  'flyspell-incorrect-face))))
2096           (setq new-overlay (car-safe overlay-list))
2097           (setq overlay-list (cdr-safe overlay-list)))
2098
2099         ;; if nothing new exits new-overlay should be nil
2100         (if new-overlay;; the length of the word may change so go to the start
2101             (setq flyspell-auto-correct-previous-pos
2102                   (overlay-start new-overlay)))))
2103
2104     (when flyspell-auto-correct-previous-pos
2105       (save-excursion
2106         (goto-char flyspell-auto-correct-previous-pos)
2107         (let ((ispell-following-word t));; point is at start
2108           (if (numberp flyspell-auto-correct-previous-pos)
2109               (goto-char flyspell-auto-correct-previous-pos))
2110           (flyspell-auto-correct-word))
2111         ;; the point may have moved so reset this
2112         (setq flyspell-auto-correct-previous-pos (point))))))
2113
2114 ;*---------------------------------------------------------------------*/
2115 ;*    flyspell-correct-word ...                                        */
2116 ;*---------------------------------------------------------------------*/
2117 (defun flyspell-correct-word (event)
2118   "Pop up a menu of possible corrections for a misspelled word.
2119 The word checked is the word at the mouse position."
2120   (interactive "e")
2121   ;; use the correct dictionary
2122   (flyspell-accept-buffer-local-defs)
2123   ;; retain cursor location (I don't know why but save-excursion here fails).
2124   (let ((save (point)))
2125     (mouse-set-point event)
2126     (let ((cursor-location (point))
2127           (word (flyspell-get-word nil))
2128           (case-fold-search nil))
2129       (if (consp word)
2130           (let ((start (car (cdr word)))
2131                 (end (car (cdr (cdr word))))
2132                 (word (car word))
2133                 poss replace)
2134             ;; now check spelling of word.
2135             (process-send-string ispell-process "%\n") ;put in verbose mode
2136             (process-send-string ispell-process (concat "^" word "\n"))
2137             ;; wait until ispell has processed word
2138             (while (progn
2139                      (accept-process-output ispell-process)
2140                      (not (string= "" (car ispell-filter)))))
2141             (setq ispell-filter (cdr ispell-filter))
2142             (if (consp ispell-filter)
2143                 (setq poss (ispell-parse-output (car ispell-filter))))
2144             (cond
2145              ((or (eq poss t) (stringp poss))
2146               ;; don't correct word
2147               t)
2148              ((null poss)
2149               ;; ispell error
2150               (error "Ispell: error in Ispell process"))
2151              ((string-match "GNU" (emacs-version))
2152               ;; the word is incorrect, we have to propose a replacement
2153               (setq replace (flyspell-emacs-popup event poss word))
2154               (cond ((eq replace 'ignore)
2155                      (goto-char save)
2156                      nil)
2157                     ((eq replace 'save)
2158                      (goto-char save)
2159                      (process-send-string ispell-process
2160                                           (concat "*" word "\n"))
2161                      (flyspell-unhighlight-at cursor-location)
2162                      (setq ispell-pdict-modified-p '(t)))
2163                     ((or (eq replace 'buffer) (eq replace 'session))
2164                      (process-send-string ispell-process
2165                                           (concat "@" word "\n"))
2166                      (if (null ispell-pdict-modified-p)
2167                          (setq ispell-pdict-modified-p
2168                                (list ispell-pdict-modified-p)))
2169                      (flyspell-unhighlight-at cursor-location)
2170                      (goto-char save)
2171                      (if (eq replace 'buffer)
2172                          (ispell-add-per-file-word-list word)))
2173                     (replace
2174                      (flyspell-unhighlight-at cursor-location)
2175                      (let ((new-word (if (atom replace)
2176                                          replace
2177                                        (car replace)))
2178                            (cursor-location
2179                             (+ (- (length word) (- end start))
2180                                cursor-location)))
2181                        (if (not (equal new-word (car poss)))
2182                            (let ((old-max (point-max)))
2183                              (delete-region start end)
2184                              (funcall flyspell-insert-function new-word)
2185                              (if flyspell-abbrev-p
2186                                  (flyspell-define-abbrev word new-word))
2187                              (flyspell-ajust-cursor-point save
2188                                                           cursor-location
2189                                                           old-max)))))
2190                     (t
2191                      (goto-char save)
2192                      nil)))
2193              ((eq flyspell-emacs 'xemacs)
2194               (flyspell-xemacs-popup
2195                event poss word cursor-location start end save)
2196               (goto-char save)))
2197             (ispell-pdict-save t))))))
2198
2199 ;*---------------------------------------------------------------------*/
2200 ;*    flyspell-xemacs-correct ...                                      */
2201 ;*---------------------------------------------------------------------*/
2202 (defun flyspell-xemacs-correct (replace poss word cursor-location start end save)
2203   "The xemacs popup menu callback."
2204   (cond ((eq replace 'ignore)
2205          nil)
2206         ((eq replace 'save)
2207          (process-send-string ispell-process (concat "*" word "\n"))
2208          (process-send-string ispell-process "#\n")
2209          (flyspell-unhighlight-at cursor-location)
2210          (setq ispell-pdict-modified-p '(t)))
2211         ((or (eq replace 'buffer) (eq replace 'session))
2212          (process-send-string ispell-process (concat "@" word "\n"))
2213          (flyspell-unhighlight-at cursor-location)
2214          (if (null ispell-pdict-modified-p)
2215              (setq ispell-pdict-modified-p
2216                    (list ispell-pdict-modified-p)))
2217          (if (eq replace 'buffer)
2218              (ispell-add-per-file-word-list word)))
2219         (replace
2220          (let ((old-max (point-max))
2221                (new-word (if (atom replace)
2222                              replace
2223                            (car replace)))
2224                (cursor-location (+ (- (length word) (- end start))
2225                                    cursor-location)))
2226            (if (not (equal new-word (car poss)))
2227                (progn
2228                  (delete-region start end)
2229                  (goto-char start)
2230                  (funcall flyspell-insert-function new-word)
2231                  (if flyspell-abbrev-p
2232                      (flyspell-define-abbrev word new-word))))
2233            (flyspell-ajust-cursor-point save cursor-location old-max)))))
2234
2235 ;*---------------------------------------------------------------------*/
2236 ;*    flyspell-ajust-cursor-point ...                                  */
2237 ;*---------------------------------------------------------------------*/
2238 (defun flyspell-ajust-cursor-point (save cursor-location old-max)
2239   (if (>= save cursor-location)
2240       (let ((new-pos (+ save (- (point-max) old-max))))
2241         (goto-char (cond
2242                     ((< new-pos (point-min))
2243                      (point-min))
2244                     ((> new-pos (point-max))
2245                      (point-max))
2246                     (t new-pos))))
2247     (goto-char save)))
2248
2249 ;*---------------------------------------------------------------------*/
2250 ;*    flyspell-emacs-popup ...                                         */
2251 ;*---------------------------------------------------------------------*/
2252 (defun flyspell-emacs-popup (event poss word)
2253   "The Emacs popup menu."
2254   (if (not event)
2255       (let* ((mouse-pos  (mouse-position))
2256              (mouse-pos  (if (nth 1 mouse-pos)
2257                              mouse-pos
2258                            (set-mouse-position (car mouse-pos)
2259                                                (/ (frame-width) 2) 2)
2260                            (unfocus-frame)
2261                            (mouse-position))))
2262         (setq event (list (list (car (cdr mouse-pos))
2263                                 (1+ (cdr (cdr mouse-pos))))
2264                           (car mouse-pos)))))
2265   (let* ((corrects   (if flyspell-sort-corrections
2266                          (sort (car (cdr (cdr poss))) 'string<)
2267                        (car (cdr (cdr poss)))))
2268          (cor-menu   (if (consp corrects)
2269                          (mapcar (lambda (correct)
2270                                    (list correct correct))
2271                                  corrects)
2272                        '()))
2273          (affix      (car (cdr (cdr (cdr poss)))))
2274          (base-menu  (let ((save (if (consp affix)
2275                                      (list
2276                                       (list (concat "Save affix: " (car affix))
2277                                             'save)
2278                                       '("Accept (session)" session)
2279                                       '("Accept (buffer)" buffer))
2280                                    '(("Save word" save)
2281                                      ("Accept (session)" session)
2282                                      ("Accept (buffer)" buffer)))))
2283                        (if (consp cor-menu)
2284                            (append cor-menu (cons "" save))
2285                          save)))
2286          (menu       (cons "flyspell correction menu" base-menu)))
2287     (car (x-popup-menu event
2288                        (list (format "%s [%s]" word (or ispell-local-dictionary
2289                                                         ispell-dictionary))
2290                              menu)))))
2291
2292 ;*---------------------------------------------------------------------*/
2293 ;*    flyspell-xemacs-popup ...                                        */
2294 ;*---------------------------------------------------------------------*/
2295 (defun flyspell-xemacs-popup (event poss word cursor-location start end save)
2296   "The XEmacs popup menu."
2297   (let* ((corrects   (if flyspell-sort-corrections
2298                          (sort (car (cdr (cdr poss))) 'string<)
2299                        (car (cdr (cdr poss)))))
2300          (cor-menu   (if (consp corrects)
2301                          (mapcar (lambda (correct)
2302                                    (vector correct
2303                                            (list 'flyspell-xemacs-correct
2304                                                  correct
2305                                                  (list 'quote poss)
2306                                                  word
2307                                                  cursor-location
2308                                                  start
2309                                                  end
2310                                                  save)
2311                                            t))
2312                                  corrects)
2313                        '()))
2314          (affix      (car (cdr (cdr (cdr poss)))))
2315          (menu       (let ((save (if (consp affix)
2316                                      (vector
2317                                       (concat "Save affix: " (car affix))
2318                                       (list 'flyspell-xemacs-correct
2319                                             ''save
2320                                             (list 'quote poss)
2321                                             word
2322                                             cursor-location
2323                                             start
2324                                             end
2325                                             save)
2326                                       t)
2327                                    (vector
2328                                     "Save word"
2329                                     (list 'flyspell-xemacs-correct
2330                                           ''save
2331                                           (list 'quote poss)
2332                                           word
2333                                           cursor-location
2334                                           start
2335                                           end
2336                                           save)
2337                                     t)))
2338                            (session (vector "Accept (session)"
2339                                             (list 'flyspell-xemacs-correct
2340                                                   ''session
2341                                                   (list 'quote poss)
2342                                                   word
2343                                                   cursor-location
2344                                                   start
2345                                                   end
2346                                                   save)
2347                                             t))
2348                            (buffer  (vector "Accept (buffer)"
2349                                             (list 'flyspell-xemacs-correct
2350                                                   ''buffer
2351                                                   (list 'quote poss)
2352                                                   word
2353                                                   cursor-location
2354                                                   start
2355                                                   end
2356                                                   save)
2357                                             t)))
2358                        (if (consp cor-menu)
2359                            (append cor-menu (list "-" save session buffer))
2360                          (list save session buffer)))))
2361     (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary
2362                                                  ispell-dictionary))
2363                       menu))))
2364
2365 ;*---------------------------------------------------------------------*/
2366 ;*    Some example functions for real autocorrecting                   */
2367 ;*---------------------------------------------------------------------*/
2368 (defun flyspell-maybe-correct-transposition (beg end poss)
2369   "Check replacements for transposed characters.
2370
2371 If the text between BEG and END is equal to a correction suggested by
2372 Ispell, after transposing two adjacent characters, correct the text,
2373 and return t.
2374
2375 The third arg POSS is either the symbol 'doublon' or a list of
2376 possible corrections as returned by 'ispell-parse-output'.
2377
2378 This function is meant to be added to 'flyspell-incorrect-hook'."
2379   (when (consp poss)
2380     (catch 'done
2381       (save-excursion
2382         (goto-char (1+ beg))
2383         (while (< (point) end)
2384           (transpose-chars 1)
2385           (when (member (buffer-substring beg end) (car (cdr (cdr poss))))
2386             (throw 'done t))
2387           (transpose-chars -1)
2388           (forward-char))
2389         nil))))
2390
2391 (defun flyspell-maybe-correct-doubling (beg end poss)
2392   "Check replacements for doubled characters.
2393
2394 If the text between BEG and END is equal to a correction suggested by
2395 Ispell, after removing a pair of doubled characters, correct the text,
2396 and return t.
2397
2398 The third arg POSS is either the symbol 'doublon' or a list of
2399 possible corrections as returned by 'ispell-parse-output'.
2400
2401 This function is meant to be added to 'flyspell-incorrect-hook'."
2402   (when (consp poss)
2403     (catch 'done
2404       (save-excursion
2405         (let ((last (char-after beg))
2406               this)
2407           (goto-char (1+ beg))
2408           (while (< (point) end)
2409             (setq this (char-after))
2410             (if (not (char-equal this last))
2411                 (forward-char)
2412               (delete-char 1)
2413               (when (member (buffer-substring beg (1- end)) (car (cdr (cdr poss))))
2414                 (throw 'done t))
2415               ;; undo
2416               (insert-char this 1))
2417             (setq last this))
2418           nil)))))
2419
2420 ;*---------------------------------------------------------------------*/
2421 ;*    flyspell-already-abbrevp ...                                     */
2422 ;*---------------------------------------------------------------------*/
2423 (defun flyspell-already-abbrevp (table word)
2424   (let ((sym (abbrev-symbol word table)))
2425     (and sym (symbolp sym))))
2426
2427 ;*---------------------------------------------------------------------*/
2428 ;*    flyspell-change-abbrev ...                                       */
2429 ;*---------------------------------------------------------------------*/
2430 (defun flyspell-change-abbrev (table old new)
2431   (set (abbrev-symbol old table) new))
2432
2433 ;*---------------------------------------------------------------------*/
2434 ;*    flyspell-auto-correct-previous-word advice ...                   */
2435 ;*---------------------------------------------------------------------*/
2436 (defadvice flyspell-auto-correct-previous-word
2437   (around easymacs-flyspell-auto-correct)
2438   "Correct current word if misspelled, else previous
2439     misspelling.  Protect against accidentally changing a word
2440     that cannot be seen, because it is somewhere off the screen."
2441   (let ((top) (bot))
2442     (save-excursion
2443       (move-to-window-line 0)
2444       (setq top (point))
2445       (move-to-window-line -1)
2446       (setq bot (point)))
2447     (save-restriction
2448       (narrow-to-region top bot)
2449       (save-excursion
2450         (re-search-forward "\\s \\|\\'" nil t)
2451         (overlay-recenter (point))
2452         ad-do-it))))
2453
2454 (ad-activate 'flyspell-auto-correct-previous-word)
2455
2456 (provide 'flyspell)
2457 ;;; flyspell.el ends here
2458 ;;; </pre>