]> code.delx.au - gnu-emacs/blobdiff - lisp/textmodes/ispell.el
(reporter-dont-compact-list): Doc fix.
[gnu-emacs] / lisp / textmodes / ispell.el
index f010c364c651d9224360b370a12c2772a9b4b080..8064b5e0582d51966e637d9cfc0c6eb16e7cc501 100644 (file)
@@ -1,18 +1,20 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: emacs-lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; GNU EMACS interface for International Ispell Version 3.1 by Geoff Kuenning.
-;;;
-;;;
-;;; Copyright (C) 1994 Free Software Foundation, Inc.
-;;;
-;;;
+;;; ispell.el --- spell checking using Ispell
+
+;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+
 ;;; Authors         : Ken Stevens <k.stevens@ieee.org>
-;;; Last Modified On: Thu Dec  8 13:17:41 EST 1994
-;;; Update Revision : 2.34
+;;; Note: version numbers and time stamp are not updated
+;;;   when this file is edited for release with GNU Emacs.
+;;; Last Modified On: Tue Jun 13 12:05:28 EDT 1995
+;;; Update Revision : 2.37
 ;;; Syntax          : emacs-lisp
 ;;; Status         : Release with 3.1.12+ ispell.
 ;;; Version        : International Ispell Version 3.1 by Geoff Kuenning.
 ;;; Bug Reports            : ispell-el-bugs@itcorp.com
-;;;
+
+;;; Note: version numbers and time stamp are not updated
+;;;   when this file is edited for release with GNU Emacs.
+
 ;;; This file is part of GNU Emacs.
 ;;;
 ;;; GNU Emacs is free software; you can redistribute it and/or modify
 ;;;
 ;;; HISTORY
 ;;;
+;;; Revision 2.37  1995/6/13 12:05:28  stevens
+;;; Removed autoload from ispell-dictionary-alist. *choices* mode-line shows
+;;; misspelled word.  Block skip for pgp & forwarded messages added.
+;;; RMS: the autoload changes had problems and I removed them.
+;;;
+;;; Revision 2.36  1995/2/6 17:39:38   stevens
+;;; Properly adjust screen with different ispell-choices-win-default-height
+;;; settings.  Skips SGML entity references.
+;;;
+;;; Revision 2.35  1995/1/13 14:16:46  stevens
+;;; Skips SGML tags, ispell-change-dictionary fix for add-hook, assure personal
+;;; dictionary is saved when called from the menu
+;;;
 ;;; Revision 2.34  1994/12/08 13:17:41  stevens
 ;;; Interaction corrected to function with all 3.1 ispell versions.
 ;;;
@@ -399,6 +414,7 @@ Otherwise use the minibuffer.")
   "*Formatting function for displaying word being spell checked.
 The function must take one string argument and return a string.")
 
