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

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