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