Mercurial > emacs
view lisp/textmodes/=ispell4.el @ 17077:8f8c3d05b158
(byte-compile-file): Bind coding-system-for-write
instead of coding-system-for-read to 'no-conversion to disbale
code convertion by write-region.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 26 Feb 1997 11:59:40 +0000 |
parents | f5f5fa38faa7 |
children | ac1673121774 |
line wrap: on
line source
;;; 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 "Non-nil means use the `-r' option when running `look'.") (defvar ispell-enable-tex-parser nil "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.") (defvar ispell-process nil "The process running Ispell") (defvar ispell-next-message nil "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. ;Notice that if the user accepts or inserts a word into his ;private dictionary, then some "good" words will be on the list. ;We would like to deal with this by looking up the words again just before ;presenting them to the user, but that is too slow on machines ;without the select system call. Therefore, see the variable ;ispell-recently-accepted. (defvar ispell-bad-words nil "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) (defun ispell-flush-bad-words () (while ispell-bad-words (if (markerp (car ispell-bad-words)) (set-marker (car ispell-bad-words) nil)) (setq ispell-bad-words (cdr ispell-bad-words))) (setq ispell-recently-accepted nil)) (defun kill-ispell () "Kill the Ispell process. Any changes in your private dictionary that have not already been dumped will be lost." (interactive) (if ispell-process (delete-process ispell-process)) (setq ispell-process nil) (ispell-flush-bad-words)) (put 'ispell-startup-error 'error-conditions '(ispell-startup-error error)) (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 () (message "Starting ispell ...") (let ((buf (get-buffer "*ispell*"))) (if buf (kill-buffer buf))) (condition-case err (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)) (accept-process-output ispell-process) (let (last-char) (save-excursion (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (setq last-char (- (point-max) 1)) (while (not (eq (char-after last-char) ?=)) (cond ((not (eq (process-status ispell-process) 'run)) (kill-ispell) (signal 'ispell-startup-error nil))) (accept-process-output ispell-process) (setq last-char (- (point-max) 1))) (goto-char (point-min)) (let ((greeting (read (current-buffer)))) (if (not (= (car greeting) 1)) (error "Bad ispell version: wanted 1, got %d" (car greeting))) (message "%s" (car (cdr greeting)))) (delete-region (point-min) last-char)))) ;; Make sure ispell is ready for a command. ;; Leaves buffer set to *ispell*, point at '='. (defun ispell-sync (intr) (if (or (null ispell-process) (not (eq (process-status ispell-process) 'run))) (start-ispell)) (if intr (interrupt-process ispell-process)) (let (last-char) (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (setq last-char (- (point-max) 1)) (while (not (eq (char-after last-char) ?=)) (accept-process-output ispell-process) (setq last-char (- (point-max) 1))) (goto-char last-char))) ;; 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 (defun ispell-cmd (&rest strings) (save-excursion (ispell-sync t) (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (erase-buffer) (setq ispell-next-message (point-min)) (while strings (process-send-string ispell-process (car strings)) (setq strings (cdr strings))) (process-send-string ispell-process "\n") (accept-process-output ispell-process) (ispell-sync nil))) (defun ispell-dump () (cond (ispell-dump-needed (setq ispell-dump-needed nil) (ispell-cmd ":dump")))) (defun ispell-insert (word) (ispell-cmd ":insert " word) (if ispell-bad-words (setq ispell-recently-accepted (cons word ispell-recently-accepted))) (setq ispell-dump-needed t)) (defun ispell-accept (word) (ispell-cmd ":accept " word) (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 () (save-excursion (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (save-restriction (goto-char ispell-next-message) (narrow-to-region (point) (progn (forward-sexp 1) (point))) (setq ispell-next-message (point)) (goto-char (point-min)) (read (current-buffer))))) (defun ispell-tex-buffer-p () (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)) (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 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 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 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. SPACE Accept the word this time, but complain if it is seen again. q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]." (interactive) (if (null start) (setq start 0)) (if (null end) (setq end 0)) (if (null buf) (setq buf (current-buffer))) (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)) (unwind-protect (progn (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)) ((and (buffer-modified-p buf) (y-or-n-p (format "Save file %s? " filename))) (save-buffer))) (message "Ispell scanning file...") (if (and ispell-enable-tex-parser (ispell-tex-buffer-p)) (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))))) (message "Parsing ispell output ...") (ispell-flush-bad-words) (let (pos bad-words) (while (numberp (setq pos (ispell-next-message))) ;;ispell may check the words on the line following the end ;;of the region - therefore, don't record anything out of range (if (or (= end 0) (< pos end)) (setq bad-words (cons (set-marker (make-marker) (+ pos 1)) bad-words)))) (setq bad-words (cons 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.") t) (t (message "Ispell parsing done.") (ispell-next)))) ;;;autoload (defalias 'ispell-buffer 'ispell) (defun ispell-next () "Resume command loop for most recent Ispell command. Return value is t unless exit is due to typing `q'." (interactive) (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))) 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 (&optional resume) "Check the spelling of the word under the cursor. 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") (ispell (current-buffer) start end)) (defun ispell-letterp (c) (and c (or (and (>= c ?A) (<= c ?Z)) (and (>= c ?a) (<= c ?z)) (>= c 128)))) (defun ispell-letter-or-quotep (c) (and c (or (and (>= c ?A) (<= c ?Z)) (and (>= c ?a) (<= c ?z)) (= c ?') (>= c 128)))) (defun ispell-find-word-start () ;;backward to a letter (if (not (ispell-letterp (char-after (point)))) (while (and (not (bobp)) (not (ispell-letterp (char-after (- (point) 1))))) (backward-char))) ;;backward to beginning of word (while (ispell-letter-or-quotep (char-after (- (point) 1))) (backward-char)) (skip-chars-forward "'")) (defun ispell-find-word-end () (while (ispell-letter-or-quotep (char-after (point))) (forward-char)) (skip-chars-backward "'")) (defun ispell-next-word () (while (and (not (eobp)) (not (ispell-letterp (char-after (point))))) (forward-char))) ;if end is nil, then do one word at start ;otherwise, do all words from the beginning of the word where ;start points, to the end of the word where end points (defun ispell-point (start message) (let ((wend (make-marker)) rescan end) ;; 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)) ;; 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) ;;; 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*"))) (cond (buf (set-buffer buf) (erase-buffer)))) (set-marker start nil) (set-marker end nil) (set-marker wend nil))) (defun ispell-still-bad (word) (let ((words ispell-recently-accepted) (ret t) (case-fold-search t)) (while words (cond ((eq (string-match (car words) word) 0) (setq ret nil) (setq words nil))) (setq words (cdr words))) ret)) (defun ispell-show-choices (word message first-line) ;;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 (unwind-protect (progn (select-window w) (enlarge-window (- 6 (window-height w)))) (select-window selwin))) (save-excursion (set-buffer buf) (bury-buffer buf) (set-window-point w (point-min)) (set-window-start w (point-min)) (erase-buffer) (insert first-line "\n") (insert "SPC skip; A accept; I insert; DIGIT select; R replace; \ L lookup; Q quit\n") (cond ((not (null message)) (let ((i 0)) (while (< i 3) (let ((j 0)) (while (< j 3) (let* ((n (+ (* j 3) i)) (choice (nth n message))) (cond (choice (let ((str (format "%d %s" n choice))) (insert str) (insert-char ? (- 20 (length str))))))) (setq j (+ j 1)))) (insert "\n") (setq i (+ i 1))))))))) (defun ispell-command-loop (word start end message) (let ((flag t) (rescan nil) first-line) (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) (<= c ?9) (setq replacement (nth (- c ?0) message))) (ispell-replace start end replacement) (setq flag nil)) ((= c ?q) (throw 'ispell-quit nil)) ((= c (nth 3 (current-input-mode))) (keyboard-quit)) ((= c ? ) (setq flag nil)) ((= c ?r) (ispell-replace start end (read-string "Replacement: ")) (setq rescan t) (setq flag nil)) ((= c ?i) (ispell-insert word) (setq flag nil)) ((= c ?a) (ispell-accept word) (setq flag nil)) ((= c ?l) (let ((val (ispell-do-look word))) (setq first-line (car val)) (setq message (cdr val)))) ((= c ??) (message "Type 'C-h d ispell' to the emacs main loop for more help") (sit-for 2)) (t (message "Bad ispell command") (sit-for 2))))) rescan)) (defun ispell-do-look (bad-word) (let (regex buf words) (cond ((null ispell-have-new-look) (setq regex (read-string "Lookup: "))) (t (setq regex (read-string "Lookup (regex): " "^")))) (setq buf (get-buffer-create "*ispell look*")) (save-excursion (set-buffer buf) (delete-region (point-min) (point-max)) (if ispell-have-new-look (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)) (goto-char (point-min)) (while (not (= (point-min) (point-max))) (end-of-line) (setq words (cons (buffer-substring (point-min) (point)) words)) (forward-line) (delete-region (point-min) (point))) (kill-buffer buf) (cons (format "Lookup '%s'" regex) (reverse words))))) (defun ispell-replace (start end new) (goto-char start) (insert new) (delete-region (point) end)) (defun reload-ispell () "Tell Ispell to re-read your private dictionary." (interactive) (ispell-cmd ":reload")) (defun batch-make-ispell () (byte-compile-file "ispell.el") (find-file "ispell.texinfo") (let ((old-dir default-directory) (default-directory "/tmp")) (texinfo-format-buffer)) (Info-validate) (if (get-buffer " *problems in info file*") (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))))) ;; 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