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

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