Commit | Line | Data |
---|---|---|
b578f267 | 1 | ;;; ispell4.el --- this is the GNU EMACS interface to GNU ISPELL version 4. |
1a06eabd | 2 | |
b578f267 | 3 | ;; Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc. |
9750e079 | 4 | |
e9571d2a ER |
5 | ;; Keywords: wp |
6 | ||
b578f267 EN |
7 | ;; This file is part of GNU Emacs. |
8 | ||
9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation; either version 2, or (at your option) | |
12 | ;; any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 | ;; Boston, MA 02111-1307, USA. | |
d299ee07 | 23 | |
e41b2db1 ER |
24 | ;;; Commentary: |
25 | ||
26 | ;; This package provides a graceful interface to ispell, the GNU | |
27 | ;; spelling checker. | |
28 | ||
282d89c0 ER |
29 | ;;; Code: |
30 | ||
d299ee07 | 31 | (defvar ispell-have-new-look t |
a6c5a8dd | 32 | "Non-nil means use the `-r' option when running `look'.") |
d299ee07 RS |
33 | |
34 | (defvar ispell-enable-tex-parser nil | |
a6c5a8dd | 35 | "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.") |
d299ee07 | 36 | |
a6c5a8dd | 37 | (defvar ispell-process nil "The process running Ispell") |
d299ee07 | 38 | (defvar ispell-next-message nil |
a6c5a8dd RS |
39 | "An integer: where in `*ispell*' buffer to find next message from Ispell.") |
40 | ||
41 | (defvar ispell-command "ispell" | |
42 | "Command for running Ispell.") | |
43 | (defvar ispell-command-options nil | |
44 | "*String (or list of strings) to pass to Ispell as command arguments. | |
925a622c | 45 | You can specify your private dictionary via the -p <filename> option. |
a6c5a8dd RS |
46 | The -S option is always passed to Ispell as the last parameter, |
47 | and need not be mentioned here.") | |
d299ee07 | 48 | |
bd28fa59 RS |
49 | (defvar ispell-look-command "look" |
50 | "*Command for running look.") | |
51 | ||
d299ee07 RS |
52 | ;Each marker in this list points to the start of a word that |
53 | ;ispell thought was bad last time it did the :file command. | |
54 | ;Notice that if the user accepts or inserts a word into his | |
55 | ;private dictionary, then some "good" words will be on the list. | |
56 | ;We would like to deal with this by looking up the words again just before | |
57 | ;presenting them to the user, but that is too slow on machines | |
58 | ;without the select system call. Therefore, see the variable | |
59 | ;ispell-recently-accepted. | |
60 | (defvar ispell-bad-words nil | |
a6c5a8dd | 61 | "A list of markers reflecting the output of the Ispell `:file' command.") |
d299ee07 RS |
62 | |
63 | ;list of words that the user has accepted, but that might still | |
64 | ;be on the bad-words list | |
65 | (defvar ispell-recently-accepted nil) | |
66 | ||
a48fc390 RS |
67 | ;; Non-nil means we have started showing an alternatives window. |
68 | ;; This is the window config from before then. | |
e3a39644 | 69 | (defvar ispell-window-configuration nil) |
a48fc390 | 70 | |
d299ee07 RS |
71 | ;t when :dump command needed |
72 | (defvar ispell-dump-needed nil) | |
73 | ||
74 | (defun ispell-flush-bad-words () | |
75 | (while ispell-bad-words | |
76 | (if (markerp (car ispell-bad-words)) | |
77 | (set-marker (car ispell-bad-words) nil)) | |
78 | (setq ispell-bad-words (cdr ispell-bad-words))) | |
79 | (setq ispell-recently-accepted nil)) | |
80 | ||
81 | (defun kill-ispell () | |
a6c5a8dd | 82 | "Kill the Ispell process. |
eb8c3be9 | 83 | Any changes in your private dictionary |
d299ee07 RS |
84 | that have not already been dumped will be lost." |
85 | (interactive) | |
86 | (if ispell-process | |
87 | (delete-process ispell-process)) | |
88 | (setq ispell-process nil) | |
89 | (ispell-flush-bad-words)) | |
90 | ||
91 | (put 'ispell-startup-error 'error-conditions | |
92 | '(ispell-startup-error error)) | |
93 | (put 'ispell-startup-error 'error-message | |
94 | "Problem starting ispell - see buffer *ispell*") | |
95 | ||
a6c5a8dd RS |
96 | ;; Start an ispell subprocess; check the version; and display the greeting. |
97 | ||
d299ee07 | 98 | (defun start-ispell () |
d299ee07 RS |
99 | (message "Starting ispell ...") |
100 | (let ((buf (get-buffer "*ispell*"))) | |
101 | (if buf | |
102 | (kill-buffer buf))) | |
103 | (condition-case err | |
a6c5a8dd RS |
104 | (setq ispell-process |
105 | (apply 'start-process "ispell" "*ispell*" ispell-command | |
106 | (append (if (listp ispell-command-options) | |
107 | ispell-command-options | |
108 | (list ispell-command-options)) | |
109 | '("-S")))) | |
d299ee07 RS |
110 | (file-error (signal 'ispell-startup-error nil))) |
111 | (process-kill-without-query ispell-process) | |
112 | (buffer-disable-undo (process-buffer ispell-process)) | |
113 | (accept-process-output ispell-process) | |
114 | (let (last-char) | |
115 | (save-excursion | |
116 | (set-buffer (process-buffer ispell-process)) | |
117 | (bury-buffer (current-buffer)) | |
118 | (setq last-char (- (point-max) 1)) | |
119 | (while (not (eq (char-after last-char) ?=)) | |
120 | (cond ((not (eq (process-status ispell-process) 'run)) | |
121 | (kill-ispell) | |
122 | (signal 'ispell-startup-error nil))) | |
123 | (accept-process-output ispell-process) | |
124 | (setq last-char (- (point-max) 1))) | |
125 | (goto-char (point-min)) | |
126 | (let ((greeting (read (current-buffer)))) | |
127 | (if (not (= (car greeting) 1)) | |
128 | (error "Bad ispell version: wanted 1, got %d" (car greeting))) | |
32bf4c34 | 129 | (message "%s" (car (cdr greeting)))) |
d299ee07 RS |
130 | (delete-region (point-min) last-char)))) |
131 | ||
a6c5a8dd RS |
132 | ;; Make sure ispell is ready for a command. |
133 | ;; Leaves buffer set to *ispell*, point at '='. | |
134 | ||
d299ee07 | 135 | (defun ispell-sync (intr) |
d299ee07 RS |
136 | (if (or (null ispell-process) |
137 | (not (eq (process-status ispell-process) 'run))) | |
138 | (start-ispell)) | |
139 | (if intr | |
140 | (interrupt-process ispell-process)) | |
141 | (let (last-char) | |
142 | (set-buffer (process-buffer ispell-process)) | |
143 | (bury-buffer (current-buffer)) | |
144 | (setq last-char (- (point-max) 1)) | |
145 | (while (not (eq (char-after last-char) ?=)) | |
146 | (accept-process-output ispell-process) | |
147 | (setq last-char (- (point-max) 1))) | |
148 | (goto-char last-char))) | |
149 | ||
a6c5a8dd RS |
150 | ;; Send a command to ispell. Choices are: |
151 | ;; | |
152 | ;; WORD Check spelling of WORD. Result is | |
153 | ;; | |
154 | ;; nil not found | |
155 | ;; t spelled ok | |
156 | ;; list of strings near misses | |
157 | ;; | |
158 | ;; :file FILENAME scan the named file, and print the file offsets of | |
159 | ;; any misspelled words | |
160 | ;; | |
161 | ;; :insert WORD put word in private dictionary | |
162 | ;; | |
163 | ;; :accept WORD don't complain about word any more this session | |
164 | ;; | |
165 | ;; :dump write out the current private dictionary, if necessary. | |
166 | ;; | |
925a622c | 167 | ;; :reload reread private dictionary (default: `~/ispell.words') |
a6c5a8dd RS |
168 | ;; |
169 | ;; :tex | |
170 | ;; :troff | |
171 | ;; :generic set type of parser to use when scanning whole files | |
d299ee07 | 172 | |
a6c5a8dd | 173 | (defun ispell-cmd (&rest strings) |
d299ee07 RS |
174 | (save-excursion |
175 | (ispell-sync t) | |
176 | (set-buffer (process-buffer ispell-process)) | |
177 | (bury-buffer (current-buffer)) | |
178 | (erase-buffer) | |
179 | (setq ispell-next-message (point-min)) | |
180 | (while strings | |
181 | (process-send-string ispell-process (car strings)) | |
182 | (setq strings (cdr strings))) | |
183 | (process-send-string ispell-process "\n") | |
184 | (accept-process-output ispell-process) | |
185 | (ispell-sync nil))) | |
186 | ||
187 | (defun ispell-dump () | |
188 | (cond (ispell-dump-needed | |
189 | (setq ispell-dump-needed nil) | |
190 | (ispell-cmd ":dump")))) | |
191 | ||
192 | (defun ispell-insert (word) | |
193 | (ispell-cmd ":insert " word) | |
194 | (if ispell-bad-words | |
195 | (setq ispell-recently-accepted (cons word ispell-recently-accepted))) | |
196 | (setq ispell-dump-needed t)) | |
197 | ||
198 | (defun ispell-accept (word) | |
199 | (ispell-cmd ":accept " word) | |
200 | (if ispell-bad-words | |
201 | (setq ispell-recently-accepted (cons word ispell-recently-accepted)))) | |
202 | ||
a6c5a8dd | 203 | ;; Return the next message sent by the Ispell subprocess. |
d299ee07 RS |
204 | |
205 | (defun ispell-next-message () | |
d299ee07 RS |
206 | (save-excursion |
207 | (set-buffer (process-buffer ispell-process)) | |
208 | (bury-buffer (current-buffer)) | |
209 | (save-restriction | |
210 | (goto-char ispell-next-message) | |
211 | (narrow-to-region (point) | |
212 | (progn (forward-sexp 1) (point))) | |
213 | (setq ispell-next-message (point)) | |
214 | (goto-char (point-min)) | |
215 | (read (current-buffer))))) | |
216 | ||
217 | (defun ispell-tex-buffer-p () | |
087aeac6 | 218 | (memq major-mode '(plain-tex-mode latex-mode slitex-mode))) |
d299ee07 | 219 | |
44ca409a | 220 | (defvar ispell-menu-map (make-sparse-keymap "Spell")) |
e3a39644 | 221 | (defalias 'ispell-menu-map ispell-menu-map) |
44ca409a | 222 | |
bd28fa59 RS |
223 | (define-key ispell-menu-map [ispell-complete-word-interior-frag] |
224 | '("Complete Interior Fragment" . ispell-complete-word-interior-frag)) | |
225 | ||
226 | (define-key ispell-menu-map [ispell-complete-word] | |
227 | '("Complete Word" . ispell-complete-word)) | |
228 | ||
44ca409a RS |
229 | (define-key ispell-menu-map [reload-ispell] |
230 | '("Reload Dictionary" . reload-ispell)) | |
231 | ||
232 | (define-key ispell-menu-map [ispell-next] | |
233 | '("Continue Check" . ispell-next)) | |
234 | ||
36ab15b2 RS |
235 | (define-key ispell-menu-map [ispell-message] |
236 | '("Check Message" . ispell-message)) | |
237 | ||
81b328e5 KH |
238 | (define-key ispell-menu-map [ispell-word] |
239 | '("Check Word" . ispell-word)) | |
240 | ||
44ca409a RS |
241 | (define-key ispell-menu-map [ispell-region] |
242 | '("Check Region" . ispell-region)) | |
243 | ||
244 | (define-key ispell-menu-map [ispell-buffer] | |
245 | '("Check Buffer" . ispell)) | |
246 | ||
3595955c | 247 | ;;;autoload |
d299ee07 | 248 | (defun ispell (&optional buf start end) |
6370a710 RS |
249 | "Run Ispell over current buffer's visited file. |
250 | First the file is scanned for misspelled words, then Ispell | |
d299ee07 RS |
251 | enters a loop with the following commands for every misspelled word: |
252 | ||
253 | DIGIT Near miss selector. If the misspelled word is close to | |
254 | some words in the dictionary, they are offered as near misses. | |
255 | r Replace. Replace the word with a string you type. Each word | |
256 | of your new string is also checked. | |
925a622c | 257 | i Insert. Insert this word in your private dictionary (by default, |
d299ee07 RS |
258 | `$HOME/ispell.words'). |
259 | a Accept. Accept this word for the rest of this editing session, | |
eb8c3be9 | 260 | but don't put it in your private dictionary. |
d299ee07 RS |
261 | l Lookup. Look for a word in the dictionary by fast binary |
262 | search, or search for a regular expression in the dictionary | |
263 | using grep. | |
264 | SPACE Accept the word this time, but complain if it is seen again. | |
f30ff39f | 265 | q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]." |
d299ee07 RS |
266 | (interactive) |
267 | (if (null start) | |
268 | (setq start 0)) | |
269 | (if (null end) | |
270 | (setq end 0)) | |
271 | ||
272 | (if (null buf) | |
273 | (setq buf (current-buffer))) | |
274 | (setq buf (get-buffer buf)) | |
275 | (if (null buf) | |
276 | (error "Can't find buffer")) | |
a48fc390 RS |
277 | ;; Deactivate the mark, because we'll do it anyway if we change something, |
278 | ;; and a region highlight while in the Ispell loop is distracting. | |
0d28f072 | 279 | (deactivate-mark) |
d299ee07 RS |
280 | (save-excursion |
281 | (set-buffer buf) | |
282 | (let ((filename buffer-file-name) | |
a48fc390 | 283 | (delete-temp nil)) |
d299ee07 RS |
284 | (unwind-protect |
285 | (progn | |
6351296c | 286 | (cond ((or (null filename) |
6eaebaa2 | 287 | (find-file-name-handler buffer-file-name nil)) |
d299ee07 RS |
288 | (setq filename (make-temp-name "/usr/tmp/ispell")) |
289 | (setq delete-temp t) | |
290 | (write-region (point-min) (point-max) filename)) | |
291 | ((and (buffer-modified-p buf) | |
292 | (y-or-n-p (format "Save file %s? " filename))) | |
293 | (save-buffer))) | |
294 | (message "Ispell scanning file...") | |
295 | (if (and ispell-enable-tex-parser | |
296 | (ispell-tex-buffer-p)) | |
297 | (ispell-cmd ":tex") | |
298 | (ispell-cmd ":generic")) | |
299 | (ispell-cmd (format ":file %s %d %d" filename start end))) | |
a48fc390 RS |
300 | (if delete-temp |
301 | (condition-case () | |
302 | (delete-file filename) | |
303 | (file-error nil))))) | |
d299ee07 RS |
304 | (message "Parsing ispell output ...") |
305 | (ispell-flush-bad-words) | |
306 | (let (pos bad-words) | |
307 | (while (numberp (setq pos (ispell-next-message))) | |
308 | ;;ispell may check the words on the line following the end | |
309 | ;;of the region - therefore, don't record anything out of range | |
310 | (if (or (= end 0) | |
311 | (< pos end)) | |
312 | (setq bad-words (cons (set-marker (make-marker) (+ pos 1)) | |
313 | bad-words)))) | |
314 | (setq bad-words (cons pos bad-words)) | |
315 | (setq ispell-bad-words (nreverse bad-words)))) | |
316 | (cond ((not (markerp (car ispell-bad-words))) | |
317 | (setq ispell-bad-words nil) | |
af4d43e9 RS |
318 | (message "No misspellings.") |
319 | t) | |
d299ee07 RS |
320 | (t |
321 | (message "Ispell parsing done.") | |
322 | (ispell-next)))) | |
323 | ||
3595955c | 324 | ;;;autoload |
31e1d920 | 325 | (defalias 'ispell-buffer 'ispell) |
f305bd74 | 326 | |
d299ee07 | 327 | (defun ispell-next () |
af4d43e9 RS |
328 | "Resume command loop for most recent Ispell command. |
329 | Return value is t unless exit is due to typing `q'." | |
d299ee07 | 330 | (interactive) |
a48fc390 | 331 | (setq ispell-window-configuration nil) |
2fc91d5b RS |
332 | (prog1 |
333 | (unwind-protect | |
334 | (catch 'ispell-quit | |
335 | ;; There used to be a save-excursion here, | |
336 | ;; but that was annoying: it's better if point doesn't move | |
337 | ;; when you type q. | |
338 | (let (next) | |
339 | (while (markerp (setq next (car ispell-bad-words))) | |
340 | (switch-to-buffer (marker-buffer next)) | |
341 | (push-mark) | |
342 | (ispell-point next "at saved position.") | |
343 | (setq ispell-bad-words (cdr ispell-bad-words)) | |
344 | (set-marker next nil))) | |
345 | t) | |
f7cf7ffe | 346 | (ispell-dehighlight) |
2fc91d5b RS |
347 | (if ispell-window-configuration |
348 | (set-window-configuration ispell-window-configuration)) | |
349 | (cond ((null ispell-bad-words) | |
06811c2d | 350 | (error "Ispell has not yet been run")) |
2fc91d5b | 351 | ((markerp (car ispell-bad-words)) |
32bf4c34 KH |
352 | (message "%s" |
353 | (substitute-command-keys | |
06811c2d | 354 | "Type \\[ispell-next] to continue"))) |
2fc91d5b RS |
355 | ((eq (car ispell-bad-words) nil) |
356 | (setq ispell-bad-words nil) | |
06811c2d | 357 | (message "No more misspellings (but checker was interrupted)")) |
2fc91d5b RS |
358 | ((eq (car ispell-bad-words) t) |
359 | (setq ispell-bad-words nil) | |
06811c2d | 360 | (message "Ispell done")) |
2fc91d5b RS |
361 | (t |
362 | (setq ispell-bad-words nil) | |
363 | (message "Bad ispell internal list")))) | |
364 | (ispell-dump))) | |
d299ee07 | 365 | |
3595955c | 366 | ;;;autoload |
6370a710 | 367 | (defun ispell-word (&optional resume) |
d299ee07 | 368 | "Check the spelling of the word under the cursor. |
a6c5a8dd | 369 | See the command `ispell' for more information. |
6370a710 RS |
370 | With a prefix argument, resume handling of the previous Ispell command." |
371 | (interactive "P") | |
372 | (if resume | |
373 | (ispell-next) | |
374 | (condition-case err | |
4638b806 RS |
375 | (unwind-protect |
376 | (catch 'ispell-quit | |
377 | (save-window-excursion | |
378 | (ispell-point (point) "at point.")) | |
379 | (ispell-dump)) | |
380 | (ispell-dehighlight)) | |
6370a710 RS |
381 | (ispell-startup-error |
382 | (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ") | |
383 | (load-library "spell") | |
384 | (define-key esc-map "$" 'spell-word) | |
385 | (spell-word))))))) | |
925a622c | 386 | |
3595955c | 387 | ;;;autoload (define-key esc-map "$" 'ispell-word) |
d299ee07 | 388 | |
3595955c | 389 | ;;;autoload |
d299ee07 RS |
390 | (defun ispell-region (start &optional end) |
391 | "Check the spelling for all of the words in the region." | |
392 | (interactive "r") | |
393 | (ispell (current-buffer) start end)) | |
394 | ||
395 | (defun ispell-letterp (c) | |
396 | (and c | |
397 | (or (and (>= c ?A) (<= c ?Z)) | |
398 | (and (>= c ?a) (<= c ?z)) | |
399 | (>= c 128)))) | |
400 | ||
401 | (defun ispell-letter-or-quotep (c) | |
402 | (and c | |
403 | (or (and (>= c ?A) (<= c ?Z)) | |
404 | (and (>= c ?a) (<= c ?z)) | |
405 | (= c ?') | |
406 | (>= c 128)))) | |
407 | ||
408 | (defun ispell-find-word-start () | |
409 | ;;backward to a letter | |
410 | (if (not (ispell-letterp (char-after (point)))) | |
411 | (while (and (not (bobp)) | |
412 | (not (ispell-letterp (char-after (- (point) 1))))) | |
413 | (backward-char))) | |
414 | ;;backward to beginning of word | |
415 | (while (ispell-letter-or-quotep (char-after (- (point) 1))) | |
416 | (backward-char)) | |
417 | (skip-chars-forward "'")) | |
418 | ||
419 | (defun ispell-find-word-end () | |
420 | (while (ispell-letter-or-quotep (char-after (point))) | |
421 | (forward-char)) | |
422 | (skip-chars-backward "'")) | |
423 | ||
424 | (defun ispell-next-word () | |
425 | (while (and (not (eobp)) | |
426 | (not (ispell-letterp (char-after (point))))) | |
427 | (forward-char))) | |
428 | ||
429 | ;if end is nil, then do one word at start | |
430 | ;otherwise, do all words from the beginning of the word where | |
431 | ;start points, to the end of the word where end points | |
432 | (defun ispell-point (start message) | |
433 | (let ((wend (make-marker)) | |
434 | rescan | |
435 | end) | |
a48fc390 RS |
436 | ;; There used to be a save-excursion here, |
437 | ;; but that was annoying: it's better if point doesn't move | |
438 | ;; when you type q. | |
d299ee07 RS |
439 | (goto-char start) |
440 | (ispell-find-word-start) ;find correct word start | |
441 | (setq start (point-marker)) | |
442 | (ispell-find-word-end) ;now find correct end | |
443 | (setq end (point-marker)) | |
e8608d6a RS |
444 | ;; Do nothing if we don't find a word. |
445 | (if (< start end) | |
446 | (while (< start end) | |
447 | (goto-char start) | |
448 | (ispell-find-word-end) ;find end of current word | |
d299ee07 RS |
449 | ;could be before 'end' if |
450 | ;user typed replacement | |
451 | ;that is more than one word | |
e8608d6a RS |
452 | (set-marker wend (point)) |
453 | (setq rescan nil) | |
454 | (setq word (buffer-substring start wend)) | |
455 | (cond ((ispell-still-bad word) | |
a48fc390 RS |
456 | ;;; This just causes confusion. -- rms. |
457 | ;;; (goto-char start) | |
458 | ;;; (sit-for 0) | |
32bf4c34 | 459 | (message "Ispell checking %s" word) |
e8608d6a RS |
460 | (ispell-cmd word) |
461 | (let ((message (ispell-next-message))) | |
462 | (cond ((eq message t) | |
463 | (message "%s: ok" word)) | |
464 | ((or (null message) | |
465 | (consp message)) | |
466 | (setq rescan | |
467 | (ispell-command-loop word start wend message))) | |
468 | (t | |
469 | (error "unknown ispell response %s" message)))))) | |
470 | (cond ((null rescan) | |
471 | (goto-char wend) | |
472 | (ispell-next-word) | |
473 | (set-marker start (point)))))) | |
d299ee07 RS |
474 | ;;clear the choices buffer; otherwise it's hard for the user to tell |
475 | ;;when we get back to the command loop | |
476 | (let ((buf (get-buffer "*ispell choices*"))) | |
477 | (cond (buf | |
478 | (set-buffer buf) | |
479 | (erase-buffer)))) | |
480 | (set-marker start nil) | |
481 | (set-marker end nil) | |
a48fc390 | 482 | (set-marker wend nil))) |
d299ee07 RS |
483 | |
484 | (defun ispell-still-bad (word) | |
485 | (let ((words ispell-recently-accepted) | |
486 | (ret t) | |
487 | (case-fold-search t)) | |
488 | (while words | |
489 | (cond ((eq (string-match (car words) word) 0) | |
490 | (setq ret nil) | |
491 | (setq words nil))) | |
492 | (setq words (cdr words))) | |
493 | ret)) | |
494 | ||
495 | (defun ispell-show-choices (word message first-line) | |
f98955ea | 496 | ;;if there is only one window on the frame, make the ispell |
d299ee07 RS |
497 | ;;messages winow be small. otherwise just use the other window |
498 | (let* ((selwin (selected-window)) | |
499 | (resize (eq selwin (next-window))) | |
500 | (buf (get-buffer-create "*ispell choices*")) | |
501 | w) | |
a48fc390 RS |
502 | (or ispell-window-configuration |
503 | (setq ispell-window-configuration (current-window-configuration))) | |
d299ee07 RS |
504 | (setq w (display-buffer buf)) |
505 | (buffer-disable-undo buf) | |
506 | (if resize | |
507 | (unwind-protect | |
508 | (progn | |
509 | (select-window w) | |
510 | (enlarge-window (- 6 (window-height w)))) | |
511 | (select-window selwin))) | |
512 | (save-excursion | |
513 | (set-buffer buf) | |
514 | (bury-buffer buf) | |
515 | (set-window-point w (point-min)) | |
516 | (set-window-start w (point-min)) | |
517 | (erase-buffer) | |
518 | (insert first-line "\n") | |
519 | (insert | |
520 | "SPC skip; A accept; I insert; DIGIT select; R replace; \ | |
521 | L lookup; Q quit\n") | |
522 | (cond ((not (null message)) | |
523 | (let ((i 0)) | |
524 | (while (< i 3) | |
525 | (let ((j 0)) | |
526 | (while (< j 3) | |
527 | (let* ((n (+ (* j 3) i)) | |
528 | (choice (nth n message))) | |
529 | (cond (choice | |
530 | (let ((str (format "%d %s" n choice))) | |
531 | (insert str) | |
532 | (insert-char ? (- 20 (length str))))))) | |
533 | (setq j (+ j 1)))) | |
534 | (insert "\n") | |
535 | (setq i (+ i 1))))))))) | |
536 | ||
537 | (defun ispell-command-loop (word start end message) | |
538 | (let ((flag t) | |
539 | (rescan nil) | |
540 | first-line) | |
541 | (if (null message) | |
542 | (setq first-line (concat "No near misses for '" word "'")) | |
543 | (setq first-line (concat "Near misses for '" word "'"))) | |
f7cf7ffe | 544 | (ispell-highlight start end) |
d299ee07 RS |
545 | (while flag |
546 | (ispell-show-choices word message first-line) | |
547 | (message "Ispell command: ") | |
8fa51910 | 548 | (undo-boundary) |
d299ee07 RS |
549 | (let ((c (downcase (read-char))) |
550 | replacement) | |
551 | (cond ((and (>= c ?0) | |
552 | (<= c ?9) | |
553 | (setq replacement (nth (- c ?0) message))) | |
554 | (ispell-replace start end replacement) | |
555 | (setq flag nil)) | |
556 | ((= c ?q) | |
af4d43e9 | 557 | (throw 'ispell-quit nil)) |
2fc91d5b | 558 | ((= c (nth 3 (current-input-mode))) |
af4d43e9 | 559 | (keyboard-quit)) |
d299ee07 RS |
560 | ((= c ? ) |
561 | (setq flag nil)) | |
562 | ((= c ?r) | |
563 | (ispell-replace start end (read-string "Replacement: ")) | |
564 | (setq rescan t) | |
565 | (setq flag nil)) | |
566 | ((= c ?i) | |
567 | (ispell-insert word) | |
568 | (setq flag nil)) | |
569 | ((= c ?a) | |
570 | (ispell-accept word) | |
571 | (setq flag nil)) | |
572 | ((= c ?l) | |
573 | (let ((val (ispell-do-look word))) | |
574 | (setq first-line (car val)) | |
575 | (setq message (cdr val)))) | |
576 | ((= c ??) | |
577 | (message | |
578 | "Type 'C-h d ispell' to the emacs main loop for more help") | |
579 | (sit-for 2)) | |
580 | (t | |
581 | (message "Bad ispell command") | |
582 | (sit-for 2))))) | |
583 | rescan)) | |
584 | ||
585 | (defun ispell-do-look (bad-word) | |
586 | (let (regex buf words) | |
587 | (cond ((null ispell-have-new-look) | |
588 | (setq regex (read-string "Lookup: "))) | |
589 | (t | |
590 | (setq regex (read-string "Lookup (regex): " "^")))) | |
591 | (setq buf (get-buffer-create "*ispell look*")) | |
592 | (save-excursion | |
593 | (set-buffer buf) | |
594 | (delete-region (point-min) (point-max)) | |
595 | (if ispell-have-new-look | |
bd28fa59 RS |
596 | (call-process ispell-look-command nil buf nil "-r" regex) |
597 | (call-process ispell-look-command nil buf nil regex)) | |
d299ee07 RS |
598 | (goto-char (point-min)) |
599 | (forward-line 10) | |
600 | (delete-region (point) (point-max)) | |
601 | (goto-char (point-min)) | |
602 | (while (not (= (point-min) (point-max))) | |
603 | (end-of-line) | |
604 | (setq words (cons (buffer-substring (point-min) (point)) words)) | |
605 | (forward-line) | |
606 | (delete-region (point-min) (point))) | |
607 | (kill-buffer buf) | |
608 | (cons (format "Lookup '%s'" regex) | |
609 | (reverse words))))) | |
610 | ||
611 | (defun ispell-replace (start end new) | |
612 | (goto-char start) | |
613 | (insert new) | |
614 | (delete-region (point) end)) | |
615 | ||
616 | (defun reload-ispell () | |
a6c5a8dd | 617 | "Tell Ispell to re-read your private dictionary." |
d299ee07 RS |
618 | (interactive) |
619 | (ispell-cmd ":reload")) | |
620 | ||
d299ee07 RS |
621 | (defun batch-make-ispell () |
622 | (byte-compile-file "ispell.el") | |
623 | (find-file "ispell.texinfo") | |
624 | (let ((old-dir default-directory) | |
625 | (default-directory "/tmp")) | |
626 | (texinfo-format-buffer)) | |
627 | (Info-validate) | |
628 | (if (get-buffer " *problems in info file*") | |
629 | (kill-emacs 1)) | |
630 | (write-region (point-min) (point-max) "ispell.info")) | |
631 | ||
f7cf7ffe RS |
632 | (defvar ispell-highlight t |
633 | "*Non-nil means to highlight ispell words.") | |
634 | ||
635 | (defvar ispell-overlay nil) | |
636 | ||
637 | (defun ispell-dehighlight () | |
638 | (and ispell-overlay | |
639 | (progn | |
640 | (delete-overlay ispell-overlay) | |
641 | (setq ispell-overlay nil)))) | |
642 | ||
643 | (defun ispell-highlight (start end) | |
644 | (and ispell-highlight | |
dc0989c6 | 645 | window-system |
f7cf7ffe RS |
646 | (progn |
647 | (or ispell-overlay | |
648 | (progn | |
649 | (setq ispell-overlay (make-overlay start end)) | |
650 | (overlay-put ispell-overlay 'face | |
651 | (if (internal-find-face 'ispell) | |
652 | 'ispell 'region)))) | |
653 | (move-overlay ispell-overlay start end (current-buffer))))) | |
654 | ||
bd28fa59 RS |
655 | ;;;; ispell-complete-word |
656 | ||
657 | ;;; Brief Description: | |
658 | ;;; Complete word fragment at point using dictionary and replace with full | |
659 | ;;; word. Expansion done in current buffer like lisp-complete-symbol. | |
660 | ;;; Completion of interior word fragments possible with prefix argument. | |
661 | ||
662 | ;;; Known Problem: | |
663 | ;;; Does not use private dictionary because GNU `look' does not use it. It | |
664 | ;;; would be nice if GNU `look' took standard input; this would allow gzip'ed | |
665 | ;;; dictionaries to be used. GNU `look' also has a bug, see | |
666 | ;;; `ispell-gnu-look-still-broken-p'. | |
667 | ||
668 | ;;; Motivation: | |
669 | ;;; The `l', "regular expression look up", keymap option of ispell-word | |
670 | ;;; (ispell-do-look) can only be run after finding a misspelled word. So | |
671 | ;;; ispell-do-look can not be used to look for words starting with `cat' to | |
672 | ;;; find `catechetical' since `cat' is a correctly spelled word. Furthermore, | |
673 | ;;; ispell-do-look does not return the entire list returned by `look'. | |
674 | ;;; | |
675 | ;;; ispell-complete-word allows you to get a completion list from the system | |
676 | ;;; dictionary and expand a word fragment at the current position in a buffer. | |
677 | ;;; These examples assume ispell-complete-word is bound to M-TAB as it is in | |
678 | ;;; text-mode; the `Complete Word' and `Complete Interior Fragment' entries of | |
679 | ;;; the "Spell" submenu under the "Edit" menu may also be used instead of | |
680 | ;;; M-TAB and C-u M-TAB, respectively. | |
681 | ;;; | |
682 | ;;; EXAMPLE 1: The word `Saskatchewan' needs to be spelled. The user may | |
683 | ;;; type `Sas' and hit M-TAB and a completion list will be built using the | |
684 | ;;; shell command `look' and displayed in the *Completions* buffer: | |
685 | ;;; | |
686 | ;;; Possible completions are: | |
687 | ;;; sash sashay | |
688 | ;;; sashayed sashed | |
689 | ;;; sashes sashimi | |
690 | ;;; Saskatchewan Saskatoon | |
691 | ;;; sass sassafras | |
692 | ;;; sassier sassing | |
693 | ;;; sasswood sassy | |
694 | ;;; | |
695 | ;;; By viewing this list the user will hopefully be motivated to insert the | |
696 | ;;; letter `k' after the `sas'. When M-TAB is hit again the word `Saskat' | |
697 | ;;; will be inserted in place of `sas' (note case) since this is a unique | |
698 | ;;; substring completion. The narrowed completion list can be viewed with | |
699 | ;;; another M-TAB | |
700 | ;;; | |
701 | ;;; Possible completions are: | |
702 | ;;; Saskatchewan Saskatoon | |
703 | ;;; | |
704 | ;;; Inserting the letter `c' and hitting M-TAB will narrow the completion | |
705 | ;;; possibilities to just `Saskatchewan' and this will be inserted in the | |
706 | ;;; buffer. At any point the user may click the mouse on a completion to | |
707 | ;;; select it. | |
708 | ;;; | |
709 | ;;; EXAMPLE 2: The user has typed `Sasaquane' and M-$ (ispell-word) gives no | |
710 | ;;; "near-misses" in which case you back up to `Sas' and hit M-TAB and find | |
711 | ;;; the correct word as above. The `Sas' will be replaced by `Saskatchewan' | |
712 | ;;; and the remaining word fragment `aquane' can be deleted. | |
713 | ;;; | |
714 | ;;; EXAMPLE 3: If a version of `look' is used that supports regular | |
715 | ;;; expressions, then `ispell-have-new-look' should be t (its default) and | |
716 | ;;; interior word fragments may also be used for the search. The word | |
717 | ;;; `pneumonia' needs to be spelled. The user can only remember the | |
718 | ;;; interior fragment `mon' in which case `C-u M-TAB' on `mon' gives a list | |
719 | ;;; of all words containing the interior word fragment `mon'. Typing `p' | |
720 | ;;; and M-TAB will narrow this list to all the words starting with `p' and | |
721 | ;;; containing `mon' from which `pneumonia' can be found as above. | |
722 | ||
723 | ;;; The user-defined variables are: | |
724 | ;;; | |
725 | ;;; ispell-look-command | |
726 | ;;; ispell-look-dictionary | |
727 | ;;; ispell-gnu-look-still-broken-p | |
728 | ||
729 | ;;; Algorithm (some similarity to lisp-complete-symbol): | |
730 | ;;; | |
731 | ;;; * call-process on command ispell-look-command (default: "look") to find | |
732 | ;;; words in ispell-look-dictionary matching `string' (or `regexp' if | |
733 | ;;; ispell-have-new-look is t). Parse output and store results in | |
734 | ;;; ispell-lookup-completions-alist. | |
735 | ;;; | |
736 | ;;; * Build completion list using try-completion and `string' | |
737 | ;;; | |
738 | ;;; * Replace `string' in buffer with matched common substring completion. | |
739 | ;;; | |
740 | ;;; * Display completion list only if there is no matched common substring. | |
741 | ;;; | |
742 | ;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when | |
743 | ;;; beginning of word fragment has changed. | |
744 | ;;; | |
745 | ;;; * Interior fragments searches are performed similarly with the exception | |
746 | ;;; that the entire fragment at point is initially removed from the buffer, | |
747 | ;;; the STRING passed to try-completion and all-completions is just "" and | |
748 | ;;; not the interior fragment; this allows all completions containing the | |
749 | ;;; interior fragment to be shown. The location in the buffer is stored to | |
750 | ;;; decide whether future completion narrowing of the current list should be | |
751 | ;;; done or if a new list should be built. See interior fragment example | |
752 | ;;; above. | |
753 | ;;; | |
754 | ;;; * Robust searches are done using a `look' with -r (regular expression) | |
755 | ;;; switch if ispell-have-new-look is t. | |
756 | ||
757 | ;;;; User-defined variables. | |
758 | ||
759 | (defvar ispell-look-dictionary nil | |
760 | "*If non-nil then spelling dictionary as string for `ispell-complete-word'. | |
761 | Overrides default dictionary file such as \"/usr/dict/words\" or GNU look's | |
762 | \"${prefix}/lib/ispell/ispell.words\"") | |
763 | ||
764 | (defvar ispell-gnu-look-still-broken-p nil | |
41ec9d2f | 765 | "*t if GNU look -r can give different results with and without trailing `.*'. |
bd28fa59 RS |
766 | Example: `look -dfr \"^ya\" foo' returns nothing, while `look -dfr \"^ya.*\" foo' |
767 | returns `yacc', where `foo' is a dictionary file containing the three lines | |
768 | ||
769 | y | |
770 | y's | |
771 | yacc | |
772 | ||
773 | Both commands should return `yacc'. If `ispell-complete-word' erroneously | |
774 | states that no completions exist for a string, then setting this variable to t | |
775 | will help find those completions.") | |
776 | ||
777 | ;;;; Internal variables. | |
778 | ||
779 | ;;; Possible completions for last word fragment. | |
780 | (defvar ispell-lookup-completions-alist nil) | |
781 | ||
782 | ;;; Last word fragment processed by `ispell-complete-word'. | |
783 | (defvar ispell-lookup-last-word nil) | |
784 | ||
785 | ;;; Buffer local variables. | |
786 | ||
787 | ;;; Value of interior-frag in last call to `ispell-complete-word'. | |
788 | (defvar ispell-lookup-last-interior-p nil) | |
789 | (make-variable-buffer-local 'ispell-lookup-last-interior-p) | |
790 | (put 'ispell-lookup-last-interior-p 'permanent-local t) | |
791 | ||
792 | ;;; Buffer position in last call to `ispell-complete-word'. | |
793 | (defvar ispell-lookup-last-bow nil) | |
794 | (make-variable-buffer-local 'ispell-lookup-last-bow) | |
795 | (put 'ispell-lookup-last-bow 'permanent-local t) | |
796 | ||
797 | ;;;; Interactive functions. | |
3595955c | 798 | ;;;autoload |
bd28fa59 RS |
799 | (defun ispell-complete-word (&optional interior-frag) |
800 | "Complete word using letters at point to word beginning using `look'. | |
801 | With optional argument INTERIOR-FRAG, word fragment at point is assumed to be | |
802 | an interior word fragment in which case `ispell-have-new-look' should be t. | |
803 | See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'." | |
804 | ||
805 | (interactive "P") | |
806 | ||
807 | ;; `look' must support regexp expressions in order to perform an interior | |
808 | ;; fragment search. | |
809 | (if (and interior-frag (not ispell-have-new-look)) | |
06811c2d | 810 | (error (concat "Sorry, `ispell-have-new-look' is nil. " |
bd28fa59 RS |
811 | "You also will need GNU Ispell's `look'."))) |
812 | ||
813 | (let* ((completion-ignore-case t) | |
814 | ||
815 | ;; Get location of beginning of word fragment. | |
816 | (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point))) | |
817 | ||
818 | ;; Get the string to look up. | |
819 | (string (buffer-substring bow (point))) | |
820 | ||
821 | ;; Get regexp for which we search and, if necessary, an interior word | |
822 | ;; fragment. | |
823 | (regexp (if interior-frag | |
824 | (concat "^.*" string ".*") | |
825 | ;; If possible use fast binary search: no trailing `.*'. | |
826 | (concat "^" string | |
827 | (if ispell-gnu-look-still-broken-p ".*")))) | |
828 | ||
829 | ;; We want all completions for case of interior fragments so set | |
830 | ;; prefix to an empty string. | |
831 | (prefix (if interior-frag "" string)) | |
832 | ||
833 | ;; Are we continuing from a previous interior fragment search? | |
834 | ;; Check last value of interior-word and if the point has moved. | |
835 | (continuing-an-interior-frag-p | |
836 | (and ispell-lookup-last-interior-p | |
837 | (equal ispell-lookup-last-bow bow))) | |
838 | ||
839 | ;; Are we starting a unique word fragment search? Always t for | |
840 | ;; interior word fragment search. | |
841 | (new-unique-string-p | |
842 | (or interior-frag (null ispell-lookup-last-word) | |
843 | (let ((case-fold-search t)) | |
844 | ;; Can we locate last word fragment as a substring of current | |
845 | ;; word fragment? If the last word fragment is larger than | |
846 | ;; the current string then we will have to rebuild the list | |
847 | ;; later. | |
848 | (not (string-match | |
849 | (concat "^" ispell-lookup-last-word) string))))) | |
850 | ||
851 | completion) | |
852 | ||
853 | ;; Check for perfect completion already. That is, maybe the user has hit | |
854 | ;; M-x ispell-complete-word one too many times? | |
855 | (if (string-equal string "") | |
856 | (if (string-equal (concat ispell-lookup-last-word " ") | |
857 | (buffer-substring | |
858 | (save-excursion (forward-word -1) (point)) (point))) | |
06811c2d RS |
859 | (error "Perfect match already") |
860 | (error "No word fragment at point"))) | |
bd28fa59 RS |
861 | |
862 | ;; Create list of words from system dictionary starting with `string' if | |
863 | ;; new string and not continuing from a previous interior fragment search. | |
864 | (if (and (not continuing-an-interior-frag-p) new-unique-string-p) | |
865 | (setq ispell-lookup-completions-alist | |
866 | (ispell-lookup-build-list string regexp))) | |
867 | ||
868 | ;; Check for a completion of `string' in the list and store `string' and | |
869 | ;; other variables for the next call. | |
870 | (setq completion (try-completion prefix ispell-lookup-completions-alist) | |
871 | ispell-lookup-last-word string | |
872 | ispell-lookup-last-interior-p interior-frag | |
873 | ispell-lookup-last-bow bow) | |
874 | ||
875 | ;; Test the completion status. | |
876 | (cond | |
877 | ||
878 | ;; * Guess is a perfect match. | |
879 | ((eq completion t) | |
880 | (insert " ") | |
881 | (message "Perfect match.")) | |
882 | ||
883 | ;; * No possibilities. | |
884 | ((null completion) | |
885 | (message "Can't find completion for \"%s\"" string) | |
886 | (beep)) | |
887 | ||
888 | ;; * Replace string fragment with matched common substring completion. | |
889 | ((and (not (string-equal completion "")) | |
890 | ;; Fold case so a completion list is built when `string' and common | |
891 | ;; substring differ only in case. | |
892 | (let ((case-fold-search t)) | |
893 | (not (string-match (concat "^" completion "$") string)))) | |
894 | (search-backward string bow) | |
895 | (replace-match completion nil t) ; FIXEDCASE doesn't work? or LITERAL? | |
896 | (message "Proposed unique substring. Repeat for completions list.")) | |
897 | ||
898 | ;; * String is a common substring completion already. Make list. | |
899 | (t | |
900 | (message "Making completion list...") | |
901 | (if (string-equal completion "") (delete-region bow (point))) | |
902 | (let ((list (all-completions prefix ispell-lookup-completions-alist))) | |
03cb2099 | 903 | (with-output-to-temp-buffer "*Completions*" |
bd28fa59 RS |
904 | (display-completion-list list))) |
905 | (message "Making completion list...done"))))) | |
906 | ||
3595955c | 907 | ;;;autoload |
bd28fa59 RS |
908 | (defun ispell-complete-word-interior-frag () |
909 | "Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG. | |
910 | A completion list is built for word fragment at point which is assumed to be | |
911 | an interior word fragment. `ispell-have-new-look' should be t." | |
912 | (interactive) | |
913 | (ispell-complete-word t)) | |
914 | ||
915 | ;;;; Internal Function. | |
916 | ||
917 | ;;; Build list of words using ispell-look-command from dictionary | |
918 | ;;; ispell-look-dictionary (if this is a non-nil string). Look for words | |
919 | ;;; starting with STRING if ispell-have-new-look is nil or look for REGEXP if | |
920 | ;;; ispell-have-new-look is t. Returns result as an alist suitable for use by | |
921 | ;;; try-completion, all-completions, and completing-read. | |
922 | (defun ispell-lookup-build-list (string regexp) | |
923 | (save-excursion | |
924 | (message "Building list...") | |
925 | (set-buffer (get-buffer-create " *ispell look*")) | |
926 | (erase-buffer) | |
927 | ||
928 | (if (stringp ispell-look-dictionary) | |
929 | (if ispell-have-new-look | |
930 | (call-process ispell-look-command nil t nil "-fr" regexp | |
931 | ispell-look-dictionary) | |
932 | (call-process ispell-look-command nil t nil "-f" string | |
933 | ispell-look-dictionary)) | |
934 | (if ispell-have-new-look | |
935 | (call-process ispell-look-command nil t nil "-fr" regexp) | |
936 | (call-process ispell-look-command nil t nil "-f" string))) | |
937 | ||
938 | ;; Build list for try-completion and all-completions by storing each line | |
939 | ;; of output starting from bottom of buffer and deleting upwards. | |
940 | (let (list) | |
941 | (goto-char (point-min)) | |
942 | (while (not (= (point-min) (point-max))) | |
943 | (end-of-line) | |
944 | (setq list (cons (buffer-substring (point-min) (point)) list)) | |
945 | (forward-line) | |
946 | (delete-region (point-min) (point))) | |
947 | ||
948 | ;; Clean. | |
949 | (erase-buffer) | |
950 | (message "Building list...done") | |
951 | ||
952 | ;; Make the list into an alist and return. | |
953 | (mapcar 'list (nreverse list))))) | |
af4d43e9 RS |
954 | \f |
955 | ;; Return regexp-quote of STRING if STRING is non-empty. | |
956 | ;; Otherwise return an unmatchable regexp. | |
957 | (defun ispell-non-empty-string (string) | |
958 | (if (or (not string) (string-equal string "")) | |
959 | "\\'\\`" ; An unmatchable string if string is null. | |
960 | (regexp-quote string))) | |
961 | ||
962 | (defvar ispell-message-cite-regexp "^ \\|^\t" | |
1f8359ba RS |
963 | "*Regular expression to match lines cited from one message into another.") |
964 | ||
d1dacaa0 RS |
965 | (defvar ispell-message-text-end |
966 | (concat "^\\(" (mapconcat (function identity) | |
967 | '( | |
968 | ;; Matches postscript files. | |
969 | "%!PS-Adobe-2.0" | |
970 | ;; Matches uuencoded text | |
971 | "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM" | |
972 | ;; Matches shell files (esp. auto-decoding) | |
973 | "#! /bin/sh" | |
974 | ;; Matches difference listing | |
975 | "diff -c .*\n\\*\\*\\* .*\n--- " | |
976 | ;; Matches "--------------------- cut here" | |
977 | "[-=]+\\s cut here") | |
978 | "\\|") | |
979 | "\\)") | |
980 | "*End of text which will be checked in ispell-message. | |
41ec9d2f | 981 | If it is a string, limit at first occurrence of that regular expression. |
d1dacaa0 RS |
982 | Otherwise, it must be a function which is called to get the limit.") |
983 | ||
984 | (defvar ispell-message-limit (* 100 80) | |
985 | "*Ispell-message will check no more than this number of characters.") | |
986 | ||
3595955c | 987 | ;;;autoload |
36ab15b2 | 988 | (defun ispell-message () |
af4d43e9 | 989 | "Check the spelling of a mail message or news post. |
d1dacaa0 | 990 | Don't check spelling of message headers (except subject) or included messages. |
af4d43e9 RS |
991 | |
992 | To spell-check whenever a message is sent, include this line in .emacs: | |
993 | (setq news-inews-hook (setq mail-send-hook 'ispell-message)) | |
994 | ||
995 | Or you can bind the function to C-c i in gnus or mail with: | |
996 | (setq mail-mode-hook (setq news-reply-mode-hook | |
997 | (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))))" | |
36ab15b2 RS |
998 | (interactive) |
999 | (save-excursion | |
82c5b4be RS |
1000 | (let (non-internal-message |
1001 | (old-case-fold-search case-fold-search) | |
1002 | (case-fold-search nil)) | |
af4d43e9 RS |
1003 | (goto-char (point-min)) |
1004 | ;; Don't spell-check the headers. | |
1005 | (if (search-forward mail-header-separator nil t) | |
1006 | ;; Move to first body line. | |
1007 | (forward-line 1) | |
1008 | (while (and (looking-at "[a-zA-Z-]+:\\|\t\\| ") | |
1009 | (not (eobp))) | |
1010 | (forward-line 1)) | |
1011 | (setq non-internal-message t) | |
1012 | ) | |
d1dacaa0 | 1013 | (let* ((cite-regexp ;Prefix of inserted text |
af4d43e9 RS |
1014 | (cond |
1015 | ((featurep 'supercite) ; sc 3.0 | |
1016 | (concat "\\(" (sc-cite-regexp) "\\)" "\\|" | |
1017 | (ispell-non-empty-string sc-reference-tag-string))) | |
1018 | ((featurep 'sc) ; sc 2.3 | |
1019 | (concat "\\(" sc-cite-regexp "\\)" "\\|" | |
1020 | (ispell-non-empty-string sc-reference-tag-string))) | |
1021 | (non-internal-message ; Assume nn sent us this message. | |
1022 | (concat "In [a-zA-Z.]+ you write:" "\\|" | |
1023 | "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|" | |
1024 | " *> *")) | |
1025 | ((equal major-mode 'news-reply-mode) ;Gnus | |
1026 | (concat "In article <" "\\|" | |
82c5b4be RS |
1027 | (if mail-yank-prefix |
1028 | (ispell-non-empty-string mail-yank-prefix) | |
1029 | ispell-message-cite-regexp))) | |
af4d43e9 RS |
1030 | ((boundp 'vm-included-text-prefix) ; VM mail message |
1031 | (concat "[^,;&+=]+ writes:" "\\|" | |
1032 | (ispell-non-empty-string vm-included-text-prefix) | |
1033 | )) | |
1034 | ((boundp 'mh-ins-buf-prefix) ; mh mail message | |
1035 | (ispell-non-empty-string mh-ins-buf-prefix)) | |
1036 | (mail-yank-prefix ; vanilla mail message. | |
1037 | (ispell-non-empty-string mail-yank-prefix)) | |
1038 | (t ispell-message-cite-regexp))) | |
d1dacaa0 RS |
1039 | (continue t) |
1040 | (limit | |
1041 | (min | |
1042 | (+ (point-min) ispell-message-limit) | |
1043 | (point-max) | |
1044 | (save-excursion | |
1045 | (cond | |
1046 | ((not ispell-message-text-end) (point-max)) | |
1047 | ((char-or-string-p ispell-message-text-end) | |
1048 | (if (re-search-forward ispell-message-text-end nil 'end) | |
1049 | (match-beginning 0) | |
1050 | (point-max))) | |
1051 | (t (funcall ispell-message-text-end)))))) | |
1052 | (search-limit ; Search limit which won't stop in middle of citation | |
1053 | (+ limit (length cite-regexp))) | |
1054 | ) | |
1055 | ;; Check the subject | |
1056 | (save-excursion | |
1057 | (let ((case-fold-search t) | |
1058 | (message-begin (point))) | |
1059 | (goto-char (point-min)) | |
1060 | ;; "\\s *" matches newline if subject is empty | |
1061 | (if (and (re-search-forward "^Subject:[\t ]*" message-begin t) | |
1062 | (not (looking-at "re\\>"))) | |
1063 | (setq continue | |
1064 | (ispell-region (- (point) 1) | |
1065 | (progn | |
1066 | (end-of-line) | |
1067 | (while (looking-at "\n[ \t]") | |
1068 | (end-of-line 2)) | |
1069 | (point)))) | |
1070 | ))) | |
1071 | ||
1072 | ;; Check the body. | |
1073 | (while (and (< (point) limit) continue) | |
af4d43e9 RS |
1074 | ;; Skip across text cited from other messages. |
1075 | (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp)) | |
d1dacaa0 | 1076 | (< (point) limit)) |
af4d43e9 | 1077 | (forward-line 1)) |
d1dacaa0 | 1078 | (if (< (point) limit) |
82c5b4be | 1079 | ;; Check the next batch of lines that *aren't* cited. |
af4d43e9 | 1080 | (let ((start (point))) |
d1dacaa0 RS |
1081 | (if (re-search-forward |
1082 | (concat "^\\(" cite-regexp "\\)") search-limit 'end) | |
1083 | (beginning-of-line)) | |
1084 | (if (> (point) limit) (goto-char limit)) | |
82c5b4be RS |
1085 | (let ((case-fold-search old-case-fold-search)) |
1086 | (save-excursion | |
1087 | (setq continue (ispell-region (- start 1) (point)))))))))))) | |
36ab15b2 | 1088 | |
aa5f8836 RS |
1089 | (provide 'ispell) |
1090 | ||
1a06eabd | 1091 | ;;; ispell.el ends here |