1 ;;; ispell4.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 the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; This package provides a graceful interface to ispell, the GNU
31 (defvar ispell-have-new-look t
32 "Non-nil means use the `-r' option when running `look'.")
34 (defvar ispell-enable-tex-parser nil
35 "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.")
37 (defvar ispell-process nil
"The process running Ispell")
38 (defvar ispell-next-message nil
39 "An integer: where in `*ispell*' buffer to find next message from Ispell.")
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.
45 You can specify your private dictionary via the -p <filename> option.
46 The -S option is always passed to Ispell as the last parameter,
47 and need not be mentioned here.")
49 (defvar ispell-look-command
"look"
50 "*Command for running look.")
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
61 "A list of markers reflecting the output of the Ispell `:file' command.")
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
)
67 ;; Non-nil means we have started showing an alternatives window.
68 ;; This is the window config from before then.
69 (defvar ispell-window-configuration nil
)
71 ;t when :dump command needed
72 (defvar ispell-dump-needed nil
)
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
))
82 "Kill the Ispell process.
83 Any changes in your private dictionary
84 that have not already been dumped will be lost."
87 (delete-process ispell-process
))
88 (setq ispell-process nil
)
89 (ispell-flush-bad-words))
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*")
96 ;; Start an ispell subprocess; check the version; and display the greeting.
98 (defun start-ispell ()
99 (message "Starting ispell ...")
100 (let ((buf (get-buffer "*ispell*")))
105 (apply 'start-process
"ispell" "*ispell*" ispell-command
106 (append (if (listp ispell-command-options
)
107 ispell-command-options
108 (list ispell-command-options
))
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
)
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
))
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
)))
129 (message "%s" (car (cdr greeting
))))
130 (delete-region (point-min) last-char
))))
132 ;; Make sure ispell is ready for a command.
133 ;; Leaves buffer set to *ispell*, point at '='.
135 (defun ispell-sync (intr)
136 (if (or (null ispell-process
)
137 (not (eq (process-status ispell-process
) 'run
)))
140 (interrupt-process ispell-process
))
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
)))
150 ;; Send a command to ispell. Choices are:
152 ;; WORD Check spelling of WORD. Result is
156 ;; list of strings near misses
158 ;; :file FILENAME scan the named file, and print the file offsets of
159 ;; any misspelled words
161 ;; :insert WORD put word in private dictionary
163 ;; :accept WORD don't complain about word any more this session
165 ;; :dump write out the current private dictionary, if necessary.
167 ;; :reload reread private dictionary (default: `~/ispell.words')
171 ;; :generic set type of parser to use when scanning whole files
173 (defun ispell-cmd (&rest strings
)
176 (set-buffer (process-buffer ispell-process
))
177 (bury-buffer (current-buffer))
179 (setq ispell-next-message
(point-min))
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
)
187 (defun ispell-dump ()
188 (cond (ispell-dump-needed
189 (setq ispell-dump-needed nil
)
190 (ispell-cmd ":dump"))))
192 (defun ispell-insert (word)
193 (ispell-cmd ":insert " word
)
195 (setq ispell-recently-accepted
(cons word ispell-recently-accepted
)))
196 (setq ispell-dump-needed t
))
198 (defun ispell-accept (word)
199 (ispell-cmd ":accept " word
)
201 (setq ispell-recently-accepted
(cons word ispell-recently-accepted
))))
203 ;; Return the next message sent by the Ispell subprocess.
205 (defun ispell-next-message ()
207 (set-buffer (process-buffer ispell-process
))
208 (bury-buffer (current-buffer))
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)))))
217 (defun ispell-tex-buffer-p ()
218 (memq major-mode
'(plain-tex-mode latex-mode slitex-mode
)))
220 (defvar ispell-menu-map
(make-sparse-keymap "Spell"))
221 (defalias 'ispell-menu-map ispell-menu-map
)
223 (define-key ispell-menu-map
[ispell-complete-word-interior-frag
]
224 '("Complete Interior Fragment" . ispell-complete-word-interior-frag
))
226 (define-key ispell-menu-map
[ispell-complete-word
]
227 '("Complete Word" . ispell-complete-word
))
229 (define-key ispell-menu-map
[reload-ispell
]
230 '("Reload Dictionary" . reload-ispell
))
232 (define-key ispell-menu-map
[ispell-next
]
233 '("Continue Check" . ispell-next
))
235 (define-key ispell-menu-map
[ispell-message
]
236 '("Check Message" . ispell-message
))
238 (define-key ispell-menu-map
[ispell-word
]
239 '("Check Word" . ispell-word
))
241 (define-key ispell-menu-map
[ispell-region
]
242 '("Check Region" . ispell-region
))
244 (define-key ispell-menu-map
[ispell-buffer
]
245 '("Check Buffer" . ispell
))
248 (defun ispell (&optional buf start end
)
249 "Run Ispell over current buffer's visited file.
250 First the file is scanned for misspelled words, then Ispell
251 enters a loop with the following commands for every misspelled word:
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.
257 i Insert. Insert this word in your private dictionary (by default,
258 `$HOME/ispell.words').
259 a Accept. Accept this word for the rest of this editing session,
260 but don't put it in your private dictionary.
261 l Lookup. Look for a word in the dictionary by fast binary
262 search, or search for a regular expression in the dictionary
264 SPACE Accept the word this time, but complain if it is seen again.
265 q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]."
273 (setq buf
(current-buffer)))
274 (setq buf
(get-buffer buf
))
276 (error "Can't find buffer"))
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.
282 (let ((filename buffer-file-name
)
286 (cond ((or (null filename
)
287 (find-file-name-handler buffer-file-name nil
))
288 (setq filename
(make-temp-name "/usr/tmp/ispell"))
290 (write-region (point-min) (point-max) filename
))
291 ((and (buffer-modified-p buf
)
292 (y-or-n-p (format "Save file %s? " filename
)))
294 (message "Ispell scanning file...")
295 (if (and ispell-enable-tex-parser
296 (ispell-tex-buffer-p))
298 (ispell-cmd ":generic"))
299 (ispell-cmd (format ":file %s %d %d" filename start end
)))
302 (delete-file filename
)
304 (message "Parsing ispell output ...")
305 (ispell-flush-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
312 (setq bad-words
(cons (set-marker (make-marker) (+ pos
1))
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
)
318 (message "No misspellings.")
321 (message "Ispell parsing done.")
325 (defalias 'ispell-buffer
'ispell
)
327 (defun ispell-next ()
328 "Resume command loop for most recent Ispell command.
329 Return value is t unless exit is due to typing `q'."
331 (setq ispell-window-configuration nil
)
335 ;; There used to be a save-excursion here,
336 ;; but that was annoying: it's better if point doesn't move
339 (while (markerp (setq next
(car ispell-bad-words
)))
340 (switch-to-buffer (marker-buffer next
))
342 (ispell-point next
"at saved position.")
343 (setq ispell-bad-words
(cdr ispell-bad-words
))
344 (set-marker next nil
)))
347 (if ispell-window-configuration
348 (set-window-configuration ispell-window-configuration
))
349 (cond ((null ispell-bad-words
)
350 (error "Ispell has not yet been run"))
351 ((markerp (car ispell-bad-words
))
353 (substitute-command-keys
354 "Type \\[ispell-next] to continue")))
355 ((eq (car ispell-bad-words
) nil
)
356 (setq ispell-bad-words nil
)
357 (message "No more misspellings (but checker was interrupted)"))
358 ((eq (car ispell-bad-words
) t
)
359 (setq ispell-bad-words nil
)
360 (message "Ispell done"))
362 (setq ispell-bad-words nil
)
363 (message "Bad ispell internal list"))))
367 (defun ispell-word (&optional resume
)
368 "Check the spelling of the word under the cursor.
369 See the command `ispell' for more information.
370 With a prefix argument, resume handling of the previous Ispell command."
377 (save-window-excursion
378 (ispell-point (point) "at point."))
380 (ispell-dehighlight))
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
)
387 ;;;autoload (define-key esc-map "$" 'ispell-word)
390 (defun ispell-region (start &optional end
)
391 "Check the spelling for all of the words in the region."
393 (ispell (current-buffer) start end
))
395 (defun ispell-letterp (c)
397 (or (and (>= c ?A
) (<= c ?Z
))
398 (and (>= c ?a
) (<= c ?z
))
401 (defun ispell-letter-or-quotep (c)
403 (or (and (>= c ?A
) (<= c ?Z
))
404 (and (>= c ?a
) (<= c ?z
))
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)))))
414 ;;backward to beginning of word
415 (while (ispell-letter-or-quotep (char-after (- (point) 1)))
417 (skip-chars-forward "'"))
419 (defun ispell-find-word-end ()
420 (while (ispell-letter-or-quotep (char-after (point)))
422 (skip-chars-backward "'"))
424 (defun ispell-next-word ()
425 (while (and (not (eobp))
426 (not (ispell-letterp (char-after (point)))))
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))
436 ;; There used to be a save-excursion here,
437 ;; but that was annoying: it's better if point doesn't move
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))
444 ;; Do nothing if we don't find a word.
448 (ispell-find-word-end) ;find end of current word
449 ;could be before 'end' if
450 ;user typed replacement
451 ;that is more than one word
452 (set-marker wend
(point))
454 (setq word
(buffer-substring start wend
))
455 (cond ((ispell-still-bad word
)
456 ;;; This just causes confusion. -- rms.
457 ;;; (goto-char start)
459 (message "Ispell checking %s" word
)
461 (let ((message (ispell-next-message)))
462 (cond ((eq message t
)
463 (message "%s: ok" word
))
467 (ispell-command-loop word start wend message
)))
469 (error "unknown ispell response %s" message
))))))
473 (set-marker start
(point))))))
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*")))
480 (set-marker start nil
)
482 (set-marker wend nil
)))
484 (defun ispell-still-bad (word)
485 (let ((words ispell-recently-accepted
)
487 (case-fold-search t
))
489 (cond ((eq (string-match (car words
) word
) 0)
492 (setq words
(cdr words
)))
495 (defun ispell-show-choices (word message first-line
)
496 ;;if there is only one window on the frame, make the ispell
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*"))
502 (or ispell-window-configuration
503 (setq ispell-window-configuration
(current-window-configuration)))
504 (setq w
(display-buffer buf
))
505 (buffer-disable-undo buf
)
510 (enlarge-window (- 6 (window-height w
))))
511 (select-window selwin
)))
515 (set-window-point w
(point-min))
516 (set-window-start w
(point-min))
518 (insert first-line
"\n")
520 "SPC skip; A accept; I insert; DIGIT select; R replace; \
522 (cond ((not (null message
))
527 (let* ((n (+ (* j
3) i
))
528 (choice (nth n message
)))
530 (let ((str (format "%d %s" n choice
)))
532 (insert-char ?
(- 20 (length str
)))))))
535 (setq i
(+ i
1)))))))))
537 (defun ispell-command-loop (word start end message
)
542 (setq first-line
(concat "No near misses for '" word
"'"))
543 (setq first-line
(concat "Near misses for '" word
"'")))
544 (ispell-highlight start end
)
546 (ispell-show-choices word message first-line
)
547 (message "Ispell command: ")
549 (let ((c (downcase (read-char)))
551 (cond ((and (>= c ?
0)
553 (setq replacement
(nth (- c ?
0) message
)))
554 (ispell-replace start end replacement
)
557 (throw 'ispell-quit nil
))
558 ((= c
(nth 3 (current-input-mode)))
563 (ispell-replace start end
(read-string "Replacement: "))
573 (let ((val (ispell-do-look word
)))
574 (setq first-line
(car val
))
575 (setq message
(cdr val
))))
578 "Type 'C-h d ispell' to the emacs main loop for more help")
581 (message "Bad ispell command")
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: ")))
590 (setq regex
(read-string "Lookup (regex): " "^"))))
591 (setq buf
(get-buffer-create "*ispell look*"))
594 (delete-region (point-min) (point-max))
595 (if ispell-have-new-look
596 (call-process ispell-look-command nil buf nil
"-r" regex
)
597 (call-process ispell-look-command nil buf nil regex
))
598 (goto-char (point-min))
600 (delete-region (point) (point-max))
601 (goto-char (point-min))
602 (while (not (= (point-min) (point-max)))
604 (setq words
(cons (buffer-substring (point-min) (point)) words
))
606 (delete-region (point-min) (point)))
608 (cons (format "Lookup '%s'" regex
)
611 (defun ispell-replace (start end new
)
614 (delete-region (point) end
))
616 (defun reload-ispell ()
617 "Tell Ispell to re-read your private dictionary."
619 (ispell-cmd ":reload"))
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))
628 (if (get-buffer " *problems in info file*")
630 (write-region (point-min) (point-max) "ispell.info"))
632 (defvar ispell-highlight t
633 "*Non-nil means to highlight ispell words.")
635 (defvar ispell-overlay nil
)
637 (defun ispell-dehighlight ()
640 (delete-overlay ispell-overlay
)
641 (setq ispell-overlay nil
))))
643 (defun ispell-highlight (start end
)
644 (and ispell-highlight
649 (setq ispell-overlay
(make-overlay start end
))
650 (overlay-put ispell-overlay
'face
651 (if (internal-find-face 'ispell
)
653 (move-overlay ispell-overlay start end
(current-buffer)))))
655 ;;;; ispell-complete-word
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.
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'.
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'.
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.
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:
686 ;;; Possible completions are:
690 ;;; Saskatchewan Saskatoon
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
701 ;;; Possible completions are:
702 ;;; Saskatchewan Saskatoon
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
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.
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.
723 ;;; The user-defined variables are:
725 ;;; ispell-look-command
726 ;;; ispell-look-dictionary
727 ;;; ispell-gnu-look-still-broken-p
729 ;;; Algorithm (some similarity to lisp-complete-symbol):
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.
736 ;;; * Build completion list using try-completion and `string'
738 ;;; * Replace `string' in buffer with matched common substring completion.
740 ;;; * Display completion list only if there is no matched common substring.
742 ;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when
743 ;;; beginning of word fragment has changed.
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
754 ;;; * Robust searches are done using a `look' with -r (regular expression)
755 ;;; switch if ispell-have-new-look is t.
757 ;;;; User-defined variables.
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\"")
764 (defvar ispell-gnu-look-still-broken-p nil
765 "*t if GNU look -r can give different results with and without trailing `.*'.
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
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.")
777 ;;;; Internal variables.
779 ;;; Possible completions for last word fragment.
780 (defvar ispell-lookup-completions-alist nil
)
782 ;;; Last word fragment processed by `ispell-complete-word'.
783 (defvar ispell-lookup-last-word nil
)
785 ;;; Buffer local variables.
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
)
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
)
797 ;;;; Interactive functions.
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'."
807 ;; `look' must support regexp expressions in order to perform an interior
809 (if (and interior-frag
(not ispell-have-new-look
))
810 (error (concat "Sorry, `ispell-have-new-look' is nil. "
811 "You also will need GNU Ispell's `look'.")))
813 (let* ((completion-ignore-case t
)
815 ;; Get location of beginning of word fragment.
816 (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point)))
818 ;; Get the string to look up.
819 (string (buffer-substring bow
(point)))
821 ;; Get regexp for which we search and, if necessary, an interior word
823 (regexp (if interior-frag
824 (concat "^.*" string
".*")
825 ;; If possible use fast binary search: no trailing `.*'.
827 (if ispell-gnu-look-still-broken-p
".*"))))
829 ;; We want all completions for case of interior fragments so set
830 ;; prefix to an empty string.
831 (prefix (if interior-frag
"" string
))
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
)))
839 ;; Are we starting a unique word fragment search? Always t for
840 ;; interior word fragment search.
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
849 (concat "^" ispell-lookup-last-word
) string
)))))
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
" ")
858 (save-excursion (forward-word -
1) (point)) (point)))
859 (error "Perfect match already")
860 (error "No word fragment at point")))
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
)))
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
)
875 ;; Test the completion status.
878 ;; * Guess is a perfect match.
881 (message "Perfect match."))
883 ;; * No possibilities.
885 (message "Can't find completion for \"%s\"" string
)
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."))
898 ;; * String is a common substring completion already. Make list.
900 (message "Making completion list...")
901 (if (string-equal completion
"") (delete-region bow
(point)))
902 (let ((list (all-completions prefix ispell-lookup-completions-alist
)))
903 (with-output-to-temp-buffer "*Completions*"
904 (display-completion-list list
)))
905 (message "Making completion list...done")))))
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."
913 (ispell-complete-word t
))
915 ;;;; Internal Function.
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
)
924 (message "Building list...")
925 (set-buffer (get-buffer-create " *ispell look*"))
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
)))
938 ;; Build list for try-completion and all-completions by storing each line
939 ;; of output starting from bottom of buffer and deleting upwards.
941 (goto-char (point-min))
942 (while (not (= (point-min) (point-max)))
944 (setq list
(cons (buffer-substring (point-min) (point)) list
))
946 (delete-region (point-min) (point)))
950 (message "Building list...done")
952 ;; Make the list into an alist and return.
953 (mapcar 'list
(nreverse list
)))))
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
)))
962 (defvar ispell-message-cite-regexp
"^ \\|^\t"
963 "*Regular expression to match lines cited from one message into another.")
965 (defvar ispell-message-text-end
966 (concat "^\\(" (mapconcat (function identity
)
968 ;; Matches postscript files.
970 ;; Matches uuencoded text
971 "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM"
972 ;; Matches shell files (esp. auto-decoding)
974 ;; Matches difference listing
975 "diff -c .*\n\\*\\*\\* .*\n--- "
976 ;; Matches "--------------------- cut here"
980 "*End of text which will be checked in ispell-message.
981 If it is a string, limit at first occurrence of that regular expression.
982 Otherwise, it must be a function which is called to get the limit.")
984 (defvar ispell-message-limit
(* 100 80)
985 "*Ispell-message will check no more than this number of characters.")
988 (defun ispell-message ()
989 "Check the spelling of a mail message or news post.
990 Don't check spelling of message headers (except subject) or included messages.
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))
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)))))"
1000 (let (non-internal-message
1001 (old-case-fold-search case-fold-search
)
1002 (case-fold-search nil
))
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.
1008 (while (and (looking-at "[a-zA-Z-]+:\\|\t\\| ")
1011 (setq non-internal-message t
)
1013 (let* ((cite-regexp ;Prefix of inserted text
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:" "\\|"
1025 ((equal major-mode
'news-reply-mode
) ;Gnus
1026 (concat "In article <" "\\|"
1027 (if mail-yank-prefix
1028 (ispell-non-empty-string mail-yank-prefix
)
1029 ispell-message-cite-regexp
)))
1030 ((boundp 'vm-included-text-prefix
) ; VM mail message
1031 (concat "[^,;&+=]+ writes:" "\\|"
1032 (ispell-non-empty-string vm-included-text-prefix
)
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
)))
1042 (+ (point-min) ispell-message-limit
)
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
)
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
)))
1055 ;; Check the subject
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\\>")))
1064 (ispell-region (- (point) 1)
1067 (while (looking-at "\n[ \t]")
1073 (while (and (< (point) limit
) continue
)
1074 ;; Skip across text cited from other messages.
1075 (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp
))
1078 (if (< (point) limit
)
1079 ;; Check the next batch of lines that *aren't* cited.
1080 (let ((start (point)))
1081 (if (re-search-forward
1082 (concat "^\\(" cite-regexp
"\\)") search-limit
'end
)
1083 (beginning-of-line))
1084 (if (> (point) limit
) (goto-char limit
))
1085 (let ((case-fold-search old-case-fold-search
))
1087 (setq continue
(ispell-region (- start
1) (point))))))))))))
1091 ;;; ispell.el ends here