1 ;;This is the GNU EMACS interface to GNU ISPELL version 3.
2 ;; Copyright (C) 1990 Free Software Foundation, Inc.
4 ;;This file is part of GNU ISPELL.
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)
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.
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.
20 (defvar ispell-have-new-look t
21 "T if default 'look' program has the -r flag.")
23 (defvar ispell-enable-tex-parser nil
24 "T to enable experimental tex parser in ispell for tex buffers.")
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.")
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.")
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)
46 ;t when :dump command needed
47 (defvar ispell-dump-needed nil)
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))
57 "Kill the ispell process.
58 Any changes the your private dictionay
59 that have not already been dumped will be lost."
62 (delete-process ispell-process))
63 (setq ispell-process nil)
64 (ispell-flush-bad-words))
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*")
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*")))
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)
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))
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))))
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)))
108 (interrupt-process ispell-process))
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)))
118 (defun ispell-cmd (&rest strings)
119 "Send a command to ispell. Choices are:
121 word any word is checked for spelling. Result is
125 list of strings near misses
127 :file filename scan the named file, and print the file offsets of
130 :insert word put word in private dictonary
132 :accept word don't complain about word any more this session
134 :dump write out the current private dictionary, if necessary.
136 :reload reread ~/ispell.words
140 :generic set type of parser to use when scanning whole files
144 (set-buffer (process-buffer ispell-process))
145 (bury-buffer (current-buffer))
147 (setq ispell-next-message (point-min))
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)
155 (defun ispell-dump ()
156 (cond (ispell-dump-needed
157 (setq ispell-dump-needed nil)
158 (ispell-cmd ":dump"))))
160 (defun ispell-insert (word)
161 (ispell-cmd ":insert " word)
163 (setq ispell-recently-accepted (cons word ispell-recently-accepted)))
164 (setq ispell-dump-needed t))
166 (defun ispell-accept (word)
167 (ispell-cmd ":accept " word)
169 (setq ispell-recently-accepted (cons word ispell-recently-accepted))))
172 (defun ispell-next-message ()
173 "Return the next message sent by the ispell subprocess."
175 (set-buffer (process-buffer ispell-process))
176 (bury-buffer (current-buffer))
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)))))
185 (defun ispell-tex-buffer-p ()
186 (memq major-mode '(plain-TeX-mode LaTeX-mode)))
189 (defun ispell (&optional buf start end)
190 "Run ispell over current buffer's visited file.
191 First the file is scanned for misspelled words, then ispell
192 enters a loop with the following commands for every misspelled word:
194 DIGIT Near miss selector. If the misspelled word is close to
195 some words in the dictionary, they are offered as near misses.
196 r Replace. Replace the word with a string you type. Each word
197 of your new string is also checked.
198 i Insert. Insert this word in your private dictonary (kept in
199 `$HOME/ispell.words').
200 a Accept. Accept this word for the rest of this editing session,
201 but don't put it in your private dictonary.
202 l Lookup. Look for a word in the dictionary by fast binary
203 search, or search for a regular expression in the dictionary
205 SPACE Accept the word this time, but complain if it is seen again.
206 q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]."
214 (setq buf (current-buffer)))
215 (setq buf (get-buffer buf))
217 (error "Can't find buffer"))
220 (let ((filename buffer-file-name)
224 (cond ((null filename)
225 (setq filename (make-temp-name "/usr/tmp/ispell"))
227 (write-region (point-min) (point-max) filename))
228 ((and (buffer-modified-p buf)
229 (y-or-n-p (format "Save file %s? " filename)))
231 (message "Ispell scanning file...")
232 (if (and ispell-enable-tex-parser
233 (ispell-tex-buffer-p))
235 (ispell-cmd ":generic"))
236 (ispell-cmd (format ":file %s %d %d" filename start end)))
239 (delete-file filename)
241 (message "Parsing ispell output ...")
242 (ispell-flush-bad-words)
244 (while (numberp (setq pos (ispell-next-message)))
245 ;;ispell may check the words on the line following the end
246 ;;of the region - therefore, don't record anything out of range
249 (setq bad-words (cons (set-marker (make-marker) (+ pos 1))
251 (setq bad-words (cons pos bad-words))
252 (setq ispell-bad-words (nreverse bad-words))))
253 (cond ((not (markerp (car ispell-bad-words)))
254 (setq ispell-bad-words nil)
255 (message "No misspellings."))
257 (message "Ispell parsing done.")
260 (defun ispell-next ()
261 "Resume command loop for most recent ispell command."
265 (save-window-excursion
268 (while (markerp (setq next (car ispell-bad-words)))
269 (switch-to-buffer (marker-buffer next))
271 (ispell-point next "at saved position.")
272 (setq ispell-bad-words (cdr ispell-bad-words))
273 (set-marker next nil))))))
274 (cond ((null ispell-bad-words)
275 (error "Ispell has not yet been run."))
276 ((markerp (car ispell-bad-words))
277 (message (substitute-command-keys
278 "Type \\[ispell-next] to continue.")))
279 ((eq (car ispell-bad-words) nil)
280 (setq ispell-bad-words nil)
281 (message "No more misspellings (but checker was interrupted.)"))
282 ((eq (car ispell-bad-words) t)
283 (setq ispell-bad-words nil)
284 (message "Ispell done."))
286 (setq ispell-bad-words nil)
287 (message "Bad ispell internal list"))))
292 (defun ispell-word ()
293 "Check the spelling of the word under the cursor.
294 See `ispell' for more information."
298 (save-window-excursion
299 (ispell-point (point) "at point."))
301 (ispell-startup-error
302 (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
303 (load-library "spell")
304 (define-key esc-map "$" 'spell-word)
306 ;;;###autoload (define-key esc-map "$" 'ispell-word)
309 (defun ispell-region (start &optional end)
310 "Check the spelling for all of the words in the region."
312 (ispell (current-buffer) start end))
314 (defun ispell-letterp (c)
316 (or (and (>= c ?A) (<= c ?Z))
317 (and (>= c ?a) (<= c ?z))
320 (defun ispell-letter-or-quotep (c)
322 (or (and (>= c ?A) (<= c ?Z))
323 (and (>= c ?a) (<= c ?z))
327 (defun ispell-find-word-start ()
328 ;;backward to a letter
329 (if (not (ispell-letterp (char-after (point))))
330 (while (and (not (bobp))
331 (not (ispell-letterp (char-after (- (point) 1)))))
333 ;;backward to beginning of word
334 (while (ispell-letter-or-quotep (char-after (- (point) 1)))
336 (skip-chars-forward "'"))
338 (defun ispell-find-word-end ()
339 (while (ispell-letter-or-quotep (char-after (point)))
341 (skip-chars-backward "'"))
343 (defun ispell-next-word ()
344 (while (and (not (eobp))
345 (not (ispell-letterp (char-after (point)))))
348 ;if end is nil, then do one word at start
349 ;otherwise, do all words from the beginning of the word where
350 ;start points, to the end of the word where end points
351 (defun ispell-point (start message)
352 (let ((wend (make-marker))
357 (ispell-find-word-start) ;find correct word start
358 (setq start (point-marker))
359 (ispell-find-word-end) ;now find correct end
360 (setq end (point-marker))
362 (error "No word %s" message))
365 (ispell-find-word-end) ;find end of current word
366 ;could be before 'end' if
367 ;user typed replacement
368 ;that is more than one word
369 (set-marker wend (point))
371 (setq word (buffer-substring start wend))
372 (cond ((ispell-still-bad word)
373 (goto-char start);just to show user where we are working
375 (message (format "Ispell checking %s" word))
377 (let ((message (ispell-next-message)))
378 (cond ((eq message t)
379 (message "%s: ok" word))
383 (ispell-command-loop word start wend message)))
385 (error "unknown ispell response %s" message))))))
389 (set-marker start (point)))))
390 ;;clear the choices buffer; otherwise it's hard for the user to tell
391 ;;when we get back to the command loop
392 (let ((buf (get-buffer "*ispell choices*")))
396 (set-marker start nil)
398 (set-marker wend nil))))
400 (defun ispell-still-bad (word)
401 (let ((words ispell-recently-accepted)
403 (case-fold-search t))
405 (cond ((eq (string-match (car words) word) 0)
408 (setq words (cdr words)))
411 (defun ispell-show-choices (word message first-line)
412 ;;if there is only one window on the screen, make the ispell
413 ;;messages winow be small. otherwise just use the other window
414 (let* ((selwin (selected-window))
415 (resize (eq selwin (next-window)))
416 (buf (get-buffer-create "*ispell choices*"))
418 (setq w (display-buffer buf))
419 (buffer-disable-undo buf)
424 (enlarge-window (- 6 (window-height w))))
425 (select-window selwin)))
429 (set-window-point w (point-min))
430 (set-window-start w (point-min))
432 (insert first-line "\n")
434 "SPC skip; A accept; I insert; DIGIT select; R replace; \
436 (cond ((not (null message))
441 (let* ((n (+ (* j 3) i))
442 (choice (nth n message)))
444 (let ((str (format "%d %s" n choice)))
446 (insert-char ? (- 20 (length str)))))))
449 (setq i (+ i 1)))))))))
451 (defun ispell-command-loop (word start end message)
456 (setq first-line (concat "No near misses for '" word "'"))
457 (setq first-line (concat "Near misses for '" word "'")))
459 (ispell-show-choices word message first-line)
460 (message "Ispell command: ")
461 (let ((c (downcase (read-char)))
463 (cond ((and (>= c ?0)
465 (setq replacement (nth (- c ?0) message)))
466 (ispell-replace start end replacement)
473 (ispell-replace start end (read-string "Replacement: "))
483 (let ((val (ispell-do-look word)))
484 (setq first-line (car val))
485 (setq message (cdr val))))
488 "Type 'C-h d ispell' to the emacs main loop for more help")
491 (message "Bad ispell command")
495 (defun ispell-do-look (bad-word)
496 (let (regex buf words)
497 (cond ((null ispell-have-new-look)
498 (setq regex (read-string "Lookup: ")))
500 (setq regex (read-string "Lookup (regex): " "^"))))
501 (setq buf (get-buffer-create "*ispell look*"))
504 (delete-region (point-min) (point-max))
505 (if ispell-have-new-look
506 (call-process "look" nil buf nil "-r" regex)
507 (call-process "look" nil buf nil regex))
508 (goto-char (point-min))
510 (delete-region (point) (point-max))
511 (goto-char (point-min))
512 (while (not (= (point-min) (point-max)))
514 (setq words (cons (buffer-substring (point-min) (point)) words))
516 (delete-region (point-min) (point)))
518 (cons (format "Lookup '%s'" regex)
521 (defun ispell-replace (start end new)
524 (delete-region (point) end))
526 (defun reload-ispell ()
527 "Tell ispell to re-read your private dictionary."
529 (ispell-cmd ":reload"))
531 (define-key esc-map "$" 'ispell-word)
532 ;; This conflicts with set-selective-display. What should we do???
533 ;;(define-key ctl-x-map "$" 'ispell-next)
535 (defun batch-make-ispell ()
536 (byte-compile-file "ispell.el")
537 (find-file "ispell.texinfo")
538 (let ((old-dir default-directory)
539 (default-directory "/tmp"))
540 (texinfo-format-buffer))
542 (if (get-buffer " *problems in info file*")
544 (write-region (point-min) (point-max) "ispell.info"))