Mercurial > emacs
comparison lisp/textmodes/=ispell4.el @ 55:5652ba2db1a7
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 26 Mar 1990 04:06:27 +0000 |
parents | |
children | a1430f8459e5 |
comparison
equal
deleted
inserted
replaced
54:bacfccb982c9 | 55:5652ba2db1a7 |
---|---|
1 ;;This is the GNU EMACS interface to GNU ISPELL version 3. | |
2 ;; Copyright (C) 1990 Free Software Foundation, Inc. | |
3 ;; | |
4 ;;This file is part of GNU ISPELL. | |
5 ;; | |
6 ;;GNU ISPELL is free software; you can redistribute it and/or modify | |
7 ;;it under the terms of the GNU General Public License as published by | |
8 ;;the Free Software Foundation; either version 1, or (at your option) | |
9 ;;any later version. | |
10 ;; | |
11 ;;GNU ISPELL is distributed in the hope that it will be useful, | |
12 ;;but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 ;;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 ;;GNU General Public License for more details. | |
15 ;; | |
16 ;;You should have received a copy of the GNU General Public License | |
17 ;;along with GNU ISPELL; see the file COPYING. If not, write to | |
18 ;;the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | |
20 (defvar ispell-have-new-look t | |
21 "T if default 'look' program has the -r flag.") | |
22 | |
23 (defvar ispell-enable-tex-parser nil | |
24 "T to enable experimental tex parser in ispell for tex buffers.") | |
25 | |
26 (defvar ispell-process nil "The process running ISPELL") | |
27 (defvar ispell-next-message nil | |
28 "An integer telling where in the *ispell* buffer where | |
29 to look for the next message from the ISPELL program.") | |
30 | |
31 ;Each marker in this list points to the start of a word that | |
32 ;ispell thought was bad last time it did the :file command. | |
33 ;Notice that if the user accepts or inserts a word into his | |
34 ;private dictionary, then some "good" words will be on the list. | |
35 ;We would like to deal with this by looking up the words again just before | |
36 ;presenting them to the user, but that is too slow on machines | |
37 ;without the select system call. Therefore, see the variable | |
38 ;ispell-recently-accepted. | |
39 (defvar ispell-bad-words nil | |
40 "A list of markers corresponding to the output of the ISPELL :file command.") | |
41 | |
42 ;list of words that the user has accepted, but that might still | |
43 ;be on the bad-words list | |
44 (defvar ispell-recently-accepted nil) | |
45 | |
46 ;t when :dump command needed | |
47 (defvar ispell-dump-needed nil) | |
48 | |
49 (defun ispell-flush-bad-words () | |
50 (while ispell-bad-words | |
51 (if (markerp (car ispell-bad-words)) | |
52 (set-marker (car ispell-bad-words) nil)) | |
53 (setq ispell-bad-words (cdr ispell-bad-words))) | |
54 (setq ispell-recently-accepted nil)) | |
55 | |
56 (defun kill-ispell () | |
57 "Kill the ispell process. | |
58 Any changes the your private dictionay | |
59 that have not already been dumped will be lost." | |
60 (interactive) | |
61 (if ispell-process | |
62 (delete-process ispell-process)) | |
63 (setq ispell-process nil) | |
64 (ispell-flush-bad-words)) | |
65 | |
66 (put 'ispell-startup-error 'error-conditions | |
67 '(ispell-startup-error error)) | |
68 (put 'ispell-startup-error 'error-message | |
69 "Problem starting ispell - see buffer *ispell*") | |
70 | |
71 (defun start-ispell () | |
72 "Start an ispell subprocess; check the version; and display the greeting." | |
73 (message "Starting ispell ...") | |
74 (let ((buf (get-buffer "*ispell*"))) | |
75 (if buf | |
76 (kill-buffer buf))) | |
77 (condition-case err | |
78 (setq ispell-process (start-process "ispell" "*ispell*" "ispell" "-S")) | |
79 (file-error (signal 'ispell-startup-error nil))) | |
80 (process-kill-without-query ispell-process) | |
81 (buffer-disable-undo (process-buffer ispell-process)) | |
82 (accept-process-output ispell-process) | |
83 (let (last-char) | |
84 (save-excursion | |
85 (set-buffer (process-buffer ispell-process)) | |
86 (bury-buffer (current-buffer)) | |
87 (setq last-char (- (point-max) 1)) | |
88 (while (not (eq (char-after last-char) ?=)) | |
89 (cond ((not (eq (process-status ispell-process) 'run)) | |
90 (kill-ispell) | |
91 (signal 'ispell-startup-error nil))) | |
92 (accept-process-output ispell-process) | |
93 (setq last-char (- (point-max) 1))) | |
94 (goto-char (point-min)) | |
95 (let ((greeting (read (current-buffer)))) | |
96 (if (not (= (car greeting) 1)) | |
97 (error "Bad ispell version: wanted 1, got %d" (car greeting))) | |
98 (message (car (cdr greeting)))) | |
99 (delete-region (point-min) last-char)))) | |
100 | |
101 ;leaves buffer set to *ispell*, point at '=' | |
102 (defun ispell-sync (intr) | |
103 "Make sure ispell is ready for a command." | |
104 (if (or (null ispell-process) | |
105 (not (eq (process-status ispell-process) 'run))) | |
106 (start-ispell)) | |
107 (if intr | |
108 (interrupt-process ispell-process)) | |
109 (let (last-char) | |
110 (set-buffer (process-buffer ispell-process)) | |
111 (bury-buffer (current-buffer)) | |
112 (setq last-char (- (point-max) 1)) | |
113 (while (not (eq (char-after last-char) ?=)) | |
114 (accept-process-output ispell-process) | |
115 (setq last-char (- (point-max) 1))) | |
116 (goto-char last-char))) | |
117 | |
118 (defun ispell-cmd (&rest strings) | |
119 "Send a command to ispell. Choices are: | |
120 | |
121 word any word is checked for spelling. Result is | |
122 | |
123 nil not found | |
124 t spelled ok | |
125 list of strings near misses | |
126 | |
127 :file filename scan the named file, and print the file offsets of | |
128 any misspelled words | |
129 | |
130 :insert word put word in private dictonary | |
131 | |
132 :accept word don't complain about word any more this session | |
133 | |
134 :dump write out the current private dictionary, if necessary. | |
135 | |
136 :reload reread ~/ispell.words | |
137 | |
138 :tex | |
139 :troff | |
140 :generic set type of parser to use when scanning whole files | |
141 " | |
142 (save-excursion | |
143 (ispell-sync t) | |
144 (set-buffer (process-buffer ispell-process)) | |
145 (bury-buffer (current-buffer)) | |
146 (erase-buffer) | |
147 (setq ispell-next-message (point-min)) | |
148 (while strings | |
149 (process-send-string ispell-process (car strings)) | |
150 (setq strings (cdr strings))) | |
151 (process-send-string ispell-process "\n") | |
152 (accept-process-output ispell-process) | |
153 (ispell-sync nil))) | |
154 | |
155 (defun ispell-dump () | |
156 (cond (ispell-dump-needed | |
157 (setq ispell-dump-needed nil) | |
158 (ispell-cmd ":dump")))) | |
159 | |
160 (defun ispell-insert (word) | |
161 (ispell-cmd ":insert " word) | |
162 (if ispell-bad-words | |
163 (setq ispell-recently-accepted (cons word ispell-recently-accepted))) | |
164 (setq ispell-dump-needed t)) | |
165 | |
166 (defun ispell-accept (word) | |
167 (ispell-cmd ":accept " word) | |
168 (if ispell-bad-words | |
169 (setq ispell-recently-accepted (cons word ispell-recently-accepted)))) | |
170 | |
171 | |
172 (defun ispell-next-message () | |
173 "Return the next message sent by the ispell subprocess." | |
174 (save-excursion | |
175 (set-buffer (process-buffer ispell-process)) | |
176 (bury-buffer (current-buffer)) | |
177 (save-restriction | |
178 (goto-char ispell-next-message) | |
179 (narrow-to-region (point) | |
180 (progn (forward-sexp 1) (point))) | |
181 (setq ispell-next-message (point)) | |
182 (goto-char (point-min)) | |
183 (read (current-buffer))))) | |
184 | |
185 (defun ispell-tex-buffer-p () | |
186 (memq major-mode '(plain-TeX-mode LaTeX-mode))) | |
187 | |
188 (defun ispell (&optional buf start end) | |
189 "Run ispell over current buffer's visited file. | |
190 First the file is scanned for misspelled words, then ispell | |
191 enters a loop with the following commands for every misspelled word: | |
192 | |
193 DIGIT Near miss selector. If the misspelled word is close to | |
194 some words in the dictionary, they are offered as near misses. | |
195 r Replace. Replace the word with a string you type. Each word | |
196 of your new string is also checked. | |
197 i Insert. Insert this word in your private dictonary (kept in | |
198 `$HOME/ispell.words'). | |
199 a Accept. Accept this word for the rest of this editing session, | |
200 but don't put it in your private dictonary. | |
201 l Lookup. Look for a word in the dictionary by fast binary | |
202 search, or search for a regular expression in the dictionary | |
203 using grep. | |
204 SPACE Accept the word this time, but complain if it is seen again. | |
205 q, C-G Leave the command loop. You can come back later with \\[ispell-next]." | |
206 (interactive) | |
207 (if (null start) | |
208 (setq start 0)) | |
209 (if (null end) | |
210 (setq end 0)) | |
211 | |
212 (if (null buf) | |
213 (setq buf (current-buffer))) | |
214 (setq buf (get-buffer buf)) | |
215 (if (null buf) | |
216 (error "Can't find buffer")) | |
217 (save-excursion | |
218 (set-buffer buf) | |
219 (let ((filename buffer-file-name) | |
220 (delete-temp nil)) | |
221 (unwind-protect | |
222 (progn | |
223 (cond ((null filename) | |
224 (setq filename (make-temp-name "/usr/tmp/ispell")) | |
225 (setq delete-temp t) | |
226 (write-region (point-min) (point-max) filename)) | |
227 ((and (buffer-modified-p buf) | |
228 (y-or-n-p (format "Save file %s? " filename))) | |
229 (save-buffer))) | |
230 (message "Ispell scanning file...") | |
231 (if (and ispell-enable-tex-parser | |
232 (ispell-tex-buffer-p)) | |
233 (ispell-cmd ":tex") | |
234 (ispell-cmd ":generic")) | |
235 (ispell-cmd (format ":file %s %d %d" filename start end))) | |
236 (if delete-temp | |
237 (condition-case () | |
238 (delete-file filename) | |
239 (file-error nil))))) | |
240 (message "Parsing ispell output ...") | |
241 (ispell-flush-bad-words) | |
242 (let (pos bad-words) | |
243 (while (numberp (setq pos (ispell-next-message))) | |
244 ;;ispell may check the words on the line following the end | |
245 ;;of the region - therefore, don't record anything out of range | |
246 (if (or (= end 0) | |
247 (< pos end)) | |
248 (setq bad-words (cons (set-marker (make-marker) (+ pos 1)) | |
249 bad-words)))) | |
250 (setq bad-words (cons pos bad-words)) | |
251 (setq ispell-bad-words (nreverse bad-words)))) | |
252 (cond ((not (markerp (car ispell-bad-words))) | |
253 (setq ispell-bad-words nil) | |
254 (message "No misspellings.")) | |
255 (t | |
256 (message "Ispell parsing done.") | |
257 (ispell-next)))) | |
258 | |
259 (defun ispell-next () | |
260 "Resume command loop for most recent ispell command." | |
261 (interactive) | |
262 (unwind-protect | |
263 (catch 'quit | |
264 (save-window-excursion | |
265 (save-excursion | |
266 (let (next) | |
267 (while (markerp (setq next (car ispell-bad-words))) | |
268 (switch-to-buffer (marker-buffer next)) | |
269 (push-mark) | |
270 (ispell-point next "at saved position.") | |
271 (setq ispell-bad-words (cdr ispell-bad-words)) | |
272 (set-marker next nil)))))) | |
273 (cond ((null ispell-bad-words) | |
274 (error "Ispell has not yet been run.")) | |
275 ((markerp (car ispell-bad-words)) | |
276 (message (substitute-command-keys | |
277 "Type \\[ispell-next] to continue."))) | |
278 ((eq (car ispell-bad-words) nil) | |
279 (setq ispell-bad-words nil) | |
280 (message "No more misspellings (but checker was interrupted.)")) | |
281 ((eq (car ispell-bad-words) t) | |
282 (setq ispell-bad-words nil) | |
283 (message "Ispell done.")) | |
284 (t | |
285 (setq ispell-bad-words nil) | |
286 (message "Bad ispell internal list")))) | |
287 (ispell-dump)) | |
288 | |
289 | |
290 (defun ispell-word () | |
291 "Check the spelling of the word under the cursor. | |
292 See `ispell' for more documentation." | |
293 (interactive) | |
294 (condition-case err | |
295 (catch 'quit | |
296 (save-window-excursion | |
297 (ispell-point (point) "at point.")) | |
298 (ispell-dump)) | |
299 (ispell-startup-error | |
300 (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ") | |
301 (load-library "spell") | |
302 (define-key esc-map "$" 'spell-word) | |
303 (spell-word)))))) | |
304 | |
305 (defun ispell-region (start &optional end) | |
306 "Check the spelling for all of the words in the region." | |
307 (interactive "r") | |
308 (ispell (current-buffer) start end)) | |
309 | |
310 (defun ispell-letterp (c) | |
311 (and c | |
312 (or (and (>= c ?A) (<= c ?Z)) | |
313 (and (>= c ?a) (<= c ?z)) | |
314 (>= c 128)))) | |
315 | |
316 (defun ispell-letter-or-quotep (c) | |
317 (and c | |
318 (or (and (>= c ?A) (<= c ?Z)) | |
319 (and (>= c ?a) (<= c ?z)) | |
320 (= c ?') | |
321 (>= c 128)))) | |
322 | |
323 (defun ispell-find-word-start () | |
324 ;;backward to a letter | |
325 (if (not (ispell-letterp (char-after (point)))) | |
326 (while (and (not (bobp)) | |
327 (not (ispell-letterp (char-after (- (point) 1))))) | |
328 (backward-char))) | |
329 ;;backward to beginning of word | |
330 (while (ispell-letter-or-quotep (char-after (- (point) 1))) | |
331 (backward-char)) | |
332 (skip-chars-forward "'")) | |
333 | |
334 (defun ispell-find-word-end () | |
335 (while (ispell-letter-or-quotep (char-after (point))) | |
336 (forward-char)) | |
337 (skip-chars-backward "'")) | |
338 | |
339 (defun ispell-next-word () | |
340 (while (and (not (eobp)) | |
341 (not (ispell-letterp (char-after (point))))) | |
342 (forward-char))) | |
343 | |
344 ;if end is nil, then do one word at start | |
345 ;otherwise, do all words from the beginning of the word where | |
346 ;start points, to the end of the word where end points | |
347 (defun ispell-point (start message) | |
348 (let ((wend (make-marker)) | |
349 rescan | |
350 end) | |
351 (save-excursion | |
352 (goto-char start) | |
353 (ispell-find-word-start) ;find correct word start | |
354 (setq start (point-marker)) | |
355 (ispell-find-word-end) ;now find correct end | |
356 (setq end (point-marker)) | |
357 (if (>= start end) | |
358 (error "No word %s" message)) | |
359 (while (< start end) | |
360 (goto-char start) | |
361 (ispell-find-word-end) ;find end of current word | |
362 ;could be before 'end' if | |
363 ;user typed replacement | |
364 ;that is more than one word | |
365 (set-marker wend (point)) | |
366 (setq rescan nil) | |
367 (setq word (buffer-substring start wend)) | |
368 (cond ((ispell-still-bad word) | |
369 (goto-char start);just to show user where we are working | |
370 (sit-for 0) | |
371 (message (format "Ispell checking %s" word)) | |
372 (ispell-cmd word) | |
373 (let ((message (ispell-next-message))) | |
374 (cond ((eq message t) | |
375 (message "%s: ok" word)) | |
376 ((or (null message) | |
377 (consp message)) | |
378 (setq rescan | |
379 (ispell-command-loop word start wend message))) | |
380 (t | |
381 (error "unknown ispell response %s" message)))))) | |
382 (cond ((null rescan) | |
383 (goto-char wend) | |
384 (ispell-next-word) | |
385 (set-marker start (point))))) | |
386 ;;clear the choices buffer; otherwise it's hard for the user to tell | |
387 ;;when we get back to the command loop | |
388 (let ((buf (get-buffer "*ispell choices*"))) | |
389 (cond (buf | |
390 (set-buffer buf) | |
391 (erase-buffer)))) | |
392 (set-marker start nil) | |
393 (set-marker end nil) | |
394 (set-marker wend nil)))) | |
395 | |
396 (defun ispell-still-bad (word) | |
397 (let ((words ispell-recently-accepted) | |
398 (ret t) | |
399 (case-fold-search t)) | |
400 (while words | |
401 (cond ((eq (string-match (car words) word) 0) | |
402 (setq ret nil) | |
403 (setq words nil))) | |
404 (setq words (cdr words))) | |
405 ret)) | |
406 | |
407 (defun ispell-show-choices (word message first-line) | |
408 ;;if there is only one window on the screen, make the ispell | |
409 ;;messages winow be small. otherwise just use the other window | |
410 (let* ((selwin (selected-window)) | |
411 (resize (eq selwin (next-window))) | |
412 (buf (get-buffer-create "*ispell choices*")) | |
413 w) | |
414 (setq w (display-buffer buf)) | |
415 (buffer-disable-undo buf) | |
416 (if resize | |
417 (unwind-protect | |
418 (progn | |
419 (select-window w) | |
420 (enlarge-window (- 6 (window-height w)))) | |
421 (select-window selwin))) | |
422 (save-excursion | |
423 (set-buffer buf) | |
424 (bury-buffer buf) | |
425 (set-window-point w (point-min)) | |
426 (set-window-start w (point-min)) | |
427 (erase-buffer) | |
428 (insert first-line "\n") | |
429 (insert | |
430 "SPC skip; A accept; I insert; DIGIT select; R replace; \ | |
431 L lookup; Q quit\n") | |
432 (cond ((not (null message)) | |
433 (let ((i 0)) | |
434 (while (< i 3) | |
435 (let ((j 0)) | |
436 (while (< j 3) | |
437 (let* ((n (+ (* j 3) i)) | |
438 (choice (nth n message))) | |
439 (cond (choice | |
440 (let ((str (format "%d %s" n choice))) | |
441 (insert str) | |
442 (insert-char ? (- 20 (length str))))))) | |
443 (setq j (+ j 1)))) | |
444 (insert "\n") | |
445 (setq i (+ i 1))))))))) | |
446 | |
447 (defun ispell-command-loop (word start end message) | |
448 (let ((flag t) | |
449 (rescan nil) | |
450 first-line) | |
451 (if (null message) | |
452 (setq first-line (concat "No near misses for '" word "'")) | |
453 (setq first-line (concat "Near misses for '" word "'"))) | |
454 (while flag | |
455 (ispell-show-choices word message first-line) | |
456 (message "Ispell command: ") | |
457 (let ((c (downcase (read-char))) | |
458 replacement) | |
459 (cond ((and (>= c ?0) | |
460 (<= c ?9) | |
461 (setq replacement (nth (- c ?0) message))) | |
462 (ispell-replace start end replacement) | |
463 (setq flag nil)) | |
464 ((= c ?q) | |
465 (throw 'quit nil)) | |
466 ((= c ? ) | |
467 (setq flag nil)) | |
468 ((= c ?r) | |
469 (ispell-replace start end (read-string "Replacement: ")) | |
470 (setq rescan t) | |
471 (setq flag nil)) | |
472 ((= c ?i) | |
473 (ispell-insert word) | |
474 (setq flag nil)) | |
475 ((= c ?a) | |
476 (ispell-accept word) | |
477 (setq flag nil)) | |
478 ((= c ?l) | |
479 (let ((val (ispell-do-look word))) | |
480 (setq first-line (car val)) | |
481 (setq message (cdr val)))) | |
482 ((= c ??) | |
483 (message | |
484 "Type 'C-h d ispell' to the emacs main loop for more help") | |
485 (sit-for 2)) | |
486 (t | |
487 (message "Bad ispell command") | |
488 (sit-for 2))))) | |
489 rescan)) | |
490 | |
491 (defun ispell-do-look (bad-word) | |
492 (let (regex buf words) | |
493 (cond ((null ispell-have-new-look) | |
494 (setq regex (read-string "Lookup: "))) | |
495 (t | |
496 (setq regex (read-string "Lookup (regex): " "^")))) | |
497 (setq buf (get-buffer-create "*ispell look*")) | |
498 (save-excursion | |
499 (set-buffer buf) | |
500 (delete-region (point-min) (point-max)) | |
501 (if ispell-have-new-look | |
502 (call-process "look" nil buf nil "-r" regex) | |
503 (call-process "look" nil buf nil regex)) | |
504 (goto-char (point-min)) | |
505 (forward-line 10) | |
506 (delete-region (point) (point-max)) | |
507 (goto-char (point-min)) | |
508 (while (not (= (point-min) (point-max))) | |
509 (end-of-line) | |
510 (setq words (cons (buffer-substring (point-min) (point)) words)) | |
511 (forward-line) | |
512 (delete-region (point-min) (point))) | |
513 (kill-buffer buf) | |
514 (cons (format "Lookup '%s'" regex) | |
515 (reverse words))))) | |
516 | |
517 (defun ispell-replace (start end new) | |
518 (goto-char start) | |
519 (insert new) | |
520 (delete-region (point) end)) | |
521 | |
522 (defun reload-ispell () | |
523 "Tell ispell to re-read your private dictionary." | |
524 (interactive) | |
525 (ispell-cmd ":reload")) | |
526 | |
527 (define-key esc-map "$" 'ispell-word) | |
528 ;; This conflicts with set-selective-display. What should we do??? | |
529 ;;(define-key ctl-x-map "$" 'ispell-next) | |
530 | |
531 (defun batch-make-ispell () | |
532 (byte-compile-file "ispell.el") | |
533 (find-file "ispell.texinfo") | |
534 (let ((old-dir default-directory) | |
535 (default-directory "/tmp")) | |
536 (texinfo-format-buffer)) | |
537 (Info-validate) | |
538 (if (get-buffer " *problems in info file*") | |
539 (kill-emacs 1)) | |
540 (write-region (point-min) (point-max) "ispell.info")) | |
541 |