1 ;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 3.
4 ;; Last-Modified: 02 Jun 1992
6 ;;Copyright (C) 1990, 1991 Free Software Foundation, Inc.
8 ;;This file is part of GNU Emacs.
10 ;;GNU Emacs is free software; you can redistribute it and/or modify
11 ;;it under the terms of the GNU General Public License as published by
12 ;;the Free Software Foundation; either version 2, or (at your option)
15 ;;GNU Emacs is distributed in the hope that it will be useful,
16 ;;but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;GNU General Public License for more details.
20 ;;You should have received a copy of the GNU General Public License
21 ;;along with GNU Emacs; see the file COPYING. If not, write to
22 ;;the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 (defvar ispell-have-new-look t
27 "T if default 'look' program has the -r flag.")
29 (defvar ispell-enable-tex-parser nil
30 "T to enable experimental tex parser in ispell for tex buffers.")
32 (defvar ispell-process nil
"The process running ISPELL")
33 (defvar ispell-next-message nil
34 "An integer telling where in the *ispell* buffer where
35 to look for the next message from the ISPELL program.")
37 ;Each marker in this list points to the start of a word that
38 ;ispell thought was bad last time it did the :file command.
39 ;Notice that if the user accepts or inserts a word into his
40 ;private dictionary, then some "good" words will be on the list.
41 ;We would like to deal with this by looking up the words again just before
42 ;presenting them to the user, but that is too slow on machines
43 ;without the select system call. Therefore, see the variable
44 ;ispell-recently-accepted.
45 (defvar ispell-bad-words nil
46 "A list of markers corresponding to the output of the ISPELL :file command.")
48 ;list of words that the user has accepted, but that might still
49 ;be on the bad-words list
50 (defvar ispell-recently-accepted nil
)
52 ;t when :dump command needed
53 (defvar ispell-dump-needed nil
)
55 (defun ispell-flush-bad-words ()
56 (while ispell-bad-words
57 (if (markerp (car ispell-bad-words
))
58 (set-marker (car ispell-bad-words
) nil
))
59 (setq ispell-bad-words
(cdr ispell-bad-words
)))
60 (setq ispell-recently-accepted nil
))
63 "Kill the ispell process.
64 Any changes the your private dictionay
65 that have not already been dumped will be lost."
68 (delete-process ispell-process
))
69 (setq ispell-process nil
)
70 (ispell-flush-bad-words))
72 (put 'ispell-startup-error
'error-conditions
73 '(ispell-startup-error error
))
74 (put 'ispell-startup-error
'error-message
75 "Problem starting ispell - see buffer *ispell*")
77 (defun start-ispell ()
78 "Start an ispell subprocess; check the version; and display the greeting."
79 (message "Starting ispell ...")
80 (let ((buf (get-buffer "*ispell*")))
84 (setq ispell-process
(start-process "ispell" "*ispell*" "ispell" "-S"))
85 (file-error (signal 'ispell-startup-error nil
)))
86 (process-kill-without-query ispell-process
)
87 (buffer-disable-undo (process-buffer ispell-process
))
88 (accept-process-output ispell-process
)
91 (set-buffer (process-buffer ispell-process
))
92 (bury-buffer (current-buffer))
93 (setq last-char
(- (point-max) 1))
94 (while (not (eq (char-after last-char
) ?
=))
95 (cond ((not (eq (process-status ispell-process
) 'run
))
97 (signal 'ispell-startup-error nil
)))
98 (accept-process-output ispell-process
)
99 (setq last-char
(- (point-max) 1)))
100 (goto-char (point-min))
101 (let ((greeting (read (current-buffer))))
102 (if (not (= (car greeting
) 1))
103 (error "Bad ispell version: wanted 1, got %d" (car greeting
)))
104 (message (car (cdr greeting
))))
105 (delete-region (point-min) last-char
))))
107 ;leaves buffer set to *ispell*, point at '='
108 (defun ispell-sync (intr)
109 "Make sure ispell is ready for a command."
110 (if (or (null ispell-process
)
111 (not (eq (process-status ispell-process
) 'run
)))
114 (interrupt-process ispell-process
))
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 (accept-process-output ispell-process
)
121 (setq last-char
(- (point-max) 1)))
122 (goto-char last-char
)))
124 (defun ispell-cmd (&rest strings
)
125 "Send a command to ispell. Choices are:
127 WORD Check spelling of WORD. Result is
131 list of strings near misses
133 :file FILENAME scan the named file, and print the file offsets of
136 :insert WORD put word in private dictonary
138 :accept WORD don't complain about word any more this session
140 :dump write out the current private dictionary, if necessary.
142 :reload reread `~/ispell.words'
146 :generic set type of parser to use when scanning whole files
150 (set-buffer (process-buffer ispell-process
))
151 (bury-buffer (current-buffer))
153 (setq ispell-next-message
(point-min))
155 (process-send-string ispell-process
(car strings
))
156 (setq strings
(cdr strings
)))
157 (process-send-string ispell-process
"\n")
158 (accept-process-output ispell-process
)
161 (defun ispell-dump ()
162 (cond (ispell-dump-needed
163 (setq ispell-dump-needed nil
)
164 (ispell-cmd ":dump"))))
166 (defun ispell-insert (word)
167 (ispell-cmd ":insert " word
)
169 (setq ispell-recently-accepted
(cons word ispell-recently-accepted
)))
170 (setq ispell-dump-needed t
))
172 (defun ispell-accept (word)
173 (ispell-cmd ":accept " word
)
175 (setq ispell-recently-accepted
(cons word ispell-recently-accepted
))))
178 (defun ispell-next-message ()
179 "Return the next message sent by the ispell subprocess."
181 (set-buffer (process-buffer ispell-process
))
182 (bury-buffer (current-buffer))
184 (goto-char ispell-next-message
)
185 (narrow-to-region (point)
186 (progn (forward-sexp 1) (point)))
187 (setq ispell-next-message
(point))
188 (goto-char (point-min))
189 (read (current-buffer)))))
191 (defun ispell-tex-buffer-p ()
192 (memq major-mode
'(plain-TeX-mode LaTeX-mode
)))
195 (defun ispell (&optional buf start end
)
196 "Run Ispell over current buffer's visited file.
197 First the file is scanned for misspelled words, then Ispell
198 enters a loop with the following commands for every misspelled word:
200 DIGIT Near miss selector. If the misspelled word is close to
201 some words in the dictionary, they are offered as near misses.
202 r Replace. Replace the word with a string you type. Each word
203 of your new string is also checked.
204 i Insert. Insert this word in your private dictonary (kept in
205 `$HOME/ispell.words').
206 a Accept. Accept this word for the rest of this editing session,
207 but don't put it in your private dictonary.
208 l Lookup. Look for a word in the dictionary by fast binary
209 search, or search for a regular expression in the dictionary
211 SPACE Accept the word this time, but complain if it is seen again.
212 q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]."
220 (setq buf
(current-buffer)))
221 (setq buf
(get-buffer buf
))
223 (error "Can't find buffer"))
226 (let ((filename buffer-file-name
)
230 (cond ((null filename
)
231 (setq filename
(make-temp-name "/usr/tmp/ispell"))
233 (write-region (point-min) (point-max) filename
))
234 ((and (buffer-modified-p buf
)
235 (y-or-n-p (format "Save file %s? " filename
)))
237 (message "Ispell scanning file...")
238 (if (and ispell-enable-tex-parser
239 (ispell-tex-buffer-p))
241 (ispell-cmd ":generic"))
242 (ispell-cmd (format ":file %s %d %d" filename start end
)))
245 (delete-file filename
)
247 (message "Parsing ispell output ...")
248 (ispell-flush-bad-words)
250 (while (numberp (setq pos
(ispell-next-message)))
251 ;;ispell may check the words on the line following the end
252 ;;of the region - therefore, don't record anything out of range
255 (setq bad-words
(cons (set-marker (make-marker) (+ pos
1))
257 (setq bad-words
(cons pos bad-words
))
258 (setq ispell-bad-words
(nreverse bad-words
))))
259 (cond ((not (markerp (car ispell-bad-words
)))
260 (setq ispell-bad-words nil
)
261 (message "No misspellings."))
263 (message "Ispell parsing done.")
267 (fset 'ispell-buffer
'ispell
)
269 (defun ispell-next ()
270 "Resume command loop for most recent ispell command."
274 (save-window-excursion
277 (while (markerp (setq next
(car ispell-bad-words
)))
278 (switch-to-buffer (marker-buffer next
))
280 (ispell-point next
"at saved position.")
281 (setq ispell-bad-words
(cdr ispell-bad-words
))
282 (set-marker next nil
))))))
283 (cond ((null ispell-bad-words
)
284 (error "Ispell has not yet been run."))
285 ((markerp (car ispell-bad-words
))
286 (message (substitute-command-keys
287 "Type \\[ispell-next] to continue.")))
288 ((eq (car ispell-bad-words
) nil
)
289 (setq ispell-bad-words nil
)
290 (message "No more misspellings (but checker was interrupted.)"))
291 ((eq (car ispell-bad-words
) t
)
292 (setq ispell-bad-words nil
)
293 (message "Ispell done."))
295 (setq ispell-bad-words nil
)
296 (message "Bad ispell internal list"))))
300 (defun ispell-word (&optional resume
)
301 "Check the spelling of the word under the cursor.
302 See `ispell' for more information.
303 With a prefix argument, resume handling of the previous Ispell command."
309 (save-window-excursion
310 (ispell-point (point) "at point."))
312 (ispell-startup-error
313 (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
314 (load-library "spell")
315 (define-key esc-map
"$" 'spell-word
)
318 (define-key esc-map
"$" 'ispell-word
)
321 (defun ispell-region (start &optional end
)
322 "Check the spelling for all of the words in the region."
324 (ispell (current-buffer) start end
))
326 (defun ispell-letterp (c)
328 (or (and (>= c ?A
) (<= c ?Z
))
329 (and (>= c ?a
) (<= c ?z
))
332 (defun ispell-letter-or-quotep (c)
334 (or (and (>= c ?A
) (<= c ?Z
))
335 (and (>= c ?a
) (<= c ?z
))
339 (defun ispell-find-word-start ()
340 ;;backward to a letter
341 (if (not (ispell-letterp (char-after (point))))
342 (while (and (not (bobp))
343 (not (ispell-letterp (char-after (- (point) 1)))))
345 ;;backward to beginning of word
346 (while (ispell-letter-or-quotep (char-after (- (point) 1)))
348 (skip-chars-forward "'"))
350 (defun ispell-find-word-end ()
351 (while (ispell-letter-or-quotep (char-after (point)))
353 (skip-chars-backward "'"))
355 (defun ispell-next-word ()
356 (while (and (not (eobp))
357 (not (ispell-letterp (char-after (point)))))
360 ;if end is nil, then do one word at start
361 ;otherwise, do all words from the beginning of the word where
362 ;start points, to the end of the word where end points
363 (defun ispell-point (start message
)
364 (let ((wend (make-marker))
369 (ispell-find-word-start) ;find correct word start
370 (setq start
(point-marker))
371 (ispell-find-word-end) ;now find correct end
372 (setq end
(point-marker))
374 (error "No word %s" message
))
377 (ispell-find-word-end) ;find end of current word
378 ;could be before 'end' if
379 ;user typed replacement
380 ;that is more than one word
381 (set-marker wend
(point))
383 (setq word
(buffer-substring start wend
))
384 (cond ((ispell-still-bad word
)
385 (goto-char start
);just to show user where we are working
387 (message (format "Ispell checking %s" word
))
389 (let ((message (ispell-next-message)))
390 (cond ((eq message t
)
391 (message "%s: ok" word
))
395 (ispell-command-loop word start wend message
)))
397 (error "unknown ispell response %s" message
))))))
401 (set-marker start
(point)))))
402 ;;clear the choices buffer; otherwise it's hard for the user to tell
403 ;;when we get back to the command loop
404 (let ((buf (get-buffer "*ispell choices*")))
408 (set-marker start nil
)
410 (set-marker wend nil
))))
412 (defun ispell-still-bad (word)
413 (let ((words ispell-recently-accepted
)
415 (case-fold-search t
))
417 (cond ((eq (string-match (car words
) word
) 0)
420 (setq words
(cdr words
)))
423 (defun ispell-show-choices (word message first-line
)
424 ;;if there is only one window on the frame, make the ispell
425 ;;messages winow be small. otherwise just use the other window
426 (let* ((selwin (selected-window))
427 (resize (eq selwin
(next-window)))
428 (buf (get-buffer-create "*ispell choices*"))
430 (setq w
(display-buffer buf
))
431 (buffer-disable-undo buf
)
436 (enlarge-window (- 6 (window-height w
))))
437 (select-window selwin
)))
441 (set-window-point w
(point-min))
442 (set-window-start w
(point-min))
444 (insert first-line
"\n")
446 "SPC skip; A accept; I insert; DIGIT select; R replace; \
448 (cond ((not (null message
))
453 (let* ((n (+ (* j
3) i
))
454 (choice (nth n message
)))
456 (let ((str (format "%d %s" n choice
)))
458 (insert-char ?
(- 20 (length str
)))))))
461 (setq i
(+ i
1)))))))))
463 (defun ispell-command-loop (word start end message
)
468 (setq first-line
(concat "No near misses for '" word
"'"))
469 (setq first-line
(concat "Near misses for '" word
"'")))
471 (ispell-show-choices word message first-line
)
472 (message "Ispell command: ")
473 (let ((c (downcase (read-char)))
475 (cond ((and (>= c ?
0)
477 (setq replacement
(nth (- c ?
0) message
)))
478 (ispell-replace start end replacement
)
485 (ispell-replace start end
(read-string "Replacement: "))
495 (let ((val (ispell-do-look word
)))
496 (setq first-line
(car val
))
497 (setq message
(cdr val
))))
500 "Type 'C-h d ispell' to the emacs main loop for more help")
503 (message "Bad ispell command")
507 (defun ispell-do-look (bad-word)
508 (let (regex buf words
)
509 (cond ((null ispell-have-new-look
)
510 (setq regex
(read-string "Lookup: ")))
512 (setq regex
(read-string "Lookup (regex): " "^"))))
513 (setq buf
(get-buffer-create "*ispell look*"))
516 (delete-region (point-min) (point-max))
517 (if ispell-have-new-look
518 (call-process "look" nil buf nil
"-r" regex
)
519 (call-process "look" nil buf nil regex
))
520 (goto-char (point-min))
522 (delete-region (point) (point-max))
523 (goto-char (point-min))
524 (while (not (= (point-min) (point-max)))
526 (setq words
(cons (buffer-substring (point-min) (point)) words
))
528 (delete-region (point-min) (point)))
530 (cons (format "Lookup '%s'" regex
)
533 (defun ispell-replace (start end new
)
536 (delete-region (point) end
))
538 (defun reload-ispell ()
539 "Tell ispell to re-read your private dictionary."
541 (ispell-cmd ":reload"))
543 (defun batch-make-ispell ()
544 (byte-compile-file "ispell.el")
545 (find-file "ispell.texinfo")
546 (let ((old-dir default-directory
)
547 (default-directory "/tmp"))
548 (texinfo-format-buffer))
550 (if (get-buffer " *problems in info file*")
552 (write-region (point-min) (point-max) "ispell.info"))
554 ;;; ispell.el ends here