cgit.sxemacs.org Git - packages/blob - xemacs-packages/ispell/ispell.el

   1 ;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
   2
   3 ;; Copyright (C) 1994-1995, 1997-2014 Free Software Foundation, Inc.
   4
   5 ;; Author:           Ken Stevens <k.stevens@ieee.org>
   6 ;; Maintainer:       Ken Stevens <k.stevens@ieee.org>
   7 ;; Stevens Mod Date: Mon Jan  7 12:32:44 PST 2003
   8 ;; Stevens Revision: 3.6
   9 ;; Status          : Release with 3.1.12+ and 3.2.0+ ispell.
  10 ;; Bug Reports     : ispell-el-bugs@itcorp.com
  11 ;; Web Site        : http://kdstevens.com/~stevens/ispell-page.html
  12 ;; Keywords: unix wp
  13
  14 ;; This file is part of GNU Emacs.
  15
  16 ;; GNU Emacs is free software: you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation, either version 3 of the License, or
  19 ;; (at your option) any later version.
  20
  21 ;; GNU Emacs is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  28
  29 ;; Note: version numbers and time stamp are not updated
  30 ;;   when this file is edited for release with GNU Emacs.
  31
  32 ;;; Commentary:
  33
  34 ;; INSTRUCTIONS
  35
  36 ;;   This code contains a section of user-settable variables that you
  37 ;; should inspect prior to installation.  Look past the end of the history
  38 ;; list.  Set them up for your locale and the preferences of the majority
  39 ;; of the users.  Otherwise the users may need to set a number of variables
  40 ;; themselves.
  41 ;;   You particularly may want to change the default dictionary for your
  42 ;; country and language.
  43 ;;   Most dictionary changes should be made in this file so all users can
  44 ;; enjoy them.  Local or modified dictionaries are supported in your .emacs
  45 ;; file.  Use the variable `ispell-local-dictionary-alist' to specify
  46 ;; your own dictionaries.
  47
  48 ;;  Depending on the mail system you use, you may want to include these:
  49 ;;  (add-hook 'news-inews-hook 'ispell-message)
  50 ;;  (add-hook 'mail-send-hook  'ispell-message)
  51 ;;  (add-hook 'mh-before-send-letter-hook 'ispell-message)
  52
  53 ;;   Ispell has a TeX parser and a nroff parser (the default).
  54 ;; The parsing is controlled by the variable ispell-parser.  Currently
  55 ;; it is just a "toggle" between TeX and nroff, but if more parsers are
  56 ;; added it will be updated.  See the variable description for more info.
  57
  58
  59 ;; TABLE OF CONTENTS
  60
  61 ;;   ispell-word
  62 ;;   ispell-region
  63 ;;   ispell-buffer
  64 ;;   ispell-message
  65 ;;   ispell-comments-and-strings
  66 ;;   ispell-continue
  67 ;;   ispell-complete-word
  68 ;;   ispell-complete-word-interior-frag
  69 ;;   ispell-change-dictionary
  70 ;;   ispell-kill-ispell
  71 ;;   ispell-pdict-save
  72 ;;   ispell-skip-region-alist
  73
  74 ;; Commands in ispell-region:
  75 ;; Character replacement: Replace word with choice.  May query-replace.
  76 ;; ` ': Accept word this time.
  77 ;; `i': Accept word and insert into private dictionary.
  78 ;; `a': Accept word for this session.
  79 ;; `A': Accept word and place in buffer-local dictionary.
  80 ;; `r': Replace word with typed-in value.  Rechecked.
  81 ;; `R': Replace word with typed-in value. Query-replaced in buffer. Rechecked.
  82 ;; `?': Show these commands
  83 ;; `x': Exit spelling buffer.  Move cursor to original point.
  84 ;; `X': Exit spelling buffer.  Leaves cursor at the current point, and permits
  85 ;;      the check to be completed later.
  86 ;; `q': Quit spelling session (Kills ispell process).
  87 ;; `l': Look up typed-in replacement in alternate dictionary.  Wildcards okay.
  88 ;; `u': Like `i', but the word is lower-cased first.
  89 ;; `m': Place entered value in personal dictionary, then recheck current word.
  90 ;; `C-l': redraws screen
  91 ;; `C-r': recursive edit
  92 ;; `C-z': suspend Emacs or iconify frame
  93
  94 ;; Buffer-Local features:
  95 ;; There are a number of buffer-local features that can be used to customize
  96 ;;  ispell for the current buffer.  This includes language dictionaries,
  97 ;;  personal dictionaries, parsing, and local word spellings.  Each of these
  98 ;;  local customizations are done either through local variables, or by
  99 ;;  including the keyword and argument(s) at the end of the buffer (usually
 100 ;;  prefixed by the comment characters).  See the end of this file for
 101 ;;  examples.  The local keywords and variables are:
 102
 103 ;;  ispell-dictionary-keyword   language-dictionary
 104 ;;      uses local variable ispell-local-dictionary
 105 ;;  ispell-pdict-keyword        personal-dictionary
 106 ;;      uses local variable ispell-local-pdict
 107 ;;  ispell-parsing-keyword      mode-arg extended-char-arg
 108 ;;  ispell-words-keyword        any number of local word spellings
 109
 110 ;; Region skipping:
 111 ;;  Place new regular expression definitions of regions you prefer not to
 112 ;;  spell check in `ispell-skip-region-alist'.  Mode-dependent features can
 113 ;;  be added to latex by modifying `ispell-tex-skip-alists'.
 114 ;;  `ispell-message' contains some custom skipping code for e-mail messages.
 115
 116 ;; BUGS:
 117 ;;  Need a way to select between different character mappings without separate
 118 ;;    dictionary entries.
 119 ;;  Multi-byte characters if not defined by current dictionary may result in the
 120 ;;    evil "misalignment error" in some versions of MULE Emacs.
 121 ;;  On some versions of Emacs, growing the minibuffer fails.
 122 ;;    see `ispell-help-in-bufferp'.
 123 ;;  Recursive edits (?C-r or ?R) inside a keyboard text replacement check (?r)
 124 ;;    can cause misalignment errors.
 125
 126 ;; HISTORY
 127
 128 ;; Modifications made in latest versions:
 129
 130 ;; Revision 3.6 2003/01/07 12:32:44     kss
 131 ;; Removed extra -d LIB in dictionary defs. (Pavel Janik)
 132 ;; Filtered process calls with duplicate dictionary entries.
 133 ;; Fixed bug where message-text-end is inside a mime skipped region.
 134 ;; Minor fixes to get ispell menus right in XEmacs
 135 ;; Fixed skip regexp so it doesn't match stuff like `/.\w'.
 136 ;; Detecting dictionary change not working.  Fixed.  kss
 137 ;; function `ispell-change-dictionary' now only completes valid dicts.
 138
 139 ;; Revision 3.5 2001/7/11 18:43:57      kss
 140 ;; Added fix for aspell to work in XEmacs (ispell-check-version).
 141 ;; Added Portuguese dictionary definition.
 142 ;; New feature: MIME mail message support, Fcc support.
 143 ;; Bug fix: retain comment syntax on lines with region skipping. (TeX $ bug...)
 144 ;; Improved allocation for graphic mode lines.  (Miles Bader)
 145 ;; Support -v flag for old versions of aspell.  (Eli Zaretskii)
 146 ;; Clear minibuffer on ^G from ispell-help (Tak Ota)
 147
 148 ;; Revision 3.4 2000/8/4 09:41:50       kss
 149 ;; Support new color display functions.
 150 ;; Fixed misalignment offset bug when replacing a string after a shift made.
 151 ;; Set to standard Author/Maintainer heading,
 152 ;; ensure localwords lists are separated from the text by newline. (Dave Love)
 153 ;; Added dictionary definition for Italian (William Deakin)
 154 ;; HTML region skipping greatly improved. (Chuck D. Phillips)
 155 ;; improved menus.  Fixed regexp matching http/email addresses.
 156 ;; one arg always for XEmacs sleep-for (gunnar Evermann)
 157 ;; support for synchronous processes (Eli Zaretskii)
 158
 159 ;; Revision 3.3  1999/11/29 11:38:34     kss
 160 ;; Only word replacements entered in from the keyboard are rechecked.
 161 ;; This fixes a bug in tex parsing and misalignment.
 162 ;; Exceptions exist for recursive edit and query-replace, with tex error
 163 ;; condition tested.  Recursive editing improved.
 164 ;; XEmacs repair for when `enable-multibyte-characters' defined - Didier Verna.
 165 ;; ispell-help fixed for XEmacs.  Choices minibuffer now displayed in XEmacs.
 166 ;; Only list valid dictionaries in Spell menu.  Russian dictionary doesn't allow
 167 ;; run-together words, and uses koi8-r font.  Don't skip text in html <TT>
 168 ;; fonts.
 169
 170 ;; Revision 3.2  1999/5/7 14:25:14      kss
 171 ;; Accept ispell versions 3.X.Y where X>=1
 172 ;; fine tuned latex region skipping.  Fixed bug in ispell-word that did not
 173 ;; point in right place on words < 2 chars.  Simplified ispell-minor-mode.
 174 ;; Fixed bug in TeX parsing when math commands are in the comments.
 175 ;; Removed calls to `when' macro.
 176
 177 ;; Revision 3.1  1998/12/1 13:21:52     kss
 178 ;; Improved and fixed customize support.
 179 ;; Improved and fixed comments in variables and messages.
 180 ;; A coding system is now required for all languages.
 181 ;; casechars improved for castellano, castellano8, and norsk dictionaries.
 182 ;; Dictionary norsk7-tex removed.  Dictionary polish added.
 183 ;; Dictionaries redefined at load-time to support dictionary changes.
 184 ;; Menu redefined at load time to support dictionary changes.
 185 ;; ispell-check-version added as an alias for `check-ispell-version'.
 186 ;; Spelling suggestions returned in order generated by ispell.
 187 ;; Small bug fixed in matching ispell error messages.
 188 ;; Robustness added to ensure `case-fold-search' doesn't get redefined.
 189 ;; Fixed bug that didn't respect case of word in `ispell-complete-word'.
 190 ;; Multibyte character coding support added for process interactions.
 191 ;; Ensure ispell process has terminated before starting new process.
 192 ;;  This can otherwise confuse process filters and hang ispell.
 193 ;; Improved skipping support for SGML.
 194 ;; Fixed bug using ^M rather than \r in `ispell-minor-check'.
 195 ;; Improved message reference matching in `ispell-message'.
 196 ;; Fixed bug in returning to nroff mode from tex mode.
 197
 198 ;;; Compatibility code for XEmacs and (not too) older emacsen:
 199
 200 (eval-and-compile ;; Protect against declare-function undefined in XEmacs
 201   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 202
 203 (declare-function ispell-check-minver "ispell" (v1 v2))
 204 (declare-function ispell-looking-back "ispell"
 205                   (regexp &optional limit &rest ignored))
 206
 207 (if (fboundp 'version<=)
 208     (defalias 'ispell-check-minver 'version<=)
 209   (defun ispell-check-minver (minver version)
 210     "Check if string VERSION is at least string MINVER.
 211 Both must be in [0-9]+.[0-9]+... format.  This is a fallback
 212 compatibility function in case `version<=' is not available."
 213     (let ((pending t)
 214           (return t)
 215           start-ver start-mver)
 216       ;; Loop until an absolute greater or smaller condition is reached
 217       ;; or until no elements are left in any of version and minver. In
 218       ;; this case version is exactly the minimal, so return OK.
 219       (while pending
 220         (let (ver mver)
 221           (if (string-match "[0-9]+" version start-ver)
 222               (setq start-ver (match-end 0)
 223                     ver (string-to-number (match-string 0 version))))
 224           (if (string-match "[0-9]+" minver start-mver)
 225               (setq start-mver (match-end 0)
 226                     mver (string-to-number (match-string 0 minver))))
 227
 228           (if (or ver mver)
 229               (progn
 230                 (or ver  (setq ver 0))
 231                 (or mver (setq mver 0))
 232                 ;; If none of below conditions match, this element is the
 233                 ;; same. Go checking next element.
 234                 (if (> ver mver)
 235                     (setq pending nil)
 236                   (if (< ver mver)
 237                       (setq pending nil
 238                             return nil))))
 239             (setq pending nil))))
 240       return)))
 241
 242 ;; XEmacs does not have looking-back
 243 (if (fboundp 'looking-back)
 244     (defalias 'ispell-looking-back 'looking-back)
 245   (defun ispell-looking-back (regexp &optional limit &rest ignored)
 246     "Return non-nil if text before point matches regular expression REGEXP.
 247 Like `looking-at' except matches before point, and is slower.
 248 LIMIT if non-nil speeds up the search by specifying a minimum
 249 starting position, to avoid checking matches that would start
 250 before LIMIT.
 251
 252 This is a stripped down compatibility function for use when
 253 full featured `looking-back' function is missing."
 254     (save-excursion
 255       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 256
 257 (eval-when-compile
 258  (if (featurep 'xemacs)
 259      (progn
 260        (define-compiler-macro purecopy (object) object)
 261        (define-compiler-macro ispell-int-char (integer)
 262          (list 'int-char integer))
 263        (define-compiler-macro ispell-find-coding-system (object)
 264          (list 'find-coding-system object))
 265        (define-compiler-macro ispell-list* (&whole form &rest args)
 266          (cons 'list* (cdr form)))
 267        (defvar transient-mark-mode))
 268    ;; GNU:
 269    (require 'cl)
 270    (define-compiler-macro ispell-int-char (integer) integer)
 271    (define-compiler-macro ispell-find-coding-system (object) object)
 272    (define-compiler-macro ispell-list* (arg &rest others)
 273      (let* ((args (reverse (cons arg others)))
 274             (form (car args)))
 275        (while (setq args (cdr args))
 276          (setq form (list 'cons (car args) form)))
 277        form))))
 278
 279 (eval-and-compile
 280   (when (not (fboundp 'use-region-p))
 281     (defalias 'use-region-p 'region-active-p)))
 282
 283 ;;; Code:
 284
 285 (defvar mail-yank-prefix)
 286
 287 (defgroup ispell nil
 288   "User variables for Emacs ispell interface."
 289   :group 'applications)
 290
 291 (if (not (fboundp 'buffer-substring-no-properties))
 292     (defun buffer-substring-no-properties (start end)
 293       (buffer-substring start end)))
 294
 295 (defalias 'check-ispell-version 'ispell-check-version)
 296
 297 ;;; **********************************************************************
 298 ;;; The following variables should be set according to personal preference
 299 ;;; and location of binaries:
 300 ;;; **********************************************************************
 301
 302
 303 ;;;  ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.1+
 304
 305 (defcustom ispell-highlight-p 'block
 306   "Highlight spelling errors when non-nil.
 307 When set to `block', assumes a block cursor with TTY displays."
 308   :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t))
 309   :group 'ispell)
 310
 311 (defcustom ispell-lazy-highlight (boundp 'lazy-highlight-cleanup)
 312   "Controls the lazy-highlighting of spelling errors.
 313 When non-nil, all text in the buffer matching the current spelling
 314 error is highlighted lazily using isearch lazy highlighting (see
 315 `lazy-highlight-initial-delay' and `lazy-highlight-interval')."
 316   :type 'boolean
 317   :group 'lazy-highlight
 318   :group 'ispell
 319   :version "22.1")
 320
 321 (defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight)
 322   "The face used for Ispell highlighting.  For Emacsen with overlays.
 323 Possible values are `highlight', `modeline', `secondary-selection',
 324 `region', and `underline'.
 325 This variable can be set by the user to whatever face they desire.
 326 It's most convenient if the cursor color and highlight color are
 327 slightly different."
 328   :type 'face
 329   :group 'ispell)
 330
 331 (defcustom ispell-check-comments t
 332   "Spelling of comments checked when non-nil.
 333 When set to `exclusive', ONLY comments are checked.  (For code comments).
 334 Warning!  Not checking comments, when a comment start is embedded in strings,
 335 may produce undesired results."
 336   :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t))
 337   :group 'ispell)
 338 ;;;###autoload
 339 (put 'ispell-check-comments 'safe-local-variable
 340      (lambda (a) (memq a '(nil t exclusive))))
 341
 342 (defcustom ispell-query-replace-choices nil
 343   "Corrections made throughout region when non-nil.
 344 Uses `query-replace' (\\[query-replace]) for corrections."
 345   :type 'boolean
 346   :group 'ispell)
 347
 348 (defcustom ispell-skip-tib nil
 349   "Does not spell check `tib' bibliography references when non-nil.
 350 Skips any text between strings matching regular expressions
 351 `ispell-tib-ref-beginning' and `ispell-tib-ref-end'.
 352
 353 TeX users beware:  Any text between [. and .] will be skipped -- even if
 354 that's your whole buffer -- unless you set `ispell-skip-tib' to nil.
 355 That includes the [.5mm] type of number..."
 356   :type 'boolean
 357   :group 'ispell)
 358
 359 (defvar ispell-tib-ref-beginning "[[<]\\."
 360   "Regexp matching the beginning of a Tib reference.")
 361
 362 (defvar ispell-tib-ref-end "\\.[]>]"
 363   "Regexp matching the end of a Tib reference.")
 364
 365 (defcustom ispell-keep-choices-win t
 366   "If non-nil, keep the `*Choices*' window for the entire spelling session.
 367 This minimizes redisplay thrashing."
 368   :type 'boolean
 369   :group 'ispell)
 370
 371 (defcustom ispell-choices-win-default-height 2
 372   "The default size of the `*Choices*' window, including the mode line.
 373 Must be greater than 1."
 374   :type 'integer
 375   :group 'ispell)
 376
 377 (defvar ispell-binary-suffixes
 378   ;; XEmacs change: added cygwin32
 379   (if (memq system-type '(ms-dos windows-nt cygwin32))
 380       ;; .btm is for 4DOS and friends, <URL:http://www.jpsoft.com/>
 381       '(".exe" ".com" ".bat" ".cmd" ".btm" "")
 382     '("")))
 383
 384 (defcustom ispell-program-name
 385   (or (locate-file "aspell"   exec-path ispell-binary-suffixes 'executable)
 386       (locate-file "ispell"   exec-path ispell-binary-suffixes 'executable)
 387       (locate-file "hunspell" exec-path ispell-binary-suffixes 'executable)
 388       "ispell")
 389   "Program invoked by \\[ispell-word] and \\[ispell-region] commands."
 390   :type 'string
 391   :set (lambda (symbol value)
 392          (set-default symbol value)
 393          (if (featurep 'ispell)
 394              (ispell-set-spellchecker-params)))
 395   :group 'ispell)
 396
 397 (defcustom ispell-alternate-dictionary
 398   (cond ((file-readable-p "/usr/dict/web2") "/usr/dict/web2")
 399         ((file-readable-p "/usr/share/dict/web2") "/usr/share/dict/web2")
 400         ((file-readable-p "/usr/dict/words") "/usr/dict/words")
 401         ((file-readable-p "/usr/lib/dict/words") "/usr/lib/dict/words")
 402         ((file-readable-p "/usr/share/dict/words") "/usr/share/dict/words")
 403         ((file-readable-p "/usr/share/lib/dict/words")
 404          "/usr/share/lib/dict/words")
 405         ((file-readable-p "/sys/dict") "/sys/dict"))
 406   "Alternate plain word-list dictionary for spelling help."
 407   :type '(choice file (const :tag "None" nil))
 408   :group 'ispell)
 409
 410 (defcustom ispell-complete-word-dict nil
 411   "Plain word-list dictionary used for word completion if
 412 different from `ispell-alternate-dictionary'."
 413   :type '(choice file (const :tag "None" nil))
 414   :group 'ispell)
 415
 416 (defcustom ispell-message-dictionary-alist nil
 417   "List used by `ispell-message' to select a new dictionary.
 418 It consists of pairs (REGEXP . DICTIONARY).  If REGEXP is found
 419 in the message headers, `ispell-local-dictionary' will be set to
 420 DICTIONARY if `ispell-local-dictionary' is not buffer-local.
 421 E.g. you may use the following value:
 422   '((\"^Newsgroups:[ \\t]*de\\\\.\" . \"deutsch8\")
 423     (\"^To:[^\\n,]+\\\\.de[ \\t\\n,>]\" . \"deutsch8\"))"
 424   :type '(repeat (cons regexp string))
 425   :group 'ispell)
 426
 427
 428 (defcustom ispell-message-fcc-skip 50000
 429   "Query before saving Fcc message copy if attachment larger than this value.
 430 Always stores Fcc copy of message when nil."
 431   :type '(choice integer (const :tag "off" nil))
 432   :group 'ispell)
 433
 434
 435 (defcustom ispell-grep-command
 436   ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they
 437   ;; cannot invoke it.  Use "grep -E" instead (see ispell-grep-options
 438   ;; below).
 439   (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep")
 440   "Name of the grep command for search processes."
 441   :type 'string
 442   :group 'ispell)
 443
 444 (defcustom ispell-grep-options
 445   (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i")
 446   "String of options to use when running the program in `ispell-grep-command'.
 447 Should probably be \"-i\" or \"-e\".
 448 Some machines (like the NeXT) don't support \"-i\"."
 449   :type 'string
 450   :group 'ispell)
 451
 452 (defcustom ispell-look-command
 453   (cond ((file-exists-p "/bin/look") "/bin/look")
 454         ((file-exists-p "/usr/local/bin/look") "/usr/local/bin/look")
 455         ((file-exists-p "/usr/bin/look") "/usr/bin/look")
 456         (t "look"))
 457   "Name of the look command for search processes.
 458 This must be an absolute file name."
 459   :type 'file
 460   :group 'ispell)
 461
 462 (defcustom ispell-look-p (file-exists-p ispell-look-command)
 463   "Non-nil means use `look' rather than `grep'.
 464 Default is based on whether `look' seems to be available."
 465   :type 'boolean
 466   :group 'ispell)
 467
 468 (defcustom ispell-have-new-look nil
 469   "Non-nil means use the `-r' option (regexp) when running `look'."
 470   :type 'boolean
 471   :group 'ispell)
 472
 473 (defcustom ispell-look-options (if ispell-have-new-look "-dfr" "-df")
 474   "String of command options for `ispell-look-command'."
 475   :type 'string
 476   :group 'ispell)
 477
 478 (defcustom ispell-use-ptys-p nil
 479   "When non-nil, Emacs uses ptys to communicate with Ispell.
 480 When nil, Emacs uses pipes."
 481   :type 'boolean
 482   :group 'ispell)
 483
 484 (defcustom ispell-following-word nil
 485   "Non-nil means `ispell-word' checks the word around or after point.
 486 Otherwise `ispell-word' checks the preceding word."
 487   :type 'boolean
 488   :group 'ispell)
 489
 490 (defcustom ispell-help-in-bufferp nil
 491   "Non-nil means display interactive keymap help in a buffer.
 492 The following values are supported:
 493   nil        Expand the minibuffer and display a short help message
 494              there for a couple of seconds.
 495   t          Pop up a new buffer and display a short help message there
 496              for a couple of seconds.
 497   electric   Pop up a new buffer and display a long help message there.
 498              User can browse and then exit the help mode."
 499   :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t))
 500   :group 'ispell)
 501
 502 (defcustom ispell-quietly nil
 503   "Non-nil means suppress messages in `ispell-word'."
 504   :type 'boolean
 505   :group 'ispell)
 506
 507 (defcustom ispell-format-word-function (function upcase)
 508   "Formatting function for displaying word being spell checked.
 509 The function must take one string argument and return a string."
 510   :type 'function
 511   :group 'ispell)
 512 (defvaralias 'ispell-format-word 'ispell-format-word-function)
 513
 514 (defcustom ispell-use-framepop-p nil
 515   "When non-nil ispell uses framepop to display choices in a dedicated frame.
 516 You can set this variable to dynamically use framepop if you are in a
 517 window system by evaluating the following on startup to set this variable:
 518   (and window-system (condition-case () (require 'framepop) (error nil)))"
 519   :type 'boolean
 520   :group 'ispell)
 521
 522 ;;;###autoload
 523 (defcustom ispell-personal-dictionary nil
 524   "File name of your personal spelling dictionary, or nil.
 525 If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
 526 \"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
 527 default dictionary and LANG the two letter language code."
 528   :type '(choice file
 529                  (const :tag "default" nil))
 530   :group 'ispell)
 531
 532 (defcustom ispell-silently-savep nil
 533   "When non-nil, save personal dictionary without asking for confirmation."
 534   :type 'boolean
 535   :group 'ispell)
 536
 537 (defvar ispell-local-dictionary-overridden nil
 538   "Non-nil means the user has explicitly set this buffer's Ispell dictionary.")
 539 (make-variable-buffer-local 'ispell-local-dictionary-overridden)
 540
 541 (defcustom ispell-local-dictionary nil
 542   "If non-nil, the dictionary to be used for Ispell commands in this buffer.
 543 The value must be a string dictionary name,
 544 or nil, which means use the global setting in `ispell-dictionary'.
 545 Dictionary names are defined in `ispell-local-dictionary-alist'
 546 and `ispell-dictionary-alist'.
 547
 548 Setting `ispell-local-dictionary' to a value has the same effect as
 549 calling \\[ispell-change-dictionary] with that value.  This variable
 550 is automatically set when defined in the file with either
 551 `ispell-dictionary-keyword' or the Local Variable syntax."
 552   :type '(choice string
 553                  (const :tag "default" nil))
 554   :group 'ispell)
 555 ;;;###autoload
 556 (put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
 557
 558 (make-variable-buffer-local 'ispell-local-dictionary)
 559
 560 (defcustom ispell-dictionary nil
 561   "Default dictionary to use if `ispell-local-dictionary' is nil."
 562   :type '(choice string
 563                  (const :tag "default" nil))
 564   :group 'ispell)
 565
 566 (defcustom ispell-extra-args nil
 567   "If non-nil, a list of extra switches to pass to the Ispell program.
 568 For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
 569 words as correct.  See also `ispell-dictionary-alist', which may be used
 570 for language-specific arguments."
 571   :type '(repeat string)
 572   :group 'ispell)
 573
 574
 575
 576 (defcustom ispell-skip-html 'use-mode-name
 577   "Indicates whether ispell should skip spell checking of SGML markup.
 578 If t, always skip SGML markup; if nil, never skip; if non-t and non-nil,
 579 guess whether SGML markup should be skipped according to the name of the
 580 buffer's major mode."
 581   :type '(choice (const :tag "always" t) (const :tag "never" nil)
 582                  (const :tag "use-mode-name" use-mode-name))
 583   :group 'ispell)
 584
 585 (make-variable-buffer-local 'ispell-skip-html)
 586
 587
 588 (defcustom ispell-local-dictionary-alist nil
 589   "List of local or customized dictionary definitions.
 590 These can override the values in `ispell-dictionary-alist'.
 591
 592 To make permanent changes to your dictionary definitions, you
 593 will need to make your changes in this variable, save, and then
 594 re-start Emacs."
 595   :type '(repeat (list (choice :tag "Dictionary"
 596                                (string :tag "Dictionary name")
 597                                (const :tag "default" nil))
 598                        (regexp :tag "Case characters")
 599                        (regexp :tag "Non case characters")
 600                        (regexp :tag "Other characters")
 601                        (boolean :tag "Many other characters")
 602                        (repeat :tag "Ispell command line args"
 603                                (string :tag "Arg"))
 604                        (choice :tag "Extended character mode"
 605                                (const "~tex") (const "~plaintex")
 606                                (const "~nroff") (const "~list")
 607                                (const "~latin1") (const "~latin3")
 608                                (const :tag "default" nil))
 609                        (coding-system :tag "Coding System")))
 610   :group 'ispell)
 611
 612
 613 (defvar ispell-dictionary-base-alist
 614   '((nil                                ; default
 615      ;; The default dictionary.  It may be English.aff, or any other
 616      ;; dictionary depending on locale and such things.  We should probably
 617      ;; ask ispell what dictionary it's using, but until we do that, let's
 618      ;; just use a minimal regexp. [:alpha:] will later be set if possible.
 619      "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
 620     ("american"                         ; Yankee English
 621      "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
 622     ("brasileiro"                       ; Brazilian mode
 623      "[A-Z\301\311\315\323\332\300\310\314\322\331\303\325\307\334\302\312\324a-z\341\351\355\363\372\340\350\354\362\371\343\365\347\374\342\352\364]"
 624      "[^A-Z\301\311\315\323\332\300\310\314\322\331\303\325\307\334\302\312\324a-z\341\351\355\363\372\340\350\354\362\371\343\365\347\374\342\352\364]"
 625      "[']" nil nil nil iso-8859-1)
 626     ("british"                          ; British version
 627      "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
 628     ("castellano"                       ; Spanish mode
 629      "[A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]"
 630      "[^A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]"
 631      "[-]" nil ("-B") "~tex" iso-8859-1)
 632     ("castellano8"                      ; 8 bit Spanish mode
 633      "[A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]"
 634      "[^A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]"
 635      "[-]" nil ("-B" "-d" "castellano") "~latin1" iso-8859-1)
 636     ("czech"
 637      "[A-Za-z\301\311\314\315\323\332\331\335\256\251\310\330\317\253\322\341\351\354\355\363\372\371\375\276\271\350\370\357\273\362]"
 638      "[^A-Za-z\301\311\314\315\323\332\331\335\256\251\310\330\317\253\322\341\351\354\355\363\372\371\375\276\271\350\370\357\273\362]"
 639      "" nil ("-B") nil iso-8859-2)
 640     ("dansk"                            ; Dansk.aff
 641      "[A-Z\306\330\305a-z\346\370\345]" "[^A-Z\306\330\305a-z\346\370\345]"
 642      "[']" nil ("-C") nil iso-8859-1)
 643     ("deutsch"                          ; Deutsch.aff
 644      "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex" iso-8859-1)
 645     ("deutsch8"
 646      "[a-zA-Z\304\326\334\344\366\337\374]"
 647      "[^a-zA-Z\304\326\334\344\366\337\374]"
 648      "[']" t ("-C" "-d" "deutsch") "~latin1" iso-8859-1)
 649     ("english"                          ; make English explicitly selectable
 650      "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
 651     ("esperanto"
 652      "[A-Za-z\246\254\266\274\306\330\335\336\346\370\375\376]"
 653      "[^A-Za-z\246\254\266\274\306\330\335\336\346\370\375\376]"
 654      "[-']" t ("-C") "~latin3" iso-8859-3)
 655     ("esperanto-tex"
 656      "[A-Za-z^\\]" "[^A-Za-z^\\]"
 657      "[-'`\"]" t ("-C" "-d" "esperanto") "~tex" iso-8859-3)
 658     ("finnish"
 659      "[A-Za-z\345\344\366\305\304\326]"
 660      "[^A-Za-z\345\344\366\305\304\326]"
 661      "[:]" nil ("-C") "~list" iso-8859-1)
 662     ("francais7"
 663      "[A-Za-z]" "[^A-Za-z]" "[`'^-]" t nil nil iso-8859-1)
 664     ("francais"                         ; Francais.aff
 665      "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]"
 666      "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]"
 667      "[-'.@]" t nil "~list" iso-8859-1)
 668     ("francais-tex"                     ; Francais.aff
 669      "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]"
 670      "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]"
 671      "[-'^`\".@]" t nil "~tex" iso-8859-1)
 672     ("german"                           ; german.aff
 673      "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex" iso-8859-1)
 674     ("german8"                          ; german.aff
 675      "[a-zA-Z\304\326\334\344\366\337\374]"
 676      "[^a-zA-Z\304\326\334\344\366\337\374]"
 677      "[']" t ("-C" "-d" "german") "~latin1" iso-8859-1)
 678     ("italiano"                         ; Italian.aff
 679      "[A-Z\300\301\310\311\314\315\322\323\331\332a-z\340\341\350\351\354\355\363\371\372]"
 680      "[^A-Z\300\301\310\311\314\315\322\323\331\332a-z\340\341\350\351\354\355\363\371\372]"
 681      "[-.]" nil ("-B" "-d" "italian") "~tex" iso-8859-1)
 682     ("nederlands"                       ; Nederlands.aff
 683      "[A-Za-z\300\301\302\303\304\305\307\310\311\312\313\314\315\316\317\322\323\324\325\326\331\332\333\334\340\341\342\343\344\345\347\350\351\352\353\354\355\356\357\361\362\363\364\365\366\371\372\373\374]"
 684      "[^A-Za-z\300\301\302\303\304\305\307\310\311\312\313\314\315\316\317\322\323\324\325\326\331\332\333\334\340\341\342\343\344\345\347\350\351\352\353\354\355\356\357\361\362\363\364\365\366\371\372\373\374]"
 685      "[']" t ("-C") nil iso-8859-1)
 686     ("nederlands8"                      ; Dutch8.aff
 687      "[A-Za-z\300\301\302\303\304\305\307\310\311\312\313\314\315\316\317\322\323\324\325\326\331\332\333\334\340\341\342\343\344\345\347\350\351\352\353\354\355\356\357\361\362\363\364\365\366\371\372\373\374]"
 688      "[^A-Za-z\300\301\302\303\304\305\307\310\311\312\313\314\315\316\317\322\323\324\325\326\331\332\333\334\340\341\342\343\344\345\347\350\351\352\353\354\355\356\357\361\362\363\364\365\366\371\372\373\374]"
 689      "[']" t ("-C") nil iso-8859-1)
 690     ("norsk"                            ; 8 bit Norwegian mode
 691      "[A-Za-z\305\306\307\310\311\322\324\330\345\346\347\350\351\362\364\370]"
 692      "[^A-Za-z\305\306\307\310\311\322\324\330\345\346\347\350\351\362\364\370]"
 693      "[\"]" nil nil "~list" iso-8859-1)
 694     ("norsk7-tex"                       ; 7 bit Norwegian TeX mode
 695      "[A-Za-z{}\\'^`]" "[^A-Za-z{}\\'^`]"
 696      "[\"]" nil ("-d" "norsk") "~plaintex" iso-8859-1)
 697     ("polish"                           ; Polish mode
 698      "[A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]"
 699      "[^A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]"
 700      "[.]" nil nil nil iso-8859-2)
 701     ("portugues"                        ; Portuguese mode
 702      "[a-zA-Z\301\302\307\311\323\340\341\342\351\352\355\363\343\347\372]"
 703      "[^a-zA-Z\301\302\307\311\323\340\341\342\351\352\355\363\343\347\372]"
 704      "[']" t ("-C") "~latin1" iso-8859-1)
 705     ("russian"                          ; Russian.aff (KOI8-R charset)
 706      "[\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]"
 707      "[^\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]"
 708      "" nil nil nil koi8-r)
 709     ("russianw"                         ; russianw.aff (CP1251 charset)
 710      "[\300\301\302\303\304\305\250\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\334\333\332\335\336\337\340\341\342\343\344\345\270\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\374\373\372\375\376\377]"
 711      "[^\300\301\302\303\304\305\250\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\334\333\332\335\336\337\340\341\342\343\344\345\270\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\374\373\372\375\376\377]"
 712      "" nil nil nil windows-1251)
 713     ("slovak"                           ; Slovakian
 714      "[A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]"
 715      "[^A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]"
 716      "" nil ("-B") nil iso-8859-2)
 717     ("slovenian"                        ; Slovenian
 718      "[A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]"
 719      "[^A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]"
 720      "" nil ("-B" "-d" "slovenian") nil iso-8859-2)
 721     ("svenska"                          ; Swedish mode
 722      "[A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]"
 723      "[^A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]"
 724      "[']" nil ("-C") "~list" iso-8859-1)
 725     ("hebrew" "[\340\341\342\343\344\345\346\347\350\351\353\352\354\356\355\360\357\361\362\364\363\367\366\365\370\371\372]" "[^\340\341\342\343\344\345\346\347\350\351\353\352\354\356\355\360\357\361\362\364\363\367\366\365\370\371\372]" "" nil ("-B") nil cp1255))
 726   "Base value for `ispell-dictionary-alist'.")
 727
 728 (defvar ispell-dictionary-alist nil
 729   "An alist of dictionaries and their associated parameters.
 730
 731 Each element of this list is also a list:
 732
 733 \(DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P
 734         ISPELL-ARGS EXTENDED-CHARACTER-MODE CHARACTER-SET\)
 735
 736 DICTIONARY-NAME is a possible string value of variable `ispell-dictionary',
 737 nil means the default dictionary.
 738
 739 CASECHARS is a regular expression of valid characters that comprise a word.
 740
 741 NOT-CASECHARS is the opposite regexp of CASECHARS.
 742
 743 OTHERCHARS is a regexp of characters in the NOT-CASECHARS set but which can be
 744 used to construct words in some special way.  If OTHERCHARS characters follow
 745 and precede characters from CASECHARS, they are parsed as part of a word,
 746 otherwise they become word-breaks.  As an example in English, assume the
 747 regular expression \"[']\" for OTHERCHARS.  Then \"they're\" and
 748 \"Steven's\" are parsed as single words including the \"'\" character, but
 749 \"Stevens'\" does not include the quote character as part of the word.
 750 If you want OTHERCHARS to be empty, use the empty string.
 751 Hint: regexp syntax requires the hyphen to be declared first here.
 752
 753 CASECHARS, NOT-CASECHARS, and OTHERCHARS must be unibyte strings
 754 containing bytes of CHARACTER-SET.  In addition, if they contain
 755 non-ASCII bytes, the regular expression must be a single
 756 `character set' construct that doesn't specify a character range
 757 for non-ASCII bytes.
 758
 759 MANY-OTHERCHARS-P is non-nil when multiple OTHERCHARS are allowed in a word.
 760 Otherwise only a single OTHERCHARS character is allowed to be part of any
 761 single word.
 762
 763 ISPELL-ARGS is a list of additional arguments passed to the ispell
 764 subprocess.
 765
 766 EXTENDED-CHARACTER-MODE should be used when dictionaries are used which
 767 have been configured in an Ispell affix file.  (For example, umlauts
 768 can be encoded as \\\"a, a\\\", \"a, ...)  Defaults are ~tex and ~nroff
 769 in English.  This has the same effect as the command-line `-T' option.
 770 The buffer Major Mode controls Ispell's parsing in tex or nroff mode,
 771 but the dictionary can control the extended character mode.
 772 Both defaults can be overruled in a buffer-local fashion.  See
 773 `ispell-parsing-keyword' for details on this.
 774
 775 CHARACTER-SET used to encode text sent to the ispell subprocess
 776 when the language uses non-ASCII characters.
 777
 778 Note that with \"ispell\" as the speller, the CASECHARS and
 779 OTHERCHARS slots of the alist should contain the same character
 780 set as casechars and otherchars in the LANGUAGE.aff file \(e.g.,
 781 english.aff\).  aspell and hunspell don't have this limitation.")
 782
 783 (defvar ispell-really-aspell nil
 784   "Non-nil if we can use aspell extensions.")
 785 (defvar ispell-really-hunspell nil
 786   "Non-nil if we can use hunspell extensions.")
 787 (defvar ispell-encoding8-command nil
 788   "Command line option prefix to select encoding if supported, nil otherwise.
 789 If setting the encoding is supported by spellchecker and is selectable from
 790 the command line, this variable will contain \"--encoding=\" for aspell
 791 and \"-i \" for hunspell, so the appropriate mime charset can be selected.
 792 That will be set in `ispell-check-version' for hunspell >= 1.1.6 and
 793 aspell >= 0.60.
 794
 795 For aspell, non-nil also means to try to automatically find its dictionaries.
 796
 797 Earlier aspell versions do not consistently support charset encoding.  Handling
 798 this would require some extra guessing in `ispell-aspell-find-dictionary'.")
 799
 800 (defvar ispell-aspell-supports-utf8 nil
 801   "Non-nil if aspell has consistent command line UTF-8 support.  Obsolete.
 802 ispell.el and flyspell.el will use for this purpose the more generic
 803 variable `ispell-encoding8-command' for both aspell and hunspell.  Is left
 804 here just for backwards compatibility.")
 805
 806 (make-obsolete-variable 'ispell-aspell-supports-utf8
 807                         'ispell-encoding8-command "23.1")
 808
 809 (defvar ispell-hunspell-dictionary-equivs-alist
 810   '(("american"      "en_US")
 811     ("brasileiro"    "pt_BR")
 812     ("british"       "en_GB")
 813     ("castellano"    "es_ES")
 814     ("castellano8"   "es_ES")
 815     ("czech"         "cs_CZ")
 816     ("dansk"         "da_DK")
 817     ("deutsch"       "de_DE")
 818     ("deutsch8"      "de_DE")
 819     ("english"       "en_US")
 820     ("esperanto"     "eo")
 821     ("esperanto-tex" "eo")
 822     ("finnish"       "fi_FI")
 823     ("francais7"     "fr_FR")
 824     ("francais"      "fr_FR")
 825     ("francais-tex"  "fr_FR")
 826     ("german"        "de_DE")
 827     ("german8"       "de_DE")
 828     ("italiano"      "it_IT")
 829     ("nederlands"    "nl_NL")
 830     ("nederlands8"   "nl_NL")
 831     ("norsk"         "nn_NO")
 832     ("norsk7-tex"    "nn_NO")
 833     ("polish"        "pl_PL")
 834     ("portugues"     "pt_PT")
 835     ("russian"       "ru_RU")
 836     ("russianw"      "ru_RU")
 837     ("slovak"        "sk_SK")
 838     ("slovenian"     "sl_SI")
 839     ("svenska"       "sv_SE")
 840     ("hebrew"        "he_IL"))
 841   "Alist with matching hunspell dict names for standard dict names in
 842   `ispell-dictionary-base-alist'.")
 843
 844 (defvar ispell-emacs-alpha-regexp
 845   (if (string-match "^[[:alpha:]]+$" "abcde")
 846       "[[:alpha:]]"
 847     nil)
 848   "[[:alpha:]] if Emacs supports [:alpha:] regexp, nil
 849 otherwise (current XEmacs does not support it).")
 850
 851 ;;; **********************************************************************
 852 ;;; The following are used by ispell, and should not be changed.
 853 ;;; **********************************************************************
 854
 855
 856
 857 ;; The version must be 3.1 or greater for this version of ispell.el
 858 ;; There is an incompatibility between version 3.1.12 and lower versions.
 859 (defconst ispell-required-version '(3 1 12)
 860   "Ispell versions with which this version of ispell.el is known to work.")
 861 (defvar ispell-offset -1
 862   "Offset that maps protocol differences between ispell 3.1 versions.")
 863
 864 (defconst ispell-version "ispell.el 3.6 - 7-Jan-2003")
 865
 866
 867 (defun ispell-check-version (&optional interactivep)
 868   "Ensure that `ispell-program-name' is valid and has the correct version.
 869 Returns version number if called interactively.
 870 Otherwise returns the library directory name, if that is defined."
 871   ;; This is a little wasteful as we actually launch ispell twice: once
 872   ;; to make sure it's the right version, and once for real.  But people
 873   ;; get confused by version mismatches *all* the time (and I've got the
 874   ;; email to prove it) so I think this is worthwhile.  And the -v[ersion]
 875   ;; option is the only way I can think of to do this that works with
 876   ;; all versions, since versions earlier than 3.0.09 didn't identify
 877   ;; themselves on startup.
 878   (interactive "p")
 879   (let ((default-directory (or (if (featurep 'xemacs)
 880                                    (temp-directory)
 881                                  (and (boundp 'temporary-file-directory)
 882                                       temporary-file-directory))
 883                                default-directory))
 884         result status ispell-program-version)
 885
 886     (with-temp-buffer
 887       (setq status (ispell-call-process
 888                     ispell-program-name nil t nil
 889                     ;; aspell doesn't accept the -vv switch.
 890                     (let ((case-fold-search
 891                            (memq system-type '(ms-dos windows-nt)))
 892                           (speller
 893                            (file-name-nondirectory ispell-program-name)))
 894                       ;; Assume anything that isn't `aspell' is Ispell.
 895                       (if (string-match "\\`aspell" speller) "-v" "-vv"))))
 896       (goto-char (point-min))
 897       (if interactivep
 898           ;; Report version information of ispell and ispell.el
 899           (progn
 900             (end-of-line)
 901             (setq result (concat (buffer-substring-no-properties (point-min)
 902                                                                  (point))
 903                                  ", "
 904                                  ispell-version))
 905             (message "%s" result))
 906         ;; return library directory.
 907         (if (re-search-forward "LIBDIR = \\\"\\([^ \t\n]*\\)\\\"" nil t)
 908             (setq result (match-string 1))))
 909       (goto-char (point-min))
 910       (if (not (memq status '(0 nil)))
 911           (error "%s exited with %s %s" ispell-program-name
 912                  (if (stringp status) "signal" "code") status))
 913
 914       ;; Get relevant version strings. Only xx.yy.... format works well
 915       (let (case-fold-search)
 916         (setq ispell-program-version
 917               (and (search-forward-regexp "\\([0-9]+\\.[0-9\\.]+\\)" nil t)
 918                    (match-string 1)))
 919
 920         ;; Make sure these variables are (re-)initialized to the default value
 921         (setq ispell-really-aspell nil
 922               ispell-aspell-supports-utf8 nil
 923               ispell-really-hunspell nil
 924               ispell-encoding8-command nil)
 925
 926         (goto-char (point-min))
 927         (or (setq ispell-really-aspell
 928                   (and (search-forward-regexp
 929                         "(but really Aspell \\([0-9]+\\.[0-9\\.-]+\\)?)" nil t)
 930                        (match-string 1)))
 931             (setq ispell-really-hunspell
 932                   (and (search-forward-regexp
 933                         "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)"
 934                         nil t)
 935                        (match-string 1)))))
 936
 937       (let ((aspell-minver    "0.50")
 938             (aspell8-minver   "0.60")
 939             (ispell0-minver   "3.1.0")
 940             (ispell-minver    "3.1.12")
 941             (hunspell8-minver "1.1.6"))
 942
 943         (if (ispell-check-minver ispell0-minver ispell-program-version)
 944             (or (ispell-check-minver ispell-minver ispell-program-version)
 945                 (setq ispell-offset 0))
 946           (error "%s release %s or greater is required"
 947                  ispell-program-name
 948                  ispell-minver))
 949
 950         (cond
 951          (ispell-really-aspell
 952           (if (ispell-check-minver aspell-minver ispell-really-aspell)
 953               (if (ispell-check-minver aspell8-minver ispell-really-aspell)
 954                   (progn
 955                     (setq ispell-aspell-supports-utf8 t)
 956                     (setq ispell-encoding8-command "--encoding=")))
 957             (setq ispell-really-aspell nil)))
 958          (ispell-really-hunspell
 959           (if (ispell-check-minver hunspell8-minver ispell-really-hunspell)
 960               (setq ispell-encoding8-command "-i")
 961             (setq ispell-really-hunspell nil))))))
 962     result))
 963
 964 (defun ispell-call-process (&rest args)
 965   "Like `call-process' but defend against bad `default-directory'."
 966   (let ((default-directory default-directory))
 967     (unless (file-accessible-directory-p default-directory)
 968       (setq default-directory (expand-file-name "~/")))
 969     (apply 'call-process args)))
 970
 971 (defun ispell-call-process-region (&rest args)
 972   "Like `call-process-region' but defend against bad `default-directory'."
 973   (let ((default-directory default-directory))
 974     (unless (file-accessible-directory-p default-directory)
 975       (setq default-directory (expand-file-name "~/")))
 976     (apply 'call-process-region args)))
 977
 978 (defun ispell-create-debug-buffer (&optional append)
 979   "Create an ispell debug buffer for debugging output.
 980 Use APPEND to append the info to previous buffer if exists,
 981 otherwise is reset.  Returns name of ispell debug buffer.
 982 See `ispell-buffer-with-debug' for an example of use."
 983   (let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
 984     (with-current-buffer ispell-debug-buffer
 985       (if append
 986           (insert
 987            (format "-----------------------------------------------\n"))
 988         (erase-buffer)))
 989     ispell-debug-buffer))
 990
 991 (defsubst ispell-print-if-debug (format &rest args)
 992   "Print message to `ispell-debug-buffer' buffer if enabled."
 993   ;; XEmacs comment; this looks like a bug, but is not. See
 994   ;; #'ispell-buffer-with-debug.
 995   (if (boundp 'ispell-debug-buffer)
 996       (with-current-buffer ispell-debug-buffer
 997         (goto-char (point-max))
 998         (insert (apply #'format format args)))))
 999
1000
1001 ;; The preparation of the menu bar menu must be autoloaded
1002 ;; because otherwise this file gets autoloaded every time Emacs starts
1003 ;; so that it can set up the menus and determine keyboard equivalents.
1004
1005 ;;;###autoload
1006 (defvar ispell-menu-map nil "Key map for ispell menu.")
1007 ;; Redo menu when loading ispell to get dictionary modifications
1008 (setq ispell-menu-map nil)
1009
1010 ;;;###autoload
1011 (defvar ispell-menu-xemacs nil
1012   "Spelling menu for XEmacs.
1013 If nil when package is loaded, a standard menu will be set,
1014 and added as a submenu of the \"Edit\" menu.")
1015
1016 ;; Break out XEmacs menu and split into several calls to avoid having
1017 ;; long lines in loaddefs.el.  Detect need off following constant.
1018
1019 ;;; Set up dictionary
1020 ;;;###autoload
1021 (defvar ispell-menu-map-needed
1022   ;; only needed when not version 18 and not XEmacs.
1023   (and (not ispell-menu-map)
1024        (not (featurep 'xemacs))
1025        'reload))
1026
1027 (defvar ispell-library-directory (condition-case ()
1028                                      (ispell-check-version)
1029                                    (error nil))
1030   "Directory where ispell dictionaries reside.")
1031
1032 (defvar ispell-process nil
1033   "The process object for Ispell.")
1034
1035 (defvar ispell-async-processp (and (fboundp 'delete-process)
1036                                    (fboundp 'process-send-string)
1037                                    (fboundp 'accept-process-output)
1038                                    ;;(fboundp 'start-process)
1039                                    ;;(fboundp 'set-process-filter)
1040                                    ;;(fboundp 'process-kill-without-query)
1041                                    )
1042   "Non-nil means that the OS supports asynchronous processes.")
1043
1044 ;; Make ispell.el work better with aspell.
1045
1046 (defvar ispell-aspell-dictionary-alist nil
1047   "An alist of parsed aspell dicts and associated parameters.
1048 Internal use.")
1049
1050 (defun ispell-find-aspell-dictionaries ()
1051   "Find Aspell's dictionaries, and record in `ispell-dictionary-alist'."
1052   (unless (and ispell-really-aspell ispell-encoding8-command)
1053     (error "This function only works with aspell >= 0.60"))
1054   (let* ((dictionaries
1055           (split-string
1056            (with-temp-buffer
1057              (ispell-call-process ispell-program-name nil t nil "dicts")
1058              (buffer-string))))
1059          ;; Search for the named dictionaries.
1060          (found
1061           (delq nil
1062                 (mapcar #'ispell-aspell-find-dictionary dictionaries))))
1063     ;; Ensure aspell's alias dictionary will override standard
1064     ;; definitions.
1065     (setq found (ispell-aspell-add-aliases found))
1066     ;; Merge into FOUND any elements from the standard
1067     ;; ispell-dictionary-base-alist which have no element in FOUND at all.
1068     (dolist (dict ispell-dictionary-base-alist)
1069       (unless (assoc (car dict) found)
1070         (setq found (nconc found (list dict)))))
1071     (setq ispell-aspell-dictionary-alist found)
1072     ;; Add a default entry
1073     (let ((default-dict
1074            '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8)))
1075       (push default-dict ispell-aspell-dictionary-alist))))
1076
1077 (defvar ispell-aspell-data-dir nil
1078   "Data directory of Aspell.")
1079
1080 (defvar ispell-aspell-dict-dir nil
1081   "Dictionary directory of Aspell.")
1082
1083 (defun ispell-get-aspell-config-value (key)
1084   "Return value of Aspell configuration option KEY.
1085 Assumes that value contains no whitespace."
1086   (with-temp-buffer
1087     (ispell-call-process ispell-program-name nil t nil "config" key)
1088     (car (split-string (buffer-string)))))
1089
1090 (defun ispell-aspell-find-dictionary (dict-name)
1091   "For aspell dictionary DICT-NAME, return a list of parameters if an
1092 associated data file is found or nil otherwise.  List format is that
1093 of `ispell-dictionary-base-alist' elements."
1094   ;; Make sure `ispell-aspell-data-dir' is defined
1095   (or ispell-aspell-data-dir
1096       (setq ispell-aspell-data-dir
1097             (ispell-get-aspell-config-value "data-dir")))
1098   ;; Try finding associated datafile
1099   (let* ((datafile1
1100           (concat ispell-aspell-data-dir "/"
1101                   ;; Strip out variant, country code, etc.
1102                   (and (string-match "^[[:alpha:]]+" dict-name)
1103                        (match-string 0 dict-name)) ".dat"))
1104          (datafile2
1105           (concat ispell-aspell-data-dir "/"
1106                   ;; Strip out anything but xx_YY.
1107                   (and (string-match "^[[:alpha:]_]+" dict-name)
1108                        (match-string 0 dict-name)) ".dat"))
1109          (data-file
1110           (if (file-readable-p datafile1)
1111               datafile1
1112             (if (file-readable-p datafile2)
1113                 datafile2)))
1114          otherchars)
1115
1116     (if data-file
1117         (with-temp-buffer
1118           (insert-file-contents data-file)
1119           ;; There is zero or one line with special characters declarations.
1120           (when (search-forward-regexp "^special" nil t)
1121             (let ((specials (split-string
1122                              (buffer-substring (point)
1123                                                (progn (end-of-line) (point))))))
1124               ;; The line looks like: special ' -** - -** . -** : -*-
1125               ;; -** means that this character
1126               ;;    - doesn't appear at word start
1127               ;;    * may appear in the middle of a word
1128               ;;    * may appear at word end
1129               ;; `otherchars' is about the middle case.
1130               (while specials
1131                 (when (eq (aref (cadr specials) 1) ?*)
1132                   (push (car specials) otherchars))
1133                 (setq specials (cddr specials)))))
1134           (list dict-name
1135                 "[[:alpha:]]"
1136                 "[^[:alpha:]]"
1137                 (regexp-opt otherchars)
1138                 t                            ; We can't tell, so set this to t
1139                 (list "-d" dict-name)
1140                 nil                             ; aspell doesn't support this
1141                 ;; Here we specify the encoding to use while communicating with
1142                 ;; aspell.  This doesn't apply to command line arguments, so
1143                 ;; just don't pass words to spellcheck as arguments...
1144                 'utf-8)))))
1145
1146 (defun ispell-aspell-add-aliases (alist)
1147   "Find aspell's dictionary aliases and add them to dictionary ALIST.
1148 Return the new dictionary alist."
1149   (let ((aliases
1150          (file-expand-wildcards
1151                   (concat (or ispell-aspell-dict-dir
1152                               (setq ispell-aspell-dict-dir
1153                                     (ispell-get-aspell-config-value "dict-dir")))
1154                           "/*.alias"))))
1155     (dolist (alias-file aliases)
1156       (with-temp-buffer
1157         (insert-file-contents alias-file)
1158         ;; Look for a line "add FOO.multi", extract FOO
1159         (when (search-forward-regexp "^add \\([^.]+\\)\\.multi" nil t)
1160           (let* ((aliasname (file-name-sans-extension
1161                              (file-name-nondirectory alias-file)))
1162                  (already-exists-p (assoc aliasname alist))
1163                  (realname (match-string 1))
1164                  (realdict (assoc realname alist)))
1165             (when (and realdict (not already-exists-p))
1166               (push (cons aliasname (cdr realdict)) alist))))))
1167     alist))
1168
1169 ;; Make ispell.el work better with hunspell.
1170
1171 (defvar ispell-hunspell-dict-paths-alist nil
1172   "Alist of parsed hunspell dicts and associated affix files.
1173 Will be used to parse corresponding .aff file and create associated
1174 parameters to be inserted into `ispell-hunspell-dictionary-alist'.
1175 Internal use.")
1176
1177 (defvar ispell-hunspell-dictionary-alist nil
1178   "Alist of parsed hunspell dicts and associated parameters.
1179 This alist will initially contain names of found dicts.  Associated
1180 parameters will be added when dict is used for the first time.
1181 Internal use.")
1182
1183 (defun ispell-hunspell-fill-dictionary-entry (dict)
1184   "Fill `ispell-dictionary-alist' uninitialized entries for `DICT' and aliases.
1185 Value will be extracted from hunspell affix file and used for
1186 all uninitialized dicts using that affix file."
1187   (if (cadr (assoc dict ispell-dictionary-alist))
1188       (message "ispell-hfde: Non void entry for %s. Skipping.\n" dict)
1189     (let ((dict-alias
1190            (cadr (assoc dict ispell-hunspell-dictionary-equivs-alist)))
1191           (use-for-dicts (list dict))
1192           (dict-args-cdr (cdr (ispell-parse-hunspell-affix-file dict)))
1193           newlist)
1194       ;; Get a list of uninitialized dicts using the same affix file.
1195       (dolist (dict-equiv-alist-entry ispell-hunspell-dictionary-equivs-alist)
1196         (let ((dict-equiv-key (car dict-equiv-alist-entry))
1197               (dict-equiv-value (cadr dict-equiv-alist-entry)))
1198           (if (or (member dict dict-equiv-alist-entry)
1199                   (member dict-alias dict-equiv-alist-entry))
1200               (dolist ( tmp-dict (list dict-equiv-key dict-equiv-value))
1201                 (if (cadr (assoc tmp-dict ispell-dictionary-alist))
1202                     (ispell-print-if-debug
1203                      "ispell-hfde: %s already expanded. Skipping.\n" tmp-dict)
1204                   (add-to-list 'use-for-dicts tmp-dict))))))
1205       (ispell-print-if-debug
1206        "ispell-hfde: Filling %s entry. Use for %s.\n" dict use-for-dicts)
1207       ;; The final loop.
1208       (dolist (entry ispell-dictionary-alist)
1209         (if (member (car entry) use-for-dicts)
1210             (add-to-list 'newlist
1211                          (append (list (car entry)) dict-args-cdr))
1212           (add-to-list 'newlist entry)))
1213       (setq ispell-dictionary-alist newlist))))
1214
1215 (defun ispell-parse-hunspell-affix-file (dict-key)
1216   "Parse hunspell affix file to extract parameters for `DICT-KEY'.
1217 Return a list in `ispell-dictionary-alist' format."
1218   (let ((affix-file (cadr (assoc dict-key ispell-hunspell-dict-paths-alist))))
1219     (unless affix-file
1220       (error "ispell-phaf: No matching entry for %s.\n" dict-key))
1221     (if (not (file-exists-p affix-file))
1222         (error "ispell-phaf: File \"%s\" not found.\n" affix-file))
1223     (let ((dict-name (file-name-sans-extension
1224                       (file-name-nondirectory affix-file)))
1225           otherchars-string otherchars-list)
1226       (with-temp-buffer
1227         (insert-file-contents affix-file)
1228         (setq otherchars-string
1229               (save-excursion
1230                 (goto-char (point-min))
1231                 (if (search-forward-regexp "^WORDCHARS +" nil t )
1232                     (buffer-substring (point)
1233                                       (progn (end-of-line) (point))))))
1234         ;; Remove trailing whitespace and extra stuff.  Make list if
1235         ;; non-nil.
1236         (setq otherchars-list
1237               (if otherchars-string
1238                   (split-string
1239                    (if (string-match " +.*$" otherchars-string)
1240                        (replace-match "" nil nil otherchars-string)
1241                      otherchars-string)
1242                    "" t)))
1243
1244         ;; Fill dict entry
1245         (list dict-key
1246               "[[:alpha:]]"
1247               "[^[:alpha:]]"
1248               (if otherchars-list
1249                   (regexp-opt otherchars-list)
1250                 "")
1251               t                   ; many-otherchars-p: We can't tell, set to t.
1252               (list "-d" dict-name)
1253               nil              ; extended-char-mode: not supported by hunspell!
1254               'utf-8)))))
1255
1256 (defun ispell-find-hunspell-dictionaries ()
1257   "Look for installed hunspell dictionaries.
1258 Will initialize `ispell-hunspell-dictionary-alist' and
1259 `ispell-hunspell-dictionary-alist' after values found
1260 and remove `ispell-hunspell-dictionary-equivs-alist'
1261 entries if a specific dict was found."
1262   (let ((hunspell-found-dicts
1263          (split-string
1264           (with-temp-buffer
1265             (ispell-call-process ispell-program-name
1266                                  null-device
1267                                  t
1268                                  nil
1269                                  "-D")
1270             (buffer-string))
1271           "[\n\r]+"
1272           t))
1273         hunspell-default-dict
1274         hunspell-default-dict-entry)
1275     (dolist (dict hunspell-found-dicts)
1276       (let* ((full-name (file-name-nondirectory dict))
1277              (basename  (file-name-sans-extension full-name))
1278              (affix-file (concat dict ".aff")))
1279         (if (string-match "\\.aff$" dict)
1280             ;; Found default dictionary
1281             (if hunspell-default-dict
1282                 (error "ispell-fhd: Default dict already defined as %s. Not using %s.\n"
1283                        hunspell-default-dict dict)
1284               (setq affix-file dict)
1285               (setq hunspell-default-dict (list basename affix-file)))
1286           (if (and (not (assoc basename ispell-hunspell-dict-paths-alist))
1287                    (file-exists-p affix-file))
1288               ;; Entry has an associated .aff file and no previous value.
1289               (let ((affix-file (expand-file-name affix-file)))
1290                 (ispell-print-if-debug
1291                  "++ ispell-fhd: dict-entry:%s name:%s basename:%s affix-file:%s\n"
1292                  dict full-name basename affix-file)
1293                 (add-to-list 'ispell-hunspell-dict-paths-alist
1294                              (list basename affix-file)))
1295             (ispell-print-if-debug
1296              "-- ispell-fhd: Skipping entry: %s\n" dict)))))
1297     ;; Remove entry from aliases alist if explicit dict was found.
1298     (let (newlist)
1299       (dolist (dict ispell-hunspell-dictionary-equivs-alist)
1300         (if (assoc (car dict) ispell-hunspell-dict-paths-alist)
1301             (ispell-print-if-debug
1302              "-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
1303              (car dict))
1304           (add-to-list 'newlist dict)))
1305       (setq ispell-hunspell-dictionary-equivs-alist newlist))
1306     ;; Add known hunspell aliases
1307     (dolist (dict-equiv ispell-hunspell-dictionary-equivs-alist)
1308       (let ((dict-equiv-key (car dict-equiv))
1309             (dict-equiv-value (cadr dict-equiv))
1310             (exclude-aliases (list   ;; Exclude TeX aliases
1311                               "esperanto-tex"
1312                               "francais7"
1313                               "francais-tex"
1314                               "norsk7-tex")))
1315         (if (and (assoc dict-equiv-value ispell-hunspell-dict-paths-alist)
1316                  (not (assoc dict-equiv-key ispell-hunspell-dict-paths-alist))
1317                  (not (member dict-equiv-key exclude-aliases)))
1318             (let ((affix-file (cadr (assoc dict-equiv-value
1319                                            ispell-hunspell-dict-paths-alist))))
1320               (ispell-print-if-debug "++ ispell-fhd: Adding alias %s -> %s.\n"
1321                                      dict-equiv-key affix-file)
1322               (add-to-list
1323                'ispell-hunspell-dict-paths-alist
1324                (list dict-equiv-key affix-file))))))
1325     ;; Parse and set values for default dictionary.
1326     (setq hunspell-default-dict (car hunspell-default-dict))
1327     (setq hunspell-default-dict-entry
1328           (ispell-parse-hunspell-affix-file hunspell-default-dict))
1329     ;; Create an alist of found dicts with only names, except for default dict.
1330     (setq ispell-hunspell-dictionary-alist
1331           (list (append (list nil) (cdr hunspell-default-dict-entry))))
1332     (dolist (dict (mapcar 'car ispell-hunspell-dict-paths-alist))
1333       (if (string= dict hunspell-default-dict)
1334           (add-to-list 'ispell-hunspell-dictionary-alist
1335                        hunspell-default-dict-entry)
1336         (add-to-list 'ispell-hunspell-dictionary-alist
1337                      (list dict))))))
1338
1339 ;; Set params according to the selected spellchecker
1340
1341 (defvar ispell-last-program-name nil
1342   "Last value of `ispell-program-name'.  Internal use.")
1343
1344 (defvar ispell-initialize-spellchecker-hook nil
1345   "Normal hook run on spellchecker initialization.
1346 This hook is run when a spellchecker is used for the first
1347 time, before `ispell-dictionary-alist' is set.  It is intended for
1348 sysadmins to override entries in `ispell-dictionary-base-alist'
1349 by putting those overrides in `ispell-base-dicts-override-alist', which is
1350 a dynamically scoped var with same format as `ispell-dictionary-alist'.
1351 This alist will not override the auto-detected values (e.g. if a recent
1352 aspell is used along with Emacs).")
1353
1354 (defun ispell-set-spellchecker-params ()
1355   "Initialize some spellchecker parameters when changed or first used."
1356   (unless (eq ispell-last-program-name ispell-program-name)
1357     (setq ispell-last-program-name ispell-program-name)
1358     (ispell-kill-ispell t)
1359     (if (and (condition-case ()
1360                  (progn
1361                    (setq ispell-library-directory (ispell-check-version))
1362                    t)
1363                (error nil))
1364              ispell-encoding8-command
1365              ispell-emacs-alpha-regexp)
1366         ;; auto-detection will only be used if spellchecker is not
1367         ;; ispell, supports a way  to set communication to UTF-8 and
1368         ;; Emacs flavor supports [:alpha:]
1369         (if ispell-really-aspell
1370             (or ispell-aspell-dictionary-alist
1371                 (ispell-find-aspell-dictionaries))
1372           (if ispell-really-hunspell
1373               (or ispell-hunspell-dictionary-alist
1374                   (ispell-find-hunspell-dictionaries)))))
1375
1376     ;; Substitute ispell-dictionary-alist with the list of
1377     ;; dictionaries corresponding to the given spellchecker.
1378     ;; If a recent aspell or hunspell, use the list of really
1379     ;; installed dictionaries and add to it elements of the original
1380     ;; list that are not present there. Allow distro info.
1381     (let ((found-dicts-alist
1382            (if (and ispell-encoding8-command
1383                     ispell-emacs-alpha-regexp)
1384                (if ispell-really-aspell
1385                    ispell-aspell-dictionary-alist
1386                  (if ispell-really-hunspell
1387                      ispell-hunspell-dictionary-alist))
1388              nil))
1389           (ispell-dictionary-base-alist ispell-dictionary-base-alist)
1390           ispell-base-dicts-override-alist ; Override only base-dicts-alist
1391           all-dicts-alist)
1392
1393       ;; While ispell and aspell (through aliases) use the traditional
1394       ;; dict naming originally expected by ispell.el, hunspell
1395       ;; uses locale based names with no alias.  We need to map
1396       ;; standard names to locale based names to make default dict
1397       ;; definitions available for hunspell.
1398       (if ispell-really-hunspell
1399           (let (tmp-dicts-alist)
1400             (dolist (adict ispell-dictionary-base-alist)
1401               (let* ((dict-name (nth 0 adict))
1402                      (dict-equiv
1403                       (cadr (assoc dict-name
1404                                    ispell-hunspell-dictionary-equivs-alist)))
1405                      (ispell-args (nth 5 adict))
1406                      (ispell-args-has-d (member "-d" ispell-args))
1407                      skip-dict)
1408                 ;; Remove "-d" option from `ispell-args' if present
1409                 (if ispell-args-has-d
1410                     (let ((ispell-args-after-d
1411                            (cdr (cdr ispell-args-has-d)))
1412                           (ispell-args-before-d
1413                            (butlast ispell-args (length ispell-args-has-d))))
1414                       (setq ispell-args
1415                             (nconc ispell-args-before-d
1416                                    ispell-args-after-d))))
1417                 ;; Unless default dict, re-add "-d" option with the mapped value
1418                 (if dict-name
1419                     (if dict-equiv
1420                         (setq ispell-args
1421                               (nconc ispell-args (list "-d" dict-equiv)))
1422                       (message
1423                        "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping."
1424                        dict-name)
1425                       (setq skip-dict t)))
1426
1427                 (unless skip-dict
1428                   (add-to-list 'tmp-dicts-alist
1429                                (list
1430                                 dict-name      ; dict name
1431                                 (nth 1 adict)  ; casechars
1432                                 (nth 2 adict)  ; not-casechars
1433                                 (nth 3 adict)  ; otherchars
1434                                 (nth 4 adict)  ; many-otherchars-p
1435                                 ispell-args    ; ispell-args
1436                                 (nth 6 adict)  ; extended-character-mode
1437                                 (nth 7 adict)  ; dict encoding
1438                                 ))))
1439               (setq ispell-dictionary-base-alist tmp-dicts-alist))))
1440
1441
1442       (run-hooks 'ispell-initialize-spellchecker-hook)
1443
1444       ;; Add dicts to ``ispell-dictionary-alist'' unless already present.
1445       (dolist (dict (append found-dicts-alist
1446                             ispell-base-dicts-override-alist
1447                             ispell-dictionary-base-alist))
1448         (unless (assoc (car dict) all-dicts-alist)
1449           (add-to-list 'all-dicts-alist dict)))
1450       (setq ispell-dictionary-alist all-dicts-alist))
1451
1452     ;; If Emacs flavor supports [:alpha:] use it for global dicts.  If
1453     ;; spellchecker also supports UTF-8 via command-line option use it
1454     ;; in communication.  This does not affect definitions in your
1455     ;; init file.
1456     (if ispell-emacs-alpha-regexp
1457         (setq ispell-dictionary-alist
1458               (mapcar
1459                #'(lambda (adict)
1460                    (list (nth 0 adict)  ; dict name
1461                          "[[:alpha:]]"  ; casechars
1462                          "[^[:alpha:]]" ; not-casechars
1463                          (nth 3 adict)  ; otherchars
1464                          (nth 4 adict)  ; many-otherchars-p
1465                          (nth 5 adict)  ; ispell-args
1466                          (nth 6 adict)  ; extended-character-mode
1467                          (if ispell-encoding8-command
1468                              'utf-8
1469                            (nth 7 adict))))
1470                ispell-dictionary-alist)))))
1471
1472
1473 (defun ispell-valid-dictionary-list ()
1474   "Return a list of valid dictionaries.
1475 The variable `ispell-library-directory' defines their location."
1476   ;; Initialize variables and dictionaries alists for desired spellchecker.
1477   ;; Make sure ispell.el is loaded to avoid some autoload loops in XEmacs
1478   ;; (and may be others)
1479   (if (featurep 'ispell)
1480       (ispell-set-spellchecker-params))
1481
1482   (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
1483         (dict-list (cons "default" nil))
1484         name dict-bname)
1485     (dolist (dict dicts)
1486       (setq name (car dict)
1487             dict-bname (or (car (cdr (member "-d" (nth 5 dict))))
1488                            name))
1489       ;; Include if the dictionary is in the library, or dir not defined.
1490       (if (and
1491            name
1492            ;; For Aspell, we already know which dictionaries exist.
1493            (or ispell-really-aspell
1494                ;; Include all dictionaries if lib directory not known.
1495                ;; Same for Hunspell, where ispell-library-directory is nil.
1496                (not ispell-library-directory)
1497                (file-exists-p (concat ispell-library-directory
1498                                       "/" dict-bname ".hash"))
1499                (file-exists-p (concat ispell-library-directory
1500                                       "/" dict-bname ".has"))))
1501           (push name dict-list)))
1502     dict-list))
1503
1504 ;; Define commands in menu in opposite order you want them to appear.
1505 ;;;###autoload
1506 (if ispell-menu-map-needed
1507     (progn
1508       (setq ispell-menu-map (make-sparse-keymap "Spell"))
1509       (define-key ispell-menu-map [ispell-change-dictionary]
1510         `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary
1511                     :help ,(purecopy "Supply explicit dictionary file name")))
1512       (define-key ispell-menu-map [ispell-kill-ispell]
1513         `(menu-item ,(purecopy "Kill Process")
1514                     (lambda () (interactive) (ispell-kill-ispell nil 'clear))
1515                     :enable (and (boundp 'ispell-process) ispell-process
1516                                  (eq (ispell-process-status) 'run))
1517                     :help ,(purecopy "Terminate Ispell subprocess")))
1518       (define-key ispell-menu-map [ispell-pdict-save]
1519         `(menu-item ,(purecopy "Save Dictionary")
1520                     (lambda () (interactive) (ispell-pdict-save t t))
1521                     :help ,(purecopy "Save personal dictionary")))
1522       (define-key ispell-menu-map [ispell-customize]
1523         `(menu-item ,(purecopy "Customize...")
1524                     (lambda () (interactive) (customize-group 'ispell))
1525                     :help ,(purecopy "Customize spell checking options")))
1526       (define-key ispell-menu-map [ispell-help]
1527         ;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ?
1528         `(menu-item ,(purecopy "Help")
1529                     (lambda () (interactive) (describe-function 'ispell-help))
1530                     :help ,(purecopy "Show standard Ispell keybindings and commands")))
1531       (define-key ispell-menu-map [flyspell-mode]
1532         `(menu-item ,(purecopy "Automatic spell checking (Flyspell)")
1533                     flyspell-mode
1534                     :help ,(purecopy "Check spelling while you edit the text")
1535                     :button (:toggle . (bound-and-true-p flyspell-mode))))
1536       (define-key ispell-menu-map [ispell-complete-word]
1537         `(menu-item ,(purecopy "Complete Word") ispell-complete-word
1538                     :help ,(purecopy "Complete word at cursor using dictionary")))
1539       (define-key ispell-menu-map [ispell-complete-word-interior-frag]
1540         `(menu-item ,(purecopy "Complete Word Fragment")
1541                     ispell-complete-word-interior-frag
1542                     :help ,(purecopy "Complete word fragment at cursor")))))
1543
1544 ;;;###autoload
1545 (if ispell-menu-map-needed
1546     (progn
1547       (define-key ispell-menu-map [ispell-continue]
1548         `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue
1549                     :enable (and (boundp 'ispell-region-end)
1550                                  (marker-position ispell-region-end)
1551                                  (equal (marker-buffer ispell-region-end)
1552                                         (current-buffer)))
1553                     :help ,(purecopy "Continue spell checking last region")))
1554       (define-key ispell-menu-map [ispell-word]
1555         `(menu-item ,(purecopy "Spell-Check Word") ispell-word
1556                     :help ,(purecopy "Spell-check word at cursor")))
1557       (define-key ispell-menu-map [ispell-comments-and-strings]
1558         `(menu-item ,(purecopy "Spell-Check Comments")
1559                     ispell-comments-and-strings
1560                     :help ,(purecopy "Spell-check only comments and strings")))))
1561
1562 ;;;###autoload
1563 (if ispell-menu-map-needed
1564     (progn
1565       (define-key ispell-menu-map [ispell-region]
1566         `(menu-item ,(purecopy "Spell-Check Region") ispell-region
1567                     :enable mark-active
1568                     :help ,(purecopy "Spell-check text in marked region")))
1569       (define-key ispell-menu-map [ispell-message]
1570         `(menu-item ,(purecopy "Spell-Check Message") ispell-message
1571                     :visible (eq major-mode 'mail-mode)
1572                     :help ,(purecopy "Skip headers and included message text")))
1573       (define-key ispell-menu-map [ispell-buffer]
1574         `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer
1575                     :help ,(purecopy "Check spelling of selected buffer")))
1576       ;;(put 'ispell-region 'menu-enable 'mark-active)
1577       (fset 'ispell-menu-map (symbol-value 'ispell-menu-map))))
1578
1579 ;;; XEmacs versions 19 & 20
1580 (if (and (featurep 'xemacs) (featurep 'menubar))
1581     (let ((dicts (if (fboundp 'ispell-valid-dictionary-list)
1582                      (reverse (ispell-valid-dictionary-list))))
1583           (current-menubar (or current-menubar default-menubar))
1584           (menu
1585            '(["Help"            (describe-function 'ispell-help) t]
1586              ;;["Help"          (popup-menu ispell-help-list)   t]
1587              ["Check Message"   ispell-message                  t]
1588              ["Check Buffer"    ispell-buffer                   t]
1589              ["Check Comments"  ispell-comments-and-strings     t]
1590              ["Check Word"      ispell-word                     t]
1591              ["Check Region"    ispell-region  (or (not zmacs-regions) (mark))]
1592              ["Continue Check"  ispell-continue                 t]
1593              ["Complete Word Frag" ispell-complete-word-interior-frag t]
1594              ["Complete Word"   ispell-complete-word            t]
1595              ["Kill Process"    (ispell-kill-ispell nil 'clear) t]
1596              ["Customize..."    (customize-group 'ispell)       t]
1597              ;; flyspell-mode may not be bound...
1598              ;;["flyspell"      flyspell-mode
1599              ;;                 :style toggle :selected flyspell-mode ]
1600              "-"
1601              ["Save Personal Dict"(ispell-pdict-save t t)       t]
1602              ["Change Dictionary" ispell-change-dictionary      t])))
1603       (if (null dicts)
1604           (setq dicts (cons "default" nil)))
1605       (dolist (name dicts)
1606         (setq menu (append menu
1607                            (list
1608                              (vector
1609                               (concat "Select " (capitalize name))
1610                               (list 'ispell-change-dictionary name)
1611                               t)))))
1612       (setq ispell-menu-xemacs menu)
1613       (if current-menubar
1614           (progn
1615             (if (car (find-menu-item current-menubar '("Cmds")))
1616                 (progn
1617                   ;; XEmacs 21.2
1618                   (delete-menu-item '("Cmds" "Spell-Check"))
1619                   (add-menu '("Cmds") "Spell-Check" ispell-menu-xemacs))
1620               ;; previous
1621               (delete-menu-item '("Edit" "Spell")) ; in case already defined
1622               (add-menu '("Edit") "Spell" ispell-menu-xemacs))))))
1623
1624 (defalias 'ispell-int-char
1625     ;; Allow incrementing characters as integers in XEmacs 20
1626     (if (featurep 'xemacs) 'int-char 'identity))
1627
1628 (defalias 'ispell-find-coding-system
1629     (if (featurep 'xemacs) 'find-coding-system 'identity))
1630
1631 (defalias 'ispell-list*
1632     (if (featurep 'xemacs)
1633         'list*
1634       #'(lambda (first &rest rest)
1635           (if rest
1636               (cons first (nconc (butlast rest) (last rest)))
1637             first))))
1638
1639 ;;; **********************************************************************
1640
1641 (defvar ispell-current-dictionary nil
1642   "The name of the current dictionary, or nil for the default.
1643 This is passed to the ispell process using the `-d' switch and is
1644 used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.")
1645
1646 (defvar ispell-current-personal-dictionary nil
1647   "The name of the current personal dictionary, or nil for the default.
1648 This is passed to the ispell process using the `-p' switch.")
1649
1650 (macrolet
1651     ((hide-ispell-dictionary-corrected (&body body)
1652        "Don't expose our corrected dictionary alist in obarray."
1653        (cons 'progn
1654              (subst '#:ispell-dictionary-corrected 'ispell-dictionary-corrected
1655                     body)))
1656      (ispell-get-current-dictionary ()
1657        "The ispell code is unclean about encoding when dealing with
1658 `ispell-dictionary-alist' and related variables. The sane thing to do is to
1659 canonicalize to internal format at read time or *maybe* at load time; the
1660 code before this macro would canonicalize every time a word was examined.
1661
1662 This macro returns a version of the current dictionary (list) canonicalized
1663 to internal format. It only canonicalizes once per dictionary, though it
1664 does check which is the current dictionary at every lookup. With a bytecode
1665 #'assoc, this is relatively cheap, though."
1666        `(hide-ispell-dictionary-corrected
1667          (let ((assoc
1668                 (or
1669                  (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1670                  (assoc ispell-current-dictionary ispell-dictionary-alist)
1671                  (error 'invalid-constant ispell-current-dictionary
1672                         "no data in `ispell-local-dictionary-alist' or \
1673 `ispell-dictionary-alist'"))))
1674            (or (cdr (assq assoc ispell-dictionary-corrected))
1675                (cdar (setq ispell-dictionary-corrected
1676                            (acons assoc (ispell-correct-case-encoding assoc)
1677                                   ispell-dictionary-corrected))))))))
1678   (hide-ispell-dictionary-corrected
1679    (defvar ispell-dictionary-corrected nil)
1680    (defalias 'ispell-correct-case-encoding
1681        (if (featurep 'mule)
1682            #'(lambda (list)
1683                (let ((coding-system (ispell-find-coding-system
1684                                      (or (nth 7 list) 'binary))))
1685                  (ispell-list* (nth 0 list)
1686                                (decode-coding-string (nth 1 list)
1687                                                      coding-system)
1688                                (decode-coding-string (nth 2 list)
1689                                                      coding-system)
1690                                (decode-coding-string (nth 3 list)
1691                                                      coding-system)
1692                                (nthcdr 4 list))))
1693          #'copy-list))
1694    (defalias 'ispell-get-casechars
1695        (lambda () (nth 1 (ispell-get-current-dictionary))))
1696    (defalias 'ispell-get-not-casechars
1697        (lambda () (nth 2 (ispell-get-current-dictionary))))
1698    (defalias 'ispell-get-otherchars
1699        (lambda () (nth 3 (ispell-get-current-dictionary))))
1700    (defalias 'ispell-get-many-otherchars-p
1701        (lambda () (nth 4 (ispell-get-current-dictionary))))
1702    (defalias 'ispell-get-ispell-args
1703        (lambda () (nth 5 (ispell-get-current-dictionary))))
1704    (defalias 'ispell-get-extended-character-mode
1705        (lambda ()
1706          (if ispell-really-hunspell ;; hunspell treats ~word as ordinary
1707              nil                    ;; words in pipe mode. Disable
1708            ;; extended-char-mode
1709            (nth 6 (ispell-get-current-dictionary)))))
1710    (defalias 'ispell-get-coding-system
1711        (lambda () (nth 7 (ispell-get-current-dictionary))))))
1712
1713 (defvar ispell-pdict-modified-p nil
1714   "Non-nil means personal dictionary has modifications to be saved.")
1715
1716 ;; If you want to save the dictionary when quitting, must do so explicitly.
1717 ;; When non-nil, the spell session is terminated.
1718 ;; When numeric, contains cursor location in buffer, and cursor remains there.
1719 (defvar ispell-quit nil)
1720
1721 (defvar ispell-process-directory nil
1722   "The directory where `ispell-process' was started.")
1723
1724 (defvar ispell-filter nil
1725   "Output filter from piped calls to Ispell.")
1726
1727 (defvar ispell-filter-continue nil
1728   "Control variable for Ispell filter function.")
1729
1730 (defvar ispell-output-buffer nil
1731   "Buffer used for reading output of a synchronous Ispell subprocess.")
1732
1733 (defvar ispell-session-buffer nil
1734   "Buffer used for passing input to a synchronous Ispell subprocess.")
1735
1736 (defvar ispell-cmd-args nil
1737   "Command-line arguments to pass to a synchronous Ispell subprocess.")
1738
1739 (defvar ispell-query-replace-marker (make-marker)
1740   "Marker for `query-replace' processing.")
1741
1742 (defvar ispell-recursive-edit-marker (make-marker)
1743   "Marker for return point from recursive edit.")
1744
1745 (defvar ispell-checking-message nil
1746   "Non-nil when we're checking a mail message.
1747 Set to the MIME boundary locations when checking messages.")
1748
1749 (defconst ispell-choices-buffer "*Choices*")
1750
1751 (defvar ispell-overlay nil "Overlay variable for Ispell highlighting.")
1752
1753 ;;; *** Buffer Local Definitions ***
1754
1755 (defconst ispell-words-keyword "LocalWords: "
1756   "The keyword for local oddly-spelled words to accept.
1757 The keyword will be followed by any number of local word spellings.
1758 There can be multiple instances of this keyword in the file.")
1759
1760 (defconst ispell-dictionary-keyword "Local IspellDict: "
1761   "The keyword for a local dictionary to use.
1762 The keyword must be followed by a valid dictionary name, defined in
1763 `ispell-local-dictionary-alist' or `ispell-dictionary-alist'.
1764 When multiple occurrences exist, the last keyword
1765 definition is used.")
1766
1767 (defconst ispell-pdict-keyword "Local IspellPersDict: "
1768   "The keyword for defining buffer local dictionaries.
1769 Keyword must be followed by the filename of a personal dictionary.
1770 The last occurring definition in the buffer will be used.")
1771
1772 (defconst ispell-parsing-keyword "Local IspellParsing: "
1773   "The keyword for overriding default Ispell parsing.
1774 The above keyword string should be followed by `latex-mode' or
1775 `nroff-mode' to put the current buffer into the desired parsing mode.
1776
1777 Extended character mode can be changed for this buffer by placing
1778 a `~' followed by an extended-character mode -- such as `~.tex'.
1779 The last occurring definition in the buffer will be used.")
1780
1781 ;;;###autoload
1782 (defvar ispell-skip-region-alist
1783   `((ispell-words-keyword          forward-line)
1784     (ispell-dictionary-keyword     forward-line)
1785     (ispell-pdict-keyword          forward-line)
1786     (ispell-parsing-keyword        forward-line)
1787     (,(purecopy "^---*BEGIN PGP [A-Z ]*--*")
1788      . ,(purecopy "^---*END PGP [A-Z ]*--*"))
1789     ;; assume multiline uuencoded file? "\nM.*$"?
1790     (,(purecopy "^begin [0-9][0-9][0-9] [^ \t]+$") . ,(purecopy "\nend\n"))
1791     (,(purecopy "^%!PS-Adobe-[123].0")   . ,(purecopy "\n%%EOF\n"))
1792     (,(purecopy "^---* \\(Start of \\)?[Ff]orwarded [Mm]essage")
1793      . ,(purecopy "^---* End of [Ff]orwarded [Mm]essage"))
1794     ;; Matches e-mail addresses, file names, http addresses, etc.  The
1795     ;; `-+' `_+' patterns are necessary for performance reasons when
1796     ;; `-' or `_' part of word syntax.
1797     (,(purecopy "\\(--+\\|_+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)"))
1798     ;; above checks /.\w sequences
1799     ;;("\\(--+\\|\\(/\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)")
1800     ;; This is a pretty complex regexp.  It can be simplified to the following:
1801     ;; "\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_]\\|~\\)+\\)+"
1802     ;; but some valid text will be skipped, e.g. "his/her".  This could be
1803     ;; fixed up (at the expense of a moderately more complex regexp)
1804     ;; by not allowing "/" to be the character which triggers the
1805     ;; identification of the computer name, e.g.:
1806     ;; "\\(\\w\\|[-_]\\)+[.:@]\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_]\\|~\\)+\\)+"
1807     )
1808   "Alist expressing beginning and end of regions not to spell check.
1809 The alist key must be a regular expression.
1810 Valid forms include:
1811   (KEY) - just skip the key.
1812   (KEY . REGEXP) - skip to the end of REGEXP.  REGEXP may be string or symbol.
1813   (KEY REGEXP) - skip to end of REGEXP.  REGEXP must be a string.
1814   (KEY FUNCTION ARGS) - FUNCTION called with ARGS returns end of region.")
1815 (put 'ispell-skip-region-alist 'risky-local-variable t)
1816
1817
1818 ;;;###autoload
1819 (defvar ispell-tex-skip-alists
1820   (purecopy
1821   '((;;("%\\[" . "%\\]") ; AMStex block comment...
1822      ;; All the standard LaTeX keywords from L. Lamport's guide:
1823      ;; \cite, \hspace, \hspace*, \hyphenation, \include, \includeonly, \input,
1824      ;; \label, \nocite, \rule (in ispell - rest included here)
1825      ("\\\\addcontentsline"              ispell-tex-arg-end 2)
1826      ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end)
1827      ("\\\\\\([aA]lph\\|arabic\\)"       ispell-tex-arg-end)
1828      ;;("\\\\author"                     ispell-tex-arg-end)
1829      ("\\\\bibliographystyle"            ispell-tex-arg-end)
1830      ("\\\\makebox"                      ispell-tex-arg-end 0)
1831      ("\\\\e?psfig"                      ispell-tex-arg-end)
1832      ("\\\\document\\(class\\|style\\)" .
1833       "\\\\begin[ \t\n]*{[ \t\n]*document[ \t\n]*}"))
1834     (;; delimited with \begin.  In ispell: displaymath, eqnarray, eqnarray*,
1835      ;; equation, minipage, picture, tabular, tabular* (ispell)
1836      ("\\(figure\\|table\\)\\*?"         ispell-tex-arg-end 0)
1837      ("list"                             ispell-tex-arg-end 2)
1838      ("program"         . "\\\\end[ \t\n]*{[ \t\n]*program[ \t\n]*}")
1839      ("verbatim\\*?"    . "\\\\end[ \t\n]*{[ \t\n]*verbatim\\*?[ \t\n]*}"))))
1840   "Lists of regions to be skipped in TeX mode.
1841 First list is used raw.
1842 Second list has key placed inside \\begin{}.
1843
1844 Delete or add any regions you want to be automatically selected
1845 for skipping in latex mode.")
1846 (put 'ispell-tex-skip-alist 'risky-local-variable t)
1847
1848
1849 ;;;###autoload
1850 (defconst ispell-html-skip-alists
1851   '(("<[cC][oO][dD][eE]\\>[^>]*>"         "</[cC][oO][dD][eE]*>")
1852     ("<[sS][cC][rR][iI][pP][tT]\\>[^>]*>" "</[sS][cC][rR][iI][pP][tT]>")
1853     ("<[aA][pP][pP][lL][eE][tT]\\>[^>]*>" "</[aA][pP][pP][lL][eE][tT]>")
1854     ("<[vV][eE][rR][bB]\\>[^>]*>"         "<[vV][eE][rR][bB]\\>[^>]*>")
1855     ;;("<[tT][tT]\\>[^>]*>"               "<[tT][tT]\\>[^>]*>")
1856     ("<[tT][tT]/"                         "/")
1857     ("<[^ \t\n>]"                         ">")
1858     ("&[^ \t\n;]"                         "[; \t\n]"))
1859   "Lists of start and end keys to skip in HTML buffers.
1860 Same format as `ispell-skip-region-alist'.
1861 Note - substrings of other matches must come last
1862  (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
1863 (put 'ispell-html-skip-alists 'risky-local-variable t)
1864
1865 (defvar ispell-local-pdict ispell-personal-dictionary
1866   "A buffer local variable containing the current personal dictionary.
1867 If non-nil, the value must be a string, which is a file name.
1868
1869 If you specify a personal dictionary for the current buffer which is
1870 different from the current personal dictionary, the effect is similar
1871 to calling \\[ispell-change-dictionary].  This variable is automatically
1872 set when defined in the file with either `ispell-pdict-keyword' or the
1873 local variable syntax.")
1874
1875 (make-variable-buffer-local 'ispell-local-pdict)
1876 ;;;###autoload(put 'ispell-local-pdict 'safe-local-variable 'stringp)
1877
1878 (defvar ispell-buffer-local-name nil
1879   "Contains the buffer name if local word definitions were used.
1880 Ispell is then restarted because the local words could conflict.")
1881
1882 (defvar ispell-buffer-session-localwords nil
1883   "List of words accepted for session in this buffer.")
1884
1885 (make-variable-buffer-local 'ispell-buffer-session-localwords)
1886
1887 (defvar ispell-parser 'use-mode-name
1888   "Indicates whether ispell should parse the current buffer as TeX Code.
1889 Special value `use-mode-name' tries to guess using the name of `major-mode'.
1890 Default parser is `nroff'.
1891 Currently the only other valid parser is `tex'.
1892
1893 You can set this variable in hooks in your init file -- eg:
1894
1895 \(add-hook 'tex-mode-hook (lambda () (setq ispell-parser 'tex)))")
1896
1897 (defvar ispell-region-end (make-marker)
1898   "Marker that allows spelling continuations.")
1899
1900 (defvar ispell-check-only nil
1901   "If non-nil, `ispell-word' does not try to correct the word.")
1902
1903
1904 ;;; **********************************************************************
1905 ;;; **********************************************************************
1906
1907
1908
1909 ;;;###autoload (define-key esc-map "$" 'ispell-word)
1910
1911
1912 (defun ispell-accept-output (&optional timeout-secs timeout-msecs)
1913   "Wait for output from ispell process, or TIMEOUT-SECS and TIMEOUT-MSECS.
1914 If asynchronous subprocesses are not supported, call `ispell-filter' and
1915 pass it the output of the last ispell invocation."
1916   (if ispell-async-processp
1917       (accept-process-output ispell-process timeout-secs timeout-msecs)
1918     (if (null ispell-process)
1919         (error "No Ispell process to read output from!")
1920       (let ((buf ispell-output-buffer)
1921             ispell-output)
1922         (if (not (bufferp buf))
1923             (setq ispell-filter nil)
1924           (with-current-buffer buf
1925             (setq ispell-output (buffer-substring-no-properties
1926                                  (point-min) (point-max))))
1927           (ispell-filter t ispell-output)
1928           (with-current-buffer buf
1929             (erase-buffer)))))))
1930
1931 (defun ispell-send-replacement (misspelled replacement)
1932   "Notify aspell that MISSPELLED should be spelled REPLACEMENT.
1933 This allows it to improve the suggestion list based on actual misspellings."
1934   (and ispell-really-aspell
1935        (ispell-send-string (concat "$$ra " misspelled "," replacement "\n"))))
1936
1937
1938 (defun ispell-send-string (string)
1939   "Send the string STRING to the Ispell process."
1940   (if ispell-async-processp
1941       (process-send-string ispell-process string)
1942     ;; Asynchronous subprocesses aren't supported on this losing system.
1943     ;; We keep all the directives passed to Ispell during the entire
1944     ;; session in a buffer, and pass them anew each time we invoke
1945     ;; Ispell to process another chunk of text.  (Yes, I know this is a
1946     ;; terrible kludge, and it's a bit slow, but it does get the work done.)
1947     (let ((cmd (aref string 0))
1948           ;; The following commands are not passed to Ispell until
1949           ;; we have a *real* reason to invoke it.
1950           (cmds-to-defer '(?* ?@ ?~ ?+ ?- ?! ?%))
1951           (session-buf ispell-session-buffer)
1952           (output-buf ispell-output-buffer)
1953           (ispell-args ispell-cmd-args)
1954           (defdir ispell-process-directory)
1955           prev-pos)
1956       (with-current-buffer session-buf
1957         (setq prev-pos (point))
1958         (setq default-directory defdir)
1959         (insert string)
1960         (if (not (memq cmd cmds-to-defer))
1961             (let (coding-system-for-read coding-system-for-write status)
1962               (if (and (boundp 'enable-multibyte-characters)
1963                        enable-multibyte-characters)
1964                   (setq coding-system-for-read (ispell-get-coding-system)
1965                         coding-system-for-write (ispell-get-coding-system)))
1966               (set-buffer output-buf)
1967               (erase-buffer)
1968               (set-buffer session-buf)
1969               (setq status
1970                     (apply 'ispell-call-process-region
1971                            (point-min) (point-max)
1972                            ispell-program-name nil
1973                            output-buf nil
1974                            "-a"
1975                            ;; hunspell -m option means something different
1976                            (if ispell-really-hunspell "" "-m")
1977                            ispell-args))
1978               (set-buffer output-buf)
1979               (goto-char (point-min))
1980               (save-match-data
1981                 (if (not (looking-at "@(#) "))
1982                     (error "Ispell error: %s"
1983                            (buffer-substring-no-properties
1984                             (point) (progn (end-of-line) (point)))))
1985                 ;; If STRING is "^Z\n", we just started Ispell and need
1986                 ;; to retain its version ID line in the output buffer.
1987                 ;; Otherwise, remove the ID line, as it will confuse
1988                 ;; `ispell-filter'.
1989                 (or (string= string "\032\n")
1990                     (progn
1991                       (forward-line)
1992                       (delete-region (point-min) (point))))
1993                 ;; If STRING begins with ^ or any normal character, we need
1994                 ;; to remove the last line from the session buffer, since it
1995                 ;; was just spell-checked, and we don't want to check it again.
1996                 ;; The same goes for the # command, since Ispell already saved
1997                 ;; the personal dictionary.
1998                 (set-buffer session-buf)
1999                 (delete-region prev-pos (point))
2000                 ;; Ispell run synchronously saves the personal dictionary
2001                 ;; after each successful command.  So we can remove any
2002                 ;; lines in the session buffer that insert words into the
2003                 ;; dictionary.
2004                 (if (memq status '(0 nil))
2005                     (let ((more-lines t))
2006                       (goto-char (point-min))
2007                       (while more-lines
2008                         (if (looking-at "^\\*")
2009                             (let ((start (point)))
2010                               (forward-line)
2011                               (delete-region start (point)))
2012                           (setq more-lines (= 0 (forward-line))))))))))))))
2013
2014
2015 ;;;###autoload
2016 (defun ispell-word (&optional following quietly continue region)
2017   "Check spelling of word under or before the cursor.
2018 If the word is not found in dictionary, display possible corrections
2019 in a window allowing you to choose one.
2020
2021 If optional argument FOLLOWING is non-nil or if `ispell-following-word'
2022 is non-nil when called interactively, then the following word
2023 \(rather than preceding\) is checked when the cursor is not over a word.
2024 When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil
2025 when called interactively, non-corrective messages are suppressed.
2026
2027 With a prefix argument (or if CONTINUE is non-nil),
2028 resume interrupted spell-checking of a buffer or region.
2029
2030 Interactively, in Transient Mark mode when the mark is active, call
2031 `ispell-region' to check the active region for spelling errors.
2032
2033 Word syntax is controlled by the definition of the chosen dictionary,
2034 which is in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'.
2035
2036 This will check or reload the dictionary.  Use \\[ispell-change-dictionary]
2037 or \\[ispell-region] to update the Ispell process.
2038
2039 Return values:
2040 nil           word is correct or spelling is accepted.
2041 0             word is inserted into buffer-local definitions.
2042 \"word\"        word corrected from word list.
2043 \(\"word\" arg\)  word is hand entered.
2044 quit          spell session exited."
2045   (interactive (list ispell-following-word ispell-quietly current-prefix-arg t))
2046   (cond
2047    ((and region (use-region-p))
2048     (ispell-region (region-beginning) (region-end)))
2049    (continue (ispell-continue))
2050    (t
2051     (ispell-set-spellchecker-params)    ; Initialize variables and dicts alists
2052     (ispell-accept-buffer-local-defs)   ; use the correct dictionary
2053     (let ((cursor-location (point))     ; retain cursor location
2054           (word (ispell-get-word following))
2055           start end poss new-word replace)
2056       ;; De-structure return word info list.
2057       (setq start (car (cdr word))
2058             end (car (cdr (cdr word)))
2059             word (car word))
2060
2061       ;; At this point it used to ignore 2-letter words.
2062       ;; But that is silly; if the user asks for it, we should do it. - rms.
2063       (or quietly
2064           (message "Checking spelling of %s..."
2065                    (funcall ispell-format-word-function word)))
2066       (ispell-send-string "%\n")        ; put in verbose mode
2067       (ispell-send-string (concat "^" word "\n"))
2068       ;; wait until ispell has processed word
2069       (while (progn
2070                (ispell-accept-output)
2071                (not (string= "" (car ispell-filter)))))
2072       ;;(ispell-send-string "!\n") ;back to terse mode.
2073       (setq ispell-filter (cdr ispell-filter)) ; remove extra \n
2074       (if (and ispell-filter (listp ispell-filter))
2075           (if (> (length ispell-filter) 1)
2076               (error "Ispell and its process have different character maps")
2077             (setq poss (ispell-parse-output (car ispell-filter)))))
2078       (cond ((eq poss t)
2079              (or quietly
2080                  (message "%s is correct"
2081                           (funcall ispell-format-word-function word)))
2082              (and (featurep 'xemacs)
2083                   (extent-at start)
2084                   (and (fboundp 'delete-extent)
2085                        (delete-extent (extent-at start)))))
2086             ((stringp poss)
2087              (or quietly
2088                  (message "%s is correct because of root %s"
2089                           (funcall ispell-format-word-function word)
2090                           (funcall ispell-format-word-function poss)))
2091              (and (featurep 'xemacs)
2092                   (extent-at start)
2093                   (and (fboundp 'delete-extent)
2094                        (delete-extent (extent-at start)))))
2095             ((null poss)
2096              (message "Error checking word %s using %s with %s dictionary"
2097                       (funcall ispell-format-word-function word)
2098                       (file-name-nondirectory ispell-program-name)
2099                       (or ispell-current-dictionary "default")))
2100             (ispell-check-only        ; called from ispell minor mode.
2101              (if (fboundp 'make-extent)
2102                  (if (fboundp 'set-extent-property)
2103                      (let ((ext (make-extent start end)))
2104                        (set-extent-property ext 'face ispell-highlight-face)
2105                        (set-extent-property ext 'priority 2000)))
2106                (beep)
2107                (message "%s is incorrect"
2108                         (funcall ispell-format-word-function word))))
2109             (t                          ; prompt for correct word.
2110              (save-window-excursion
2111                (setq replace (ispell-command-loop
2112                               (car (cdr (cdr poss)))
2113                               (car (cdr (cdr (cdr poss))))
2114                               (car poss) start end)))
2115              (cond ((equal 0 replace)
2116                     (ispell-add-per-file-word-list (car poss)))
2117                    (replace
2118                     (setq new-word (if (atom replace) replace (car replace))
2119                           cursor-location (+ (- (length word) (- end start))
2120                                              cursor-location))
2121                     (if (not (equal new-word (car poss)))
2122                         (progn
2123                           (goto-char start)
2124                           ;; Insert first and then delete,
2125                           ;; to avoid collapsing markers before and after
2126                           ;; into a single place.
2127                           (insert new-word)
2128                           (delete-region (point) end)
2129                           ;; It is meaningless to preserve the cursor position
2130                           ;; inside a word that has changed.
2131                           (setq cursor-location (point))
2132                           (setq end (point))))
2133                     (if (not (atom replace)) ;recheck spelling of replacement
2134                         (progn
2135                           (if (car (cdr replace)) ; query replace requested
2136                               (save-window-excursion
2137                                 (query-replace word new-word t)))
2138                           (goto-char start)
2139                           ;; single word could be split into multiple words
2140                           (setq ispell-quit (not (ispell-region start end)))
2141                           ))))
2142              ;; keep if rechecking word and we keep choices win.
2143              (if (get-buffer ispell-choices-buffer)
2144                  (kill-buffer ispell-choices-buffer))))
2145       (ispell-pdict-save ispell-silently-savep)
2146       ;; NB: Cancels ispell-quit incorrectly if called from ispell-region
2147       (if ispell-quit (setq ispell-quit nil replace 'quit))
2148       (goto-char cursor-location)       ; return to original location
2149       replace))))
2150
2151
2152 (defun ispell-get-word (following &optional extra-otherchars)
2153   "Return the word for spell-checking according to ispell syntax.
2154 If optional argument FOLLOWING is non-nil or if `ispell-following-word'
2155 is non-nil when called interactively, then the following word
2156 \(rather than preceding\) is checked when the cursor is not over a word.
2157 Optional second argument contains otherchars that can be included in word
2158 many times (see the doc string of `ispell-dictionary-alist' for details
2159 about otherchars).
2160
2161 Word syntax is controlled by the definition of the chosen dictionary,
2162 which is in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'."
2163   (ispell-set-spellchecker-params)    ; Initialize variables and dicts alists
2164   (let* ((ispell-casechars (ispell-get-casechars))
2165          (ispell-not-casechars (ispell-get-not-casechars))
2166          (ispell-otherchars (ispell-get-otherchars))
2167          (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
2168          (word-regexp (concat ispell-casechars
2169                               "+\\("
2170                               (if (not (string= "" ispell-otherchars))
2171                                   (concat ispell-otherchars "?"))
2172                               (if extra-otherchars
2173                                   (concat extra-otherchars "?"))
2174                               ispell-casechars
2175                               "+\\)"
2176                               (if (or ispell-many-otherchars-p
2177                                       extra-otherchars)
2178                                   "*" "?")))
2179          did-it-once prevpt
2180          start end word)
2181     ;; find the word
2182     (if (not (looking-at ispell-casechars))
2183         (if following
2184             (re-search-forward ispell-casechars (point-max) t)
2185           (re-search-backward ispell-casechars (point-min) t)))
2186     ;; move to front of word
2187     (re-search-backward ispell-not-casechars (point-min) 'start)
2188     (while (and (or (and (not (string= "" ispell-otherchars))
2189                          (looking-at ispell-otherchars))
2190                     (and extra-otherchars (looking-at extra-otherchars)))
2191                 (not (bobp))
2192                 (or (not did-it-once)
2193                     ispell-many-otherchars-p)
2194                 (not (eq prevpt (point))))
2195       (if (and extra-otherchars (looking-at extra-otherchars))
2196           (progn
2197             (backward-char 1)
2198             (if (looking-at ispell-casechars)
2199                 (re-search-backward ispell-not-casechars (point-min) 'move)))
2200         (setq did-it-once t
2201               prevpt (point))
2202         (backward-char 1)
2203         (if (looking-at ispell-casechars)
2204             (re-search-backward ispell-not-casechars (point-min) 'move)
2205           (backward-char -1))))
2206     ;; Now mark the word and save to string.
2207     (if (not (re-search-forward word-regexp (point-max) t))
2208         (if ispell-check-only
2209             ;; return dummy word when just flagging misspellings
2210             (list "" (point) (point))
2211           (error "No word found to check!"))
2212       (setq start (copy-marker (match-beginning 0))
2213             end (point-marker)
2214             word (buffer-substring-no-properties start end))
2215       (list word start end))))
2216
2217
2218 ;; Global ispell-pdict-modified-p is set by ispell-command-loop and
2219 ;; tracks changes in the dictionary.  The global may either be
2220 ;; a value or a list, whose value is the state of whether the
2221 ;; dictionary needs to be saved.
2222
2223 ;;;###autoload
2224 (defun ispell-pdict-save (&optional no-query force-save)
2225   "Check to see if the personal dictionary has been modified.
2226 If so, ask if it needs to be saved."
2227   (interactive (list ispell-silently-savep t))
2228   (if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p))
2229       (setq ispell-pdict-modified-p (car ispell-pdict-modified-p)))
2230   (when (and (or ispell-pdict-modified-p force-save)
2231              (or no-query
2232                  (y-or-n-p "Personal dictionary modified.  Save? ")))
2233     (ispell-send-string "#\n")  ; save dictionary
2234     (message "Personal dictionary saved.")
2235     (when flyspell-mode
2236       (flyspell-mode 0)
2237       (flyspell-mode 1)))
2238   ;; unassert variable, even if not saved to avoid questioning.
2239   (setq ispell-pdict-modified-p nil))
2240
2241 (defvar message-log-max)
2242
2243 (defun ispell-command-loop (miss guess word start end)
2244   "Display possible corrections from list MISS.
2245 GUESS lists possibly valid affix construction of WORD.
2246 Returns nil to keep word.
2247 Returns 0 to insert locally into buffer-local dictionary.
2248 Returns string for new chosen word.
2249 Returns list for new replacement word (will be rechecked).
2250   Query-replace when list length is 2.
2251   Automatic query-replace when second element is `query-replace'.
2252 Highlights the word, which is assumed to run from START to END.
2253 Global `ispell-pdict-modified-p' becomes a list where the only value
2254 indicates whether the dictionary has been modified when option `a'
2255 or `i' is used.
2256 Global `ispell-quit' set to start location to continue spell session."
2257   (let ((count ?0)
2258         (line ispell-choices-win-default-height)
2259         ;; ensure 4 context lines.
2260         (max-lines (- (ispell-adjusted-window-height) 4))
2261         (choices miss)
2262         (window-min-height (min window-min-height
2263                                 ispell-choices-win-default-height))
2264         (command-characters '( ?  ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m ))
2265         (dedicated (window-dedicated-p (selected-window)))
2266         (skipped 0)
2267         char num result textwin dedicated-win)
2268
2269     ;; setup the *Choices* buffer with valid data.
2270     (with-current-buffer (get-buffer-create ispell-choices-buffer)
2271       (setq mode-line-format
2272             (concat
2273              "--  %b  --  word: " word
2274              "  --  dict: " (or ispell-current-dictionary "default")
2275              "  --  prog: " (file-name-nondirectory ispell-program-name)))
2276       ;; XEmacs: no need for horizontal scrollbar in choices window
2277       (if (featurep 'xemacs)
2278           (set-specifier horizontal-scrollbar-visible-p nil
2279                          (cons (current-buffer) nil)))
2280       (erase-buffer)
2281       (if guess
2282           (progn
2283             (insert "Affix rules generate and capitalize "
2284                     "this word as shown below:\n\t")
2285             (while guess
2286               (if (> (+ 4 (current-column) (length (car guess)))
2287                      (window-width))
2288                   (progn
2289                     (insert "\n\t")
2290                     (setq line (1+ line))))
2291               (insert (car guess) "    ")
2292               (setq guess (cdr guess)))
2293             (insert "\nUse option `i' to accept this spelling and put it in your private dictionary.\n")
2294             (setq line (+ line (if choices 3 2)))))
2295       (while (and choices
2296                   (< (if (> (+ 7 (current-column) (length (car choices))
2297                                (if (> count ?~) 3 0))
2298                             (window-width))
2299                          (progn
2300                            (insert "\n")
2301                            (setq line (1+ line)))
2302                        line)
2303                      max-lines))
2304         ;; not so good if there are over 20 or 30 options, but then, if
2305         ;; there are that many you don't want to scan them all anyway...
2306         (while (memq count command-characters) ; skip command characters.
2307           (setq count (ispell-int-char (1+ count))
2308                 skipped (1+ skipped)))
2309         (insert "(" count ") " (car choices) "  ")
2310         (setq choices (cdr choices)
2311               count (ispell-int-char (1+ count))))
2312       (setq count (ispell-int-char (- count ?0 skipped))))
2313
2314     ;; ensure word is visible
2315     (if (not (pos-visible-in-window-p end))
2316         (sit-for 0))
2317
2318     ;; allow temporary split of dedicated windows...
2319     (if dedicated
2320         (progn
2321           (setq dedicated-win (selected-window))
2322           (set-window-dedicated-p dedicated-win nil)))
2323
2324     ;; Display choices for misspelled word.
2325     (ispell-show-choices line end)
2326     (select-window (setq textwin (next-window)))
2327
2328     ;; highlight word, protecting current buffer status
2329     (unwind-protect
2330         (progn
2331           (and ispell-highlight-p
2332                (ispell-highlight-spelling-error start end t))
2333           ;; Loop until a valid choice is made.
2334           (while
2335               (eq
2336                t
2337                (setq
2338                 result
2339                 (progn
2340                   (undo-boundary)
2341                   (let (message-log-max)
2342                     (message (concat "C-h or ? for more options; SPC to leave "
2343                                      "unchanged, Character to replace word")))
2344                   (let ((inhibit-quit t)
2345                         (input-valid t)
2346                         event)
2347                     (setq char nil skipped 0)
2348                     ;; If the user types C-g, or generates some other
2349                     ;; non-character event (such as a frame switch
2350                     ;; event), stop ispell.  As a special exception,
2351                     ;; ignore mouse events occurring in the same frame.
2352                     (while (and input-valid (not (characterp char)))
2353                       (setq event (next-key-event))
2354                       (setq input-valid
2355                             (or (not (null (setq char (event-to-character
2356                                                        event))))
2357                                 (and (mouse-event-p char)
2358                                      (eq (selected-frame)
2359                                          (window-frame
2360                                           (event-window event)))))))
2361                     (when (or quit-flag (not input-valid) (= char ?\C-g))
2362                       (setq char ?X quit-flag nil)))
2363                   ;; Adjust num to array offset skipping command characters.
2364                   (let ((com-chars command-characters))
2365                     (while com-chars
2366                       (if (and (> (car com-chars) ?0) (< (car com-chars) char))
2367                           (setq skipped (1+ skipped)))
2368                       (setq com-chars (cdr com-chars)))
2369                     (setq num (- char ?0 skipped)))
2370
2371                   (cond
2372                    ((= char ? ) nil)    ; accept word this time only
2373                    ((= char ?i)         ; accept and insert word into pers dict
2374                     (ispell-send-string (concat "*" word "\n"))
2375                     (setq ispell-pdict-modified-p '(t)) ; dictionary modified!
2376                     (and (fboundp 'flyspell-unhighlight-at)
2377                          (flyspell-unhighlight-at start))
2378                     nil)
2379                    ((or (= char ?a) (= char ?A)) ; accept word without insert
2380                     (ispell-send-string (concat "@" word "\n"))
2381                     (add-to-list 'ispell-buffer-session-localwords word)
2382                     (and (fboundp 'flyspell-unhighlight-at)
2383                          (flyspell-unhighlight-at start))
2384                     (or ispell-buffer-local-name ; session localwords might conflict
2385                         (setq ispell-buffer-local-name (buffer-name)))
2386                     (if (null ispell-pdict-modified-p)
2387                         (setq ispell-pdict-modified-p
2388                               (list ispell-pdict-modified-p)))
2389                     (if (= char ?A) 0)) ; return 0 for ispell-add buffer-local
2390                    ((or (= char ?r) (= char ?R)) ; type in replacement
2391                     (and (eq 'block ispell-highlight-p) ; refresh tty's
2392                          (ispell-highlight-spelling-error start end nil t))
2393                     (let ((result
2394                            (if (or (= char ?R) ispell-query-replace-choices)
2395                                (list (read-string
2396                                       (format "Query-replacement for %s: "word)
2397                                       word)
2398                                      t)
2399                              (cons (read-string "Replacement for: " word)
2400                                    nil))))
2401                       (and (eq 'block ispell-highlight-p)
2402                            (ispell-highlight-spelling-error start end nil
2403                                                             'block))
2404                       result))
2405                    ((or (= char ??) (= char help-char) (= char ?\C-h))
2406                     (and (eq 'block ispell-highlight-p)
2407                          (ispell-highlight-spelling-error start end nil t))
2408                     (ispell-help)
2409                     (and (eq 'block ispell-highlight-p)
2410                          (ispell-highlight-spelling-error start end nil
2411                                                           'block))
2412                     t)
2413                    ;; Quit and move point back.
2414                    ((= char ?x)
2415                     (ispell-pdict-save ispell-silently-savep)
2416                     (message "Exited spell-checking")
2417                     (setq ispell-quit t)
2418                     nil)
2419                    ;; Quit and preserve point.
2420                    ((= char ?X)
2421                     (ispell-pdict-save ispell-silently-savep)
2422                     (message "%s"
2423                      (substitute-command-keys
2424                       (concat "Spell-checking suspended;"
2425                               " use C-u \\[ispell-word] to resume")))
2426                     (setq ispell-quit start)
2427                     nil)
2428                    ((= char ?q)
2429                     (if (y-or-n-p "Really kill Ispell process? ")
2430                         (progn
2431                           (ispell-kill-ispell t) ; terminate process.
2432                           (setq ispell-quit (or (not ispell-checking-message)
2433                                                 (point))
2434                                 ispell-pdict-modified-p nil))
2435                       t))               ; continue if they don't quit.
2436                    ((= char ?l)
2437                     (and (eq 'block ispell-highlight-p) ; refresh tty displays
2438                          (ispell-highlight-spelling-error start end nil t))
2439                     (let ((new-word (read-string
2440                                      "Lookup string (`*' is wildcard): "
2441                                      word)))
2442                       (if new-word
2443                           (progn
2444                             (with-current-buffer (get-buffer-create
2445                                                   ispell-choices-buffer)
2446                               (erase-buffer)
2447                               (setq count ?0
2448                                     skipped 0
2449                                     mode-line-format ;; setup the *Choices* buffer with valid data.
2450                                     (concat "--  %b  --  word: " new-word
2451                                             "  --  word-list: "
2452                                             (or ispell-complete-word-dict
2453                                                 ispell-alternate-dictionary))
2454                                     miss (ispell-lookup-words new-word)
2455                                     choices miss
2456                                     line ispell-choices-win-default-height)
2457                               (while (and choices ; adjust choices window.
2458                                           (< (if (> (+ 7 (current-column)
2459                                                        (length (car choices))
2460                                                        (if (> count ?~) 3 0))
2461                                                     (window-width))
2462                                                  (progn
2463                                                    (insert "\n")
2464                                                    (setq line (1+ line)))
2465                                                line)
2466                                              max-lines))
2467                                 (while (memq count command-characters)
2468                                   (setq count (ispell-int-char (1+ count))
2469                                         skipped (1+ skipped)))
2470                                 (insert "(" count ") " (car choices) "  ")
2471                                 (setq choices (cdr choices)
2472                                       count (ispell-int-char (1+ count))))
2473                               (setq count (ispell-int-char
2474                                            (- count ?0 skipped))))
2475                             (ispell-show-choices line end)
2476                             (select-window (next-window)))))
2477                     (and (eq 'block ispell-highlight-p)
2478                          (ispell-highlight-spelling-error start end nil
2479                                                           'block))
2480                     t)                  ; reselect from new choices
2481                    ((= char ?u)         ; insert lowercase into dictionary
2482                     (ispell-send-string (concat "*" (downcase word) "\n"))
2483                     (setq ispell-pdict-modified-p '(t)) ; dictionary modified!
2484                     nil)
2485                    ((= char ?m)         ; type in what to insert
2486                     (ispell-send-string
2487                      (concat "*" (read-string "Insert: " word) "\n"))
2488                     (setq ispell-pdict-modified-p '(t))
2489                     (cons word nil))
2490                    ((and (>= num 0) (< num count))
2491                     (if ispell-query-replace-choices ; Query replace flag
2492                         (list (nth num miss) 'query-replace)
2493                       (nth num miss)))
2494                    ((= char ?\C-l)
2495                     (redraw-display) t)
2496                    ((= char ?\C-r)
2497                     ;; This may have alignment errors if current line is edited
2498                     (if (marker-position ispell-recursive-edit-marker)
2499                         (progn
2500                           (message "Only one recursive edit session supported")
2501                           (beep)
2502                           (sit-for 2))
2503                       (set-marker ispell-recursive-edit-marker start)
2504                       ;;(set-marker ispell-region-end reg-end)
2505                       (and ispell-highlight-p           ; unhighlight
2506                            (ispell-highlight-spelling-error start end))
2507                       (unwind-protect
2508                           (progn
2509                             (message
2510                              "%s"
2511                              (substitute-command-keys
2512                               (concat "Exit recursive edit with"
2513                                       " \\[exit-recursive-edit]")))
2514                             (save-window-excursion (save-excursion
2515                                                      (recursive-edit))))
2516                         ;; protected
2517                         (goto-char ispell-recursive-edit-marker)
2518                         (if (not (equal (marker-buffer
2519                                          ispell-recursive-edit-marker)
2520                                         (current-buffer)))
2521                             (progn
2522                               (set-marker ispell-recursive-edit-marker nil)
2523                               (error
2524                                "Cannot continue ispell from this buffer.")))
2525                         (set-marker ispell-recursive-edit-marker nil)))
2526                     (list word nil))    ; recheck starting at this word.
2527                    ((= char ?\C-z)
2528                     (funcall (key-binding "\C-z"))
2529                     t)
2530                    (t (ding) t))))))
2531           result)
2532       ;; protected
2533       (and ispell-highlight-p           ; unhighlight
2534            (save-window-excursion
2535              (select-window textwin)
2536              (ispell-highlight-spelling-error start end)))
2537       (if dedicated
2538           (set-window-dedicated-p dedicated-win t)))))
2539
2540
2541
2542 (defun ispell-show-choices (line end)
2543   "Show the choices in another buffer or frame."
2544   (if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer))
2545       (progn
2546         (framepop-display-buffer (get-buffer ispell-choices-buffer))
2547         ;; (get-buffer-window ispell-choices-buffer t)
2548         (select-window (previous-window))) ; *Choices* window
2549     ;; standard selection by splitting a small buffer out of this window.
2550     (let ((choices-window (get-buffer-window ispell-choices-buffer)))
2551       (if choices-window
2552           (if (= line (ispell-adjusted-window-height choices-window))
2553               (select-window choices-window)
2554             ;; *Choices* window changed size.  Adjust the choices window
2555             ;; without scrolling the spelled window when possible
2556             (let ((window-line
2557                    (- line (ispell-adjusted-window-height choices-window)))
2558                   (visible (progn (vertical-motion -1) (point))))
2559               (if (< line ispell-choices-win-default-height)
2560                   (setq window-line (+ window-line
2561                                        (- ispell-choices-win-default-height
2562                                           line))))
2563               (move-to-window-line 0)
2564               (vertical-motion window-line)
2565               (set-window-start (selected-window)
2566                                 (if (> (point) visible) visible (point)))
2567               (goto-char end)
2568               (select-window choices-window)
2569               (enlarge-window window-line)))
2570         ;; Overlay *Choices* window when it isn't showing
2571         (ispell-overlay-window (max line ispell-choices-win-default-height)))
2572       (switch-to-buffer ispell-choices-buffer)
2573       (goto-char (point-min)))))
2574
2575
2576 ;;;###autoload
2577 (defun ispell-help ()
2578   "Display a list of the options available when a misspelling is encountered.
2579
2580 Selections are:
2581
2582 DIGIT: Replace the word with a digit offered in the *Choices* buffer.
2583 SPC:   Accept word this time.
2584 `i':   Accept word and insert into private dictionary.
2585 `a':   Accept word for this session.
2586 `A':   Accept word and place in `buffer-local dictionary'.
2587 `r':   Replace word with typed-in value.  Rechecked.
2588 `R':   Replace word with typed-in value.  Query-replaced in buffer.  Rechecked.
2589 `?':   Show these commands.
2590 `x':   Exit spelling buffer.  Move cursor to original point.
2591 `X':   Exit spelling buffer.  Leaves cursor at the current point, and permits
2592         the aborted check to be completed later.
2593 `q':   Quit spelling session (Kills ispell process).
2594 `l':   Look up typed-in replacement in alternate dictionary.  Wildcards okay.
2595 `u':   Like `i', but the word is lower-cased first.
2596 `m':   Place typed-in value in personal dictionary, then recheck current word.
2597 `C-l':  Redraw screen.
2598 `C-r':  Recursive edit.
2599 `C-z':  Suspend Emacs or iconify frame."
2600
2601   (if (equal ispell-help-in-bufferp 'electric)
2602       (progn
2603         (require 'ehelp)
2604         (with-electric-help
2605          (function (lambda ()
2606                      ;;This shouldn't be necessary: with-electric-help needs
2607                      ;; an optional argument telling it about the smallest
2608                      ;; acceptable window-height of the help buffer.
2609                      ;;(if (< (window-height) 15)
2610                      ;;  (enlarge-window
2611                      ;;   (- 15 (ispell-adjusted-window-height))))
2612                      (princ "Selections are:
2613
2614 DIGIT: Replace the word with a digit offered in the *Choices* buffer.
2615 SPC:   Accept word this time.
2616 `i':   Accept word and insert into private dictionary.
2617 `a':   Accept word for this session.
2618 `A':   Accept word and place in `buffer-local dictionary'.
2619 `r':   Replace word with typed-in value.  Rechecked.
2620 `R':   Replace word with typed-in value.  Query-replaced in buffer.  Rechecked.
2621 `?':   Show these commands.
2622 `x':   Exit spelling buffer.  Move cursor to original point.
2623 `X':   Exit spelling buffer.  Leaves cursor at the current point, and permits
2624         the aborted check to be completed later.
2625 `q':   Quit spelling session (Kills ispell process).
2626 `l':   Look up typed-in replacement in alternate dictionary.  Wildcards okay.
2627 `u':   Like `i', but the word is lower-cased first.
2628 `m':   Place typed-in value in personal dictionary, then recheck current word.
2629 `C-l':  Redraw screen.
2630 `C-r':  Recursive edit.
2631 `C-z':  Suspend Emacs or iconify frame.")
2632                      nil))))
2633
2634
2635     (let ((help-1 (concat "[r/R]eplace word; [a/A]ccept for this session; "
2636                           "[i]nsert into private dictionary"))
2637           (help-2 (concat "[l]ook a word up in alternate dictionary;  "
2638                           "e[x/X]it;  [q]uit session"))
2639           (help-3 (concat "[u]ncapitalized insert into dict.  "
2640                           "Type 'x C-h f ispell-help' for more help")))
2641       (save-window-excursion
2642         (if ispell-help-in-bufferp
2643             (progn
2644               (ispell-overlay-window 4)
2645               (switch-to-buffer (get-buffer-create "*Ispell Help*"))
2646               (insert (concat help-1 "\n" help-2 "\n" help-3))
2647               (sit-for 5)
2648               (kill-buffer "*Ispell Help*"))
2649           (unwind-protect
2650               (let ((resize-mini-windows 'grow-only))
2651                 (select-window (minibuffer-window))
2652                 (erase-buffer)
2653                 (message nil)
2654                 ;;(set-minibuffer-window (selected-window))
2655                 (enlarge-window 2)
2656                 (insert (concat help-1 "\n" help-2 "\n" help-3))
2657                 (sit-for 5))
2658             (erase-buffer)))))))
2659
2660
2661 (define-obsolete-function-alias 'lookup-words 'ispell-lookup-words) ; "24.4")
2662
2663 (defun ispell-lookup-words (word &optional lookup-dict)
2664   "Look up WORD in optional word-list dictionary LOOKUP-DICT.
2665 A `*' serves as a wild card.  If no wild cards, `look' is used if it exists.
2666 Otherwise the variable `ispell-grep-command' contains the command used to
2667 search for the words (usually egrep).
2668
2669 Optional second argument contains the dictionary to use; the default is
2670 `ispell-alternate-dictionary', overridden by `ispell-complete-word-dict'
2671 if defined."
2672   ;; We don't use the filter for this function, rather the result is written
2673   ;; into a buffer.  Hence there is no need to save the filter values.
2674   (if (null lookup-dict)
2675       (setq lookup-dict (or ispell-complete-word-dict
2676                             ispell-alternate-dictionary)))
2677
2678   (if lookup-dict
2679       (unless (file-readable-p lookup-dict)
2680         (error (concat "ispell-lookup-words error: "
2681                        "Unreadable or missing plain word-list "
2682                        lookup-dict)))
2683     (error (concat "lookup-words error: No plain word-list found at system"
2684                    "default locations.  "
2685                    "Customize `ispell-alternate-dictionary' to set yours.")))
2686
2687   (let* ((process-connection-type ispell-use-ptys-p)
2688          (wild-p (string-match "\\*" word))
2689          (look-p (and ispell-look-p     ; Only use look for an exact match.
2690                       (or ispell-have-new-look (not wild-p))))
2691          (prog (if look-p ispell-look-command ispell-grep-command))
2692          (args (if look-p ispell-look-options ispell-grep-options))
2693          status results loc)
2694     (with-temp-buffer
2695       (message "Starting \"%s\" process..." (file-name-nondirectory prog))
2696       (if look-p
2697           nil
2698         (insert "^" word)
2699         ;; When there are no wildcards, append one, for consistency
2700         ;; with `look' behavior.
2701         (unless wild-p (insert "*"))
2702         (insert "$")
2703         ;; Convert * to .*
2704         (while (search-backward "*" nil t) (insert "."))
2705         (setq word (buffer-string))
2706         (erase-buffer))
2707       (setq status (apply 'ispell-call-process prog nil t nil
2708                           (nconc (if (and args (> (length args) 0))
2709                                      (list args)
2710                                    (if look-p nil
2711                                      (list "-e")))
2712                                  (list word)
2713                                  (if lookup-dict (list lookup-dict)))))
2714       ;; `grep' returns status 1 and no output when word not found, which
2715       ;; is a perfectly normal thing.
2716       (if (stringp status)
2717           (error "error: %s exited with signal %s"
2718                  (file-name-nondirectory prog) status)
2719         ;; Else collect words into `results' in FIFO order.
2720         (goto-char (point-max))
2721         ;; Assure we've ended with \n.
2722         (or (bobp) (= (preceding-char) ?\n) (insert ?\n))
2723         (while (not (bobp))
2724           (setq loc (point))
2725           (forward-line -1)
2726           (push (buffer-substring-no-properties (point)
2727                                                 (1- loc))
2728                 results))))
2729     (if (and results (string-match ".+: " (car results)))
2730         (error "%s error: %s" ispell-grep-command (car results)))
2731     results))
2732
2733
2734 ;; "ispell-filter" is a list of output lines from the generating function.
2735 ;;   Each full line (ending with \n) is a separate item on the list.
2736 ;; "output" can contain multiple lines, part of a line, or both.
2737 ;; "start" and "end" are used to keep bounds on lines when "output" contains
2738 ;;   multiple lines.
2739 ;; "ispell-filter-continue" is true when we have received only part of a
2740 ;;   line as output from a generating function ("output" did not end with \n)
2741 ;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n!
2742 ;;   This is the case when a process dies or fails. The default behavior
2743 ;;   in this case treats the next input received as fresh input.
2744
2745 (defun ispell-filter (process output)
2746   "Output filter function for ispell, grep, and look."
2747   (let ((start 0)
2748         (continue t)
2749         end)
2750     (while continue
2751       (setq end (string-match "\n" output start)) ; get text up to the newline.
2752       ;; If we get out of sync and ispell-filter-continue is asserted when we
2753       ;; are not continuing, treat the next item as a separate list.  When
2754       ;; ispell-filter-continue is asserted, ispell-filter *should* always be a
2755       ;; list!
2756
2757       ;; Continue with same line (item)?
2758       (if (and ispell-filter-continue ispell-filter (listp ispell-filter))
2759           ;; Yes.  Add it to the prev item
2760           (setcar ispell-filter
2761                   (concat (car ispell-filter) (substring output start end)))
2762         ;; No. This is a new line and item.
2763         (setq ispell-filter
2764               (cons (substring output start end) ispell-filter)))
2765       (if (null end)
2766           ;; We've completed reading the output, but didn't finish the line.
2767           (setq ispell-filter-continue t continue nil)
2768         ;; skip over newline, this line complete.
2769         (setq ispell-filter-continue nil end (1+ end))
2770         (if (= end (length output))     ; No more lines in output
2771             (setq continue nil)         ;  so we can exit the filter.
2772           (setq start end))))))         ; else move start to next line of input
2773
2774
2775 ;; This function destroys the mark location if it is in the word being
2776 ;; highlighted.
2777 (defun ispell-highlight-spelling-error-generic (start end &optional highlight
2778                                                       refresh)
2779   "Highlight the word from START to END with a kludge using `inverse-video'.
2780 When the optional third arg HIGHLIGHT is set, the word is highlighted;
2781 otherwise it is displayed normally.
2782 Uses block cursor to highlight one character.
2783 Optional REFRESH will unhighlighted then highlight, using block cursor
2784  highlighting when REFRESH is equal to `block'."
2785   (and (eq 'block ispell-highlight-p)
2786        (or (eq 'block refresh)
2787            (setq start (1+ start))))    ; On block non-refresh, inc start.
2788   (let ((modified (buffer-modified-p))  ; don't allow this fn to modify buffer
2789         (buffer-read-only nil)          ; Allow highlighting read-only buffers.
2790         (text (buffer-substring-no-properties start end))
2791                                         ; Save highlight region.
2792         (inhibit-quit t)                ; inhibit interrupt processing here.
2793         (buffer-undo-list t))           ; don't clutter the undo list.
2794     (goto-char end)
2795     (delete-region start end)
2796     (insert-char ?  (- end start))      ; minimize amount of redisplay
2797     (sit-for 0)                         ; update display
2798     (if highlight (setq inverse-video (not inverse-video))) ; toggle video
2799     (delete-region start end)           ; delete whitespace
2800     (insert text)                       ; insert text in inverse video.
2801     (sit-for 0)                         ; update display showing inverse video.
2802     (if (not highlight)
2803         (goto-char end)
2804       (setq inverse-video (not inverse-video)) ; toggle video
2805       (and (eq 'block ispell-highlight-p)
2806            (goto-char (1- start))))     ; use block cursor to "highlight" char
2807     (set-buffer-modified-p modified)    ; don't modify if flag not set.
2808     (and refresh                        ; re-highlight
2809          (ispell-highlight-spelling-error-generic
2810           (if (eq 'block refresh) start (- start 2)) end t))))
2811
2812
2813 (defun ispell-highlight-spelling-error-xemacs (start end &optional highlight)
2814   "Highlight the word from START to END using `isearch-highlight'.
2815 When the optional third arg HIGHLIGHT is set, the word is highlighted,
2816 otherwise it is displayed normally."
2817   (if highlight
2818       (isearch-highlight start end)
2819     (isearch-dehighlight))
2820   ;;(sit-for 0)
2821   )
2822
2823
2824 (defun ispell-highlight-spelling-error-overlay (start end &optional highlight)
2825   "Highlight the word from START to END using overlays.
2826 When the optional third arg HIGHLIGHT is set, the word is highlighted
2827 otherwise it is displayed normally.
2828
2829 The variable `ispell-highlight-face' selects the face to use for highlighting."
2830   (if highlight
2831       (if ispell-overlay
2832           (move-overlay ispell-overlay start end (current-buffer))
2833         (setq ispell-overlay (make-overlay start end))
2834         (overlay-put ispell-overlay 'priority 1001) ;higher than lazy overlays
2835         (overlay-put ispell-overlay 'face ispell-highlight-face))
2836     (if ispell-overlay
2837         (delete-overlay ispell-overlay)))
2838   (if (and ispell-lazy-highlight (boundp 'lazy-highlight-cleanup))
2839       (if highlight
2840           (let ((isearch-string
2841                  (concat
2842                   "\\b"
2843                   (regexp-quote (buffer-substring-no-properties start end))
2844                   "\\b"))
2845                 (isearch-regexp t)
2846                 (isearch-case-fold-search nil)
2847                 (isearch-forward t)
2848                 (isearch-other-end start)
2849                 (isearch-error nil))
2850             (declare (special reg-start reg-end))
2851             (isearch-lazy-highlight-new-loop
2852              (if (boundp 'reg-start) reg-start)
2853              (if (boundp 'reg-end)   reg-end)))
2854         (lazy-highlight-cleanup lazy-highlight-cleanup)
2855         (setq isearch-lazy-highlight-last-string nil))))
2856
2857
2858 (defun ispell-highlight-spelling-error (start end &optional highlight refresh)
2859   (cond
2860    ((featurep 'xemacs)
2861     (ispell-highlight-spelling-error-xemacs start end highlight))
2862    ((and (featurep 'faces)
2863          (or (and (fboundp 'display-color-p) (display-color-p))
2864              window-system))
2865     (ispell-highlight-spelling-error-overlay start end highlight))
2866    (t (ispell-highlight-spelling-error-generic start end highlight refresh))))
2867
2868 (defun ispell-adjusted-window-height (&optional window)
2869   "Like `window-height', adjusted to correct for the effect of tall mode-lines.
2870 The value returned is actually the nominal number of text-lines in the
2871 window plus 1.  On a terminal, this is the same value returned by
2872 `window-height', but if the window has a mode-line is taller than a normal
2873 text line, the returned value may be smaller than that from
2874 `window-height'."
2875   (cond ((fboundp 'window-text-height)
2876          (1+ (window-text-height window)))
2877         ((or (and (fboundp 'display-graphic-p) (display-graphic-p))
2878              (and (featurep 'xemacs) window-system))
2879          (1- (window-height window)))
2880         (t
2881          (window-height window))))
2882
2883 (defun ispell-overlay-window (height)
2884   "Create a window covering the top HEIGHT lines of the current window.
2885 Ensure that the line above point is still visible but otherwise avoid
2886 scrolling the current window.  Leave the new window selected."
2887   (save-excursion
2888     (let ((oldot (save-excursion (vertical-motion -1) (point)))
2889           (top (save-excursion (move-to-window-line height) (point))))
2890       ;; If line above old point (line starting at oldot) would be
2891       ;; hidden by new window, scroll it to just below new win
2892       ;; otherwise set top line of other win so it doesn't scroll.
2893       (if (< oldot top) (setq top oldot))
2894       ;; if frame is unsplittable, temporarily disable that...
2895       (if (cdr (assq 'unsplittable (frame-parameters (selected-frame))))
2896           (let ((frame (selected-frame)))
2897             (modify-frame-parameters frame '((unsplittable . nil)))
2898             (split-window nil height)
2899             (modify-frame-parameters frame '((unsplittable . t))))
2900         (split-window nil height))
2901       (let ((deficit (- height (ispell-adjusted-window-height))))
2902         (when (> deficit 0)
2903           ;; Number of lines the window is still too short.  We ensure that
2904           ;; there are at least (1- HEIGHT) lines visible in the window.
2905           (enlarge-window deficit)
2906           (goto-char top)
2907           (vertical-motion deficit)
2908           (setq top (min (point) oldot))))
2909       (set-window-start (next-window) top))))
2910
2911
2912 ;; Should we add a compound word match return value?
2913 (defun ispell-parse-output (output &optional accept-list shift)
2914   "Parse the OUTPUT string from Ispell process and return:
2915 1: t for an exact match.
2916 2: A string containing the root word matched via suffix removal.
2917 3: A list of possible correct spellings of the format:
2918    (\"ORIGINAL-WORD\" OFFSET MISS-LIST GUESS-LIST)
2919    ORIGINAL-WORD is a string of the possibly misspelled word.
2920    OFFSET is an integer giving the line offset of the word.
2921    MISS-LIST and GUESS-LIST are possibly null lists of guesses and misses.
2922 4: nil when an error has occurred.
2923
2924 Optional second arg ACCEPT-LIST is list of words already accepted.
2925 Optional third arg SHIFT is an offset to apply based on previous corrections."
2926   (cond
2927    ((string= output "") t)              ; for startup with pipes...
2928    ((string= output "*") t)             ; exact match
2929    ((string= output "-") t)             ; compound word match
2930    ((eq (aref output 0) ?+)             ; found because of root word
2931     (substring output 2))               ; return root word
2932    ((equal 0 (string-match "[\ra-zA-Z]" output))
2933     (ding)                              ; error message from ispell!
2934     (message "Ispell error: %s" output)
2935     (sit-for 5)
2936     nil)
2937    (t                                   ; need to process &, ?, and #'s
2938     (let ((type (aref output 0))        ; &, ?, or #
2939           (original-word (substring output 2 (string-match " " output 2)))
2940           (cur-count 0)                 ; contains number of misses + guesses
2941           count miss-list guess-list offset)
2942       (setq output (substring output (match-end 0))) ; skip over misspelling
2943       (if (eq type ?#)
2944           (setq count 0)                ; no misses for type #
2945         (setq count (string-to-number output) ; get number of misses.
2946               output (substring output (1+ (string-match " " output 1)))))
2947       (setq offset (string-to-number output))
2948       (setq output (if (eq type ?#)     ; No miss or guess list.
2949                        nil
2950                      (substring output (1+ (string-match " " output 1)))))
2951       (while output
2952         (let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess.
2953           (setq cur-count (1+ cur-count))
2954           (if (> cur-count count)
2955               (push (substring output 0 end) guess-list)
2956             (push (substring output 0 end) miss-list))
2957           (setq output (if (match-end 1) ; True only when at end of line.
2958                            nil           ; No more misses or guesses.
2959                          (substring output (+ end 2))))))
2960       ;; return results.  Accept word if it was already accepted.
2961       ;; adjust offset.
2962       (if (member original-word accept-list)
2963           t
2964         (list original-word
2965               (if (numberp shift) (+ shift offset) offset)
2966               (nreverse miss-list) (nreverse guess-list)))))))
2967
2968
2969 (defun ispell-process-status ()
2970   "Return the status of the Ispell process.
2971 When asynchronous processes are not supported, `run' is always returned."
2972   (if ispell-async-processp
2973       (process-status ispell-process)
2974     (and ispell-process 'run)))
2975
2976
2977 (defun ispell-start-process ()
2978   "Start the ispell process, with support for no asynchronous processes.
2979 Keeps argument list for future ispell invocations for no async support."
2980   ;; `ispell-current-dictionary' and `ispell-current-personal-dictionary'
2981   ;; are properly set in `ispell-internal-change-dictionary'.
2982
2983   ;; Parse hunspell affix file if using hunspell and entry is uninitialized.
2984   (if ispell-really-hunspell
2985       (or (cadr (assoc ispell-current-dictionary ispell-dictionary-alist))
2986           (ispell-hunspell-fill-dictionary-entry ispell-current-dictionary)))
2987   (let* ((default-directory
2988            (if (file-accessible-directory-p default-directory)
2989                default-directory
2990              ;; Defend against bad `default-directory'.
2991              (expand-file-name "~/")))
2992          (orig-args (ispell-get-ispell-args))
2993          (args
2994           (append
2995            (if (and ispell-current-dictionary      ; Not for default dict (nil)
2996                     (not (member "-d" orig-args))) ; Only define if not overridden.
2997                (list "-d" ispell-current-dictionary))
2998            orig-args
2999            (if ispell-current-personal-dictionary ; Use specified pers dict.
3000                (list "-p"
3001                      (expand-file-name ispell-current-personal-dictionary)))
3002            ;; If we are using recent aspell or hunspell, make sure we use the
3003            ;; right encoding for communication. ispell or older aspell/hunspell
3004            ;; does not support this.
3005            (if ispell-encoding8-command
3006                (if ispell-really-hunspell
3007                    (list ispell-encoding8-command
3008                          (upcase (symbol-name (ispell-get-coding-system))))
3009                  (list
3010                   (concat ispell-encoding8-command
3011                           (symbol-name (ispell-get-coding-system))))))
3012            ispell-extra-args)))
3013
3014     ;; Initially we don't know any buffer's local words.
3015     (setq ispell-buffer-local-name nil)
3016
3017     (if ispell-async-processp
3018         (let ((process-connection-type ispell-use-ptys-p))
3019           (apply 'start-process
3020                  "ispell" nil ispell-program-name
3021                  "-a"                   ; Accept single input lines.
3022                  ;; Make root/affix combos not in dict.
3023                  ;; hunspell -m option means different.
3024                  (if ispell-really-hunspell "" "-m")
3025                  args))
3026       (setq ispell-cmd-args args
3027             ispell-output-buffer (generate-new-buffer " *ispell-output*")
3028             ispell-session-buffer (generate-new-buffer " *ispell-session*"))
3029       (ispell-send-string "\032\n")     ; so Ispell prints version and exits
3030       t)))
3031
3032
3033 (defun ispell-init-process ()
3034   "Check status of Ispell process and start if necessary."
3035   (let* (;; Basename of dictionary used by the spell-checker
3036          (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args))))
3037                          ispell-current-dictionary))
3038          ;; The directory where process was started.
3039          (current-ispell-directory default-directory)
3040          ;; The default directory for the process.
3041          ;; Use "~/" as default-directory unless using Ispell with per-dir
3042          ;; personal dictionaries and not in a minibuffer under XEmacs
3043          (default-directory
3044            (if (or ispell-really-aspell
3045                    ispell-really-hunspell
3046                    ;; Protect against bad default-directory
3047                    (not (file-accessible-directory-p default-directory))
3048                    ;; Ispell and per-dir personal dicts available
3049                    (not (or (file-readable-p (concat default-directory
3050                                                      ".ispell_words"))
3051                             (file-readable-p (concat default-directory
3052                                                      ".ispell_"
3053                                                      (or dict-bname
3054                                                          "default")))))
3055                    ;; Ispell, in a minibuffer, and XEmacs
3056                    (and (window-minibuffer-p)
3057                         (not (fboundp 'minibuffer-selected-window))))
3058                (expand-file-name "~/")
3059              (expand-file-name default-directory))))
3060     ;; Check if process needs restart
3061     (if (and ispell-process
3062              (eq (ispell-process-status) 'run)
3063              ;; Unless we are using an explicit personal dictionary, ensure
3064              ;; we're in the same default directory!  Restart check for
3065              ;; personal dictionary is done in
3066              ;; `ispell-internal-change-dictionary', called from
3067              ;; `ispell-buffer-local-dict'
3068              (or (or ispell-local-pdict ispell-personal-dictionary)
3069                  (equal ispell-process-directory default-directory)))
3070         (setq ispell-filter nil ispell-filter-continue nil)
3071       ;; may need to restart to select new personal dictionary.
3072       (ispell-kill-ispell t)
3073       (message "Starting new Ispell process %s with %s dictionary..."
3074                ispell-program-name
3075                (or ispell-local-dictionary ispell-dictionary "default"))
3076       (sit-for 0)
3077       (setq ispell-library-directory (ispell-check-version)
3078             ispell-process (ispell-start-process)
3079             ispell-filter nil
3080             ispell-filter-continue nil
3081             ispell-process-directory default-directory)
3082
3083       (unless (equal ispell-process-directory (expand-file-name "~/"))
3084         ;; At this point, `ispell-process-directory' will be "~/" unless using
3085         ;; Ispell with directory-specific dicts and not in XEmacs minibuffer.
3086         ;; If not, kill ispell process when killing buffer.  It may be in a
3087         ;; removable device that would otherwise become un-mountable.
3088         (with-current-buffer
3089             (if (and (window-minibuffer-p)                  ;; In minibuffer
3090                      (fboundp 'minibuffer-selected-window)) ;; Not XEmacs.
3091                 ;; In this case kill ispell only when parent buffer is killed
3092                 ;; to avoid over and over ispell kill.
3093                 (window-buffer (minibuffer-selected-window))
3094               (current-buffer))
3095           ;; 'local does not automatically make hook buffer-local in XEmacs.
3096           (if (featurep 'xemacs)
3097               (make-local-hook 'kill-buffer-hook))
3098           (add-hook 'kill-buffer-hook
3099                     (lambda () (ispell-kill-ispell t)) nil 'local)))
3100
3101       (if ispell-async-processp
3102           (set-process-filter ispell-process 'ispell-filter))
3103       ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'.
3104       (if (and (or (featurep 'xemacs)
3105                    (and (boundp 'enable-multibyte-characters)
3106                         enable-multibyte-characters))
3107                (fboundp 'set-process-coding-system))
3108           (set-process-coding-system ispell-process (ispell-get-coding-system)
3109                                      (ispell-get-coding-system)))
3110       ;; Get version ID line
3111       (ispell-accept-output 3)
3112       ;; get more output if filter empty?
3113       (if (null ispell-filter) (ispell-accept-output 3))
3114       (cond ((null ispell-filter)
3115              (error "%s did not output version line" ispell-program-name))
3116             ((and
3117               (stringp (car ispell-filter))
3118               (if (string-match "warning: " (car ispell-filter))
3119                   (progn
3120                     (ispell-accept-output 3) ; was warn msg.
3121                     (stringp (car ispell-filter)))
3122                 (null (cdr ispell-filter)))
3123               (string-match "^@(#) " (car ispell-filter)))
3124              ;; got the version line as expected (we already know it's the right
3125              ;; version, so don't bother checking again.)
3126              nil)
3127             (t
3128              ;; Otherwise, it must be an error message.  Show the user.
3129              ;; But first wait to see if some more output is going to arrive.
3130              ;; Otherwise we get cool errors like "Can't open ".
3131              (sleep-for 1)
3132              (ispell-accept-output 3)
3133              (error "%s" (mapconcat 'identity ispell-filter "\n"))))
3134       (setq ispell-filter nil)          ; Discard version ID line
3135       (let ((extended-char-mode (ispell-get-extended-character-mode)))
3136         (if extended-char-mode          ; ~ extended character mode
3137             (ispell-send-string (concat extended-char-mode "\n"))))
3138       (if ispell-async-processp
3139           (if (not (featurep 'xemacs))
3140               (set-process-query-on-exit-flag ispell-process nil)
3141             (if (fboundp 'set-process-query-on-exit-flag)
3142                 (set-process-query-on-exit-flag ispell-process nil)
3143               (process-kill-without-query ispell-process)))))))
3144
3145 ;;;###autoload
3146 (defun ispell-kill-ispell (&optional no-error clear)
3147   "Kill current Ispell process (so that you may start a fresh one).
3148 With NO-ERROR, just return non-nil if there was no Ispell running.
3149 With CLEAR, buffer session localwords are cleaned."
3150   (interactive)
3151   ;; This hook is typically used by flyspell to flush some variables used
3152   ;; to optimize the common cases.
3153   (run-hooks 'ispell-kill-ispell-hook)
3154   (if (or clear (interactive-p))
3155       (setq ispell-buffer-session-localwords nil))
3156   (if (not (and ispell-process
3157                 (eq (ispell-process-status) 'run)))
3158       (or no-error
3159           (error "There is no Ispell process running!"))
3160     (if ispell-async-processp
3161         (delete-process ispell-process)
3162       ;; Synchronous processes
3163       (ispell-send-string "\n")         ; Make sure side effects occurred.
3164       (kill-buffer ispell-output-buffer)
3165       (kill-buffer ispell-session-buffer)
3166       (setq ispell-output-buffer nil
3167             ispell-session-buffer nil))
3168     (setq ispell-process nil)
3169     (message "Ispell process killed")
3170     nil))
3171
3172 ;; ispell-change-dictionary is set in some people's hooks.  Maybe this should
3173 ;;  call ispell-init-process rather than wait for a spell checking command?
3174
3175 ;;;###autoload
3176 (defun ispell-change-dictionary (dict &optional arg)
3177   "Change to dictionary DICT for Ispell.
3178 With a prefix arg, set it \"globally\", for all buffers.
3179 Without a prefix arg, set it \"locally\", just for this buffer.
3180
3181 By just answering RET you can find out what the current dictionary is."
3182   (interactive
3183    (list (completing-read
3184           "Use new dictionary (RET for current, SPC to complete): "
3185           (and (fboundp 'ispell-valid-dictionary-list)
3186                (mapcar 'list (ispell-valid-dictionary-list)))
3187           nil t)
3188          current-prefix-arg))
3189   (ispell-set-spellchecker-params) ; Initialize variables and dicts alists
3190   (unless arg (ispell-buffer-local-dict 'no-reload))
3191   (if (equal dict "default") (setq dict nil))
3192   ;; This relies on completing-read's bug of returning "" for no match
3193   (cond ((equal dict "")
3194          (ispell-internal-change-dictionary)
3195          (message "Using %s dictionary"
3196                   (or (and (not arg) ispell-local-dictionary)
3197                       ispell-dictionary "default")))
3198         ((equal dict (or (and (not arg) ispell-local-dictionary)
3199                          ispell-dictionary "default"))
3200          ;; Specified dictionary is the default already. Could reload
3201          ;; the dictionaries if needed.
3202          (ispell-internal-change-dictionary)
3203          (and (interactive-p)
3204               (message "No change, using %s dictionary" dict)))
3205         (t                              ; reset dictionary!
3206          (if (or (assoc dict ispell-local-dictionary-alist)
3207                  (assoc dict ispell-dictionary-alist))
3208              (if arg
3209                  ;; set default dictionary
3210                  (setq ispell-dictionary dict)
3211                ;; set local dictionary
3212                (setq ispell-local-dictionary dict)
3213                (setq ispell-local-dictionary-overridden t))
3214            (error "Undefined dictionary: %s" dict))
3215          (ispell-internal-change-dictionary)
3216          (setq ispell-buffer-session-localwords nil)
3217          (message "%s Ispell dictionary set to %s"
3218                   (if arg "Global" "Local")
3219                   dict))))
3220
3221 (defun ispell-internal-change-dictionary ()
3222   "Update the dictionary and the personal dictionary used by Ispell.
3223 This may kill the Ispell process; if so, a new one will be started
3224 when needed."
3225   (let* ((dict (or ispell-local-dictionary ispell-dictionary))
3226          (pdict (or ispell-local-pdict ispell-personal-dictionary))
3227          (expanded-pdict (if pdict (expand-file-name pdict))))
3228     (unless (and (equal ispell-current-dictionary dict)
3229                  (equal ispell-current-personal-dictionary
3230                         expanded-pdict))
3231       (ispell-kill-ispell t)
3232       (setq ispell-current-dictionary dict
3233             ispell-current-personal-dictionary expanded-pdict))))
3234
3235 ;; Avoid error messages when compiling for these dynamic variables.
3236 (defvar ispell-start)
3237 (defvar ispell-end)
3238
3239 ;; Spelling of comments are checked when ispell-check-comments is non-nil.
3240
3241 ;;;###autoload
3242 (defun ispell-region (reg-start reg-end &optional recheckp shift)
3243   "Interactively check a region for spelling errors.
3244 Return nil if spell session was terminated, otherwise returns shift offset
3245 amount for last line processed."
3246   (interactive "r")                     ; Don't flag errors on read-only bufs.
3247   (ispell-set-spellchecker-params)      ; Initialize variables and dicts alists
3248   (if (not recheckp)
3249       (ispell-accept-buffer-local-defs)) ; set up dictionary, local words, etc.
3250   (let ((skip-region-start (make-marker))
3251         (rstart (make-marker))
3252         (rstart (make-marker))
3253         (region-type (if (and (eql reg-start (point-min))
3254                               (eql reg-end (point-max)))
3255                          (buffer-name)
3256                        "region"))
3257         (program-basename (file-name-nondirectory ispell-program-name))
3258         (dictionary (or ispell-current-dictionary "default")))
3259     (unwind-protect
3260         (save-excursion
3261           (message "Spell-checking %s using %s with %s dictionary..."
3262                    region-type program-basename dictionary)
3263           ;; Returns cursor to original location.
3264           (save-window-excursion
3265             (goto-char reg-start)
3266             (let ((transient-mark-mode)
3267                   (case-fold-search case-fold-search)
3268                   (query-fcc t)
3269                   in-comment key)
3270               (ispell-print-if-debug
3271                "ispell-region: (ispell-skip-region-list):\n%s
3272 ispell-region: (ispell-begin-skip-region-regexp):\n%s
3273 ispell-region: Search for first region to skip after (ispell-begin-skip-region-regexp)\n"
3274                (ispell-skip-region-list)
3275                (ispell-begin-skip-region-regexp))
3276               (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
3277                   (progn
3278                     (setq key (match-string-no-properties 0))
3279                     (set-marker skip-region-start (- (point) (length key)))
3280                     (goto-char reg-start)
3281                     (ispell-print-if-debug
3282                      "ispell-region: First skip: %s at (pos,line,column): (%s,%s,%s).\n"
3283                      key
3284                      (save-excursion (goto-char skip-region-start) (point))
3285                      (line-number-at-pos skip-region-start)
3286                      (save-excursion (goto-char skip-region-start) (current-column)))))
3287               (ispell-print-if-debug
3288                "ispell-region: Continue spell-checking with %s and %s dictionary...\n"
3289                 program-basename dictionary)
3290               (set-marker rstart reg-start)
3291               (set-marker ispell-region-end reg-end)
3292               (while (and (not ispell-quit)
3293                           (< (point) ispell-region-end))
3294                 ;; spell-check region with skipping
3295                 (if (and (marker-position skip-region-start)
3296                          (<= skip-region-start (point)))
3297                     (progn
3298                       ;; If region inside line comment, must keep comment start.
3299                       (setq in-comment (point)
3300                             in-comment
3301                             (and comment-start
3302                                  (or (null comment-end) (string= "" comment-end))
3303                                  (save-excursion
3304                                    (beginning-of-line)
3305                                    (re-search-forward comment-start in-comment t))
3306                                  comment-start))
3307                       ;; Can change skip-regexps (in ispell-message)
3308                       (ispell-skip-region key) ; moves pt past region.
3309                       (set-marker rstart (point))
3310                       ;; check for saving large attachments...
3311                       (setq query-fcc (and query-fcc
3312                                            (ispell-ignore-fcc skip-region-start
3313                                                               rstart)))
3314                       (if (and (< rstart ispell-region-end)
3315                                (re-search-forward
3316                                 (ispell-begin-skip-region-regexp)
3317                                 ispell-region-end t))
3318                           (progn
3319                             (setq key (match-string-no-properties 0))
3320                             (set-marker skip-region-start
3321                                         (- (point) (length key)))
3322                             (goto-char rstart)
3323                             (ispell-print-if-debug
3324                              "ispell-region: Next skip: %s at (pos,line,column): (%s,%s,%s).\n"
3325                              key
3326                              (save-excursion (goto-char skip-region-start) (point))
3327                              (line-number-at-pos skip-region-start)
3328                              (save-excursion (goto-char skip-region-start) (current-column))))
3329                         (set-marker skip-region-start nil))))
3330                 (setq reg-end (max (point)
3331                                    (if (marker-position skip-region-start)
3332                                        (min skip-region-start ispell-region-end)
3333                                      (marker-position ispell-region-end))))
3334                 (let* ((ispell-start (point))
3335                        (ispell-end (min (point-at-eol) reg-end))
3336                        ;; See if line must be prefixed by comment string to
3337                        ;; let ispell know this is part of a comment string.
3338                        ;; This is only supported in some modes.  In
3339                        ;; particular, this is not supported in autoconf mode
3340                        ;; where adding the comment string messes everything
3341                        ;; up because ispell tries to spellcheck the `dnl'
3342                        ;; string header causing misalignments in some cases
3343                        ;; (debbugs.gnu.org: #12768).
3344                        (add-comment (and in-comment
3345                                          (not (string= in-comment "dnl "))
3346                                          in-comment))
3347                        (string (ispell-get-line
3348                                 ispell-start ispell-end add-comment)))
3349                   (ispell-print-if-debug
3350                    "ispell-region: string pos (%s->%s), eol: %s, [\
3351 in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n" ispell-start
3352                    ispell-end (point-at-eol) in-comment add-comment string)
3353                   (if add-comment ; account for comment chars added
3354                       (setq ispell-start (- ispell-start (length add-comment))
3355                             ;; Reset `in-comment' (and indirectly
3356                             ;; `add-comment') for new line
3357                             in-comment nil))
3358                   (setq ispell-end (point)) ; "end" tracks region retrieved.
3359                   (if string            ; there is something to spell check!
3360                       ;; (special start end)
3361                       (setq shift (ispell-process-line string
3362                                                        (and recheckp shift))))
3363                   (goto-char ispell-end)))))
3364           (if ispell-quit
3365               nil
3366             (or shift 0)))
3367       ;; protected
3368       (if (and (not (and recheckp ispell-keep-choices-win))
3369                (get-buffer ispell-choices-buffer))
3370           (kill-buffer ispell-choices-buffer))
3371       (set-marker skip-region-start nil)
3372       (set-marker rstart nil)
3373       (if ispell-quit
3374           (progn
3375             ;; preserve or clear the region for ispell-continue.
3376             (if (not (numberp ispell-quit))
3377                 (set-marker ispell-region-end nil)
3378               ;; Ispell-continue enabled - ispell-region-end is set.
3379               (goto-char ispell-quit))
3380             ;; Check for aborting
3381             (if (and ispell-checking-message (numberp ispell-quit))
3382                 (progn
3383                   (setq ispell-quit nil)
3384                   (error "Message send aborted")))
3385             (if (not recheckp) (setq ispell-quit nil)))
3386         (if (not recheckp) (set-marker ispell-region-end nil))
3387         ;; Only save if successful exit.
3388         (ispell-pdict-save ispell-silently-savep)
3389         (message "Spell-checking %s using %s with %s dictionary...done"
3390                  region-type program-basename dictionary)))))
3391
3392
3393 (defun ispell-begin-skip-region-regexp ()
3394   "Return a regexp of the search keys for region skipping.
3395 Includes `ispell-skip-region-alist' plus tex, tib, html, and comment keys.
3396 Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
3397   (mapconcat
3398    'identity
3399    (delq nil
3400          (list
3401           ;; messages
3402           (if (and ispell-checking-message
3403                    (not (eq t ispell-checking-message)))
3404               (mapconcat #'car ispell-checking-message "\\|"))
3405           ;; tex
3406           (if (eq ispell-parser 'tex)
3407               (ispell-begin-tex-skip-regexp))
3408           ;; html stuff
3409           (if ispell-skip-html
3410               (ispell-begin-skip-region ispell-html-skip-alists))
3411           ;; tib
3412           (if ispell-skip-tib ispell-tib-ref-beginning)
3413           ;; Comments
3414           (if (and (eq 'exclusive ispell-check-comments) comment-start)
3415               ;; search from end of current comment to start of next comment.
3416               (if (string= "" comment-end) "^" (regexp-quote comment-end)))
3417           (if (and (null ispell-check-comments) comment-start)
3418               (regexp-quote comment-start))
3419           (ispell-begin-skip-region ispell-skip-region-alist)))
3420    "\\|"))
3421
3422
3423 (defun ispell-begin-skip-region (skip-alist)
3424   "Regular expression for start of regions to skip generated from SKIP-ALIST.
3425 Each selection should be a key of SKIP-ALIST;
3426 otherwise, the current line is skipped."
3427   (mapconcat (lambda (lst) (if (stringp (car lst)) (car lst) (eval (car lst))))
3428              skip-alist
3429              "\\|"))
3430
3431
3432 (defun ispell-begin-tex-skip-regexp ()
3433   "Regular expression of tex commands to skip.
3434 Generated from `ispell-tex-skip-alists'."
3435   (concat
3436    ;; raw tex keys
3437    (mapconcat (function (lambda (lst) (car lst)))
3438               (car ispell-tex-skip-alists)
3439               "\\|")
3440    "\\|"
3441    ;; keys wrapped in begin{}
3442    (mapconcat (function (lambda (lst)
3443                           (concat "\\\\begin[ \t\n]*{[ \t\n]*"
3444                                   (car lst)
3445                                   "[ \t\n]*}")))
3446               (car (cdr ispell-tex-skip-alists))
3447               "\\|")))
3448
3449
3450 (defun ispell-skip-region-list ()
3451   "Return a list describing key and body regions to skip for this buffer.
3452 Includes regions defined by `ispell-skip-region-alist', tex mode,
3453 `ispell-html-skip-alists', and `ispell-checking-message'.
3454 Manual checking must include comments and tib references.
3455 The list is of the form described by variable `ispell-skip-region-alist'.
3456 Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
3457   (let ((skip-alist ispell-skip-region-alist))
3458     ;; only additional explicit region definition is tex.
3459     (if (eq ispell-parser 'tex)
3460         (setq case-fold-search nil
3461               skip-alist (append (car ispell-tex-skip-alists)
3462                                  (car (cdr ispell-tex-skip-alists))
3463                                  skip-alist)))
3464     (if ispell-skip-html
3465         (setq skip-alist (append ispell-html-skip-alists skip-alist)))
3466     (if (and ispell-checking-message
3467              (not (eq t ispell-checking-message)))
3468         (setq skip-alist (append ispell-checking-message skip-alist)))
3469     skip-alist))
3470
3471
3472 (defun ispell-tex-arg-end (&optional arg)
3473   "Skip across ARG number of braces."
3474   (condition-case nil
3475       (progn
3476         (while (looking-at "[ \t\n]*\\[") (forward-sexp))
3477         (forward-sexp (or arg 1)))
3478     (error
3479      (message "Error skipping s-expressions at point %d." (point))
3480      (beep)
3481      (sit-for 2))))
3482
3483
3484 (defun ispell-ignore-fcc (start end)
3485   "Delete the Fcc: message header when large attachments are included.
3486 Return value `nil' if file with large attachments is saved.
3487 This can be used to avoid multiple questions for multiple large attachments.
3488 Returns point to starting location afterwards."
3489   (let ((result t))
3490     (if (and ispell-checking-message ispell-message-fcc-skip)
3491         (if (< ispell-message-fcc-skip (- end start))
3492             (let (case-fold-search head-end)
3493               (goto-char (point-min))
3494               (setq head-end
3495                     (or (re-search-forward
3496                          (concat "^" (regexp-quote mail-header-separator) "$")
3497                          nil t)
3498                         (re-search-forward "^$" nil t)
3499                         (point-min)))
3500               (goto-char (point-min))
3501               (if (re-search-forward "^Fcc:" head-end t)
3502                   (if (y-or-n-p
3503                        "Save copy of this message with large attachments? ")
3504                       (setq result nil)
3505                     (beginning-of-line)
3506                     (kill-line 1)))
3507               (goto-char end))))
3508     result))
3509
3510
3511 (defun ispell-skip-region (key)
3512   "Skip across KEY and then to end of region.
3513 Key lookup determines region to skip.
3514 Point is placed at end of skipped region."
3515   ;; move over key to begin checking.
3516   (forward-char (length key))
3517   (let ((start (point))
3518         ;; Regenerate each call... This function can change region definition.
3519         (alist (ispell-skip-region-list))
3520         alist-key null-skip)
3521     (cond
3522      ;; what about quoted comment, or comment inside strings?
3523      ((and (null ispell-check-comments) comment-start
3524            (string= key comment-start))
3525       (if (string= "" comment-end)
3526           (forward-line)
3527         (search-forward comment-end ispell-region-end t)))
3528      ((and (eq 'exclusive ispell-check-comments) comment-start
3529            (string= key comment-end))
3530       (search-forward comment-start ispell-region-end :end))
3531      ((and ispell-skip-tib (string-match ispell-tib-ref-beginning key))
3532       (re-search-forward ispell-tib-ref-end ispell-region-end t))
3533      ;; markings from alist
3534      (t
3535       (while alist
3536         (setq alist-key (eval (car (car alist))))
3537         (if (string-match alist-key key)
3538             (progn
3539               (setq alist (cdr (car alist)))
3540               (cond
3541                ((null alist) (setq null-skip t)) ; done!  Just skip key.
3542                ((not (consp alist))
3543                 ;; Search past end of spell region to find this region end.
3544                 (re-search-forward (eval alist) (point-max) t))
3545                ((and (= 1 (length alist))
3546                      (stringp (car alist)))
3547                 (re-search-forward (car alist) (point-max) t))
3548                (t
3549                 (setq null-skip t)      ; error handling in functions!
3550                 (if (consp (cdr alist))
3551                     (apply (car alist) (cdr alist))
3552                   (funcall (car alist)))))
3553               (setq alist nil))
3554           (setq alist (cdr alist))))))
3555     (if (and (= start (point)) (null null-skip))
3556         (progn
3557           (message "Matching region end for `%s' point %d not found"
3558                    key (point))
3559           (beep)
3560           (sit-for 2)))))
3561
3562
3563 (defun ispell-get-line (start end in-comment)
3564   "Grab the next line of data.
3565 Returns a string with the line data."
3566   (let ((ispell-casechars (ispell-get-casechars))
3567         string)
3568     (cond                               ; LOOK AT THIS LINE AND SKIP OR PROCESS
3569      ((eolp)                            ; END OF LINE, just go to next line.
3570       (forward-line))
3571      ;;((looking-at "[-#@*+!%~^]")      ; SKIP SPECIAL ISPELL CHARACTERS
3572      ;; (forward-char 1))               ; not needed as quoted below.
3573      ((or (re-search-forward ispell-casechars end t) ; TEXT EXISTS
3574           (re-search-forward "[][()${}]" end t)) ; or MATH COMMANDS
3575       (setq string (concat "^" in-comment
3576                            (buffer-substring-no-properties start end)
3577                            "\n"))
3578       (goto-char end))
3579      (t (goto-char end)))               ; EMPTY LINE, skip it.
3580     string))
3581
3582
3583 (defun ispell-looking-at (string)
3584   (let ((coding (ispell-get-coding-system))
3585         (len (length string)))
3586     (and (<= (+ (point) len) (point-max))
3587          (equal (encode-coding-string string coding)
3588                 (encode-coding-string (buffer-substring-no-properties
3589                                        (point) (+ (point) len))
3590                                       coding)))))
3591
3592 (defun ispell-process-line (string shift)
3593   "Send STRING, a line of text, to ispell and process the result.
3594 This will modify the buffer for spelling errors.
3595 Requires variables ISPELL-START and ISPELL-END to be defined in its
3596 dynamic scope.
3597 Returns the sum SHIFT due to changes in word replacements."
3598   ;;(declare special ispell-start ispell-end)
3599   (let (poss accept-list)
3600     (if (not (numberp shift))
3601         (setq shift 0))
3602     ;; send string to spell process and get input.
3603     (ispell-send-string string)
3604     (while (progn
3605              (ispell-accept-output)
3606              ;; Last item of output contains a blank line.
3607              (not (string= "" (car ispell-filter)))))
3608     ;; parse all inputs from the stream one word at a time.
3609     ;; Place in FIFO order and remove the blank item.
3610     (setq ispell-filter (nreverse (cdr ispell-filter)))
3611     (while (and (not ispell-quit) ispell-filter)
3612       ;; get next word, accounting for accepted words and start shifts
3613       (setq poss (ispell-parse-output (car ispell-filter)
3614                                       accept-list shift))
3615       (if (and poss (listp poss))       ; spelling error occurred.
3616           ;; Whenever we have misspellings, we can change
3617           ;; the buffer.  Keep boundaries as markers.
3618           ;; Markers can move with highlighting!  This destroys
3619           ;; end of region markers line-end and ispell-region-end
3620           (let ((word-start
3621                  (copy-marker (+ ispell-start ispell-offset (car (cdr poss)))))
3622                 (word-len (length (car poss)))
3623                 (line-end (copy-marker ispell-end))
3624                 (line-start (copy-marker ispell-start))
3625                 recheck-region replace)
3626             (goto-char word-start)
3627             ;; Adjust the horizontal scroll & point
3628             (ispell-horiz-scroll)
3629             (goto-char (+ word-len word-start))
3630             (ispell-horiz-scroll)
3631             (goto-char word-start)
3632             (ispell-horiz-scroll)
3633
3634             ;; Alignment cannot be tracked and this error will occur when
3635             ;; `query-replace' makes multiple corrections on the starting line.
3636             (or (ispell-looking-at (car poss))
3637                 ;; This occurs due to filter pipe problems
3638                 (error (concat "Ispell misalignment: word "
3639                                "`%s' point %d; probably incompatible versions")
3640                        (car poss) (marker-position word-start)))
3641             ;; ispell-cmd-loop can go recursive & change buffer
3642             (if ispell-keep-choices-win
3643                 (setq replace (ispell-command-loop
3644                                (car (cdr (cdr poss)))
3645                                (car (cdr (cdr (cdr poss))))
3646                                (car poss) (marker-position word-start)
3647                                (+ word-len (marker-position word-start))))
3648               (save-window-excursion
3649                 (setq replace (ispell-command-loop
3650                                (car (cdr (cdr poss)))
3651                                (car (cdr (cdr (cdr poss))))
3652                                (car poss) (marker-position word-start)
3653                                (+ word-len (marker-position word-start))))))
3654
3655             (goto-char word-start)
3656             ;; Recheck when query replace edit changes misspelled word.
3657             ;; Error in tex mode when a potential math mode change exists.
3658             (if (and replace (listp replace) (= 2 (length replace)))
3659                 (if (and (eq ispell-parser 'tex)
3660                          (string-match "[\\\\][]()[]\\|\\\\begin\\|\\$"
3661                                        (regexp-quote string)))
3662                     (error
3663                      "Don't start query replace on a line with math characters"
3664                      )
3665                   (set-marker line-end (point))
3666                   (setq ispell-filter nil
3667                         recheck-region t)))
3668
3669             ;; insert correction if needed
3670             (cond
3671              ((or (null replace)
3672                   (equal 0 replace))    ; ACCEPT/INSERT
3673               (if (equal 0 replace)     ; BUFFER-LOCAL DICT ADD
3674                   (ispell-add-per-file-word-list (car poss)))
3675               ;; do not recheck accepted word on this line
3676               (setq accept-list (cons (car poss) accept-list)))
3677              (t                         ; replacement word selected or entered
3678               (delete-region (point) (+ word-len (point)))
3679               (if (not (listp replace))
3680                   (progn
3681                     (insert replace) ; insert dictionary word
3682                     (ispell-send-replacement (car poss) replace)
3683                     (setq accept-list (cons replace accept-list)))
3684                 (let ((replace-word (car replace)))
3685                   ;; Recheck hand entered replacement word
3686                   (insert replace-word)
3687                   (ispell-send-replacement (car poss) replace-word)
3688                   (if (car (cdr replace))
3689                       (save-window-excursion
3690                         (delete-other-windows) ; to correctly show help.
3691                         ;; Assume case-replace &
3692                         ;; case-fold-search correct?
3693                         (query-replace (car poss) (car replace) t)))
3694                   (goto-char word-start)
3695                   ;; do not recheck if already accepted
3696                   (if (member replace-word accept-list)
3697                       (setq accept-list (cons replace-word accept-list)
3698                             replace replace-word)
3699                     (let ((region-end (copy-marker ispell-region-end)))
3700                       (setq recheck-region ispell-filter
3701                             ispell-filter nil ; save filter
3702                             shift 0     ; already accounted
3703                             shift (ispell-region
3704                                   word-start
3705                                   (+ word-start (length replace-word))
3706                                   t shift))
3707                       (if (null shift)  ; quitting check.
3708                           (setq shift 0))
3709                       (set-marker ispell-region-end region-end)
3710                       (set-marker region-end nil)
3711                       (setq ispell-filter recheck-region
3712                             recheck-region nil
3713                             replace replace-word)))))
3714
3715               (setq shift (+ shift (- (length replace) word-len)))
3716
3717               ;; Move line-start across word...
3718               ;; new shift function does this now...
3719               ;;(set-marker line-start (+ line-start
3720               ;;                        (- (length replace)
3721               ;;                           (length (car poss)))))
3722               ))
3723             (if (not ispell-quit)
3724                 ;; FIXME: remove redundancy with identical code above.
3725                 (let (message-log-max)
3726                   (message
3727                    "Continuing spelling check using %s with %s dictionary..."
3728                    (file-name-nondirectory ispell-program-name)
3729                    (or ispell-current-dictionary "default"))))
3730             (sit-for 0)
3731             (setq ispell-start (marker-position line-start)
3732                   ispell-end (marker-position line-end))
3733             ;; Adjust markers when end of region lost from highlighting.
3734             (if (and (not recheck-region)
3735                      (< ispell-end (+ word-start word-len)))
3736                 (setq ispell-end (+ word-start word-len)))
3737             (if (= word-start ispell-region-end)
3738                 (set-marker ispell-region-end (+ word-start word-len)))
3739             ;; going out of scope - unneeded
3740             (set-marker line-start nil)
3741             (set-marker word-start nil)
3742             (set-marker line-end nil)))
3743       ;; finished with misspelling!
3744       (setq ispell-filter (cdr ispell-filter)))
3745     shift))
3746
3747
3748 ;;;###autoload
3749 (defun ispell-comments-and-strings ()
3750   "Check comments and strings in the current buffer for spelling errors."
3751   (interactive)
3752   (goto-char (point-min))
3753   (let (state done)
3754     (while (not done)
3755       (setq done t)
3756       (setq state (parse-partial-sexp (point) (point-max)
3757                                       nil nil state 'syntax-table))
3758       (if (or (nth 3 state) (nth 4 state))
3759           (let ((start (point)))
3760             (setq state (parse-partial-sexp start (point-max)
3761                                             nil nil state 'syntax-table))
3762             (if (or (nth 3 state) (nth 4 state))
3763                 (error "Unterminated string or comment"))
3764             (save-excursion
3765               (setq done (not (ispell-region start (point))))))))))
3766
3767
3768 ;;;###autoload
3769 (defun ispell-buffer ()
3770   "Check the current buffer for spelling errors interactively."
3771   (interactive)
3772   (ispell-region (point-min) (point-max)))
3773
3774
3775 ;;;###autoload
3776 (defun ispell-continue ()
3777   "Continue a halted spelling session beginning with the current word."
3778   (interactive)
3779   (if (not (marker-position ispell-region-end))
3780       (message "No session to continue.  Use 'X' command when checking!")
3781     (if (not (equal (marker-buffer ispell-region-end) (current-buffer)))
3782         (message "Must continue ispell from buffer %s"
3783                  (buffer-name (marker-buffer ispell-region-end)))
3784       (ispell-region
3785        ;; find beginning of current word:
3786        (car (cdr (ispell-get-word t)))
3787        (marker-position ispell-region-end)))))
3788
3789
3790 ;;; Horizontal scrolling
3791 (defun ispell-horiz-scroll ()
3792   "Place point within the horizontal visibility of its window area."
3793   (if truncate-lines                    ; display truncating lines?
3794       ;; See if display needs to be scrolled.
3795       (let ((column (- (current-column) (max (window-hscroll) 1))))
3796         (if (and (< column 0) (> (window-hscroll) 0))
3797             (scroll-right (max (- column) 10))
3798           (if (>= column (- (window-width) 2))
3799               (scroll-left (max (- column (window-width) -3) 10)))))))
3800
3801
3802 ;;; Interactive word completion.
3803 ;; Forces "previous-word" processing.  Do we want to make this selectable?
3804
3805 ;;;###autoload
3806 (defun ispell-complete-word (&optional interior-frag)
3807   "Try to complete the word before or under point.
3808 If optional INTERIOR-FRAG is non-nil then the word may be a character
3809 sequence inside of a word.
3810
3811 Standard ispell choices are then available."
3812   (interactive "P")
3813   (let ((cursor-location (point))
3814         (case-fold-search-val case-fold-search)
3815         (word (ispell-get-word nil "\\*")) ; force "previous-word" processing.
3816         start end possibilities replacement)
3817     (setq start (car (cdr word))
3818           end (car (cdr (cdr word)))
3819           word (car word)
3820           possibilities
3821           (or (string= word "")         ; Will give you every word
3822               (ispell-lookup-words (concat (and interior-frag "*") word
3823                                     (if (or interior-frag (null ispell-look-p))
3824                                         "*"))
3825                             (or ispell-complete-word-dict
3826                                 ispell-alternate-dictionary))))
3827     (cond ((eq possibilities t)
3828            (message "No word to complete"))
3829           ((null possibilities)
3830            (message "No match for \"%s\"" word))
3831           (t                            ; There is a modification...
3832            (setq case-fold-search nil)  ; Try and respect case of word.
3833            (cond
3834             ((string-equal (upcase word) word)
3835              (setq possibilities (mapcar 'upcase possibilities)))
3836             ((eq (upcase (aref word 0)) (aref word 0))
3837              (setq possibilities (mapcar (function
3838                                           (lambda (pos)
3839                                             (if (eq (aref word 0) (aref pos 0))
3840                                                 pos
3841                                               (capitalize pos))))
3842                                          possibilities))))
3843            (setq case-fold-search case-fold-search-val)
3844            (save-window-excursion
3845              (setq replacement
3846                    (ispell-command-loop possibilities nil word start end)))
3847            (cond
3848             ((equal 0 replacement)      ; BUFFER-LOCAL ADDITION
3849              (ispell-add-per-file-word-list word))
3850             (replacement                ; REPLACEMENT WORD
3851              (delete-region start end)
3852              (setq word (if (atom replacement) replacement (car replacement))
3853                    cursor-location (+ (- (length word) (- end start))
3854                                       cursor-location))
3855              (insert word)
3856              (if (not (atom replacement)) ; recheck spelling of replacement.
3857                  (progn
3858                    (goto-char cursor-location)
3859                    (ispell-word nil t)))))
3860            (if (get-buffer ispell-choices-buffer)
3861                (kill-buffer ispell-choices-buffer))))
3862     (ispell-pdict-save ispell-silently-savep)
3863     (goto-char cursor-location)))
3864
3865
3866 ;;;###autoload
3867 (defun ispell-complete-word-interior-frag ()
3868   "Completes word matching character sequence inside a word."
3869   (interactive)
3870   (ispell-complete-word t))
3871
3872
3873 ;;;###autoload
3874 (defun ispell ()
3875   "Interactively check a region or buffer for spelling errors.
3876 If `transient-mark-mode' is on, and a region is active, spell-check
3877 that region.  Otherwise spell-check the buffer.
3878
3879 Ispell dictionaries are not distributed with Emacs.  If you are
3880 looking for a dictionary, please see the distribution of the GNU ispell
3881 program, or do an Internet search; there are various dictionaries
3882 available on the net."
3883   (interactive)
3884   (if (if (featurep 'xemacs)
3885           (and zmacs-regions zmacs-region-active-p)
3886         (and (boundp 'transient-mark-mode) transient-mark-mode
3887              (boundp 'mark-active) mark-active))
3888       (ispell-region (region-beginning) (region-end))
3889     (ispell-buffer)))
3890
3891
3892 ;;; **********************************************************************
3893 ;;;                     Ispell Minor Mode
3894 ;;; **********************************************************************
3895
3896 (defvar ispell-minor-keymap
3897   (let ((map (make-sparse-keymap)))
3898     (define-key map " " 'ispell-minor-check)
3899     (define-key map "\r" 'ispell-minor-check)
3900     map)
3901   "Keymap used for Ispell minor mode.")
3902
3903 ;;;###autoload
3904 (define-minor-mode ispell-minor-mode
3905   "Toggle last-word spell checking (Ispell minor mode).
3906 With a prefix argument ARG, enable Ispell minor mode if ARG is
3907 positive, and disable it otherwise.  If called from Lisp, enable
3908 the mode if ARG is omitted or nil.
3909
3910 Ispell minor mode is a buffer-local minor mode.  When enabled,
3911 typing SPC or RET warns you if the previous word is incorrectly
3912 spelled.
3913
3914 All the buffer-local variables and dictionaries are ignored.  To
3915 read them into the running ispell process, type \\[ispell-word]
3916 SPC.
3917
3918 For spell-checking \"on the fly\", not just after typing SPC or
3919 RET, use `flyspell-mode'."
3920   nil " Spell" ispell-minor-keymap)
3921
3922 (defun ispell-minor-check ()
3923   "Check previous word, then continue with the normal binding of this key.
3924 Don't check previous word when character before point is a space or newline.
3925 Don't read buffer-local settings or word lists."
3926   (interactive "*")
3927   (let ((ispell-minor-mode nil)
3928         (ispell-check-only t)
3929         (last-char (char-after (1- (point)))))
3930     (command-execute (key-binding (this-command-keys)))
3931     (if (not (or (eq last-char ?\ ) (eq last-char ?\n)
3932                  (and ispell-skip-html (eq last-char ?>))
3933                  (and ispell-skip-html (eq last-char ?\;))))
3934         (ispell-word nil t))))
3935
3936
3937 ;;; **********************************************************************
3938 ;;;                     Ispell Message
3939 ;;; **********************************************************************
3940
3941 (defvar ispell-message-text-end
3942   (mapconcat (function identity)
3943              '(
3944                ;; Don't spell check signatures
3945                "^-- $"
3946                ;; Matches PostScript files.
3947                ;;"^%!PS-Adobe-[123].0"
3948                ;; Matches uuencoded text
3949                ;;"^begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM"
3950                ;; Matches shell files (especially auto-decoding)
3951                "^#! /bin/[ck]?sh"
3952                ;; Matches context difference listing
3953                "\\(\\(^cd .*\n\\)?diff -c .*\\)?\n\\*\\*\\* .*\n--- .*\n\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*"
3954                ;; Matches unidiff difference listing
3955                "\\(diff -u .*\\)?\n--- .*\n\\+\\+\\+ .*\n@@ [-+][0-9]+,[0-9]+ [-+][0-9]+,[0-9]+ @@"
3956                ;; Matches reporter.el bug report
3957                "^current state:\n==============\n"
3958                ;; Matches commonly used "cut" boundaries
3959                "^\\(- \\)?[-=_]+\\s ?\\(cut here\\|Environment Follows\\)")
3960              "\\|")
3961   "Text beyond which `ispell-message' will not spell-check.
3962 If it is a string, limit is the first occurrence of that regular expression.
3963 Otherwise, it must be a function which is called to get the limit.")
3964 (put 'ispell-message-text-end 'risky-local-variable t)
3965
3966
3967 (defun ispell-mime-multipartp (&optional limit)
3968   "Return multipart message start boundary or nil if none."
3969   ;; caller must ensure `case-fold-search' is set to `t'
3970   (and
3971    (re-search-forward
3972     "Content-Type: *multipart/\\([^ \t\n]*;[ \t]*[\n]?[ \t]*\\)+boundary="
3973     limit t)
3974    (let (boundary)
3975      (if (looking-at "\"")
3976          (let (start)
3977            (forward-char)
3978            (setq start (point))
3979            (while (not (looking-at "\""))
3980              (forward-char 1))
3981            (setq boundary (buffer-substring-no-properties start (point))))
3982        (let ((start (point)))
3983          (while (looking-at "[-0-9a-zA-Z'()+_,./:=?]")
3984            (forward-char))
3985          (setq boundary (buffer-substring-no-properties start (point)))))
3986      (if (< (length boundary) 1)
3987          (setq boundary nil)
3988        (concat "--" boundary)))))
3989
3990
3991 (defun ispell-mime-skip-part (boundary)
3992   "Move point across header, or entire MIME part if message is encoded.
3993 All specified types except `7bit' `8bit' and `quoted-printable' are considered
3994 encoded and therefore skipped.  See rfc 1521, 2183, ...
3995 If no boundary is given, then entire message is skipped.
3996
3997 This starts one line ABOVE the MIME content messages, on the boundary marker,
3998 for operation with the generic region-skipping code.
3999 This places new MIME boundaries into variable `ispell-checking-message'."
4000   (forward-line)                        ; skip over boundary to headers
4001   (let ((save-case-fold-search case-fold-search)
4002         (continuep t)
4003         textp)
4004     (setq case-fold-search t
4005           ispell-skip-html nil)
4006     (while continuep
4007       (setq continuep nil)
4008       (if (looking-at "Content-Type: *text/")
4009           (progn
4010             (goto-char (match-end 0))
4011             (if (looking-at "html")
4012                 (setq ispell-skip-html t))
4013             (setq textp t
4014                   continuep t)
4015             (re-search-forward "\\(.*;[ \t]*[\n]\\)*.*$" nil t)
4016             (forward-line)))
4017       (if (looking-at "Content-Transfer-Encoding: *\\([^ \t\n]*\\)")
4018           (let ((match (buffer-substring (match-beginning 1) (match-end 1))))
4019             (setq textp (member (upcase match)
4020                                 ;; only spell check the following encodings:
4021                                 '("7BIT" "8BIT" "QUOTED-PRINTABLE" "BINARY"))
4022                   continuep t)
4023             (goto-char (match-end 0))
4024             (re-search-forward "\\(.*;[ \t]*[\n]\\)*.*$" nil t)
4025             (forward-line)))
4026       ;; hierarchical boundary definition
4027       (if (looking-at "Content-Type: *multipart/")
4028           (let ((new-boundary (ispell-mime-multipartp)))
4029             (if (string-match new-boundary boundary)
4030                 (setq continuep t)
4031               ;; first pass redefine skip function to include new boundary
4032               ;;(re-search-backward boundary nil t)
4033               (forward-line)
4034               (setq ispell-checking-message
4035                     (cons
4036                      (list new-boundary 'ispell-mime-skip-part new-boundary)
4037                      (if (eq t ispell-checking-message) nil
4038                        ispell-checking-message))
4039                     textp t
4040                     continuep t)))
4041         ;; Skip all MIME headers that don't affect spelling
4042         (if (looking-at "Content-[^ \t]*: *\\(.*;[ \t]*[\n]\\)*.*$")
4043             (progn
4044               (setq continuep t)
4045               (goto-char (match-end 0))
4046               (forward-line)))))
4047
4048     (setq case-fold-search save-case-fold-search)
4049     (if textp
4050         (point)
4051       ;; encoded message.  Skip to boundary, or entire message.
4052       (if (not boundary)
4053           (goto-char (point-max))
4054         (re-search-forward boundary nil t)
4055         (beginning-of-line)
4056         (point)))))
4057
4058
4059 ;;;###autoload
4060 (defun ispell-message ()
4061   "Check the spelling of a mail message or news post.
4062 Don't check spelling of message headers except the Subject field.
4063 Don't check included messages.
4064
4065 To abort spell checking of a message region and send the message anyway,
4066 use the `x' command.  (Any subsequent regions will be checked.)
4067 The `X' command aborts sending the message so that you can edit the buffer.
4068
4069 To spell-check whenever a message is sent, include the appropriate lines
4070 in your .emacs file:
4071    (add-hook 'message-send-hook 'ispell-message)  ;; GNUS 5
4072    (add-hook 'news-inews-hook 'ispell-message)    ;; GNUS 4
4073    (add-hook 'mail-send-hook  'ispell-message)
4074    (add-hook 'mh-before-send-letter-hook 'ispell-message)
4075
4076 You can bind this to the key C-c i in GNUS or mail by adding to
4077 `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
4078    (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))"
4079   (interactive)
4080   (save-excursion
4081     (goto-char (point-min))
4082     (let* (boundary mimep
4083            (ispell-skip-region-alist-save ispell-skip-region-alist)
4084            ;; Nil when message came from outside (eg calling Emacs as editor)
4085            ;; Non-nil marker of end of headers.
4086            (internal-messagep
4087             (re-search-forward
4088              (concat "^" (regexp-quote mail-header-separator) "$") nil t))
4089            (end-of-headers              ; Start of body.
4090             (copy-marker
4091              (or internal-messagep
4092                  (re-search-forward "^$" nil t)
4093                  (point-min))))
4094            (limit (copy-marker          ; End of region we will spell check.
4095                    (cond
4096                     ((not ispell-message-text-end) (point-max))
4097                     ((char-or-string-p ispell-message-text-end)
4098                      (if (re-search-forward ispell-message-text-end nil t)
4099                          (match-beginning 0)
4100                        (point-max)))
4101                     (t (min (point-max) (funcall ispell-message-text-end))))))
4102            (default-prefix   ; Vanilla cite prefix (just used for cite-regexp)
4103              (if (and (boundp 'mail-yank-prefix) mail-yank-prefix)
4104                  (ispell-non-empty-string mail-yank-prefix)
4105                "   \\|\t"))
4106            (cite-regexp                 ;Prefix of quoted text
4107             (cond
4108              ((functionp 'sc-cite-regexp)       ; sc 3.0
4109               (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
4110                       (ispell-non-empty-string sc-reference-tag-string)))
4111              ((boundp 'sc-cite-regexp)          ; sc 2.3
4112               (concat "\\(" sc-cite-regexp "\\)" "\\|"
4113                       (ispell-non-empty-string sc-reference-tag-string)))
4114              ((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below
4115                   (equal major-mode 'message-mode))   ;GNUS 5
4116               (concat "In article <" "\\|"
4117                       "[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|"
4118                       message-cite-prefix-regexp
4119                       "\\|"
4120                       default-prefix))
4121              ((equal major-mode 'mh-letter-mode) ; mh mail message
4122               (concat "[^,;&+=\n]+ writes:" "\\|"
4123                       (ispell-non-empty-string mh-ins-buf-prefix)))
4124              ((not internal-messagep)   ; Assume nn sent us this message.
4125               (concat "In [a-zA-Z.]+ you write:" "\\|"
4126                       "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|"
4127                       " *> *"))
4128              ((boundp 'vm-included-text-prefix) ; VM mail message
4129               (concat "[^,;&+=\n]+ writes:" "\\|"
4130                       (ispell-non-empty-string vm-included-text-prefix)))
4131              (t default-prefix)))
4132            (ispell-skip-region-alist
4133             (cons (list (concat "^\\(" cite-regexp "\\)")
4134                         (function forward-line))
4135                   ispell-skip-region-alist))
4136            (old-case-fold-search case-fold-search)
4137            (dictionary-alist ispell-message-dictionary-alist)
4138            (ispell-checking-message t))
4139
4140       ;; Select dictionary for message
4141       (or (local-variable-p 'ispell-local-dictionary (current-buffer))
4142           (while dictionary-alist
4143             (goto-char (point-min))
4144             (if (re-search-forward (car (car dictionary-alist))
4145                                    end-of-headers t)
4146                 (setq ispell-local-dictionary (cdr (car dictionary-alist))
4147                       dictionary-alist nil)
4148               (setq dictionary-alist (cdr dictionary-alist)))))
4149
4150       (unwind-protect
4151           (progn
4152             ;; Spell check any original Subject:
4153             (goto-char (point-min))
4154             (setq case-fold-search t
4155                   mimep (re-search-forward "MIME-Version:" end-of-headers t))
4156             (goto-char (point-min))
4157             (if (re-search-forward "^Subject: *" end-of-headers t)
4158                 (progn
4159                   (goto-char (match-end 0))
4160                   (if (and (not (looking-at ".*Re\\>"))
4161                            (not (looking-at "\\[")))
4162                       (progn
4163                         (setq case-fold-search old-case-fold-search)
4164                         (ispell-region (point)
4165                                        (progn ;Tab-initiated continuation lns.
4166                                          (end-of-line)
4167                                          (while (looking-at "\n[ \t]")
4168                                            (end-of-line 2))
4169                                          (point)))))))
4170             (if mimep
4171                 (progn
4172                   (goto-char (point-min))
4173                   (setq boundary (ispell-mime-multipartp end-of-headers))))
4174             ;; Adjust message limit to MIME message if necessary.
4175             (and boundary
4176                  (re-search-forward (concat boundary "--") nil t)
4177                  (re-search-backward boundary nil t)
4178                  (< (point) (marker-position limit))
4179                  (set-marker limit (point)))
4180             (goto-char (point-min))
4181             ;; Select type or skip checking if this is a non-multipart message
4182             ;; Point moved to end of buffer if region is encoded.
4183             (when (and mimep (not boundary))
4184                   (goto-char (point-min))
4185                   (re-search-forward "Content-[^ \t]*:" end-of-headers t)
4186                   (forward-line -1)     ; following fn starts one line above
4187                   (ispell-mime-skip-part nil)
4188                   ;; if message-text-end region, limit may be less than point.
4189                   (if (> (point) limit)
4190                   (set-marker limit (point))))
4191             (goto-char (max end-of-headers (point)))
4192             (forward-line 1)
4193             (setq case-fold-search old-case-fold-search)
4194             ;; Define MIME regions to skip.
4195             (if boundary
4196                 (setq ispell-checking-message
4197                       (list (list boundary 'ispell-mime-skip-part boundary))))
4198             (ispell-region (point) limit))
4199         (set-marker end-of-headers nil)
4200         (set-marker limit nil)
4201         (setq ispell-skip-region-alist ispell-skip-region-alist-save
4202               ispell-skip-html nil
4203               case-fold-search old-case-fold-search)))))
4204
4205
4206 (defun ispell-non-empty-string (string)
4207   (if (or (not string) (string-equal string ""))
4208       "\\'\\`" ; An unmatchable string if string is null.
4209     (regexp-quote string)))
4210
4211
4212 ;;; **********************************************************************
4213 ;;;                     Buffer Local Functions
4214 ;;; **********************************************************************
4215
4216
4217 (defun ispell-accept-buffer-local-defs ()
4218   "Load all buffer-local information, restarting Ispell when necessary."
4219   (ispell-buffer-local-dict)            ; May kill ispell-process.
4220   (ispell-buffer-local-words)           ; Will initialize ispell-process.
4221   (ispell-buffer-local-parsing))
4222
4223
4224 (defun ispell-buffer-local-parsing ()
4225   "Place Ispell into parsing mode for this buffer.
4226 Overrides the default parsing mode.
4227 Includes LaTeX/Nroff modes and extended character mode."
4228   ;; (ispell-init-process) must already be called.
4229   (ispell-send-string "!\n")            ; Put process in terse mode.
4230   ;; We assume all major modes with "tex-mode" in them should use latex parsing
4231   ;; When exclusively checking comments, set to raw text mode (nroff).
4232   (if (and (not (eq 'exclusive ispell-check-comments))
4233            (or (and (eq ispell-parser 'use-mode-name)
4234                     (string-match "[Tt][Ee][Xx]-mode"
4235                                   (symbol-name major-mode)))
4236                (eq ispell-parser 'tex)))
4237       (progn
4238         (ispell-send-string "+\n")      ; set ispell mode to tex
4239         (if (not (eq ispell-parser 'tex))
4240             (set (make-local-variable 'ispell-parser) 'tex)))
4241     (ispell-send-string "-\n"))         ; set mode to normal (nroff)
4242   ;; If needed, test for SGML & HTML modes and set a buffer local nil/t value.
4243   (if (and ispell-skip-html (not (eq ispell-skip-html t)))
4244       (setq ispell-skip-html
4245             (not (null (string-match "sgml\\|html\\|xml"
4246                                      (downcase (symbol-name major-mode)))))))
4247   ;; Set default extended character mode for given buffer, if any.
4248   (let ((extended-char-mode (ispell-get-extended-character-mode)))
4249     (if extended-char-mode
4250         (ispell-send-string (concat extended-char-mode "\n"))))
4251   ;; Set buffer-local parsing mode and extended character mode, if specified.
4252   (save-excursion
4253     (goto-char (point-max))
4254     ;; Uses last occurrence of ispell-parsing-keyword
4255     (if (search-backward ispell-parsing-keyword nil t)
4256         (let ((end (point-at-eol))
4257               string)
4258           (search-forward ispell-parsing-keyword)
4259           (while (re-search-forward " *\\([^ \"]+\\)" end t)
4260             ;; space separated definitions.
4261             (setq string (downcase (match-string-no-properties 1)))
4262             (cond ((and (string-match "latex-mode" string)
4263                         (not (eq 'exclusive ispell-check-comments)))
4264                    (ispell-send-string "+\n~tex\n"))
4265                   ((string-match "nroff-mode" string)
4266                    (ispell-send-string "-\n~nroff\n"))
4267                   ((string-match "~" string) ; Set extended character mode.
4268                    (ispell-send-string (concat string "\n")))
4269                   (t (message "Invalid Ispell Parsing argument!")
4270                      (sit-for 2))))))))
4271
4272
4273 ;; Can kill the current ispell process
4274
4275 (defun ispell-buffer-local-dict (&optional no-reload)
4276   "Initializes local dictionary and local personal dictionary.
4277 If optional NO-RELOAD is non-nil, do not reload any dictionary.
4278 When a dictionary is defined in the buffer (see variable
4279 `ispell-dictionary-keyword'), it will override the local setting
4280 from \\[ispell-change-dictionary].
4281 Both should not be used to define a buffer-local dictionary."
4282   (save-excursion
4283     (goto-char (point-min))
4284     (let (end)
4285       ;; Override the local variable definition.
4286       ;; Uses last occurrence of ispell-dictionary-keyword.
4287       (goto-char (point-max))
4288       (unless ispell-local-dictionary-overridden
4289         (if (search-backward ispell-dictionary-keyword nil t)
4290             (progn
4291               (search-forward ispell-dictionary-keyword)
4292               (setq end (point-at-eol))
4293               (if (re-search-forward " *\\([^ \"]+\\)" end t)
4294                   (setq ispell-local-dictionary
4295                         (match-string-no-properties 1))))))
4296       (goto-char (point-max))
4297       (if (search-backward ispell-pdict-keyword nil t)
4298           (progn
4299             (search-forward ispell-pdict-keyword)
4300             (setq end (point-at-eol))
4301             (if (re-search-forward " *\\([^ \"]+\\)" end t)
4302                 (setq ispell-local-pdict
4303                       (match-string-no-properties 1)))))))
4304   (unless no-reload
4305     ;; Reload if new dictionary (maybe the personal one) defined.
4306     (ispell-internal-change-dictionary)))
4307
4308
4309 (defun ispell-buffer-local-words ()
4310   "Load the buffer-local dictionary in the current buffer."
4311   ;; If there's an existing ispell process that's wrong for this use,
4312   ;; kill it.
4313   (if (and ispell-buffer-local-name
4314            (not (equal ispell-buffer-local-name (buffer-name))))
4315       (ispell-kill-ispell t))
4316   ;; Actually start a new ispell process, because we need
4317   ;; to send commands now to specify the local words to it.
4318   (ispell-init-process)
4319   (dolist (session-localword ispell-buffer-session-localwords)
4320     (ispell-send-string (concat "@" session-localword "\n")))
4321   (or ispell-buffer-local-name
4322       (if ispell-buffer-session-localwords
4323           (setq ispell-buffer-local-name (buffer-name))))
4324   (save-excursion
4325     (goto-char (point-min))
4326     (while (search-forward ispell-words-keyword nil t)
4327       (or ispell-buffer-local-name
4328           (setq ispell-buffer-local-name (buffer-name)))
4329       (let ((end (point-at-eol))
4330             (ispell-casechars (ispell-get-casechars))
4331             string)
4332         ;; buffer-local words separated by a space, and can contain
4333         ;; any character other than a space.  Not rigorous enough.
4334         (while (re-search-forward " *\\([^ ]+\\)" end t)
4335           (setq string (match-string-no-properties 1))
4336           ;; This can fail when string contains a word with invalid chars.
4337           ;; Error handling needs to be added between ispell and Emacs.
4338           (if (and (< 1 (length string))
4339                    (equal 0 (string-match ispell-casechars string)))
4340               (ispell-send-string (concat "@" string "\n"))))))))
4341
4342
4343 ;;; returns optionally adjusted region-end-point.
4344
4345 ;; If comment-padright is defined, newcomment must be loaded.
4346 (declare-function comment-add "newcomment" (arg))
4347
4348 (defun ispell-add-per-file-word-list (word)
4349   "Add WORD to the per-file word list."
4350   (or ispell-buffer-local-name
4351       (setq ispell-buffer-local-name (buffer-name)))
4352   (save-excursion
4353     (goto-char (point-min))
4354     (let (line-okay search done found)
4355       (while (not done)
4356         (let ((case-fold-search nil))
4357           (setq search (search-forward ispell-words-keyword nil 'move)
4358               found (or found search)
4359               line-okay (< (+ (length word) 1 ; 1 for space after word..
4360                               (progn (end-of-line) (current-column)))
4361                              fill-column)))
4362         (if (or (and search line-okay)
4363                 (null search))
4364             (progn
4365               (setq done t)
4366               (if (null search)
4367                   (progn
4368                     (open-line 1)
4369                     (unless found (newline))
4370                     (insert (if comment-start
4371                                 (concat
4372                                   (if (fboundp 'comment-padright)
4373                                       ;; Try and use the proper comment marker,
4374                                       ;; e.g. ";;" rather than ";".
4375                                       (comment-padright comment-start
4376                                                         (comment-add nil))
4377                                     comment-start)
4378                                   " ")
4379                               "")
4380                             ispell-words-keyword)
4381                     (if (and comment-end (> (length comment-end) 0))
4382                         (save-excursion
4383                           (newline)
4384                           (insert comment-end)))))
4385               (insert (concat " " word))))))))
4386
4387 (add-to-list 'debug-ignored-errors "^No word found to check!$")
4388
4389 (provide 'ispell)
4390
4391 \f
4392 ;;; LOCAL VARIABLES AND BUFFER-LOCAL VALUE EXAMPLES.
4393
4394 ;; Local Variable options:
4395 ;; mode: name(-mode)
4396 ;; eval: expression
4397 ;; local-variable: value
4398
4399 ;; The following sets the buffer local dictionary to `american' English
4400 ;; and spell checks only comments.
4401
4402 ;; Local Variables:
4403 ;; mode: emacs-lisp
4404 ;; comment-column: 40
4405 ;; ispell-check-comments: exclusive
4406 ;; ispell-local-dictionary: "american"
4407 ;; End:
4408
4409
4410 ;;; MORE EXAMPLES OF ISPELL BUFFER-LOCAL VALUES
4411
4412 ;; The following places this file in nroff parsing and extended char modes.
4413 ;; Local IspellParsing: nroff-mode ~nroff
4414 ;; Change IspellPersDict to IspellPersDict: to enable the following line.
4415 ;; Local IspellPersDict ~/.ispell_lisp
4416 ;; The following were automatically generated by ispell using the 'A' command:
4417 ; LocalWords:  settable alist inews mh frag pdict Wildcards iconify arg tex kss
4418 ; LocalWords:  alists minibuffer bufferp autoload loaddefs aff Dansk KOI SPC op
4419 ; LocalWords:  Francais Nederlands charset autoloaded popup nonmenu regexp num
4420 ; LocalWords:  AMStex hspace includeonly nocite epsfig displaymath eqnarray reg
4421 ; LocalWords:  minipage modeline pers dict unhighlight buf grep sync prev inc
4422 ; LocalWords:  fn oldot NB AIX msg init read's bufs pt cmd Quinlan eg
4423 ; LocalWords:  uuencoded unidiff sc nn VM SGML eval IspellPersDict
4424 ; LocalWords:  lns XEmacs HTML casechars Multibyte
4425
4426 ;;; ispell.el ends here