-;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 3.
-
-;;Copyright (C) 1990, 1991 Free Software Foundation, Inc.
-;;
-;;This file is part of GNU ISPELL.
-;;
-;;GNU ISPELL is free software; you can redistribute it and/or modify
-;;it under the terms of the GNU General Public License as published by
-;;the Free Software Foundation; either version 2, or (at your option)
-;;any later version.
-;;
-;;GNU ISPELL is distributed in the hope that it will be useful,
-;;but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;GNU General Public License for more details.
-;;
-;;You should have received a copy of the GNU General Public License
-;;along with GNU ISPELL; see the file COPYING. If not, write to
-;;the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; ispell4.el --- this is the GNU EMACS interface to GNU ISPELL version 4.
+
+;; Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc.
+
+;; Keywords: wp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides a graceful interface to ispell, the GNU
+;; spelling checker.
+
+;;; Code:
(defvar ispell-have-new-look t
- "T if default 'look' program has the -r flag.")
+ "Non-nil means use the `-r' option when running `look'.")
(defvar ispell-enable-tex-parser nil
- "T to enable experimental tex parser in ispell for tex buffers.")
+ "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.")
-(defvar ispell-process nil "The process running ISPELL")
+(defvar ispell-process nil "The process running Ispell")
(defvar ispell-next-message nil
- "An integer telling where in the *ispell* buffer where
-to look for the next message from the ISPELL program.")
+ "An integer: where in `*ispell*' buffer to find next message from Ispell.")
+
+(defvar ispell-command "ispell"
+ "Command for running Ispell.")
+(defvar ispell-command-options nil
+ "*String (or list of strings) to pass to Ispell as command arguments.
+You can specify your private dictionary via the -p <filename> option.
+The -S option is always passed to Ispell as the last parameter,
+and need not be mentioned here.")
+
+(defvar ispell-look-command "look"
+ "*Command for running look.")
;Each marker in this list points to the start of a word that
;ispell thought was bad last time it did the :file command.
;without the select system call. Therefore, see the variable
;ispell-recently-accepted.
(defvar ispell-bad-words nil
- "A list of markers corresponding to the output of the ISPELL :file command.")
+ "A list of markers reflecting the output of the Ispell `:file' command.")
;list of words that the user has accepted, but that might still
;be on the bad-words list
(defvar ispell-recently-accepted nil)
+;; Non-nil means we have started showing an alternatives window.
+;; This is the window config from before then.
+(defvar ispell-window-configuration nil)
+
;t when :dump command needed
(defvar ispell-dump-needed nil)
(setq ispell-recently-accepted nil))
(defun kill-ispell ()
- "Kill the ispell process.
-Any changes the your private dictionay
+ "Kill the Ispell process.
+Any changes in your private dictionary
that have not already been dumped will be lost."
(interactive)
(if ispell-process
(put 'ispell-startup-error 'error-message
"Problem starting ispell - see buffer *ispell*")
+;; Start an ispell subprocess; check the version; and display the greeting.
+
(defun start-ispell ()
- "Start an ispell subprocess; check the version; and display the greeting."
(message "Starting ispell ...")
(let ((buf (get-buffer "*ispell*")))
(if buf
(kill-buffer buf)))
(condition-case err
- (setq ispell-process (start-process "ispell" "*ispell*" "ispell" "-S"))
+ (setq ispell-process
+ (apply 'start-process "ispell" "*ispell*" ispell-command
+ (append (if (listp ispell-command-options)
+ ispell-command-options
+ (list ispell-command-options))
+ '("-S"))))
(file-error (signal 'ispell-startup-error nil)))
(process-kill-without-query ispell-process)
(buffer-disable-undo (process-buffer ispell-process))
(let ((greeting (read (current-buffer))))
(if (not (= (car greeting) 1))
(error "Bad ispell version: wanted 1, got %d" (car greeting)))
- (message (car (cdr greeting))))
+ (message "%s" (car (cdr greeting))))
(delete-region (point-min) last-char))))
-;leaves buffer set to *ispell*, point at '='
+;; Make sure ispell is ready for a command.
+;; Leaves buffer set to *ispell*, point at '='.
+
(defun ispell-sync (intr)
- "Make sure ispell is ready for a command."
(if (or (null ispell-process)
(not (eq (process-status ispell-process) 'run)))
(start-ispell))
(setq last-char (- (point-max) 1)))
(goto-char last-char)))
-(defun ispell-cmd (&rest strings)
- "Send a command to ispell. Choices are:
-
-word any word is checked for spelling. Result is
-
- nil not found
- t spelled ok
- list of strings near misses
-
-:file filename scan the named file, and print the file offsets of
- any misspelled words
-
-:insert word put word in private dictonary
-
-:accept word don't complain about word any more this session
-
-:dump write out the current private dictionary, if necessary.
+;; Send a command to ispell. Choices are:
+;;
+;; WORD Check spelling of WORD. Result is
+;;
+;; nil not found
+;; t spelled ok
+;; list of strings near misses
+;;
+;; :file FILENAME scan the named file, and print the file offsets of
+;; any misspelled words
+;;
+;; :insert WORD put word in private dictionary
+;;
+;; :accept WORD don't complain about word any more this session
+;;
+;; :dump write out the current private dictionary, if necessary.
+;;
+;; :reload reread private dictionary (default: `~/ispell.words')
+;;
+;; :tex
+;; :troff
+;; :generic set type of parser to use when scanning whole files
-:reload reread ~/ispell.words
-
-:tex
-:troff
-:generic set type of parser to use when scanning whole files
-"
+(defun ispell-cmd (&rest strings)
(save-excursion
(ispell-sync t)
(set-buffer (process-buffer ispell-process))
(if ispell-bad-words
(setq ispell-recently-accepted (cons word ispell-recently-accepted))))
+;; Return the next message sent by the Ispell subprocess.
(defun ispell-next-message ()
- "Return the next message sent by the ispell subprocess."
(save-excursion
(set-buffer (process-buffer ispell-process))
(bury-buffer (current-buffer))
(read (current-buffer)))))
(defun ispell-tex-buffer-p ()
- (memq major-mode '(plain-TeX-mode LaTeX-mode)))
+ (memq major-mode '(plain-tex-mode latex-mode slitex-mode)))
+
+(defvar ispell-menu-map (make-sparse-keymap "Spell"))
+(defalias 'ispell-menu-map ispell-menu-map)
+
+(define-key ispell-menu-map [ispell-complete-word-interior-frag]
+ '("Complete Interior Fragment" . ispell-complete-word-interior-frag))
+
+(define-key ispell-menu-map [ispell-complete-word]
+ '("Complete Word" . ispell-complete-word))
+
+(define-key ispell-menu-map [reload-ispell]
+ '("Reload Dictionary" . reload-ispell))
-;;;###autoload
+(define-key ispell-menu-map [ispell-next]
+ '("Continue Check" . ispell-next))
+
+(define-key ispell-menu-map [ispell-message]
+ '("Check Message" . ispell-message))
+
+(define-key ispell-menu-map [ispell-word]
+ '("Check Word" . ispell-word))
+
+(define-key ispell-menu-map [ispell-region]
+ '("Check Region" . ispell-region))
+
+(define-key ispell-menu-map [ispell-buffer]
+ '("Check Buffer" . ispell))
+
+;;;autoload
(defun ispell (&optional buf start end)
- "Run ispell over current buffer's visited file.
-First the file is scanned for misspelled words, then ispell
+ "Run Ispell over current buffer's visited file.
+First the file is scanned for misspelled words, then Ispell
enters a loop with the following commands for every misspelled word:
DIGIT Near miss selector. If the misspelled word is close to
some words in the dictionary, they are offered as near misses.
r Replace. Replace the word with a string you type. Each word
of your new string is also checked.
-i Insert. Insert this word in your private dictonary (kept in
+i Insert. Insert this word in your private dictionary (by default,
`$HOME/ispell.words').
a Accept. Accept this word for the rest of this editing session,
- but don't put it in your private dictonary.
+ but don't put it in your private dictionary.
l Lookup. Look for a word in the dictionary by fast binary
search, or search for a regular expression in the dictionary
using grep.
(setq buf (get-buffer buf))
(if (null buf)
(error "Can't find buffer"))
+ ;; Deactivate the mark, because we'll do it anyway if we change something,
+ ;; and a region highlight while in the Ispell loop is distracting.
+ (deactivate-mark)
(save-excursion
(set-buffer buf)
(let ((filename buffer-file-name)
- (delete-temp nil))
+ (delete-temp nil))
(unwind-protect
(progn
- (cond ((null filename)
+ (cond ((or (null filename)
+ (find-file-name-handler buffer-file-name nil))
(setq filename (make-temp-name "/usr/tmp/ispell"))
(setq delete-temp t)
(write-region (point-min) (point-max) filename))
(ispell-cmd ":tex")
(ispell-cmd ":generic"))
(ispell-cmd (format ":file %s %d %d" filename start end)))
- (if delete-temp
- (condition-case ()
- (delete-file filename)
- (file-error nil)))))
+ (if delete-temp
+ (condition-case ()
+ (delete-file filename)
+ (file-error nil)))))
(message "Parsing ispell output ...")
(ispell-flush-bad-words)
(let (pos bad-words)
(setq ispell-bad-words (nreverse bad-words))))
(cond ((not (markerp (car ispell-bad-words)))
(setq ispell-bad-words nil)
- (message "No misspellings."))
+ (message "No misspellings.")
+ t)
(t
(message "Ispell parsing done.")
(ispell-next))))
-;;;###autoload
-(fset 'ispell-buffer 'ispell)
+;;;autoload
+(defalias 'ispell-buffer 'ispell)
(defun ispell-next ()
- "Resume command loop for most recent ispell command."
+ "Resume command loop for most recent Ispell command.
+Return value is t unless exit is due to typing `q'."
(interactive)
- (unwind-protect
- (catch 'quit
- (save-window-excursion
- (save-excursion
+ (setq ispell-window-configuration nil)
+ (prog1
+ (unwind-protect
+ (catch 'ispell-quit
+ ;; There used to be a save-excursion here,
+ ;; but that was annoying: it's better if point doesn't move
+ ;; when you type q.
(let (next)
(while (markerp (setq next (car ispell-bad-words)))
(switch-to-buffer (marker-buffer next))
(push-mark)
(ispell-point next "at saved position.")
(setq ispell-bad-words (cdr ispell-bad-words))
- (set-marker next nil))))))
- (cond ((null ispell-bad-words)
- (error "Ispell has not yet been run."))
- ((markerp (car ispell-bad-words))
- (message (substitute-command-keys
- "Type \\[ispell-next] to continue.")))
- ((eq (car ispell-bad-words) nil)
- (setq ispell-bad-words nil)
- (message "No more misspellings (but checker was interrupted.)"))
- ((eq (car ispell-bad-words) t)
- (setq ispell-bad-words nil)
- (message "Ispell done."))
- (t
- (setq ispell-bad-words nil)
- (message "Bad ispell internal list"))))
- (ispell-dump))
-
+ (set-marker next nil)))
+ t)
+ (ispell-dehighlight)
+ (if ispell-window-configuration
+ (set-window-configuration ispell-window-configuration))
+ (cond ((null ispell-bad-words)
+ (error "Ispell has not yet been run"))
+ ((markerp (car ispell-bad-words))
+ (message "%s"
+ (substitute-command-keys
+ "Type \\[ispell-next] to continue")))
+ ((eq (car ispell-bad-words) nil)
+ (setq ispell-bad-words nil)
+ (message "No more misspellings (but checker was interrupted)"))
+ ((eq (car ispell-bad-words) t)
+ (setq ispell-bad-words nil)
+ (message "Ispell done"))
+ (t
+ (setq ispell-bad-words nil)
+ (message "Bad ispell internal list"))))
+ (ispell-dump)))
-;;;###autoload
-(defun ispell-word ()
+;;;autoload
+(defun ispell-word (&optional resume)
"Check the spelling of the word under the cursor.
-See `ispell' for more information."
- (interactive)
- (condition-case err
- (catch 'quit
- (save-window-excursion
- (ispell-point (point) "at point."))
- (ispell-dump))
- (ispell-startup-error
- (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
- (load-library "spell")
- (define-key esc-map "$" 'spell-word)
- (spell-word))))))
-;;;###autoload
-(define-key esc-map "$" 'ispell-word)
-
-;;;###autoload
+See the command `ispell' for more information.
+With a prefix argument, resume handling of the previous Ispell command."
+ (interactive "P")
+ (if resume
+ (ispell-next)
+ (condition-case err
+ (unwind-protect
+ (catch 'ispell-quit
+ (save-window-excursion
+ (ispell-point (point) "at point."))
+ (ispell-dump))
+ (ispell-dehighlight))
+ (ispell-startup-error
+ (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
+ (load-library "spell")
+ (define-key esc-map "$" 'spell-word)
+ (spell-word)))))))
+
+;;;autoload (define-key esc-map "$" 'ispell-word)
+
+;;;autoload
(defun ispell-region (start &optional end)
"Check the spelling for all of the words in the region."
(interactive "r")
(let ((wend (make-marker))
rescan
end)
- (save-excursion
+ ;; There used to be a save-excursion here,
+ ;; but that was annoying: it's better if point doesn't move
+ ;; when you type q.
(goto-char start)
(ispell-find-word-start) ;find correct word start
(setq start (point-marker))
(ispell-find-word-end) ;now find correct end
(setq end (point-marker))
- (if (>= start end)
- (error "No word %s" message))
- (while (< start end)
- (goto-char start)
- (ispell-find-word-end) ;find end of current word
+ ;; Do nothing if we don't find a word.
+ (if (< start end)
+ (while (< start end)
+ (goto-char start)
+ (ispell-find-word-end) ;find end of current word
;could be before 'end' if
;user typed replacement
;that is more than one word
- (set-marker wend (point))
- (setq rescan nil)
- (setq word (buffer-substring start wend))
- (cond ((ispell-still-bad word)
- (goto-char start);just to show user where we are working
- (sit-for 0)
- (message (format "Ispell checking %s" word))
- (ispell-cmd word)
- (let ((message (ispell-next-message)))
- (cond ((eq message t)
- (message "%s: ok" word))
- ((or (null message)
- (consp message))
- (setq rescan
- (ispell-command-loop word start wend message)))
- (t
- (error "unknown ispell response %s" message))))))
- (cond ((null rescan)
- (goto-char wend)
- (ispell-next-word)
- (set-marker start (point)))))
+ (set-marker wend (point))
+ (setq rescan nil)
+ (setq word (buffer-substring start wend))
+ (cond ((ispell-still-bad word)
+;;; This just causes confusion. -- rms.
+;;; (goto-char start)
+;;; (sit-for 0)
+ (message "Ispell checking %s" word)
+ (ispell-cmd word)
+ (let ((message (ispell-next-message)))
+ (cond ((eq message t)
+ (message "%s: ok" word))
+ ((or (null message)
+ (consp message))
+ (setq rescan
+ (ispell-command-loop word start wend message)))
+ (t
+ (error "unknown ispell response %s" message))))))
+ (cond ((null rescan)
+ (goto-char wend)
+ (ispell-next-word)
+ (set-marker start (point))))))
;;clear the choices buffer; otherwise it's hard for the user to tell
;;when we get back to the command loop
(let ((buf (get-buffer "*ispell choices*")))
(erase-buffer))))
(set-marker start nil)
(set-marker end nil)
- (set-marker wend nil))))
+ (set-marker wend nil)))
(defun ispell-still-bad (word)
(let ((words ispell-recently-accepted)
ret))
(defun ispell-show-choices (word message first-line)
- ;;if there is only one window on the screen, make the ispell
+ ;;if there is only one window on the frame, make the ispell
;;messages winow be small. otherwise just use the other window
(let* ((selwin (selected-window))
(resize (eq selwin (next-window)))
(buf (get-buffer-create "*ispell choices*"))
w)
+ (or ispell-window-configuration
+ (setq ispell-window-configuration (current-window-configuration)))
(setq w (display-buffer buf))
(buffer-disable-undo buf)
(if resize
(if (null message)
(setq first-line (concat "No near misses for '" word "'"))
(setq first-line (concat "Near misses for '" word "'")))
+ (ispell-highlight start end)
(while flag
(ispell-show-choices word message first-line)
(message "Ispell command: ")
+ (undo-boundary)
(let ((c (downcase (read-char)))
replacement)
(cond ((and (>= c ?0)
(ispell-replace start end replacement)
(setq flag nil))
((= c ?q)
- (throw 'quit nil))
+ (throw 'ispell-quit nil))
+ ((= c (nth 3 (current-input-mode)))
+ (keyboard-quit))
((= c ? )
(setq flag nil))
((= c ?r)
(set-buffer buf)
(delete-region (point-min) (point-max))
(if ispell-have-new-look
- (call-process "look" nil buf nil "-r" regex)
- (call-process "look" nil buf nil regex))
+ (call-process ispell-look-command nil buf nil "-r" regex)
+ (call-process ispell-look-command nil buf nil regex))
(goto-char (point-min))
(forward-line 10)
(delete-region (point) (point-max))
(delete-region (point) end))
(defun reload-ispell ()
- "Tell ispell to re-read your private dictionary."
+ "Tell Ispell to re-read your private dictionary."
(interactive)
(ispell-cmd ":reload"))
-(define-key esc-map "$" 'ispell-word)
-;; This conflicts with set-selective-display. What should we do???
-;;(define-key ctl-x-map "$" 'ispell-next)
-
(defun batch-make-ispell ()
(byte-compile-file "ispell.el")
(find-file "ispell.texinfo")
(kill-emacs 1))
(write-region (point-min) (point-max) "ispell.info"))
+(defvar ispell-highlight t
+ "*Non-nil means to highlight ispell words.")
+
+(defvar ispell-overlay nil)
+
+(defun ispell-dehighlight ()
+ (and ispell-overlay
+ (progn
+ (delete-overlay ispell-overlay)
+ (setq ispell-overlay nil))))
+
+(defun ispell-highlight (start end)
+ (and ispell-highlight
+ window-system
+ (progn
+ (or ispell-overlay
+ (progn
+ (setq ispell-overlay (make-overlay start end))
+ (overlay-put ispell-overlay 'face
+ (if (internal-find-face 'ispell)
+ 'ispell 'region))))
+ (move-overlay ispell-overlay start end (current-buffer)))))
+
+;;;; ispell-complete-word
+
+;;; Brief Description:
+;;; Complete word fragment at point using dictionary and replace with full
+;;; word. Expansion done in current buffer like lisp-complete-symbol.
+;;; Completion of interior word fragments possible with prefix argument.
+
+;;; Known Problem:
+;;; Does not use private dictionary because GNU `look' does not use it. It
+;;; would be nice if GNU `look' took standard input; this would allow gzip'ed
+;;; dictionaries to be used. GNU `look' also has a bug, see
+;;; `ispell-gnu-look-still-broken-p'.
+
+;;; Motivation:
+;;; The `l', "regular expression look up", keymap option of ispell-word
+;;; (ispell-do-look) can only be run after finding a misspelled word. So
+;;; ispell-do-look can not be used to look for words starting with `cat' to
+;;; find `catechetical' since `cat' is a correctly spelled word. Furthermore,
+;;; ispell-do-look does not return the entire list returned by `look'.
+;;;
+;;; ispell-complete-word allows you to get a completion list from the system
+;;; dictionary and expand a word fragment at the current position in a buffer.
+;;; These examples assume ispell-complete-word is bound to M-TAB as it is in
+;;; text-mode; the `Complete Word' and `Complete Interior Fragment' entries of
+;;; the "Spell" submenu under the "Edit" menu may also be used instead of
+;;; M-TAB and C-u M-TAB, respectively.
+;;;
+;;; EXAMPLE 1: The word `Saskatchewan' needs to be spelled. The user may
+;;; type `Sas' and hit M-TAB and a completion list will be built using the
+;;; shell command `look' and displayed in the *Completions* buffer:
+;;;
+;;; Possible completions are:
+;;; sash sashay
+;;; sashayed sashed
+;;; sashes sashimi
+;;; Saskatchewan Saskatoon
+;;; sass sassafras
+;;; sassier sassing
+;;; sasswood sassy
+;;;
+;;; By viewing this list the user will hopefully be motivated to insert the
+;;; letter `k' after the `sas'. When M-TAB is hit again the word `Saskat'
+;;; will be inserted in place of `sas' (note case) since this is a unique
+;;; substring completion. The narrowed completion list can be viewed with
+;;; another M-TAB
+;;;
+;;; Possible completions are:
+;;; Saskatchewan Saskatoon
+;;;
+;;; Inserting the letter `c' and hitting M-TAB will narrow the completion
+;;; possibilities to just `Saskatchewan' and this will be inserted in the
+;;; buffer. At any point the user may click the mouse on a completion to
+;;; select it.
+;;;
+;;; EXAMPLE 2: The user has typed `Sasaquane' and M-$ (ispell-word) gives no
+;;; "near-misses" in which case you back up to `Sas' and hit M-TAB and find
+;;; the correct word as above. The `Sas' will be replaced by `Saskatchewan'
+;;; and the remaining word fragment `aquane' can be deleted.
+;;;
+;;; EXAMPLE 3: If a version of `look' is used that supports regular
+;;; expressions, then `ispell-have-new-look' should be t (its default) and
+;;; interior word fragments may also be used for the search. The word
+;;; `pneumonia' needs to be spelled. The user can only remember the
+;;; interior fragment `mon' in which case `C-u M-TAB' on `mon' gives a list
+;;; of all words containing the interior word fragment `mon'. Typing `p'
+;;; and M-TAB will narrow this list to all the words starting with `p' and
+;;; containing `mon' from which `pneumonia' can be found as above.
+
+;;; The user-defined variables are:
+;;;
+;;; ispell-look-command
+;;; ispell-look-dictionary
+;;; ispell-gnu-look-still-broken-p
+
+;;; Algorithm (some similarity to lisp-complete-symbol):
+;;;
+;;; * call-process on command ispell-look-command (default: "look") to find
+;;; words in ispell-look-dictionary matching `string' (or `regexp' if
+;;; ispell-have-new-look is t). Parse output and store results in
+;;; ispell-lookup-completions-alist.
+;;;
+;;; * Build completion list using try-completion and `string'
+;;;
+;;; * Replace `string' in buffer with matched common substring completion.
+;;;
+;;; * Display completion list only if there is no matched common substring.
+;;;
+;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when
+;;; beginning of word fragment has changed.
+;;;
+;;; * Interior fragments searches are performed similarly with the exception
+;;; that the entire fragment at point is initially removed from the buffer,
+;;; the STRING passed to try-completion and all-completions is just "" and
+;;; not the interior fragment; this allows all completions containing the
+;;; interior fragment to be shown. The location in the buffer is stored to
+;;; decide whether future completion narrowing of the current list should be
+;;; done or if a new list should be built. See interior fragment example
+;;; above.
+;;;
+;;; * Robust searches are done using a `look' with -r (regular expression)
+;;; switch if ispell-have-new-look is t.
+
+;;;; User-defined variables.
+
+(defvar ispell-look-dictionary nil
+ "*If non-nil then spelling dictionary as string for `ispell-complete-word'.
+Overrides default dictionary file such as \"/usr/dict/words\" or GNU look's
+\"${prefix}/lib/ispell/ispell.words\"")
+
+(defvar ispell-gnu-look-still-broken-p nil
+ "*t if GNU look -r can give different results with and without trailing `.*'.
+Example: `look -dfr \"^ya\" foo' returns nothing, while `look -dfr \"^ya.*\" foo'
+returns `yacc', where `foo' is a dictionary file containing the three lines
+
+ y
+ y's
+ yacc
+
+Both commands should return `yacc'. If `ispell-complete-word' erroneously
+states that no completions exist for a string, then setting this variable to t
+will help find those completions.")
+
+;;;; Internal variables.
+
+;;; Possible completions for last word fragment.
+(defvar ispell-lookup-completions-alist nil)
+
+;;; Last word fragment processed by `ispell-complete-word'.
+(defvar ispell-lookup-last-word nil)
+
+;;; Buffer local variables.
+
+;;; Value of interior-frag in last call to `ispell-complete-word'.
+(defvar ispell-lookup-last-interior-p nil)
+(make-variable-buffer-local 'ispell-lookup-last-interior-p)
+(put 'ispell-lookup-last-interior-p 'permanent-local t)
+
+;;; Buffer position in last call to `ispell-complete-word'.
+(defvar ispell-lookup-last-bow nil)
+(make-variable-buffer-local 'ispell-lookup-last-bow)
+(put 'ispell-lookup-last-bow 'permanent-local t)
+
+;;;; Interactive functions.
+;;;autoload
+(defun ispell-complete-word (&optional interior-frag)
+ "Complete word using letters at point to word beginning using `look'.
+With optional argument INTERIOR-FRAG, word fragment at point is assumed to be
+an interior word fragment in which case `ispell-have-new-look' should be t.
+See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'."
+
+ (interactive "P")
+
+ ;; `look' must support regexp expressions in order to perform an interior
+ ;; fragment search.
+ (if (and interior-frag (not ispell-have-new-look))
+ (error (concat "Sorry, `ispell-have-new-look' is nil. "
+ "You also will need GNU Ispell's `look'.")))
+
+ (let* ((completion-ignore-case t)
+
+ ;; Get location of beginning of word fragment.
+ (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point)))
+
+ ;; Get the string to look up.
+ (string (buffer-substring bow (point)))
+
+ ;; Get regexp for which we search and, if necessary, an interior word
+ ;; fragment.
+ (regexp (if interior-frag
+ (concat "^.*" string ".*")
+ ;; If possible use fast binary search: no trailing `.*'.
+ (concat "^" string
+ (if ispell-gnu-look-still-broken-p ".*"))))
+
+ ;; We want all completions for case of interior fragments so set
+ ;; prefix to an empty string.
+ (prefix (if interior-frag "" string))
+
+ ;; Are we continuing from a previous interior fragment search?
+ ;; Check last value of interior-word and if the point has moved.
+ (continuing-an-interior-frag-p
+ (and ispell-lookup-last-interior-p
+ (equal ispell-lookup-last-bow bow)))
+
+ ;; Are we starting a unique word fragment search? Always t for
+ ;; interior word fragment search.
+ (new-unique-string-p
+ (or interior-frag (null ispell-lookup-last-word)
+ (let ((case-fold-search t))
+ ;; Can we locate last word fragment as a substring of current
+ ;; word fragment? If the last word fragment is larger than
+ ;; the current string then we will have to rebuild the list
+ ;; later.
+ (not (string-match
+ (concat "^" ispell-lookup-last-word) string)))))
+
+ completion)
+
+ ;; Check for perfect completion already. That is, maybe the user has hit
+ ;; M-x ispell-complete-word one too many times?
+ (if (string-equal string "")
+ (if (string-equal (concat ispell-lookup-last-word " ")
+ (buffer-substring
+ (save-excursion (forward-word -1) (point)) (point)))
+ (error "Perfect match already")
+ (error "No word fragment at point")))
+
+ ;; Create list of words from system dictionary starting with `string' if
+ ;; new string and not continuing from a previous interior fragment search.
+ (if (and (not continuing-an-interior-frag-p) new-unique-string-p)
+ (setq ispell-lookup-completions-alist
+ (ispell-lookup-build-list string regexp)))
+
+ ;; Check for a completion of `string' in the list and store `string' and
+ ;; other variables for the next call.
+ (setq completion (try-completion prefix ispell-lookup-completions-alist)
+ ispell-lookup-last-word string
+ ispell-lookup-last-interior-p interior-frag
+ ispell-lookup-last-bow bow)
+
+ ;; Test the completion status.
+ (cond
+
+ ;; * Guess is a perfect match.
+ ((eq completion t)
+ (insert " ")
+ (message "Perfect match."))
+
+ ;; * No possibilities.
+ ((null completion)
+ (message "Can't find completion for \"%s\"" string)
+ (beep))
+
+ ;; * Replace string fragment with matched common substring completion.
+ ((and (not (string-equal completion ""))
+ ;; Fold case so a completion list is built when `string' and common
+ ;; substring differ only in case.
+ (let ((case-fold-search t))
+ (not (string-match (concat "^" completion "$") string))))
+ (search-backward string bow)
+ (replace-match completion nil t) ; FIXEDCASE doesn't work? or LITERAL?
+ (message "Proposed unique substring. Repeat for completions list."))
+
+ ;; * String is a common substring completion already. Make list.
+ (t
+ (message "Making completion list...")
+ (if (string-equal completion "") (delete-region bow (point)))
+ (let ((list (all-completions prefix ispell-lookup-completions-alist)))
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list list)))
+ (message "Making completion list...done")))))
+
+;;;autoload
+(defun ispell-complete-word-interior-frag ()
+ "Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG.
+A completion list is built for word fragment at point which is assumed to be
+an interior word fragment. `ispell-have-new-look' should be t."
+ (interactive)
+ (ispell-complete-word t))
+
+;;;; Internal Function.
+
+;;; Build list of words using ispell-look-command from dictionary
+;;; ispell-look-dictionary (if this is a non-nil string). Look for words
+;;; starting with STRING if ispell-have-new-look is nil or look for REGEXP if
+;;; ispell-have-new-look is t. Returns result as an alist suitable for use by
+;;; try-completion, all-completions, and completing-read.
+(defun ispell-lookup-build-list (string regexp)
+ (save-excursion
+ (message "Building list...")
+ (set-buffer (get-buffer-create " *ispell look*"))
+ (erase-buffer)
+
+ (if (stringp ispell-look-dictionary)
+ (if ispell-have-new-look
+ (call-process ispell-look-command nil t nil "-fr" regexp
+ ispell-look-dictionary)
+ (call-process ispell-look-command nil t nil "-f" string
+ ispell-look-dictionary))
+ (if ispell-have-new-look
+ (call-process ispell-look-command nil t nil "-fr" regexp)
+ (call-process ispell-look-command nil t nil "-f" string)))
+
+ ;; Build list for try-completion and all-completions by storing each line
+ ;; of output starting from bottom of buffer and deleting upwards.
+ (let (list)
+ (goto-char (point-min))
+ (while (not (= (point-min) (point-max)))
+ (end-of-line)
+ (setq list (cons (buffer-substring (point-min) (point)) list))
+ (forward-line)
+ (delete-region (point-min) (point)))
+
+ ;; Clean.
+ (erase-buffer)
+ (message "Building list...done")
+
+ ;; Make the list into an alist and return.
+ (mapcar 'list (nreverse list)))))
+\f
+;; Return regexp-quote of STRING if STRING is non-empty.
+;; Otherwise return an unmatchable regexp.
+(defun ispell-non-empty-string (string)
+ (if (or (not string) (string-equal string ""))
+ "\\'\\`" ; An unmatchable string if string is null.
+ (regexp-quote string)))
+
+(defvar ispell-message-cite-regexp "^ \\|^\t"
+ "*Regular expression to match lines cited from one message into another.")
+
+(defvar ispell-message-text-end
+ (concat "^\\(" (mapconcat (function identity)
+ '(
+ ;; Matches postscript files.
+ "%!PS-Adobe-2.0"
+ ;; Matches uuencoded text
+ "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM"
+ ;; Matches shell files (esp. auto-decoding)
+ "#! /bin/sh"
+ ;; Matches difference listing
+ "diff -c .*\n\\*\\*\\* .*\n--- "
+ ;; Matches "--------------------- cut here"
+ "[-=]+\\s cut here")
+ "\\|")
+ "\\)")
+ "*End of text which will be checked in ispell-message.
+If it is a string, limit at first occurrence of that regular expression.
+Otherwise, it must be a function which is called to get the limit.")
+
+(defvar ispell-message-limit (* 100 80)
+ "*Ispell-message will check no more than this number of characters.")
+
+;;;autoload
+(defun ispell-message ()
+ "Check the spelling of a mail message or news post.
+Don't check spelling of message headers (except subject) or included messages.
+
+To spell-check whenever a message is sent, include this line in .emacs:
+ (setq news-inews-hook (setq mail-send-hook 'ispell-message))
+
+Or you can bind the function to C-c i in gnus or mail with:
+ (setq mail-mode-hook (setq news-reply-mode-hook
+ (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))))"
+ (interactive)
+ (save-excursion
+ (let (non-internal-message
+ (old-case-fold-search case-fold-search)
+ (case-fold-search nil))
+ (goto-char (point-min))
+ ;; Don't spell-check the headers.
+ (if (search-forward mail-header-separator nil t)
+ ;; Move to first body line.
+ (forward-line 1)
+ (while (and (looking-at "[a-zA-Z-]+:\\|\t\\| ")
+ (not (eobp)))
+ (forward-line 1))
+ (setq non-internal-message t)
+ )
+ (let* ((cite-regexp ;Prefix of inserted text
+ (cond
+ ((featurep 'supercite) ; sc 3.0
+ (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
+ (ispell-non-empty-string sc-reference-tag-string)))
+ ((featurep 'sc) ; sc 2.3
+ (concat "\\(" sc-cite-regexp "\\)" "\\|"
+ (ispell-non-empty-string sc-reference-tag-string)))
+ (non-internal-message ; Assume nn sent us this message.
+ (concat "In [a-zA-Z.]+ you write:" "\\|"
+ "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|"
+ " *> *"))
+ ((equal major-mode 'news-reply-mode) ;Gnus
+ (concat "In article <" "\\|"
+ (if mail-yank-prefix
+ (ispell-non-empty-string mail-yank-prefix)
+ ispell-message-cite-regexp)))
+ ((boundp 'vm-included-text-prefix) ; VM mail message
+ (concat "[^,;&+=]+ writes:" "\\|"
+ (ispell-non-empty-string vm-included-text-prefix)
+ ))
+ ((boundp 'mh-ins-buf-prefix) ; mh mail message
+ (ispell-non-empty-string mh-ins-buf-prefix))
+ (mail-yank-prefix ; vanilla mail message.
+ (ispell-non-empty-string mail-yank-prefix))
+ (t ispell-message-cite-regexp)))
+ (continue t)
+ (limit
+ (min
+ (+ (point-min) ispell-message-limit)
+ (point-max)
+ (save-excursion
+ (cond
+ ((not ispell-message-text-end) (point-max))
+ ((char-or-string-p ispell-message-text-end)
+ (if (re-search-forward ispell-message-text-end nil 'end)
+ (match-beginning 0)
+ (point-max)))
+ (t (funcall ispell-message-text-end))))))
+ (search-limit ; Search limit which won't stop in middle of citation
+ (+ limit (length cite-regexp)))
+ )
+ ;; Check the subject
+ (save-excursion
+ (let ((case-fold-search t)
+ (message-begin (point)))
+ (goto-char (point-min))
+ ;; "\\s *" matches newline if subject is empty
+ (if (and (re-search-forward "^Subject:[\t ]*" message-begin t)
+ (not (looking-at "re\\>")))
+ (setq continue
+ (ispell-region (- (point) 1)
+ (progn
+ (end-of-line)
+ (while (looking-at "\n[ \t]")
+ (end-of-line 2))
+ (point))))
+ )))
+
+ ;; Check the body.
+ (while (and (< (point) limit) continue)
+ ;; Skip across text cited from other messages.
+ (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp))
+ (< (point) limit))
+ (forward-line 1))
+ (if (< (point) limit)
+ ;; Check the next batch of lines that *aren't* cited.
+ (let ((start (point)))
+ (if (re-search-forward
+ (concat "^\\(" cite-regexp "\\)") search-limit 'end)
+ (beginning-of-line))
+ (if (> (point) limit) (goto-char limit))
+ (let ((case-fold-search old-case-fold-search))
+ (save-excursion
+ (setq continue (ispell-region (- start 1) (point))))))))))))
+
+(provide 'ispell)
+
;;; ispell.el ends here