code.delx.au - gnu-emacs/blob - lisp/textmodes/flyspell.el

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