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