Mercurial > emacs
view lisp/textmodes/=ispell4.el @ 3946:535f1f575d04
(set-visited-file-name): Rename auto-save file only if it exists.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 01 Jul 1993 20:33:56 +0000 |
parents | c9938769a6b7 |
children | 6228decc1353 |
line wrap: on
line source
;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 4. ;;Copyright (C) 1990, 1991 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, 675 Mass Ave, Cambridge, MA 02139, 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 use this to specify the name of your private dictionary. The -S option is always passed to Ispell as the last parameter, and need not be mentioned here.") ;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) ;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 (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 `~/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))) ;;;###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 (kept in `$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. (if transient-mark-mode (progn (setq mark-active nil) (run-hooks 'deactivate-mark-hook))) (save-excursion (set-buffer buf) (let ((filename buffer-file-name) (delete-temp nil)) (unwind-protect (progn (cond ((null filename) (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 (message "Ispell parsing done.") (ispell-next)))) ;;;###autoload (defalias 'ispell-buffer 'ispell) (defun ispell-next () "Resume command loop for most recent Ispell command." (interactive) (setq ispell-window-configuration nil) (unwind-protect (catch '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)))) (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 (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 (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 (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)) (if (>= start end) (error "No word %s" message)) (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 (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))))) ;;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 "'"))) (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 'quit nil)) ((= 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 "look" nil buf nil "-r" regex) (call-process "look" 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")) (provide 'ispell) ;;; ispell.el ends here