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

   1 ;;; flyspell.el --- On-the-fly spell checker
   2
   3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   4
   5 ;; Author: Manuel Serrano <Manuel.Serrano@unice.fr>
   6 ;; Keywords: convenience
   7
   8 ;;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; commentary:
  26 ;;
  27 ;; Flyspell is a minor Emacs mode performing on-the-fly spelling
  28 ;; checking.
  29 ;;
  30 ;; To enter the flyspell minor mode, Meta-x flyspell-mode.
  31 ;;
  32 ;; Note: consider setting the variable ispell-parser to 'tex to
  33 ;; avoid TeX command checking (use `(setq ispell-parser 'tex)')
  34 ;; _before_ entering flyspell.
  35 ;;
  36 ;; Some user variables control the behavior of flyspell.  They are
  37 ;; those defined under the `User variables' comment.
  38 ;;
  39 ;; Note: as suggested by Yaron M. Minsky, if you use flyspell when
  40 ;; sending mails, you should add the following:
  41 ;;    (add-hook 'mail-send-hook 'flyspell-mode-off)
  42
  43 ;;; Code:
  44 (require 'font-lock)
  45 (require 'ispell)
  46
  47 (defgroup flyspell nil
  48   "Spellchecking on the fly."
  49   :tag "FlySpell"
  50   :prefix "flyspell-"
  51   :group 'processes)
  52
  53 ;*---------------------------------------------------------------------*/
  54 ;*    User variables ...                                               */
  55 ;*---------------------------------------------------------------------*/
  56 (defcustom flyspell-highlight-flag t
  57   "*Non-nil means use highlight, nil means use mini-buffer messages."
  58   :group 'flyspell
  59   :type 'boolean)
  60
  61 (defcustom flyspell-doublon-as-error-flag t
  62   "*Non-nil means consider doublon as misspelling."
  63   :group 'flyspell
  64   :type 'boolean)
  65
  66 (defcustom flyspell-sort-corrections t
  67   "*Non-nil means, sort the corrections alphabetically before popping them."
  68   :group 'flyspell
  69   :type 'boolean)
  70
  71 (defcustom flyspell-incorrect-color "OrangeRed"
  72   "*The color used for highlighting incorrect words."
  73   :group 'flyspell
  74   :type 'string)
  75
  76 (defcustom flyspell-duplicate-color "Gold3"
  77   "*The color used for highlighting incorrect words but appearing at least twice."
  78   :group 'flyspell
  79   :type 'string)
  80
  81 (defcustom flyspell-underline-p t
  82   "*Non-nil means, incorrect words are underlined."
  83   :group 'flyspell
  84   :type 'boolean)
  85
  86 (defcustom flyspell-auto-correct-binding
  87   "\M-\t"
  88   "*Non-nil means that its value (a binding) will bound to the flyspell
  89 auto-correct."
  90   :group 'flyspell
  91   :type '(choice (const nil) string))
  92
  93 (defcustom flyspell-command-hook t
  94   "*Non-nil means that `post-command-hook' is used to check
  95 already typed words."
  96   :group 'flyspell
  97   :type 'boolean)
  98
  99 (defcustom flyspell-duplicate-distance -1
 100   "*The distance from duplication.
 101 -1 means no limit.
 102 0 means no window."
 103   :group 'flyspell
 104   :type 'number)
 105
 106 (defcustom flyspell-delay 3
 107   "*The number of second before checking words on post-command-hook if
 108 the current command is a delay command."
 109   :group 'flyspell
 110   :type 'number)
 111
 112 (defcustom flyspell-persistent-highlight t
 113   "*T means that hilighted words are not removed until the word are corrected."
 114   :group 'flyspell
 115   :type 'boolean)
 116
 117 (defcustom flyspell-highlight-properties t
 118   "*T means highlight incorrect words even if a property exists for this word."
 119   :group 'flyspell
 120   :type 'boolean)
 121
 122 (defcustom flyspell-default-delayed-commands
 123   '(self-insert-command
 124     delete-backward-char
 125     delete-char)
 126   "The list of always delayed command (that is flyspell is not activated
 127 after any of these commands."
 128   :group 'flyspell
 129   :type '(repeat (symbol)))
 130
 131 (defcustom flyspell-delayed-commands
 132   nil
 133   "*If non nil, this variable must hold a list a symbol. Each symbol is
 134 the name of an delayed command (that is a command that does not activate
 135 flyspell checking."
 136   :group 'flyspell
 137   :type '(repeat (symbol)))
 138
 139 (defcustom flyspell-issue-welcome-flag t
 140   "*Non-nil means that flyspell issues a welcome message when started."
 141   :group 'flyspell
 142   :type 'boolean)
 143
 144 (defcustom flyspell-consider-dash-as-word-delimiter-flag nil
 145   "*Non-nil means that the `-' char is considered as a word delimiter."
 146   :group 'flyspell
 147   :type 'boolean)
 148
 149 (defcustom flyspell-incorrect-hook nil
 150   "*Non-nil means a list of hooks to be executed when incorrect
 151 words are encountered. Each hook is a function of two arguments that are
 152 location of the beginning and the end of the incorrect region."
 153   :group 'flyspell)
 154
 155 (defcustom flyspell-multi-language-p t
 156   "*Non-nil means that flyspell could be use with several buffers checking
 157 several languages. Non-nil means that a new ispell process will be spawned
 158 per buffer. If nil, only one unique ispell process will be running."
 159   :group 'flyspell
 160   :type 'boolean)
 161
 162 ;*---------------------------------------------------------------------*/
 163 ;*    Mode specific options                                            */
 164 ;*    -------------------------------------------------------------    */
 165 ;*    Mode specific options enable users to disable flyspell on        */
 166 ;*    certain word depending of the emacs mode. For instance, when     */
 167 ;*    using flyspell with mail-mode add the following expression       */
 168 ;*    in your .emacs file:                                             */
 169 ;*       (add-hook 'mail-mode                                          */
 170 ;*           '(lambda () (setq flyspell-generic-check-word-p           */
 171 ;*                             'mail-mode-flyspell-verify)))           */
 172 ;*---------------------------------------------------------------------*/
 173 (defvar flyspell-generic-check-word-p nil
 174   "Function providing per-mode customization over which words are flyspelled.
 175 Returns t to continue checking, nil otherwise.")
 176 (make-variable-buffer-local 'flyspell-generic-check-word-p)
 177
 178 (defun mail-mode-flyspell-verify ()
 179   "Return t if we want flyspell to check the word under point."
 180   (save-excursion
 181     (or (progn
 182           (beginning-of-line)
 183           (looking-at "Subject:"))
 184         (not (or (re-search-forward mail-header-separator nil t)
 185                  (re-search-backward message-signature-separator nil t)
 186                  (progn
 187                    (beginning-of-line)
 188                    (looking-at "[>}|]")))))))
 189
 190 (defun texinfo-mode-flyspell-verify ()
 191   "Return t if we want flyspell to check the word under point."
 192   (save-excursion
 193     (forward-word -1)
 194     (not (looking-at "@"))))
 195
 196 ;*---------------------------------------------------------------------*/
 197 ;*    Overlay compatibility                                            */
 198 ;*---------------------------------------------------------------------*/
 199 (autoload 'make-overlay        "overlay" "" t)
 200 (autoload 'move-overlay        "overlay" "" t)
 201 (autoload 'overlayp            "overlay" "" t)
 202 (autoload 'overlay-properties  "overlay" "" t)
 203 (autoload 'overlays-in         "overlay" "" t)
 204 (autoload 'delete-overlay      "overlay" "" t)
 205 (autoload 'overlays-at         "overlay" "" t)
 206 (autoload 'overlay-put         "overlay" "" t)
 207 (autoload 'overlay-get         "overlay" "" t)
 208
 209 (defun flyspell-font-lock-make-face (l)
 210   "Because emacs and xemacs does not behave the same I uses my owe
 211 font-lock-make-face function. This function is similar to the gnu-emacs
 212 font-lock-make-face function."
 213   (let ((fname (car l))
 214         (color (car (cdr l)))
 215         (italic (car (cdr (cdr l))))
 216         (bold (car (cdr (cdr (cdr l)))))
 217         (underline (car (cdr (cdr (cdr (cdr l)))))))
 218     (let ((face (copy-face 'default fname)))
 219       (if color
 220           (set-face-foreground face color))
 221       (if (and italic bold)
 222           (condition-case nil
 223               (make-face-bold-italic face)
 224             (error nil))
 225         (progn
 226           (if italic
 227               (condition-case nil
 228                   (make-face-italic face)
 229                 (error nil)))
 230           (if bold
 231               (condition-case nil
 232                   (make-face-bold face)
 233                 (error nil)))))
 234       (if underline
 235           (condition-case nil
 236               (set-face-underline-p face t)
 237             (error nil)))
 238       (if (not (x-display-color-p))
 239           (condition-case nil
 240               (make-face-bold face)
 241             (error nil)))
 242       face)))
 243
 244 ;*---------------------------------------------------------------------*/
 245 ;*    Which emacs are we currently running                             */
 246 ;*---------------------------------------------------------------------*/
 247 (defvar flyspell-emacs
 248   (cond
 249    ((string-match "XEmacs" emacs-version)
 250     'xemacs)
 251    (t
 252     'emacs))
 253   "The Emacs we are currently running.")
 254
 255 ;*---------------------------------------------------------------------*/
 256 ;*    cl compatibility                                                 */
 257 ;*---------------------------------------------------------------------*/
 258 (defmacro push (x place)
 259   "(push X PLACE): insert X at the head of the list stored in PLACE.
 260 Analogous to (setf PLACE (cons X PLACE)), though more careful about
 261 evaluating each argument only once and in the right order.  PLACE has
 262 to be a symbol."
 263   (list 'setq place (list 'cons x place)))
 264
 265 ;*---------------------------------------------------------------------*/
 266 ;*    The minor mode declaration.                                      */
 267 ;*---------------------------------------------------------------------*/
 268 (defvar flyspell-mode nil)
 269 (make-variable-buffer-local 'flyspell-mode)
 270
 271 (defvar flyspell-mode-map (make-sparse-keymap))
 272 (defvar flyspell-mouse-map (make-sparse-keymap))
 273
 274 (or (assoc 'flyspell-mode minor-mode-alist)
 275     (push '(flyspell-mode " Fly") minor-mode-alist))
 276
 277 (or (assoc 'flyspell-mode minor-mode-map-alist)
 278     (push (cons 'flyspell-mode flyspell-mode-map) minor-mode-map-alist))
 279
 280 (if flyspell-auto-correct-binding
 281     (define-key flyspell-mode-map flyspell-auto-correct-binding
 282       (function flyspell-auto-correct-word)))
 283 ;; mouse bindings
 284 (cond
 285  ((eq flyspell-emacs 'xemacs)
 286   (define-key flyspell-mouse-map [(button2)]
 287     (function flyspell-correct-word/mouse-keymap)))
 288  (t
 289   (define-key flyspell-mode-map [(mouse-2)]
 290     (function flyspell-correct-word/local-keymap))))
 291
 292 ;; the name of the overlay property that defines the keymap
 293 (defvar flyspell-overlay-keymap-property-name
 294   (if (string-match "19.*XEmacs" emacs-version)
 295       'keymap
 296     'local-map))
 297
 298 ;*---------------------------------------------------------------------*/
 299 ;*    Highlighting                                                     */
 300 ;*---------------------------------------------------------------------*/
 301 (flyspell-font-lock-make-face (list 'flyspell-incorrect-face
 302                                     flyspell-incorrect-color
 303                                     nil
 304                                     t
 305                                     flyspell-underline-p))
 306 (flyspell-font-lock-make-face (list 'flyspell-duplicate-face
 307                                     flyspell-duplicate-color
 308                                     nil
 309                                     t
 310                                     flyspell-underline-p))
 311
 312 (defvar flyspell-overlay nil)
 313
 314 ;*---------------------------------------------------------------------*/
 315 ;*    flyspell-mode ...                                                */
 316 ;*---------------------------------------------------------------------*/
 317 ;;;###autoload
 318 (defun flyspell-mode (&optional arg)
 319   "Minor mode performing on-the-fly spelling checking.
 320 Ispell is automatically spawned on background for each entered words.
 321 The default flyspells behavior is to highlight incorrect words.
 322 With prefix ARG, turn Flyspell minor mode on iff ARG is positive.
 323
 324 Bindings:
 325 \\[ispell-word]: correct words (using Ispell).
 326 \\[flyspell-auto-correct-word]: automatically correct word.
 327 \\[flyspell-correct-word] (or mouse-2): popup correct words.
 328
 329 Hooks:
 330 flyspell-mode-hook is runner after flyspell is entered.
 331
 332 Remark:
 333 `flyspell-mode' uses `ispell-mode'.  Thus all Ispell options are
 334 valid.  For instance, a personal dictionary can be used by
 335 invoking `ispell-change-dictionary'.
 336
 337 Consider using the `ispell-parser' to check your text.  For instance
 338 consider adding:
 339 (add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
 340 in your .emacs file.
 341
 342 flyspell-region checks all words inside a region.
 343
 344 flyspell-buffer checks the whole buffer."
 345   (interactive "P")
 346   ;; we set the mode on or off
 347   (setq flyspell-mode (not (or (and (null arg) flyspell-mode)
 348                                (<= (prefix-numeric-value arg) 0))))
 349   (if flyspell-mode
 350       (flyspell-mode-on)
 351     (flyspell-mode-off))
 352   ;; we force the modeline re-printing
 353   (set-buffer-modified-p (buffer-modified-p)))
 354
 355 ;*---------------------------------------------------------------------*/
 356 ;*    flyspell-mode-on ...                                             */
 357 ;*---------------------------------------------------------------------*/
 358 (defun flyspell-mode-on ()
 359   "Turn flyspell mode on.  Do not use, use `flyspell-mode' instead."
 360   (message "flyspell on: %S" (current-buffer))
 361   (setq ispell-highlight-face 'flyspell-incorrect-face)
 362   ;; ispell initialization
 363   (if flyspell-multi-language-p
 364       (progn
 365         (make-variable-buffer-local 'ispell-dictionary)
 366         (make-variable-buffer-local 'ispell-process)
 367         (make-variable-buffer-local 'ispell-filter)
 368         (make-variable-buffer-local 'ispell-filter-continue)
 369         (make-variable-buffer-local 'ispell-process-directory)
 370         (make-variable-buffer-local 'ispell-parser)))
 371   ;; we initialize delayed commands symbol
 372   (flyspell-delay-commands)
 373   ;; we bound flyspell action to post-command hook
 374   (if flyspell-command-hook
 375       (progn
 376         (make-local-hook 'post-command-hook)
 377         (add-hook 'post-command-hook
 378                   (function flyspell-post-command-hook)
 379                   t
 380                   t)))
 381   ;; we bound flyspell action to pre-command hook
 382   (if flyspell-command-hook
 383       (progn
 384         (make-local-hook 'pre-command-hook)
 385         (add-hook 'pre-command-hook
 386                   (function flyspell-pre-command-hook)
 387                   t
 388                   t)))
 389   ;; the welcome message
 390   (if flyspell-issue-welcome-flag
 391       (message
 392        (if flyspell-auto-correct-binding
 393            (format "Welcome to flyspell. Use %S or mouse-2 to correct words."
 394                    (key-description flyspell-auto-correct-binding))
 395          "Welcome to flyspell. Use mouse-2 to correct words.")))
 396   ;; we have to kill the flyspell process when the buffer is deleted.
 397   ;; (thanks to Jeff Miller and Roland Rosenfeld who sent me this
 398   ;; improvement).
 399   (add-hook 'kill-buffer-hook
 400             '(lambda ()
 401                (if flyspell-mode
 402                    (flyspell-mode-off))))
 403   ;; we end with the flyspell hooks
 404   (run-hooks 'flyspell-mode-hook))
 405
 406 ;*---------------------------------------------------------------------*/
 407 ;*    flyspell-delay-commands ...                                      */
 408 ;*---------------------------------------------------------------------*/
 409 (defun flyspell-delay-commands ()
 410   "Install the delayed command."
 411   (mapcar 'flyspell-delay-command flyspell-default-delayed-commands)
 412   (mapcar 'flyspell-delay-command flyspell-delayed-commands))
 413
 414 ;*---------------------------------------------------------------------*/
 415 ;*    flyspell-delay-command ...                                       */
 416 ;*---------------------------------------------------------------------*/
 417 (defun flyspell-delay-command (command)
 418   "Set COMMAND to be delayed.
 419 When flyspell `post-command-hook' is invoked because a delayed command
 420 as been used the current word is not immediatly checked.
 421 It will be checked only after flyspell-delay second."
 422   (interactive "Scommand: ")
 423   (put command 'flyspell-delayed t))
 424
 425 ;*---------------------------------------------------------------------*/
 426 ;*    flyspell-ignore-commands ...                                     */
 427 ;*---------------------------------------------------------------------*/
 428 (defun flyspell-ignore-commands ()
 429   "This is an obsolete function, use flyspell-delays command instead."
 430   (flyspell-delay-commands))
 431
 432 ;*---------------------------------------------------------------------*/
 433 ;*    flyspell-ignore-command ...                                      */
 434 ;*---------------------------------------------------------------------*/
 435 (defun flyspell-ignore-command (command)
 436   "This is an obsolete function, use flyspell-delay command instead.
 437 COMMAND is the name of the command to be delayed."
 438   (flyspell-delay-command command))
 439
 440 (make-obsolete 'flyspell-ignore-commands 'flyspell-delay-commands)
 441 (make-obsolete 'flyspell-ignore-command 'flyspell-delay-command)
 442
 443 ;*---------------------------------------------------------------------*/
 444 ;*    flyspell-word-cache ...                                          */
 445 ;*---------------------------------------------------------------------*/
 446 (defvar flyspell-word-cache-start  nil)
 447 (defvar flyspell-word-cache-end    nil)
 448 (defvar flyspell-word-cache-word   nil)
 449 (make-variable-buffer-local 'flyspell-word-cache-start)
 450 (make-variable-buffer-local 'flyspell-word-cache-end)
 451 (make-variable-buffer-local 'flyspell-word-cache-word)
 452
 453 ;*---------------------------------------------------------------------*/
 454 ;*    The flyspell pre-hook, store the current position. In the        */
 455 ;*    post command hook, we will check, if the word at this position   */
 456 ;*    has to be spell checked.                                         */
 457 ;*---------------------------------------------------------------------*/
 458 (defvar flyspell-pre-buffer nil)
 459 (defvar flyspell-pre-point  nil)
 460
 461 ;*---------------------------------------------------------------------*/
 462 ;*    flyspell-pre-command-hook ...                                    */
 463 ;*---------------------------------------------------------------------*/
 464 (defun flyspell-pre-command-hook ()
 465   "This function is internally used by Flyspell to get a cursor location
 466 before a user command."
 467   (interactive)
 468   (setq flyspell-pre-buffer (current-buffer))
 469   (setq flyspell-pre-point  (point)))
 470
 471 ;*---------------------------------------------------------------------*/
 472 ;*    flyspell-mode-off ...                                            */
 473 ;*---------------------------------------------------------------------*/
 474 (defun flyspell-mode-off ()
 475   "Turn flyspell mode off.  Do not use.  Use `flyspell-mode' instead."
 476   ;; the bye-bye message
 477   (message "Quiting Flyspell...%S" (current-buffer))
 478   ;; we stop the running ispell
 479   (ispell-kill-ispell t)
 480   ;; we remove the hooks
 481   (if flyspell-command-hook
 482       (progn
 483         (remove-hook 'post-command-hook
 484                      (function flyspell-post-command-hook)
 485                      t)
 486         (remove-hook 'pre-command-hook
 487                      (function flyspell-pre-command-hook)
 488                      t)))
 489   ;; we remove all the flyspell hilightings
 490   (flyspell-delete-all-overlays)
 491   ;; we have to erase pre cache variables
 492   (setq flyspell-pre-buffer nil)
 493   (setq flyspell-pre-point  nil)
 494   ;; we mark the mode as killed
 495   (setq flyspell-mode nil))
 496
 497 ;*---------------------------------------------------------------------*/
 498 ;*    flyspell-check-word-p ...                                        */
 499 ;*---------------------------------------------------------------------*/
 500 (defun flyspell-check-word-p ()
 501   "This function returns t when the word at `point' has to be
 502 checked. The answer depends of several criteria. Mostly we
 503 check word delimiters."
 504   (cond
 505    ((<= (- (point-max) 1) (point-min))
 506     ;; the buffer is not filled enough
 507     nil)
 508    ((not (and (symbolp this-command) (get this-command 'flyspell-delayed)))
 509     ;; the current command is not delayed, that
 510     ;; is that we must check the word now
 511     t)
 512    ((and (> (point) (point-min))
 513          (save-excursion
 514            (backward-char 1)
 515            (and (looking-at (flyspell-get-not-casechars))
 516                 (or flyspell-consider-dash-as-word-delimiter-flag
 517                     (not (looking-at "\\-"))))))
 518     ;; yes because we have reached or typed a word delimiter
 519     t)
 520    ((not (integerp flyspell-delay))
 521     ;; yes because the user had settup a non delay configuration
 522     t)
 523    (t
 524     (if (fboundp 'about-xemacs)
 525         (sit-for flyspell-delay nil)
 526       (sit-for flyspell-delay 0 nil)))))
 527
 528 ;*---------------------------------------------------------------------*/
 529 ;*    flyspell-check-pre-word-p ...                                    */
 530 ;*---------------------------------------------------------------------*/
 531 (defun flyspell-check-pre-word-p ()
 532   "When to we have to check the word that was at point before
 533 the current command?"
 534   (cond
 535    ((or (not (numberp flyspell-pre-point))
 536         (not (bufferp flyspell-pre-buffer))
 537         (not (buffer-live-p flyspell-pre-buffer)))
 538     nil)
 539    ((or (= flyspell-pre-point (- (point) 1))
 540         (= flyspell-pre-point (point))
 541         (= flyspell-pre-point (+ (point) 1)))
 542     nil)
 543    ((not (eq (current-buffer) flyspell-pre-buffer))
 544     t)
 545    ((not (and (numberp flyspell-word-cache-start)
 546               (numberp flyspell-word-cache-end)))
 547     t)
 548    (t
 549     (or (< flyspell-pre-point flyspell-word-cache-start)
 550         (> flyspell-pre-point flyspell-word-cache-end)))))
 551
 552 ;*---------------------------------------------------------------------*/
 553 ;*    flyspell-post-command-hook ...                                   */
 554 ;*---------------------------------------------------------------------*/
 555 (defun flyspell-post-command-hook ()
 556   "The `post-command-hook' used by flyspell to check a word in-the-fly."
 557   (interactive)
 558   (if (flyspell-check-word-p)
 559       (flyspell-word))
 560   (if (flyspell-check-pre-word-p)
 561       (save-excursion
 562         (set-buffer flyspell-pre-buffer)
 563         (save-excursion
 564           (goto-char flyspell-pre-point)
 565           (flyspell-word)))))
 566
 567 ;*---------------------------------------------------------------------*/
 568 ;*    flyspell-word ...                                                */
 569 ;*---------------------------------------------------------------------*/
 570 (defun flyspell-word (&optional following)
 571   "Spell check a word."
 572   (interactive (list current-prefix-arg))
 573   (if (interactive-p)
 574       (setq following ispell-following-word))
 575   (save-excursion
 576     (ispell-accept-buffer-local-defs)   ; use the correct dictionary
 577     (let ((cursor-location (point))     ; retain cursor location
 578           (word (flyspell-get-word following))
 579           start end poss)
 580       (if (or (eq word nil)
 581               (and (fboundp flyspell-generic-check-word-p)
 582                    (not (funcall flyspell-generic-check-word-p))))
 583           t
 584         (progn
 585           ;; destructure return word info list.
 586           (setq start (car (cdr word))
 587                 end (car (cdr (cdr word)))
 588                 word (car word))
 589           ;; before checking in the directory, we check for doublons.
 590           (cond
 591            ((and flyspell-doublon-as-error-flag
 592                  (save-excursion
 593                    (goto-char start)
 594                    (word-search-backward word
 595                                          (- start
 596                                             (+ 1 (- end start)))
 597                                          t)))
 598             ;; yes, this is a doublon
 599             (flyspell-highlight-incorrect-region start end))
 600            ((and (eq flyspell-word-cache-start start)
 601                  (eq flyspell-word-cache-end end)
 602                  (string-equal flyspell-word-cache-word word))
 603             ;; this word had been already checked, we skip
 604             nil)
 605            ((and (eq ispell-parser 'tex)
 606                  (flyspell-tex-command-p word))
 607             ;; this is a correct word (because a tex command)
 608             (flyspell-unhighlight-at start)
 609             (if (> end start)
 610                 (flyspell-unhighlight-at (- end 1)))
 611             t)
 612            (t
 613             ;; we setup the cache
 614             (setq flyspell-word-cache-start start)
 615             (setq flyspell-word-cache-end end)
 616             (setq flyspell-word-cache-word word)
 617             ;; now check spelling of word.
 618             (process-send-string ispell-process "%\n")
 619             ;; put in verbose mode
 620             (process-send-string ispell-process
 621                                  (concat "^" word "\n"))
 622             ;; wait until ispell has processed word
 623             (while (progn
 624                      (accept-process-output ispell-process)
 625                      (not (string= "" (car ispell-filter)))))
 626             ;; (process-send-string ispell-process "!\n")
 627             ;; back to terse mode.
 628             (setq ispell-filter (cdr ispell-filter))
 629             (if (listp ispell-filter)
 630                 (setq poss (ispell-parse-output (car ispell-filter))))
 631             (cond ((eq poss t)
 632                    ;; correct
 633                    (flyspell-unhighlight-at start)
 634                    (if (> end start)
 635                        (flyspell-unhighlight-at (- end 1)))
 636                    t)
 637                   ((and (stringp poss) flyspell-highlight-flag)
 638                    ;; correct
 639                    (flyspell-unhighlight-at start)
 640                    (if (> end start)
 641                        (flyspell-unhighlight-at (- end 1)))
 642                    t)
 643                   ((null poss)
 644                    (flyspell-unhighlight-at start)
 645                    (if (> end start)
 646                        (flyspell-unhighlight-at (- end 1)))
 647                    (message "Error in ispell process"))
 648                   ((or (and (< flyspell-duplicate-distance 0)
 649                             (or (save-excursion
 650                                   (goto-char start)
 651                                   (word-search-backward word
 652                                                         (point-min)
 653                                                         t))
 654                                 (save-excursion
 655                                   (goto-char end)
 656                                   (word-search-forward word
 657                                                        (point-max)
 658                                                        t))))
 659                        (and (> flyspell-duplicate-distance 0)
 660                             (or (save-excursion
 661                                   (goto-char start)
 662                                   (word-search-backward
 663                                    word
 664                                    (- start
 665                                       flyspell-duplicate-distance)
 666                                    t))
 667                                 (save-excursion
 668                                   (goto-char end)
 669                                   (word-search-forward
 670                                    word
 671                                    (+ end
 672                                       flyspell-duplicate-distance)
 673                                    t)))))
 674                    (if flyspell-highlight-flag
 675                        (flyspell-highlight-duplicate-region start end)
 676                      (message (format "misspelling duplicate `%s'"
 677                                       word))))
 678                   (t
 679                    ;; incorrect highlight the location
 680                    (if flyspell-highlight-flag
 681                        (flyspell-highlight-incorrect-region start end)
 682                      (message (format "mispelling `%s'" word)))))
 683             (goto-char cursor-location) ; return to original location
 684             (if ispell-quit (setq ispell-quit nil)))))))))
 685
 686 ;*---------------------------------------------------------------------*/
 687 ;*    flyspell-tex-command-p ...                                       */
 688 ;*---------------------------------------------------------------------*/
 689 (defun flyspell-tex-command-p (word)
 690   "Is a word a TeX command?"
 691   (eq (aref word 0) ?\\))
 692
 693 ;*---------------------------------------------------------------------*/
 694 ;*    flyspell-casechars-cache ...                                     */
 695 ;*---------------------------------------------------------------------*/
 696 (defvar flyspell-casechars-cache nil)
 697 (defvar flyspell-ispell-casechars-cache nil)
 698 (make-variable-buffer-local 'flyspell-casechars-cache)
 699 (make-variable-buffer-local 'flyspell-ispell-casechars-cache)
 700
 701 ;*---------------------------------------------------------------------*/
 702 ;*    flyspell-get-casechars ...                                       */
 703 ;*---------------------------------------------------------------------*/
 704 (defun flyspell-get-casechars ()
 705   "This function builds a string that is the regexp of word chars.
 706 In order
 707 to avoid one useless string construction, this function changes the last
 708 char of the ispell-casechars string."
 709   (let ((ispell-casechars (ispell-get-casechars)))
 710     (cond
 711      ((eq ispell-casechars flyspell-ispell-casechars-cache)
 712       flyspell-casechars-cache)
 713      ((not (eq ispell-parser 'tex))
 714       (setq flyspell-ispell-casechars-cache ispell-casechars)
 715       (setq flyspell-casechars-cache
 716             (concat (substring ispell-casechars
 717                                0
 718                                (- (length ispell-casechars) 1))
 719                     "{}]"))
 720       flyspell-casechars-cache)
 721      (t
 722       (setq flyspell-ispell-casechars-cache ispell-casechars)
 723       (setq flyspell-casechars-cache ispell-casechars)
 724       flyspell-casechars-cache))))
 725
 726 ;*---------------------------------------------------------------------*/
 727 ;*    flyspell-get-not-casechars-cache ...                             */
 728 ;*---------------------------------------------------------------------*/
 729 (defvar flyspell-not-casechars-cache nil)
 730 (defvar flyspell-ispell-not-casechars-cache nil)
 731 (make-variable-buffer-local 'flyspell-not-casechars-cache)
 732 (make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
 733
 734 ;*---------------------------------------------------------------------*/
 735 ;*    flyspell-get-not-casechars ...                                   */
 736 ;*---------------------------------------------------------------------*/
 737 (defun flyspell-get-not-casechars ()
 738   "This function builds a string that is the regexp of non-word chars."
 739   (let ((ispell-not-casechars (ispell-get-not-casechars)))
 740     (cond
 741      ((eq ispell-not-casechars flyspell-ispell-not-casechars-cache)
 742       flyspell-not-casechars-cache)
 743      ((not (eq ispell-parser 'tex))
 744       (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
 745       (setq flyspell-not-casechars-cache
 746             (concat (substring ispell-not-casechars
 747                                0
 748                                (- (length ispell-not-casechars) 1))
 749                     "{}]"))
 750       flyspell-not-casechars-cache)
 751      (t
 752       (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
 753       (setq flyspell-not-casechars-cache ispell-not-casechars)
 754       flyspell-not-casechars-cache))))
 755
 756 ;*---------------------------------------------------------------------*/
 757 ;*    flyspell-get-word ...                                            */
 758 ;*---------------------------------------------------------------------*/
 759 (defun flyspell-get-word (following)
 760   "Return the word for spell-checking according to Ispell syntax.
 761 If optional argument FOLLOWING is non-nil or if `ispell-following-word'
 762 is non-nil when called interactively, then the following word
 763 \(rather than preceding\) is checked when the cursor is not over a word.
 764 Optional second argument contains otherchars that can be included in word
 765 many times.
 766
 767 Word syntax described by `ispell-dictionary-alist' (which see)."
 768   (let* ((flyspell-casechars (flyspell-get-casechars))
 769          (flyspell-not-casechars (flyspell-get-not-casechars))
 770          (ispell-otherchars (ispell-get-otherchars))
 771          (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
 772          (word-regexp (concat flyspell-casechars
 773                               "+\\("
 774                               ispell-otherchars
 775                               "?"
 776                               flyspell-casechars
 777                               "+\\)"
 778                               (if ispell-many-otherchars-p
 779                                   "*" "?")))
 780          (tex-prelude "[\\\\{]")
 781          (tex-regexp  (if (eq ispell-parser 'tex)
 782                           (concat tex-prelude "?" word-regexp "}?")
 783                         word-regexp))
 784
 785          did-it-once
 786          start end word)
 787     ;; find the word
 788     (if (not (or (looking-at flyspell-casechars)
 789                  (and (eq ispell-parser 'tex)
 790                       (looking-at tex-prelude))))
 791         (if following
 792             (re-search-forward flyspell-casechars (point-max) t)
 793           (re-search-backward flyspell-casechars (point-min) t)))
 794     ;; move to front of word
 795     (re-search-backward flyspell-not-casechars (point-min) 'start)
 796     (let ((pos nil))
 797       (while (and (looking-at ispell-otherchars)
 798                   (not (bobp))
 799                   (or (not did-it-once)
 800                       ispell-many-otherchars-p)
 801                   (not (eq pos (point))))
 802         (setq pos (point))
 803         (setq did-it-once t)
 804         (backward-char 1)
 805         (if (looking-at flyspell-casechars)
 806             (re-search-backward flyspell-not-casechars (point-min) 'move)
 807           (backward-char -1))))
 808     ;; Now mark the word and save to string.
 809     (if (eq (re-search-forward tex-regexp (point-max) t) nil)
 810         nil
 811       (progn
 812         (setq start (match-beginning 0)
 813               end (point)
 814               word (buffer-substring start end))
 815         (list word start end)))))
 816
 817 ;*---------------------------------------------------------------------*/
 818 ;*    flyspell-region ...                                              */
 819 ;*---------------------------------------------------------------------*/
 820 (defun flyspell-region (beg end)
 821   "Flyspell text between BEG and END."
 822   (interactive "r")
 823   (save-excursion
 824     (goto-char beg)
 825     (let ((count 0))
 826       (while (< (point) end)
 827         (if (= count 100)
 828             (progn
 829               (message "Spell Checking...%d%%"
 830                        (* 100 (/ (float (point)) (- end beg))))
 831               (setq count 0))
 832           (setq count (+ 1 count)))
 833         (flyspell-word)
 834         (let ((cur (point)))
 835           (forward-word 1)
 836           (if (and (< (point) end) (> (point) (+ cur 1)))
 837               (backward-char 1)))))
 838     (backward-char 1)
 839     (message "Spell Checking...done")
 840     (flyspell-word)))
 841
 842 ;*---------------------------------------------------------------------*/
 843 ;*    flyspell-buffer ...                                              */
 844 ;*---------------------------------------------------------------------*/
 845 (defun flyspell-buffer ()
 846   "Flyspell whole buffer."
 847   (interactive)
 848   (flyspell-region (point-min) (point-max)))
 849
 850 ;*---------------------------------------------------------------------*/
 851 ;*    flyspell-overlay-p ...                                           */
 852 ;*---------------------------------------------------------------------*/
 853 (defun flyspell-overlay-p (o)
 854   "A predicate that return true iff O is an overlay used by flyspell."
 855   (and (overlayp o) (overlay-get o 'flyspell-overlay)))
 856
 857 ;*---------------------------------------------------------------------*/
 858 ;*    flyspell-delete-all-overlays ...                                 */
 859 ;*    -------------------------------------------------------------    */
 860 ;*    Remove all the overlays introduced by flyspell.                  */
 861 ;*---------------------------------------------------------------------*/
 862 (defun flyspell-delete-all-overlays ()
 863   "Delete all the overlays used by flyspell."
 864   (let ((l (overlays-in (point-min) (point-max))))
 865     (while (consp l)
 866       (progn
 867         (if (flyspell-overlay-p (car l))
 868             (delete-overlay (car l)))
 869         (setq l (cdr l))))))
 870
 871 ;*---------------------------------------------------------------------*/
 872 ;*    flyspell-unhighlight-at ...                                      */
 873 ;*---------------------------------------------------------------------*/
 874 (defun flyspell-unhighlight-at (pos)
 875   "Remove the flyspell overlay that are located at POS."
 876   (if flyspell-persistent-highlight
 877       (let ((overlays (overlays-at pos)))
 878         (while (consp overlays)
 879           (if (flyspell-overlay-p (car overlays))
 880               (delete-overlay (car overlays)))
 881           (setq overlays (cdr overlays))))
 882     (delete-overlay flyspell-overlay)))
 883
 884 ;*---------------------------------------------------------------------*/
 885 ;*    flyspell-properties-at-p ...                                     */
 886 ;*    -------------------------------------------------------------    */
 887 ;*    Is there an highlight properties at position pos?                */
 888 ;*---------------------------------------------------------------------*/
 889 (defun flyspell-properties-at-p (beg)
 890   "Return the text property at position BEG."
 891   (let ((prop (text-properties-at beg))
 892         (keep t))
 893     (while (and keep (consp prop))
 894       (if (and (eq (car prop) 'local-map) (consp (cdr prop)))
 895           (setq prop (cdr (cdr prop)))
 896         (setq keep nil)))
 897     (consp prop)))
 898
 899 ;*---------------------------------------------------------------------*/
 900 ;*    make-flyspell-overlay ...                                        */
 901 ;*---------------------------------------------------------------------*/
 902 (defun make-flyspell-overlay (beg end face mouse-face)
 903   "Allocate a new flyspell overlay that will be used to hilight
 904 an incorrect word."
 905   (let ((flyspell-overlay (make-overlay beg end)))
 906     (overlay-put flyspell-overlay 'face face)
 907     (overlay-put flyspell-overlay 'mouse-face mouse-face)
 908     (overlay-put flyspell-overlay 'flyspell-overlay t)
 909     (if (eq flyspell-emacs 'xemacs)
 910         (overlay-put flyspell-overlay
 911                      flyspell-overlay-keymap-property-name
 912                      flyspell-mouse-map))))
 913
 914 ;*---------------------------------------------------------------------*/
 915 ;*    flyspell-highlight-incorrect-region ...                          */
 916 ;*---------------------------------------------------------------------*/
 917 (defun flyspell-highlight-incorrect-region (beg end)
 918   "The setup of an overlay on a region (starting at BEG and ending at END)
 919 that corresponds to an incorrect word."
 920   (run-hook-with-args 'flyspell-incorrect-hook beg end)
 921   (if (or (not (flyspell-properties-at-p beg)) flyspell-highlight-properties)
 922       (progn
 923         ;; we cleanup current overlay at the same position
 924         (if (and (not flyspell-persistent-highlight)
 925                  (overlayp flyspell-overlay))
 926             (delete-overlay flyspell-overlay)
 927           (let ((overlays (overlays-at beg)))
 928             (while (consp overlays)
 929               (if (flyspell-overlay-p (car overlays))
 930                   (delete-overlay (car overlays)))
 931               (setq overlays (cdr overlays)))))
 932         ;; now we can use a new overlay
 933         (setq flyspell-overlay
 934               (make-flyspell-overlay beg end
 935                                      'flyspell-incorrect-face 'highlight)))))
 936
 937 ;*---------------------------------------------------------------------*/
 938 ;*    flyspell-highlight-duplicate-region ...                          */
 939 ;*---------------------------------------------------------------------*/
 940 (defun flyspell-highlight-duplicate-region (beg end)
 941   "The setup of an overlay on a region (starting at BEG and ending at END)
 942 that corresponds to an duplicated word."
 943   (if (or (not (flyspell-properties-at-p beg)) flyspell-highlight-properties)
 944       (progn
 945         ;; we cleanup current overlay at the same position
 946         (if (and (not flyspell-persistent-highlight)
 947                  (overlayp flyspell-overlay))
 948             (delete-overlay flyspell-overlay)
 949           (let ((overlays (overlays-at beg)))
 950             (while (consp overlays)
 951               (if (flyspell-overlay-p (car overlays))
 952                   (delete-overlay (car overlays)))
 953               (setq overlays (cdr overlays)))))
 954         ;; now we can use a new overlay
 955         (setq flyspell-overlay
 956               (make-flyspell-overlay beg end
 957                                      'flyspell-duplicate-face 'highlight)))))
 958
 959 ;*---------------------------------------------------------------------*/
 960 ;*    flyspell-auto-correct-cache ...                                  */
 961 ;*---------------------------------------------------------------------*/
 962 (defvar flyspell-auto-correct-pos nil)
 963 (defvar flyspell-auto-correct-region nil)
 964 (defvar flyspell-auto-correct-ring nil)
 965
 966 ;*---------------------------------------------------------------------*/
 967 ;*    flyspell-auto-correct-word ...                                   */
 968 ;*---------------------------------------------------------------------*/
 969 (defun flyspell-auto-correct-word (pos)
 970   "Auto correct the word at position POS."
 971   (interactive "d")
 972   ;; use the correct dictionary
 973   (ispell-accept-buffer-local-defs)
 974   (if (eq flyspell-auto-correct-pos pos)
 975       ;; we have already been using the function at the same location
 976       (progn
 977         (save-excursion
 978           (let ((start (car flyspell-auto-correct-region))
 979                 (len   (cdr flyspell-auto-correct-region)))
 980             (delete-region start (+ start len))
 981             (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring))
 982             (let* ((word (car flyspell-auto-correct-ring))
 983                    (len  (length word)))
 984               (rplacd flyspell-auto-correct-region len)
 985               (goto-char start)
 986               (insert word))))
 987         (setq flyspell-auto-correct-pos (point)))
 988     ;; retain cursor location
 989     (let ((cursor-location pos)
 990           (word (flyspell-get-word nil))
 991           start end poss)
 992       ;; destructure return word info list.
 993       (setq start (car (cdr word))
 994             end (car (cdr (cdr word)))
 995             word (car word))
 996       ;; now check spelling of word.
 997       (process-send-string ispell-process "%\n") ;put in verbose mode
 998       (process-send-string ispell-process (concat "^" word "\n"))
 999       ;; wait until ispell has processed word
1000       (while (progn
1001                (accept-process-output ispell-process)
1002                (not (string= "" (car ispell-filter)))))
1003       (setq ispell-filter (cdr ispell-filter))
1004       (if (listp ispell-filter)
1005           (setq poss (ispell-parse-output (car ispell-filter))))
1006       (cond ((or (eq poss t) (stringp poss))
1007              ;; don't correct word
1008              t)
1009             ((null poss)
1010              ;; ispell error
1011              (error "Ispell: error in Ispell process"))
1012             (t
1013              ;; the word is incorrect, we have to propose a replacement
1014              (let ((replacements (if flyspell-sort-corrections
1015                                      (sort (car (cdr (cdr poss))) 'string<)
1016                                    (car (cdr (cdr poss))))))
1017                (if (consp replacements)
1018                    (progn
1019                      (let ((replace (car replacements)))
1020                        (setq word replace)
1021                        (setq cursor-location (+ (- (length word) (- end start))
1022                                                 cursor-location))
1023                        (if (not (equal word (car poss)))
1024                            (progn
1025                              ;; the save the current replacements
1026                              (setq flyspell-auto-correct-pos cursor-location)
1027                              (setq flyspell-auto-correct-region
1028                                    (cons start (length word)))
1029                              (let ((l replacements))
1030                                (while (consp (cdr l))
1031                                  (setq l (cdr l)))
1032                                (rplacd l (cons (car poss) replacements)))
1033                              (setq flyspell-auto-correct-ring
1034                                    (cdr replacements))
1035                              (delete-region start end)
1036                              (insert word)))))))))
1037       ;; return to original location
1038       (goto-char cursor-location)
1039       (ispell-pdict-save t))))
1040
1041 ;*---------------------------------------------------------------------*/
1042 ;*    flyspell-correct-word ...                                        */
1043 ;*---------------------------------------------------------------------*/
1044 (defun flyspell-correct-word (event)
1045   "Check spelling of word under or before the cursor.
1046 If the word is not found in dictionary, display possible corrections
1047 in a popup menu allowing you to choose one.
1048
1049 Word syntax described by `ispell-dictionary-alist' (which see).
1050
1051 This will check or reload the dictionary.  Use \\[ispell-change-dictionary]
1052 or \\[ispell-region] to update the Ispell process."
1053   (interactive "e")
1054   (if (eq flyspell-emacs 'xemacs)
1055       (flyspell-correct-word/mouse-keymap event)
1056       (flyspell-correct-word/local-keymap event)))
1057
1058 ;*---------------------------------------------------------------------*/
1059 ;*    flyspell-correct-word/local-keymap ...                           */
1060 ;*---------------------------------------------------------------------*/
1061 (defun flyspell-correct-word/local-keymap (event)
1062   "emacs 19.xx seems to be buggous. Overlay keymap does not seems
1063 to work correctly with local map. That is, if a key is not
1064 defined for the overlay keymap, the current local map, is not
1065 checked. The binding is resolved with the global map. The
1066 consequence is that we can not use overlay map with flyspell."
1067   (interactive "e")
1068   (save-window-excursion
1069     (let ((save (point)))
1070       (mouse-set-point event)
1071       ;; we look for a flyspell overlay here
1072       (let ((overlays (overlays-at (point)))
1073             (overlay  nil))
1074         (while (consp overlays)
1075           (if (flyspell-overlay-p (car overlays))
1076               (progn
1077                 (setq overlay (car overlays))
1078                 (setq overlays nil))
1079             (setq overlays (cdr overlays))))
1080         ;; we return to the correct location
1081         (goto-char save)
1082         ;; we check to see if button2 has been used overlay a
1083         ;; flyspell overlay
1084         (if overlay
1085             ;; yes, so we use the flyspell function
1086             (flyspell-correct-word/mouse-keymap event)
1087           ;; no so we have to use the non flyspell binding
1088           (let ((flyspell-mode nil))
1089             (if (key-binding (this-command-keys))
1090                 (command-execute (key-binding (this-command-keys))))))))))
1091
1092 ;*---------------------------------------------------------------------*/
1093 ;*    flyspell-correct-word ...                                        */
1094 ;*---------------------------------------------------------------------*/
1095 (defun flyspell-correct-word/mouse-keymap (event)
1096   "Popup a menu to present possible correction. The word checked is the
1097 word at the mouse position."
1098   (interactive "e")
1099   ;; use the correct dictionary
1100   (ispell-accept-buffer-local-defs)
1101   ;; retain cursor location (I don't know why but save-excursion here fails).
1102   (let ((save (point)))
1103     (mouse-set-point event)
1104     (let ((cursor-location (point))
1105           (word (flyspell-get-word nil))
1106           start end poss replace)
1107       ;; destructure return word info list.
1108       (setq start (car (cdr word))
1109             end (car (cdr (cdr word)))
1110             word (car word))
1111       ;; now check spelling of word.
1112       (process-send-string ispell-process "%\n") ;put in verbose mode
1113       (process-send-string ispell-process (concat "^" word "\n"))
1114       ;; wait until ispell has processed word
1115       (while (progn
1116                (accept-process-output ispell-process)
1117                (not (string= "" (car ispell-filter)))))
1118       (setq ispell-filter (cdr ispell-filter))
1119       (if (listp ispell-filter)
1120           (setq poss (ispell-parse-output (car ispell-filter))))
1121       (cond ((or (eq poss t) (stringp poss))
1122              ;; don't correct word
1123              t)
1124             ((null poss)
1125              ;; ispell error
1126              (error "Ispell: error in Ispell process"))
1127             ((string-match "GNU" (emacs-version))
1128              ;; the word is incorrect, we have to propose a replacement
1129              (setq replace (flyspell-gnuemacs-popup event poss word))
1130              (cond ((eq replace 'ignore)
1131                     nil)
1132                    ((eq replace 'save)
1133                     (process-send-string ispell-process (concat "*" word "\n"))
1134                     (flyspell-unhighlight-at cursor-location)
1135                     (setq ispell-pdict-modified-p '(t)))
1136                    ((or (eq replace 'buffer) (eq replace 'session))
1137                     (process-send-string ispell-process (concat "@" word "\n"))
1138                     (if (null ispell-pdict-modified-p)
1139                         (setq ispell-pdict-modified-p
1140                               (list ispell-pdict-modified-p)))
1141                     (flyspell-unhighlight-at cursor-location)
1142                     (if (eq replace 'buffer)
1143                         (ispell-add-per-file-word-list word)))
1144                    (replace
1145                     (setq word (if (atom replace) replace (car replace))
1146                           cursor-location (+ (- (length word) (- end start))
1147                                              cursor-location))
1148                     (if (not (equal word (car poss)))
1149                         (progn
1150                           (delete-region start end)
1151                           (insert word))))))
1152             ((string-match "XEmacs" (emacs-version))
1153              (flyspell-xemacs-popup
1154               event poss word cursor-location start end)))
1155       (ispell-pdict-save t))
1156     (if (< save (point-max))
1157         (goto-char save)
1158       (goto-char (point-max)))))
1159
1160 ;*---------------------------------------------------------------------*/
1161 ;*    flyspell-xemacs-correct ...                                      */
1162 ;*---------------------------------------------------------------------*/
1163 (defun flyspell-xemacs-correct (replace poss word cursor-location start end)
1164   "The xemacs popup menu callback."
1165   (cond ((eq replace 'ignore)
1166          nil)
1167         ((eq replace 'save)
1168          (process-send-string ispell-process (concat "*" word "\n"))
1169          (flyspell-unhighlight-at cursor-location)
1170          (setq ispell-pdict-modified-p '(t)))
1171         ((or (eq replace 'buffer) (eq replace 'session))
1172          (process-send-string ispell-process (concat "@" word "\n"))
1173          (flyspell-unhighlight-at cursor-location)
1174          (if (null ispell-pdict-modified-p)
1175              (setq ispell-pdict-modified-p
1176                    (list ispell-pdict-modified-p)))
1177          (if (eq replace 'buffer)
1178              (ispell-add-per-file-word-list word)))
1179         (replace
1180          (setq word (if (atom replace) replace (car replace))
1181                cursor-location (+ (- (length word) (- end start))
1182                                   cursor-location))
1183          (if (not (equal word (car poss)))
1184              (save-excursion
1185                (delete-region start end)
1186                (goto-char start)
1187                (insert word))))))
1188
1189 ;*---------------------------------------------------------------------*/
1190 ;*    flyspell-gnuemacs-popup                                          */
1191 ;*---------------------------------------------------------------------*/
1192 (defun flyspell-gnuemacs-popup (event poss word)
1193   "The gnu-emacs popup menu."
1194   (if (not event)
1195       (let* ((mouse-pos  (mouse-position))
1196              (mouse-pos  (if (nth 1 mouse-pos)
1197                              mouse-pos
1198                            (set-mouse-position (car mouse-pos)
1199                                                (/ (frame-width) 2) 2)
1200                            (unfocus-frame)
1201                            (mouse-position))))
1202         (setq event (list (list (car (cdr mouse-pos))
1203                                 (1+ (cdr (cdr mouse-pos))))
1204                           (car mouse-pos)))))
1205   (let* ((corrects   (if flyspell-sort-corrections
1206                          (sort (car (cdr (cdr poss))) 'string<)
1207                        (car (cdr (cdr poss)))))
1208          (cor-menu   (if (consp corrects)
1209                          (mapcar (lambda (correct)
1210                                    (list correct correct))
1211                                  corrects)
1212                        '()))
1213          (affix      (car (cdr (cdr (cdr poss)))))
1214          (base-menu  (let ((save (if (consp affix)
1215                                      (list
1216                                       (list (concat "Save affix: " (car affix))
1217                                             'save)
1218                                       '("Accept (session)" accept)
1219                                       '("Accept (buffer)" buffer))
1220                                    '(("Save word" save)
1221                                      ("Accept (session)" session)
1222                                      ("Accept (buffer)" buffer)))))
1223                        (if (consp cor-menu)
1224                            (append cor-menu (cons "" save))
1225                          save)))
1226          (menu       (cons "flyspell correction menu" base-menu)))
1227     (car (x-popup-menu event
1228                        (list (format "%s [%s]" word (or ispell-local-dictionary
1229                                                         ispell-dictionary))
1230                              menu)))))
1231
1232 ;*---------------------------------------------------------------------*/
1233 ;*    flyspell-xemacs-popup                                            */
1234 ;*---------------------------------------------------------------------*/
1235 (defun flyspell-xemacs-popup (event poss word cursor-location start end)
1236   "The xemacs popup menu."
1237   (let* ((corrects   (if flyspell-sort-corrections
1238                          (sort (car (cdr (cdr poss))) 'string<)
1239                        (car (cdr (cdr poss)))))
1240          (cor-menu   (if (consp corrects)
1241                          (mapcar (lambda (correct)
1242                                    (vector correct
1243                                            (list 'flyspell-xemacs-correct
1244                                                  correct
1245                                                  (list 'quote poss)
1246                                                  word
1247                                                  cursor-location
1248                                                  start
1249                                                  end)
1250                                            t))
1251                                  corrects)
1252                        '()))
1253          (affix      (car (cdr (cdr (cdr poss)))))
1254          (menu       (let ((save (if (consp affix)
1255                                      (vector
1256                                       (concat "Save affix: " (car affix))
1257                                       (list 'flyspell-xemacs-correct
1258                                             ''save
1259                                             (list 'quote poss)
1260                                             word
1261                                             cursor-location
1262                                             start
1263                                             end)
1264                                       t)
1265                                    (vector
1266                                     "Save word"
1267                                     (list 'flyspell-xemacs-correct
1268                                           ''save
1269                                           (list 'quote poss)
1270                                           word
1271                                           cursor-location
1272                                           start
1273                                           end)
1274                                     t)))
1275                            (session (vector "Accept (session)"
1276                                             (list 'flyspell-xemacs-correct
1277                                                   ''session
1278                                                   (list 'quote poss)
1279                                                   word
1280                                                   cursor-location
1281                                                   start
1282                                                   end)
1283                                             t))
1284                            (buffer  (vector "Accept (buffer)"
1285                                             (list 'flyspell-xemacs-correct
1286                                                   ''buffer
1287                                                   (list 'quote poss)
1288                                                   word
1289                                                   cursor-location
1290                                                   start
1291                                                   end)
1292                                             t)))
1293                        (if (consp cor-menu)
1294                            (append cor-menu (list "-" save session buffer))
1295                          (list save session buffer)))))
1296     (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary
1297                                                  ispell-dictionary))
1298                       menu))))
1299
1300 (provide 'flyspell)
1301
1302 ;;; flyspell.el ends here