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