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