1 ;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 4.
3 ;;Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc.
7 ;;This file is part of GNU Emacs.
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)
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.
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
21 ;;the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 ;; This package provides a graceful interface to ispell, the GNU
30 (defvar ispell-have-new-look t
31 "Non-nil means use the `-r' option when running `look'.")
33 (defvar ispell-enable-tex-parser nil
34 "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.")
36 (defvar ispell-process nil
"The process running Ispell")
37 (defvar ispell-next-message nil
38 "An integer: where in `*ispell*' buffer to find next message from Ispell.")
40 (defvar ispell-command
"ispell"
41 "Command for running Ispell.")
42 (defvar ispell-command-options nil
43 "*String (or list of strings) to pass to Ispell as command arguments.
44 You can use this to specify the name of your private dictionary.
45 The -S option is always passed to Ispell as the last parameter,
46 and need not be mentioned here.")
48 ;Each marker in this list points to the start of a word that
49 ;ispell thought was bad last time it did the :file command.
50 ;Notice that if the user accepts or inserts a word into his
51 ;private dictionary, then some "good" words will be on the list.
52 ;We would like to deal with this by looking up the words again just before
53 ;presenting them to the user, but that is too slow on machines
54 ;without the select system call. Therefore, see the variable
55 ;ispell-recently-accepted.
56 (defvar ispell-bad-words nil
57 "A list of markers reflecting the output of the Ispell `:file' command.")
59 ;list of words that the user has accepted, but that might still
60 ;be on the bad-words list
61 (defvar ispell-recently-accepted nil
)
63 ;; Non-nil means we have started showing an alternatives window.
64 ;; This is the window config from before then.
65 (defvar ispell-window-configuration nil
)
67 ;t when :dump command needed
68 (defvar ispell-dump-needed nil
)
70 (defun ispell-flush-bad-words ()
71 (while ispell-bad-words
72 (if (markerp (car ispell-bad-words
))
73 (set-marker (car ispell-bad-words
) nil
))
74 (setq ispell-bad-words
(cdr ispell-bad-words
)))
75 (setq ispell-recently-accepted nil
))
78 "Kill the Ispell process.
79 Any changes in your private dictionary
80 that have not already been dumped will be lost."
83 (delete-process ispell-process
))
84 (setq ispell-process nil
)
85 (ispell-flush-bad-words))
87 (put 'ispell-startup-error
'error-conditions
88 '(ispell-startup-error error
))
89 (put 'ispell-startup-error
'error-message
90 "Problem starting ispell - see buffer *ispell*")
92 ;; Start an ispell subprocess; check the version; and display the greeting.
94 (defun start-ispell ()
95 (message "Starting ispell ...")
96 (let ((buf (get-buffer "*ispell*")))
101 (apply 'start-process
"ispell" "*ispell*" ispell-command
102 (append (if (listp ispell-command-options
)
103 ispell-command-options
104 (list ispell-command-options
))
106 (file-error (signal 'ispell-startup-error nil
)))
107 (process-kill-without-query ispell-process
)
108 (buffer-disable-undo (process-buffer ispell-process
))
109 (accept-process-output ispell-process
)
112 (set-buffer (process-buffer ispell-process
))
113 (bury-buffer (current-buffer))
114 (setq last-char
(- (point-max) 1))
115 (while (not (eq (char-after last-char
) ?
=))
116 (cond ((not (eq (process-status ispell-process
) 'run
))
118 (signal 'ispell-startup-error nil
)))
119 (accept-process-output ispell-process
)
120 (setq last-char
(- (point-max) 1)))
121 (goto-char (point-min))
122 (let ((greeting (read (current-buffer))))
123 (if (not (= (car greeting
) 1))
124 (error "Bad ispell version: wanted 1, got %d" (car greeting
)))
125 (message (car (cdr greeting
))))
126 (delete-region (point-min) last-char
))))
128 ;; Make sure ispell is ready for a command.
129 ;; Leaves buffer set to *ispell*, point at '='.
131 (defun ispell-sync (intr)
132 (if (or (null ispell-process
)
133 (not (eq (process-status ispell-process
) 'run
)))
136 (interrupt-process ispell-process
))
138 (set-buffer (process-buffer ispell-process
))
139 (bury-buffer (current-buffer))
140 (setq last-char
(- (point-max) 1))
141 (while (not (eq (char-after last-char
) ?
=))
142 (accept-process-output ispell-process
)
143 (setq last-char
(- (point-max) 1)))
144 (goto-char last-char
)))
146 ;; Send a command to ispell. Choices are:
148 ;; WORD Check spelling of WORD. Result is
152 ;; list of strings near misses
154 ;; :file FILENAME scan the named file, and print the file offsets of
155 ;; any misspelled words
157 ;; :insert WORD put word in private dictionary
159 ;; :accept WORD don't complain about word any more this session
161 ;; :dump write out the current private dictionary, if necessary.
163 ;; :reload reread `~/ispell.words'
167 ;; :generic set type of parser to use when scanning whole files
169 (defun ispell-cmd (&rest strings
)
172 (set-buffer (process-buffer ispell-process
))
173 (bury-buffer (current-buffer))
175 (setq ispell-next-message
(point-min))
177 (process-send-string ispell-process
(car strings
))
178 (setq strings
(cdr strings
)))
179 (process-send-string ispell-process
"\n")
180 (accept-process-output ispell-process
)
183 (defun ispell-dump ()
184 (cond (ispell-dump-needed
185 (setq ispell-dump-needed nil
)
186 (ispell-cmd ":dump"))))
188 (defun ispell-insert (word)
189 (ispell-cmd ":insert " word
)
191 (setq ispell-recently-accepted
(cons word ispell-recently-accepted
)))
192 (setq ispell-dump-needed t
))
194 (defun ispell-accept (word)
195 (ispell-cmd ":accept " word
)
197 (setq ispell-recently-accepted
(cons word ispell-recently-accepted
))))
199 ;; Return the next message sent by the Ispell subprocess.
201 (defun ispell-next-message ()
203 (set-buffer (process-buffer ispell-process
))
204 (bury-buffer (current-buffer))
206 (goto-char ispell-next-message
)
207 (narrow-to-region (point)
208 (progn (forward-sexp 1) (point)))
209 (setq ispell-next-message
(point))
210 (goto-char (point-min))
211 (read (current-buffer)))))
213 (defun ispell-tex-buffer-p ()
214 (memq major-mode
'(plain-TeX-mode LaTeX-mode
)))
216 (defvar ispell-menu-map
(make-sparse-keymap "Spell"))
217 (defalias 'ispell-menu-map ispell-menu-map
)
219 (define-key ispell-menu-map
[reload-ispell
]
220 '("Reload Dictionary" . reload-ispell
))
222 (define-key ispell-menu-map
[ispell-next
]
223 '("Continue Check" . ispell-next
))
225 (define-key ispell-menu-map
[ispell-region
]
226 '("Check Region" . ispell-region
))
228 (define-key ispell-menu-map
[ispell-buffer
]
229 '("Check Buffer" . ispell
))
231 (define-key ispell-menu-map
[ispell-word
]
232 '("Check Word" . ispell-word
))
235 (defun ispell (&optional buf start end
)
236 "Run Ispell over current buffer's visited file.
237 First the file is scanned for misspelled words, then Ispell
238 enters a loop with the following commands for every misspelled word:
240 DIGIT Near miss selector. If the misspelled word is close to
241 some words in the dictionary, they are offered as near misses.
242 r Replace. Replace the word with a string you type. Each word
243 of your new string is also checked.
244 i Insert. Insert this word in your private dictionary (kept in
245 `$HOME/ispell.words').
246 a Accept. Accept this word for the rest of this editing session,
247 but don't put it in your private dictionary.
248 l Lookup. Look for a word in the dictionary by fast binary
249 search, or search for a regular expression in the dictionary
251 SPACE Accept the word this time, but complain if it is seen again.
252 q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]."
260 (setq buf
(current-buffer)))
261 (setq buf
(get-buffer buf
))
263 (error "Can't find buffer"))
264 ;; Deactivate the mark, because we'll do it anyway if we change something,
265 ;; and a region highlight while in the Ispell loop is distracting.
269 (let ((filename buffer-file-name
)
273 (cond ((null filename
)
274 (setq filename
(make-temp-name "/usr/tmp/ispell"))
276 (write-region (point-min) (point-max) filename
))
277 ((and (buffer-modified-p buf
)
278 (y-or-n-p (format "Save file %s? " filename
)))
280 (message "Ispell scanning file...")
281 (if (and ispell-enable-tex-parser
282 (ispell-tex-buffer-p))
284 (ispell-cmd ":generic"))
285 (ispell-cmd (format ":file %s %d %d" filename start end
)))
288 (delete-file filename
)
290 (message "Parsing ispell output ...")
291 (ispell-flush-bad-words)
293 (while (numberp (setq pos
(ispell-next-message)))
294 ;;ispell may check the words on the line following the end
295 ;;of the region - therefore, don't record anything out of range
298 (setq bad-words
(cons (set-marker (make-marker) (+ pos
1))
300 (setq bad-words
(cons pos bad-words
))
301 (setq ispell-bad-words
(nreverse bad-words
))))
302 (cond ((not (markerp (car ispell-bad-words
)))
303 (setq ispell-bad-words nil
)
304 (message "No misspellings."))
306 (message "Ispell parsing done.")
310 (defalias 'ispell-buffer
'ispell
)
312 (defun ispell-next ()
313 "Resume command loop for most recent Ispell command."
315 (setq ispell-window-configuration nil
)
318 ;; There used to be a save-excursion here,
319 ;; but that was annoying: it's better if point doesn't move
322 (while (markerp (setq next
(car ispell-bad-words
)))
323 (switch-to-buffer (marker-buffer next
))
325 (ispell-point next
"at saved position.")
326 (setq ispell-bad-words
(cdr ispell-bad-words
))
327 (set-marker next nil
))))
328 (if ispell-window-configuration
329 (set-window-configuration ispell-window-configuration
))
330 (cond ((null ispell-bad-words
)
331 (error "Ispell has not yet been run."))
332 ((markerp (car ispell-bad-words
))
333 (message (substitute-command-keys
334 "Type \\[ispell-next] to continue.")))
335 ((eq (car ispell-bad-words
) nil
)
336 (setq ispell-bad-words nil
)
337 (message "No more misspellings (but checker was interrupted.)"))
338 ((eq (car ispell-bad-words
) t
)
339 (setq ispell-bad-words nil
)
340 (message "Ispell done."))
342 (setq ispell-bad-words nil
)
343 (message "Bad ispell internal list"))))
347 (defun ispell-word (&optional resume
)
348 "Check the spelling of the word under the cursor.
349 See the command `ispell' for more information.
350 With a prefix argument, resume handling of the previous Ispell command."
356 (save-window-excursion
357 (ispell-point (point) "at point."))
359 (ispell-startup-error
360 (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
361 (load-library "spell")
362 (define-key esc-map
"$" 'spell-word
)
365 (define-key esc-map
"$" 'ispell-word
)
368 (defun ispell-region (start &optional end
)
369 "Check the spelling for all of the words in the region."
371 (ispell (current-buffer) start end
))
373 (defun ispell-letterp (c)
375 (or (and (>= c ?A
) (<= c ?Z
))
376 (and (>= c ?a
) (<= c ?z
))
379 (defun ispell-letter-or-quotep (c)
381 (or (and (>= c ?A
) (<= c ?Z
))
382 (and (>= c ?a
) (<= c ?z
))
386 (defun ispell-find-word-start ()
387 ;;backward to a letter
388 (if (not (ispell-letterp (char-after (point))))
389 (while (and (not (bobp))
390 (not (ispell-letterp (char-after (- (point) 1)))))
392 ;;backward to beginning of word
393 (while (ispell-letter-or-quotep (char-after (- (point) 1)))
395 (skip-chars-forward "'"))
397 (defun ispell-find-word-end ()
398 (while (ispell-letter-or-quotep (char-after (point)))
400 (skip-chars-backward "'"))
402 (defun ispell-next-word ()
403 (while (and (not (eobp))
404 (not (ispell-letterp (char-after (point)))))
407 ;if end is nil, then do one word at start
408 ;otherwise, do all words from the beginning of the word where
409 ;start points, to the end of the word where end points
410 (defun ispell-point (start message
)
411 (let ((wend (make-marker))
414 ;; There used to be a save-excursion here,
415 ;; but that was annoying: it's better if point doesn't move
418 (ispell-find-word-start) ;find correct word start
419 (setq start
(point-marker))
420 (ispell-find-word-end) ;now find correct end
421 (setq end
(point-marker))
423 (error "No word %s" message
))
426 (ispell-find-word-end) ;find end of current word
427 ;could be before 'end' if
428 ;user typed replacement
429 ;that is more than one word
430 (set-marker wend
(point))
432 (setq word
(buffer-substring start wend
))
433 (cond ((ispell-still-bad word
)
434 ;;; This just causes confusion. -- rms.
435 ;;; (goto-char start)
437 (message (format "Ispell checking %s" word
))
439 (let ((message (ispell-next-message)))
440 (cond ((eq message t
)
441 (message "%s: ok" word
))
445 (ispell-command-loop word start wend message
)))
447 (error "unknown ispell response %s" message
))))))
451 (set-marker start
(point)))))
452 ;;clear the choices buffer; otherwise it's hard for the user to tell
453 ;;when we get back to the command loop
454 (let ((buf (get-buffer "*ispell choices*")))
458 (set-marker start nil
)
460 (set-marker wend nil
)))
462 (defun ispell-still-bad (word)
463 (let ((words ispell-recently-accepted
)
465 (case-fold-search t
))
467 (cond ((eq (string-match (car words
) word
) 0)
470 (setq words
(cdr words
)))
473 (defun ispell-show-choices (word message first-line
)
474 ;;if there is only one window on the frame, make the ispell
475 ;;messages winow be small. otherwise just use the other window
476 (let* ((selwin (selected-window))
477 (resize (eq selwin
(next-window)))
478 (buf (get-buffer-create "*ispell choices*"))
480 (or ispell-window-configuration
481 (setq ispell-window-configuration
(current-window-configuration)))
482 (setq w
(display-buffer buf
))
483 (buffer-disable-undo buf
)
488 (enlarge-window (- 6 (window-height w
))))
489 (select-window selwin
)))
493 (set-window-point w
(point-min))
494 (set-window-start w
(point-min))
496 (insert first-line
"\n")
498 "SPC skip; A accept; I insert; DIGIT select; R replace; \
500 (cond ((not (null message
))
505 (let* ((n (+ (* j
3) i
))
506 (choice (nth n message
)))
508 (let ((str (format "%d %s" n choice
)))
510 (insert-char ?
(- 20 (length str
)))))))
513 (setq i
(+ i
1)))))))))
515 (defun ispell-command-loop (word start end message
)
520 (setq first-line
(concat "No near misses for '" word
"'"))
521 (setq first-line
(concat "Near misses for '" word
"'")))
523 (ispell-show-choices word message first-line
)
524 (message "Ispell command: ")
526 (let ((c (downcase (read-char)))
528 (cond ((and (>= c ?
0)
530 (setq replacement
(nth (- c ?
0) message
)))
531 (ispell-replace start end replacement
)
538 (ispell-replace start end
(read-string "Replacement: "))
548 (let ((val (ispell-do-look word
)))
549 (setq first-line
(car val
))
550 (setq message
(cdr val
))))
553 "Type 'C-h d ispell' to the emacs main loop for more help")
556 (message "Bad ispell command")
560 (defun ispell-do-look (bad-word)
561 (let (regex buf words
)
562 (cond ((null ispell-have-new-look
)
563 (setq regex
(read-string "Lookup: ")))
565 (setq regex
(read-string "Lookup (regex): " "^"))))
566 (setq buf
(get-buffer-create "*ispell look*"))
569 (delete-region (point-min) (point-max))
570 (if ispell-have-new-look
571 (call-process "look" nil buf nil
"-r" regex
)
572 (call-process "look" nil buf nil regex
))
573 (goto-char (point-min))
575 (delete-region (point) (point-max))
576 (goto-char (point-min))
577 (while (not (= (point-min) (point-max)))
579 (setq words
(cons (buffer-substring (point-min) (point)) words
))
581 (delete-region (point-min) (point)))
583 (cons (format "Lookup '%s'" regex
)
586 (defun ispell-replace (start end new
)
589 (delete-region (point) end
))
591 (defun reload-ispell ()
592 "Tell Ispell to re-read your private dictionary."
594 (ispell-cmd ":reload"))
596 (defun batch-make-ispell ()
597 (byte-compile-file "ispell.el")
598 (find-file "ispell.texinfo")
599 (let ((old-dir default-directory
)
600 (default-directory "/tmp"))
601 (texinfo-format-buffer))
603 (if (get-buffer " *problems in info file*")
605 (write-region (point-min) (point-max) "ispell.info"))
609 ;;; ispell.el ends here