+;;;###autoload
 (defvar ispell-personal-dictionary nil
   "*File name of your personal spelling dictionary, or nil.
 If nil, the default personal dictionary, \"~/.ispell_DICTNAME\" is used,
@@ -425,6 +441,10 @@ For example, '(\"-W\" \"3\") to cause it to accept all 1-3 character
 words as correct.  See also `ispell-dictionary-alist', which may be used
 for language-specific arguments.")
 
+;;; The preparation of the menu bar menu must be autoloaded
+;;; because otherwise this file gets autoloaded every time Emacs starts
+;;; so that it can set up the menus and determine keyboard equivalents.
+
 ;;;###autoload
 (defvar ispell-dictionary-alist-1      ; sk  9-Aug-1991 18:28
   '((nil                               ; default (english.aff)
@@ -518,7 +538,6 @@ Note that the CASECHARS and OTHERCHARS slots of the alist should
 contain the same character set as casechars and otherchars in the
 language.aff file \(e.g., english.aff\).")
 
-
 ;;;###autoload
 (defvar ispell-menu-map nil "Key map for ispell menu")
 
@@ -531,11 +550,13 @@ language.aff file \(e.g., english.aff\).")
 ;;;###autoload
 (defconst ispell-menu-map-needed       ; make sure this is not Lucid Emacs
   (and (not ispell-menu-map)
-       ;; make sure this isn't Lucid Emacs
-       (featurep 'menu-bar) (string-lessp "19" emacs-version)))
+;;; This is commented out because it fails in Emacs.
+;;; due to the fact that menu-bar is loaded much later than loaddefs.
+;;;       ;; make sure this isn't Lucid Emacs
+;;;       (featurep 'menu-bar)
+       (not (string-match "Lucid" emacs-version))))
 
-
-;;; setup dictionary
+;;; Set up dictionary
 ;;;###autoload
 (if ispell-menu-map-needed
     (let ((dicts (reverse (cons (cons "default" nil) ispell-dictionary-alist)))
@@ -560,7 +581,7 @@ language.aff file \(e.g., english.aff\).")
       (define-key ispell-menu-map [ispell-kill-ispell]
        '("Kill Process" . ispell-kill-ispell))
       (define-key ispell-menu-map [ispell-pdict-save]
-       '("Save Dictionary" . (lambda () (interactive) (ispell-pdict-save t))))
+       '("Save Dictionary" . (lambda () (interactive) (ispell-pdict-save t t))))
       (define-key ispell-menu-map [ispell-complete-word]
        '("Complete Word" . ispell-complete-word))
       (define-key ispell-menu-map [ispell-complete-word-interior-frag]
@@ -606,7 +627,7 @@ language.aff file \(e.g., english.aff\).")
             ["Complete Word"   ispell-complete-word            t]
             ["Kill Process"    ispell-kill-ispell              t]
             "-"
-            ["Save Dictionary" (ispell-pdict-save t)           t]
+            ["Save Dictionary" (ispell-pdict-save t t)         t]
             ["Change Dictionary" ispell-change-dictionary      t]))
          name)
       (while dicts
@@ -631,7 +652,7 @@ language.aff file \(e.g., english.aff\).")
 
 
 ;;; The version must be 3.1 or greater for this version of ispell.el
-;;; There is an incompatibility between versin 3.1.12 and lower versions.
+;;; There is an incompatibility between version 3.1.12 and lower versions.
 (defconst ispell-required-version '("3.1." 12)
   "Ispell versions with which this version of ispell.el is known to work.")
 (defvar ispell-offset 1
@@ -720,6 +741,10 @@ The above keyword string should be followed by `latex-mode' or
 Extended character mode can be changed for this buffer by placing
 a `~' followed by an extended-character mode -- such as `~.tex'.")
 
+(defvar ispell-skip-sgml nil
+  "Skips spell checking of SGML tags and entity references when non-nil.
+This variable is set when major-mode is sgml-mode or html-mode.")
+
 (defvar ispell-local-pdict ispell-personal-dictionary
   "A buffer local variable containing the current personal dictionary.
 If non-nil, the value must be a string, which is a file name.
@@ -760,10 +785,12 @@ You can set this variable in hooks in your init file -- eg:
 ;;; **********************************************************************
 
 
-(if (string-lessp "19" emacs-version)
-    (defalias 'ispell 'ispell-buffer))
+(and (string-lessp "19" emacs-version)
+     (not (boundp 'epoch::version))
+     (defalias 'ispell 'ispell-buffer))
 
-;;;###autoload (define-key global-map "\M-$" 'ispell-word)
+;;;###autoload
+(define-key global-map "\M-$" 'ispell-word)
 
 ;;;###autoload
 (defun ispell-word (&optional following quietly continue)
@@ -921,7 +948,9 @@ If so, ask if it needs to be saved."
       (setq ispell-pdict-modified-p (car ispell-pdict-modified-p)))
   (if (or ispell-pdict-modified-p force-save)
       (if (or no-query (y-or-n-p "Personal dictionary modified.  Save? "))
-         (process-send-string ispell-process "#\n")))
+         (progn
+           (process-send-string ispell-process "#\n")
+           (message "Personal dictionary saved."))))
   ;; unassert variable, even if not saved to avoid questioning.
   (setq ispell-pdict-modified-p nil))
 
@@ -951,7 +980,7 @@ used."
     ;; setup the *Choices* buffer with valid data.
     (save-excursion
       (set-buffer (get-buffer-create ispell-choices-buffer))
-      (setq mode-line-format "--  %b  --")
+      (setq mode-line-format (concat "--  %b  --  word: " word))
       (erase-buffer)
       (if guess
          (progn
@@ -993,19 +1022,23 @@ used."
     ;; Display choices for misspelled word.
     (let ((choices-window (get-buffer-window ispell-choices-buffer)))
       (if choices-window
-         (if (not (equal line (window-height choices-window)))
-             ;; *Choices* window changed size.  Adjust the choices window
-             ;; without scrolling the spelled window when possible
-             (let ((window-line (- line (window-height choices-window)))
-                   (visible (progn (forward-line -1) (point))))
-               (move-to-window-line 0)
-               (forward-line window-line)
-               (set-window-start (selected-window)
-                                 (if (> (point) visible) visible (point)))
-               (goto-char end)
-               (select-window (previous-window)) ; *Choices* window
-               (enlarge-window window-line))
-           (select-window choices-window))
+         (if (= line (window-height choices-window))
+             (select-window choices-window)
+           ;; *Choices* window changed size.  Adjust the choices window
+           ;; without scrolling the spelled window when possible
+           (let ((window-line (- line (window-height choices-window)))
+                 (visible (progn (forward-line -1) (point))))
+             (if (< line ispell-choices-win-default-height)
+                 (setq window-line (+ window-line
+                                      (- ispell-choices-win-default-height
+                                         line))))
+             (move-to-window-line 0)
+             (forward-line window-line)
+             (set-window-start (selected-window)
+                               (if (> (point) visible) visible (point)))
+             (goto-char end)
+             (select-window (previous-window)) ; *Choices* window
+             (enlarge-window window-line)))
        ;; Overlay *Choices* window when it isn't showing
        (ispell-overlay-window (max line ispell-choices-win-default-height)))
       (switch-to-buffer ispell-choices-buffer)
@@ -1100,7 +1133,9 @@ used."
                              (erase-buffer)
                              (setq count ?0
                                    skipped 0
-                                   mode-line-format "--  %b  --"
+                                   mode-line-format (concat
+                                                     "--  %b  --  word: "
+                                                     new-word)
                                    miss (lookup-words new-word)
                                    choices miss)
                              (while (and choices ; adjust choices window.
@@ -1122,11 +1157,19 @@ used."
                                      count (1+ count)))
                              (setq count (- count ?0 skipped)))
                            (select-window (previous-window))
-                           (if (/= new-line line)
-                               (progn
+                           (if (and (/= new-line line)
+                                    (> (max line new-line)
+                                       ispell-choices-win-default-height))
+                               (let* ((minh ispell-choices-win-default-height)
+                                      (gr-bl (if (< line minh) ; blanks
+                                                 (- minh line)
+                                               0))
+                                      (shr-bl (if (< new-line minh) ; blanks
+                                                  (- minh new-line)
+                                                0)))
                                  (if (> new-line line)
-                                     (enlarge-window (- new-line line))
-                                   (shrink-window (- line new-line)))
+                                     (enlarge-window (- new-line line gr-bl))
+                                   (shrink-window (- line new-line shr-bl)))
                                  (setq line new-line)))
                            (select-window (next-window)))))
                    t)                  ; reselect from new choices
@@ -1443,13 +1486,13 @@ scrolling the current window.  Leave the new window selected."
   ;; all versions, since versions earlier than 3.0.09 didn't identify
   ;; themselves on startup.
   (save-excursion
-    (set-buffer (get-buffer-create " *ispell-tmp*"))
-    (erase-buffer)
-    ;; Avoid obscure bugs caused by users who change the syntax of `.' in
-    ;; whatever default major mode the user uses, e.g. text mode
-    (set-syntax-table (standard-syntax-table))
-    (let ((status (call-process ispell-program-name nil t nil "-v"))
-         (case-fold-search t))
+    (let ((case-fold-search t)
+         ;; avoid bugs when syntax of `.' changes in various default modes
+         (default-major-mode 'fundamental-mode)
+         status)
+      (set-buffer (get-buffer-create " *ispell-tmp*"))
+      (erase-buffer)
+      (setq status (call-process ispell-program-name nil t nil "-v"))
       (goto-char (point-min))
       (if (not (memq status '(0 nil)))
          (error "%s exited with %s %s" ispell-program-name
@@ -1513,9 +1556,14 @@ scrolling the current window.  Leave the new window selected."
     (accept-process-output ispell-process) ; Get version ID line
     (cond ((null ispell-filter)
           (error "%s did not output version line" ispell-program-name))
-         ((and (null (cdr ispell-filter))
-               (stringp (car ispell-filter))
-               (string-match "^@(#) " (car ispell-filter)))
+         ((and
+           (stringp (car ispell-filter))
+           (if (string-match "warning: " (car ispell-filter))
+               (progn
+                 (accept-process-output ispell-process 5) ; 1st was warn msg.
+                 (stringp (car ispell-filter)))
+             (null (cdr ispell-filter)))
+           (string-match "^@(#) " (car ispell-filter)))
           ;; got the version line as expected (we already know it's the right
           ;; version, so don't bother checking again.)
           nil)
@@ -1548,6 +1596,9 @@ With NO-ERROR, just return non-nil if there was no Ispell running."
     nil))
 
 
+;;; ispell-change-dictionary is set in some people's hooks.  Maybe this should
+;;;  call ispell-init-process rather than wait for a spell checking command?
+
 ;;;###autoload
 (defun ispell-change-dictionary (dict &optional arg)
   "Change `ispell-dictionary' (q.v.) and kill old Ispell process.
@@ -1567,9 +1618,11 @@ With prefix argument, set the default directory."
         (message "Using %s dictionary"
                  (or ispell-local-dictionary ispell-dictionary "default")))
        ((and (equal dict ispell-dictionary)
-             (equal dict ispell-local-dictionary))
+             (or (null ispell-local-dictionary)
+                 (equal dict ispell-local-dictionary)))
         ;; Specified dictionary is the default already.  No-op
-        (message "No change, using %s dictionary" (or dict "default")))
+        (and (interactive-p)
+             (message "No change, using %s dictionary" (or dict "default"))))
        (t                              ; reset dictionary!
         (if (assoc dict ispell-dictionary-alist)
             (progn
@@ -1607,7 +1660,8 @@ With prefix argument, set the default directory."
        ;; Returns cursor to original location.
        (save-window-excursion
          (goto-char reg-start)
-         (let ((transient-mark-mode nil))
+         (let ((transient-mark-mode nil)
+               ref-type)
            (while (and (not ispell-quit) (< (point) reg-end))
              (let ((start (point))
                    (offset-change 0)
@@ -1642,23 +1696,41 @@ With prefix argument, set the default directory."
                                        "\n")
                                offset-change (- offset-change ispell-offset)))
                      (goto-char limit))))
-                ((and ispell-skip-tib  ; SKIP TIB REFERENCES!
-                      (re-search-forward ispell-tib-ref-beginning end t))
-                 (if (= (- (point) 2) start) ; tib ref is 2 chars.
-                     ;; Skip to end of tib ref, not necessarily on this line.
-                     ;; Return an error if tib ref not found
-                     (if (not(re-search-forward ispell-tib-ref-end reg-end t))
+                ((looking-at "[---#@*+!%~^]") ; SKIP SPECIAL ISPELL CHARACTERS
+                 (forward-char 1))
+                ((or (and ispell-skip-tib ; SKIP TIB REFERENCES OR SGML MARKUP
+                          (re-search-forward ispell-tib-ref-beginning end t)
+                          (setq ref-type 'tib))
+                     (and ispell-skip-sgml
+                          (search-forward "[<&]" end t)
+                          (setq ref-type 'sgml)))
+                 (if (or (and (eq 'tib ref-type) ; tib tag is 2 chars.
+                              (= (- (point) 2) start))
+                         (and (eq 'sgml ref-type) ; sgml skips 1 char.
+                              (= (- (point) 1) start)))
+                     ;; Skip to end of reference, not necessarily on this line
+                     ;; Return an error if tib/sgml reference not found
+                     (if (or
+                          (and
+                           (eq 'tib ref-type)
+                           (not
+                            (re-search-forward ispell-tib-ref-end reg-end t)))
+                          (and (eq 'sgml ref-type)
+                               (not (search-forward "[>;]" reg-end t))))
                          (progn
                            (ispell-pdict-save ispell-silently-savep)
                            (ding)
                            (message
                             (concat
-                             "Open tib reference--set `ispell-skip-tib'"
-                             " to nil to avoid this error"))
+                             "Open tib or SGML command.  Fix buffer or set "
+                             (if (eq 'tib ref-type)
+                                 "ispell-skip-tib"
+                               "ispell-skip-sgml")
+                             " to nil"))
                            ;; keep cursor at error location
                            (setq ispell-quit (- (point) 2))))
-                   ;; tib ref starts later on line. Check spelling before tib.
-                   (let ((limit (- (point) 2)))
+                   ;; Check spelling between reference and start of the line.
+                   (let ((limit (- (point) (if (eq 'tib ref-type) 2 1))))
                      (goto-char start)
                      (if (or (re-search-forward ispell-casechars limit t)
                              (re-search-forward "[][()$]" limit t))
@@ -1667,8 +1739,6 @@ With prefix argument, set the default directory."
                                        "\n")
                                offset-change (- offset-change ispell-offset)))
                      (goto-char limit))))
-                ((looking-at "[---#@*+!%~^]") ; SKIP SPECIAL ISPELL CHARACTERS
-                 (forward-char 1))
                 ((or (re-search-forward ispell-casechars end t) ; TEXT EXISTS
                      (re-search-forward "[][()$]" end t)) ; or MATH COMMANDS
                  (setq string (concat "^" (buffer-substring start end) "\n")
@@ -1713,6 +1783,8 @@ With prefix argument, set the default directory."
                                   (concat "Ispell misalignment: word "
                                           "`%s' point %d; please retry")
                                   (car poss) word-start))
+                              (if (not (pos-visible-in-window-p))
+                                  (sit-for 0))
                              (if ispell-keep-choices-win
                                  (setq replace
                                        (ispell-command-loop
@@ -1952,7 +2024,7 @@ warns you if the previous word is incorrectly spelled."
   (setq ispell-minor-mode
        (not (or (and (null arg) ispell-minor-mode)
                 (<= (prefix-numeric-value arg) 0))))
-  (set-buffer-modified-p (buffer-modified-p)))
+  (force-mode-line-update))
  
 (defun ispell-minor-check ()
   ;; Check previous word then continue with the normal binding of this key.
@@ -1975,21 +2047,50 @@ warns you if the previous word is incorrectly spelled."
   (mapconcat (function identity)
             '(
               ;; Matches postscript files.
-              "^%!PS-Adobe-[23].0"
+              "^%!PS-Adobe-[123].0"
               ;; Matches uuencoded text
               "^begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM"
               ;; Matches shell files (esp. auto-decoding)
               "^#! /bin/[ck]?sh"
               ;; Matches context difference listing
               "\\(diff -c .*\\)?\n\\*\\*\\* .*\n--- .*\n\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*"
+               ;; Matches reporter.el bug report
+               "^current state:\n==============\n"
               ;; Matches "----------------- cut here"
-              "^[-=_]+\\s ?cut here")
+              ;; and "------- Start of forwarded message"
+              "^[-=_]+\\s ?\\(cut here\\|Start of forwarded message\\)")
             "\\|")
   "*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-start-skip
+  (mapconcat (function identity)
+            '(
+              ;; Matches forwarded messages
+              "^---* Forwarded Message"
+              ;; Matches PGP Public Key block
+              "^---*BEGIN PGP [A-Z ]*--*"
+              )
+            "\\|")
+  "Spelling is skipped inside these start/end groups by ispell-message.
+Assumed that blocks are not mutually inclusive.")
+
+
+(defvar ispell-message-end-skip
+  (mapconcat (function identity)
+            '(
+              ;; Matches forwarded messages
+              "^--- End of Forwarded Message"
+              ;; Matches PGP Public Key block
+              "^---*END PGP [A-Z ]*--*"
+              )
+            "\\|")
+  "Spelling is skipped inside these start/end groups by ispell-message.
+Assumed that blocks are not mutually inclusive.")
+
+
 ;;;###autoload
 (defun ispell-message ()
   "Check the spelling of a mail message or news post.
@@ -2078,21 +2179,36 @@ You can bind this to the key C-c i in GNUS or mail by adding to
        (forward-line 1))
       (setq case-fold-search nil)
       ;; Skip mail header, particularly for non-english languages.
-      (if (looking-at mail-header-separator)
+      (if (looking-at (concat (regexp-quote mail-header-separator) "$"))
          (forward-line 1))
       (while (< (point) limit)
        ;; Skip across text cited from other messages.
        (while (and (looking-at cite-regexp-start)
                    (< (point) limit)
                    (zerop (forward-line 1))))
+
        (if (< (point) limit)
-           ;; Check the next batch of lines that *aren't* cited.
-           (let ((end (save-excursion
-                        (if (re-search-forward cite-regexp-end limit 'end)
-                            (match-beginning 0)
-                          (marker-position limit)))))
-             (ispell-region (point) end)
-             (goto-char end))))
+           (let* ((start (point))
+                  ;; Check the next batch of lines that *aren't* cited.
+                  (end-c (and (re-search-forward cite-regexp-end limit 'end)
+                              (match-beginning 0)))
+                  ;; Skip a block of included text.
+                  (end-fwd (and (goto-char start)
+                                (re-search-forward ispell-message-start-skip
+                                                   limit 'end)
+                                (progn (beginning-of-line)
+                                       (point))))
+                  (end (or (and end-c end-fwd (min end-c end-fwd))
+                           end-c end-fwd
+                           ;; defalut to limit of text.
+                           (marker-position limit))))
+             (goto-char start)
+             (ispell-region start end)
+             (if (and end-fwd (= end end-fwd))
+                 (progn
+                   (goto-char end)
+                   (re-search-forward ispell-message-end-skip limit 'end))
+               (goto-char end)))))
       (set-marker limit nil))))
 
 
@@ -2126,6 +2242,8 @@ Includes latex/nroff modes and extended character mode."
          (eq ispell-parser 'tex))
       (process-send-string ispell-process "+\n") ; set ispell mode to tex
     (process-send-string ispell-process "-\n"))        ; set mode to normal (nroff)
+  ;; Hard-wire test for SGML & HTML mode.
+  (setq ispell-skip-sgml (memq major-mode '(sgml-mode html-mode)))
   ;; Set default extended character mode for given buffer, if any.
   (let ((extended-char-mode (ispell-get-extended-character-mode)))
     (if extended-char-mode
@@ -2249,7 +2367,7 @@ Both should not be used to define a buffer-local dictionary."
   reg-end)
 
 
-(defconst ispell-version "2.34 -- Thu Dec  8 13:17:41 EST 1994")
+(defconst ispell-version "2.37 -- Tue Jun 13 12:05:28 EDT 1995")
 
 (provide 'ispell)