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