home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / ispell.el < prev    next >
Encoding:
Text File  |  1993-03-31  |  38.7 KB  |  978 lines
  1. ;;; Spelling correction interface for GNU EMACS "ispell"
  2. ;;; Id: ispell.el,v 2.20 1993/03/31  00:32:53  jwz Exp 
  3. ;;;
  4. ;;; Log: ispell.el,v 
  5. ;;; Revision 2.20  1993/03/31  00:32:53  jwz
  6. ;;; Added Lucid Emacs support. 
  7. ;;; Added version checking to detect mismatches between ispell.el and
  8. ;;; ispell.c instead of failing silently.
  9. ;;; Added a save-excursion to ispell-word so that it doesn't move the
  10. ;;; cursor to the beginning of the word, which was just too damn annoying.
  11. ;;; Made it position the cursor at the end of the word instead of the
  12. ;;; beginning, since that looks better.
  13. ;;; ispell-complete (really, lookup-words) didn't work for me at all,
  14. ;;; so I rewrote it in a simpler way.
  15. ;;;
  16. ;;; Revision 2.19  1992/01/10  10:54:08  geoff
  17. ;;; Make another attempt at fixing the "Bogus, dude" problem.  This one is
  18. ;;; less elegant, but has the advantage of working.
  19. ;;;
  20. ;;; Revision 2.18  1992/01/07  10:04:52  geoff
  21. ;;; Fix the "Bogus, Dude" problem in ispell-word.
  22. ;;;
  23. ;;; Revision 2.17  91/09/12  00:01:42  geoff
  24. ;;; Add some changes to make ispell-complete-word work better, though
  25. ;;; still not perfectly.
  26. ;;; 
  27. ;;; Revision 2.16  91/09/04  18:00:52  geoff
  28. ;;; More updates from Sebastian, to make the multiple-dictionary support
  29. ;;; more flexible.
  30. ;;; 
  31. ;;; Revision 2.15  91/09/04  17:30:02  geoff
  32. ;;; Sebastian Kremer's tib support
  33. ;;; 
  34. ;;; Revision 2.14  91/09/04  16:19:37  geoff
  35. ;;; Don't do set-window-start if the move-to-window-line moved us
  36. ;;; downward, rather than upward.  This prevents getting the buffer all
  37. ;;; confused.  Also, don't use the "not-modified" function to clear the
  38. ;;; modification flag;  instead use set-buffer-modified-p.  This prevents
  39. ;;; extra messages from flashing.
  40. ;;; 
  41. ;;; Revision 2.13  91/09/04  14:35:41  geoff
  42. ;;; Fix a spelling error in a comment.  Add code to handshake with the
  43. ;;; ispell process before sending anything to it.
  44. ;;; 
  45. ;;; Revision 2.12  91/09/03  20:14:21  geoff
  46. ;;; Add Sebastian Kremer's multiple-language support.
  47. ;;; 
  48.  
  49. ;;; Walt Buehring
  50. ;;; Texas Instruments - Computer Science Center
  51. ;;; ARPA:  Buehring%TI-CSL@CSNet-Relay
  52. ;;; UUCP:  {smu, texsun, im4u, rice} ! ti-csl ! buehring
  53.  
  54. ;;; ispell-region and associated routines added by
  55. ;;; Perry Smith
  56. ;;; pedz@bobkat
  57. ;;; Tue Jan 13 20:18:02 CST 1987
  58.  
  59. ;;; extensively modified by Mark Davies and Andrew Vignaux
  60. ;;; {mark,andrew}@vuwcomp
  61. ;;; Sun May 10 11:45:04 NZST 1987
  62.  
  63. ;;; This file has overgone a major overhaul to be compatible with ispell
  64. ;;; version 2.1.  Most of the functions have been totally rewritten, and
  65. ;;; many user-accessible variables have been added.  The syntax table has
  66. ;;; been removed since it didn't work properly anyway, and a filter is
  67. ;;; used rather than a buffer.  Regular expressions are used based on
  68. ;;; ispell's internal definition of characters (see ispell(4)).
  69. ;;; Ken Stevens     ARPA: stevens@hplabs.hp.com    UUCP: hplabs!stevens
  70. ;;; Tue Jan  3 16:59:07 PST 1989
  71. ;;; Some new updates:
  72. ;;; - Updated to version 3.0 to include terse processing.
  73. ;;; - Added a variable for the look command.
  74. ;;; - Fixed a bug in ispell-word when cursor is far away from the word
  75. ;;;   that is to be checked.
  76. ;;; - Ispell places the incorrect word or guess in the minibuffer now.
  77. ;;; - fixed a bug with 'l' option when multiple windows are on the screen.
  78. ;;; - lookup-words just didn't work with the process filter.  Fixed.
  79. ;;; - Rewrote the process filter to make it cleaner and more robust
  80. ;;;   in the event of a continued line not being completed.
  81. ;;; - Made ispell-init-process more robust in handling errors.
  82. ;;; - Fixed bug in continuation location after a region has been modified by
  83. ;;;   correcting a misspelling.
  84. ;;; Mon 17 Sept 1990
  85.  
  86. ;;; Sebastian Kremer <sk@thp.uni-koeln.de>
  87. ;;; Wed Aug  7 14:02:17 MET DST 1991
  88. ;;; - Ported ispell-complete-word from Ispell 2 to Ispell 3.
  89. ;;; - Added ispell-kill-ispell command.
  90. ;;; - Added ispell:dictionary and ispell:dictionary-alist variables to
  91. ;;;   support other than default language.  See their docstrings and
  92. ;;;   command ispell-change-dictionary.
  93. ;;; - (ispelled it :-)
  94. ;;; - Added ispell:check-tib variable to support the tib bibliography
  95. ;;;   program.
  96.  
  97. ;;; To fully install this, add this file to your GNU lisp directory and 
  98. ;;; compile it with M-X byte-compile-file.  Then add the following to the
  99. ;;; appropriate init file:
  100.  
  101. ;;;  (autoload 'ispell-word "ispell"
  102. ;;;    "Check the spelling of word in buffer." t)
  103. ;;;  (global-set-key "\e$" 'ispell-word)
  104. ;;;  (autoload 'ispell-region "ispell"
  105. ;;;    "Check the spelling of region." t)
  106. ;;;  (autoload 'ispell-buffer "ispell"
  107. ;;;    "Check the spelling of buffer." t)
  108. ;;;  (autoload 'ispell-complete-word "ispell"
  109. ;;;    "Look up current word in dictionary and try to complete it." t)
  110. ;;;  (autoload 'ispell-change-dictionary "ispell"
  111. ;;;    "Change ispell dictionary." t)
  112.  
  113.  
  114. ;;; **********************************************************************
  115. ;;; The following variables should be set according to personal preference
  116. ;;; and location of binaries:
  117. ;;; **********************************************************************
  118.  
  119.  
  120. ;;;  ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.0
  121.  
  122. (defconst ispell:required-version "3.0.09")
  123.  
  124. ;;; Highlighting can slow down display at slow baud and emacs in
  125. ;;; X11 windows cannot take advantage of highlighting (yet).
  126. (defconst ispell:highlight-p t
  127.   "*When not nil, spelling errors will be highlighted.")
  128.  
  129. (defvar ispell:check-comments nil
  130.   "*When true, the spelling of comments in region is checked.")
  131.  
  132. (defvar ispell:check-tib nil
  133.   "*If non-nil, the spelling of references for the tib(1) bibliography
  134. program is checked.  Else any text between strings matching the regexps
  135. ispell:tib-ref-beginning and ispell:tib-ref-end is ignored, usually what
  136. you want.")
  137.  
  138. (defvar ispell:tib-ref-beginning "\\(\\[\\.\\)\\|\\(<\\.\\)"
  139.   "Regexp matching the beginning of a Tib reference.")
  140.  
  141. (defvar ispell:tib-ref-end "\\(\\.\\]\\)\\|\\(\\.\>\\)"
  142.   "Regexp matching the end of a Tib reference.")
  143.  
  144. (defvar ispell:keep-choices-win t
  145.   "*When true, the *Choices* window remains for spelling session.")
  146.  
  147. (defvar ispell:program-name "ispell"
  148.   "Program invoked by ispell-word and ispell-region commands.")
  149.  
  150. (defvar ispell:alternate-dictionary
  151.   (cond ((file-exists-p "/usr/dict/web2") "/usr/dict/web2")
  152.     ((file-exists-p "/sys/dict") "/sys/dict")
  153.     (t "/usr/dict/words"))
  154.   "Alternate dictionary for spelling help.")
  155.  
  156. (defvar ispell:grep-command "/usr/bin/egrep"
  157.   "Name of the grep command for search processes.")
  158.  
  159. (defvar ispell:look-command "/usr/bin/look"
  160.   "Name of the look command for search processes.")
  161.  
  162. (defvar ispell:dictionary nil
  163.   "If non-nil, a dictionary to use instead of the default one.
  164. This is passed to the ispell process using the \"-d\" switch and is
  165. used as key in ispell:dictionary-alist (which see).
  166.  
  167. You should set this variable before your first call to ispell (e.g. in
  168. your .emacs), or use the \\[ispell-change-dictionary] command to
  169. change it, as changing this variable only takes effect in a newly
  170. started ispell process.")
  171.  
  172. (defvar ispell:dictionary-alist        ; sk  9-Aug-1991 18:28
  173.   '((nil                ; default (english.aff) 
  174.      "[A-Za-z]" "[^A-Za-z]" "[---']" nil nil)
  175.     ("german"                ; german.aff
  176.      "[A-Za-z]" "[^A-Za-z]" "[---'\"]" t ("-C")) 
  177.     ;; add more dicts before this line
  178.     )
  179.   "An alist of dictionaries and their associated parameters.
  180.  
  181. Each element of this list is also a list:
  182.  
  183.     \(DICTIONARY-NAME
  184.         CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P
  185.         ISPELL-ARGS\)
  186.  
  187. DICTIONARY-NAME is a possible value of variable ispell:dictionary, nil
  188. means the default dictionary.
  189.  
  190. CASECHARS is a regular expression of valid characters that comprise a
  191. word.
  192.  
  193. NOT-CASECHARS is the opposite regexp of CASECHARS.
  194.  
  195. OTHERCHARS is a regular expression of other characters that are valid
  196. in word constructs.  Otherchars cannot be adjacent to each other in a
  197. word, nor can they begin or end a word.  This implies we can't check
  198. \"Stevens'\" as a correct possessive and other correct formations.
  199.  
  200. Hint: regexp syntax requires the hyphen to be declared first here.
  201.  
  202. MANY-OTHERCHARS-P is non-nil if many otherchars are to be allowed in a
  203. word instead of only one.
  204.  
  205. ISPELL-ARGS is a list of additional arguments passed to the ispell
  206. subprocess.
  207.  
  208. Note that the CASECHARS and OTHERCHARS slots of the alist should
  209. contain the same character set as casechars and otherchars in the
  210. language.aff file (e.g., english.aff).")
  211.  
  212. (defun ispell:get-casechars ()
  213.   (nth 1 (assoc ispell:dictionary ispell:dictionary-alist)))
  214. (defun ispell:get-not-casechars ()
  215.   (nth 2 (assoc ispell:dictionary ispell:dictionary-alist)))
  216. (defun ispell:get-otherchars ()
  217.   (nth 3 (assoc ispell:dictionary ispell:dictionary-alist)))
  218. (defun ispell:get-many-otherchars-p ()
  219.   (nth 4 (assoc ispell:dictionary ispell:dictionary-alist)))
  220. (defun ispell:get-ispell-args ()
  221.   (nth 5 (assoc ispell:dictionary ispell:dictionary-alist)))
  222.  
  223.  
  224. ;;; **********************************************************************
  225. ;;; The following are used by ispell, and should not be changed.
  226. ;;; **********************************************************************
  227.  
  228.  
  229. (defvar ispell-process nil
  230.   "Holds the process object for 'ispell'")
  231.  
  232. (defvar ispell:pdict-modified-p nil
  233.   "T when the personal dictionary has modifications that need to be written.")
  234.  
  235. (defvar ispell:quit nil
  236.   "Set to t when user want to abort ispell session.")
  237.  
  238. (defvar ispell:look-p t
  239.   "Use look. Automatically reset if look not available")
  240.  
  241. (defvar ispell:filter nil
  242.   "Output filter from piped calls to ispell.")
  243.  
  244. (defvar ispell:filter-continue nil
  245.   "Control variable for ispell filter function.")
  246.  
  247.  
  248.  
  249.  
  250. (defun ispell-word (&optional preceding quietly)
  251.   "Check spelling of word under or following the cursor.
  252. If word not found in dictionary, display possible corrections in a window 
  253. and let user select.
  254.   Optional argument PRECEDING set for checking preceding word when not
  255. over a word, and QUIETLY suppresses messages when word is correct.
  256.   Word syntax described by ispell:dictionary-alist (which see)."
  257.   (interactive)
  258.   (save-excursion
  259.   (let* ((ispell-casechars (ispell:get-casechars))
  260.      (ispell-not-casechars (ispell:get-not-casechars))
  261.      (ispell-otherchars (ispell:get-otherchars))
  262.      (ispell-many-otherchars-p (ispell:get-many-otherchars-p))
  263.      (word-regexp (concat ispell-casechars
  264.                   "+\\("
  265.                   ispell-otherchars
  266.                   "?"
  267.                   ispell-casechars
  268.                   "+\\)"
  269.                   (if ispell-many-otherchars-p "*" "?")))
  270.      did-it-once
  271.      ispell:keep-choices-win    ; override global to force creation
  272.      start end word poss replace)
  273.     (save-excursion
  274.       ;; find the word
  275.       (if (not (looking-at ispell-casechars))
  276.       (if preceding
  277.           (re-search-backward ispell-casechars (point-min) t)
  278.         (re-search-forward ispell-casechars (point-max) t)))
  279.       ;; move to front of word
  280.       (re-search-backward ispell-not-casechars (point-min) 'start)
  281.       (while (and (looking-at ispell-otherchars)
  282.           (not (bobp))
  283.           (or (not did-it-once)
  284.               ispell-many-otherchars-p))
  285.     (progn
  286.       (setq did-it-once t)
  287.       (backward-char 1)
  288.       (if (looking-at ispell-casechars)
  289.           (re-search-backward ispell-not-casechars (point-min) t)
  290.         (backward-char -1))))
  291.       ;; Now mark the word and save to string.
  292.       (or (re-search-forward word-regexp (point-max) t)
  293.       (error "No word found to check!"))
  294.       (setq start (match-beginning 0)
  295.         end (match-end 0)
  296.         word (buffer-substring start end)))
  297.     (goto-char end)
  298.     ;; now check spelling of word.
  299.     (or quietly (message "Checking spelling of %s..." (upcase word)))
  300.     (ispell-init-process)        ; erases ispell output buffer
  301.     (process-send-string ispell-process "%\n") ;put in verbose mode
  302.     (process-send-string ispell-process (concat "^" word "\n"))
  303.     ;; wait until ispell has processed word
  304.     (while (progn
  305.          (accept-process-output ispell-process)
  306.          (not (string= "" (car ispell:filter)))))
  307.     (process-send-string ispell-process "!\n") ;back to terse mode.
  308.     (setq ispell:filter (cdr ispell:filter))
  309.     (if (listp ispell:filter)
  310.     (setq poss (ispell-parse-output (car ispell:filter))))
  311.     (cond ((eq poss t)
  312.        (or quietly (message "Found %s" (upcase word))))
  313.       ((stringp poss)
  314.        (or quietly (message "Found %s because of root %s" (upcase word) (upcase poss))))
  315.       ((null poss) (message "Error in ispell process"))
  316.       (t
  317.        (unwind-protect
  318.            (progn
  319.          (if ispell:highlight-p
  320.              (highlight-spelling-error start end t)) ; highlight word
  321.          (setq replace (ispell-choose (car (cdr (cdr poss)))
  322.                           (car (cdr (cdr (cdr poss))))
  323.                           (car poss)))
  324.          ;; update ispell:pdict-modified-p
  325.          (if (listp ispell:pdict-modified-p)
  326.              (setq ispell:pdict-modified-p
  327.                (car ispell:pdict-modified-p))))
  328.          ;; protected
  329.          (if ispell:highlight-p  ; clear highlight
  330.          (highlight-spelling-error start end)))
  331.        (cond (replace
  332.           (goto-char end)
  333.           (delete-region start end)
  334.           (if (atom replace)
  335.               (insert-string replace)
  336.             (insert-string (car replace)) ; replacement string, recheck spelling.
  337.             (ispell-word t quietly))))
  338.        (if (get-buffer "*Choices*")
  339.            (kill-buffer "*Choices*"))))
  340.     (ispell-pdict-save)
  341.     (if ispell:quit (setq ispell:quit nil)))))
  342.  
  343.  
  344. (defun ispell-pdict-save ()
  345.   "Check to see if the personal dictionary has been modified.
  346.   If so, ask if it needs to be saved."
  347.   (interactive)
  348.   (if ispell:pdict-modified-p
  349.       (if (y-or-n-p "Personal dictionary modified.  Save? ")
  350.       (process-send-string ispell-process "#\n")))
  351.   (setq ispell:pdict-modified-p nil))        ; unassert variable, even if not saved to avoid questioning.
  352.  
  353.  
  354. ;;; Global ispell:pdict-modified-p is used to track changes in the dictionary.
  355. ;;;   The global becomes a list when we either accept or insert word into the dictionary.
  356. ;;;   The value of the only element in the list is the state of whether the dictionary
  357. ;;;   needs to be saved.
  358. (defun ispell-choose (miss guess word)
  359.   "Display possible corrections from list MISS.
  360.   GUESS lists possibly valid affix construction of WORD.
  361.   Returns nil to keep word.
  362.           string for new chosen word.
  363.           list for new replacement word (needs rechecking).
  364.   Global ispell:pdict-modified-p becomes a list where the only value indicates
  365.    whether the dictionary has been modified when option a or i is used.  This
  366.    must be returned to an atom by the calling program."
  367.   (unwind-protect
  368.       (save-window-excursion
  369.     (let ((count 0)
  370.           (line 2)
  371.           (choices miss)
  372.           (window-min-height 2)
  373.           char num result)
  374.       (save-excursion
  375.         (if ispell:keep-choices-win
  376.         (select-window (previous-window))
  377.           (set-buffer (get-buffer-create "*Choices*"))
  378.           (setq mode-line-format "--  %b  --"))
  379.         (if (equal (get-buffer "*Choices*") (current-buffer))
  380.         (erase-buffer)
  381.           (error "Bogus, dude!  I should be in the *Choices* buffer, but I'm not!"))
  382.         (if guess
  383.         (progn
  384.           (insert "\tAffix rules generate and capitalize this word as shown below:\n")
  385.           (while guess
  386.             (if (> (+ 4 (current-column) (length (car guess)))
  387.                (window-width))
  388.             (progn
  389.               (insert "\n")
  390.               (setq line (1+ line))))
  391.             (insert (car guess) "    ")
  392.             (setq guess (cdr guess)))
  393.           (insert "\nUse option \"i\" if this is a correct composition from the derivative root.\n\n")
  394.           (setq line (+ line 4))))
  395.         (while choices
  396.           (if (> (+ 7 (current-column) (length (car choices)))
  397.              (window-width))
  398.           (progn
  399.             (insert "\n")
  400.             (setq line (1+ line))))
  401.           ;; not so good if there are over 20 or 30 options, but then, if
  402.           ;; there are that many you don't want to have to scan them all anyway...
  403.           (insert "(" (+ count ?0) ") " (car choices) "  ")
  404.           (setq choices (cdr choices)
  405.             count (if (memq count '(14 48 56 59 64 71))    ; skip command characters.
  406.                   (if (= count 64)
  407.                   (+ count 3)
  408.                 (+ count 2))
  409.                 (1+ count)))))
  410.       (if ispell:keep-choices-win
  411.           (if (> line ispell:keep-choices-win)
  412.           (progn
  413.             (switch-to-buffer "*Choices*")
  414.             (select-window (next-window))
  415.             (save-excursion
  416.               (let ((cur-point (point)))
  417.             (move-to-window-line (- line ispell:keep-choices-win))
  418.             (if (<= (point) cur-point)
  419.                 (set-window-start (selected-window) (point)))))
  420.             (select-window (previous-window))
  421.             (enlarge-window (- line ispell:keep-choices-win))
  422.             (goto-char (point-min))))
  423.         (overlay-window line))
  424.       (switch-to-buffer "*Choices*")
  425.       (select-window (next-window))
  426.       (while (eq t
  427.              (setq result
  428.                (progn
  429.                  (message "^h or ? for more options; Space to leave unchanged, Character to replace word")
  430.                  (setq char (read-char))
  431.                  (setq num (- char ?0))
  432.                  (cond ((< num 15))    ; hack to map num to choices, avoiding command characters.
  433.                    ((< num 49) (setq num (- num 1)))
  434.                    ((< num 57) (setq num (- num 2)))
  435.                    ((< num 60) (setq num (- num 3)))
  436.                    ((< num 65) (setq num (- num 4)))
  437.                    ((< num 72) (setq num (- num 6)))
  438.                    (t (setq num (- num 7))))
  439.                  (cond ((= char ? ) nil) ; accept word this time only
  440.                    ((= char ?i)    ; accept and insert word into personal dictionary
  441.                     (process-send-string ispell-process (concat "*" word "\n"))    ; no return value
  442.                     (setq ispell:pdict-modified-p '(t))
  443.                     nil)
  444.                    ((= char ?a)    ; accept word, don't insert in dictionary
  445.                     (process-send-string ispell-process (concat "@" word "\n"))    ; no return value
  446.                     (setq ispell:pdict-modified-p (list ispell:pdict-modified-p))
  447.                     nil)
  448.                    ((= char ?r)    ; type in replacement
  449.                     (cons (read-string "Replacement: " word) nil))
  450.                    ((or (= char ??) (= char help-char) (= char ?\C-h))
  451.                     (ispell-choose-help)
  452.                     t)
  453.                    ((= char ?x)
  454.                     (setq ispell:quit t) nil)
  455.                    ((= char ?q)
  456.                     (if (y-or-n-p "Really quit ignoring changes? ")
  457.                     (progn
  458.                       (setq ispell:quit t)
  459.                       (process-send-eof ispell-process) ; terminate process.
  460.                       (setq ispell:pdict-modified-p nil))))
  461.                    ;; Cannot return to initial state after this....
  462.                    ((= char ?l)
  463.                     (let ((new-word (read-string "Lookup string ('*' is wildcard): " word))
  464.                       (new-line 2))
  465.                       (cond (new-word
  466.                          (save-excursion
  467.                            (setq count 0)
  468.                            (set-buffer (get-buffer-create "*Choices*")) (erase-buffer)
  469.                            (setq mode-line-format "--  %b  --")
  470.                            (setq miss (lookup-words new-word))
  471.                            (setq choices miss)
  472.                            (while choices
  473.                          (if (> (+ 7 (current-column) (length (car choices)))
  474.                             (window-width))
  475.                              (progn
  476.                                (insert "\n")
  477.                                (setq new-line (1+ new-line))))
  478.                          (insert "(" (+ count ?0) ") " (car choices) "  ")
  479.                          (setq choices (cdr choices)
  480.                                count (if (memq count '(14 48 56 59 64 71)) ; skip commands
  481.                                  (if (= count 64)
  482.                                      (+ count 3)
  483.                                    (+ count 2))
  484.                                    (1+ count)))))
  485.                          (select-window (previous-window))
  486.                          (if (/= new-line line)
  487.                          (if (> new-line line)
  488.                              (enlarge-window (- new-line line))
  489.                            (shrink-window (- line new-line))))
  490.                          (select-window (next-window)))))
  491.                     t)
  492.                    ((and (>= num 0) (< num count))
  493.                     (nth num miss))
  494.                    ((= char ?\C-l)
  495.                     (redraw-display) t)
  496.                    ((= char ?\C-r)
  497.                     (save-excursion (recursive-edit)) t)
  498.                    ((= char ?\C-z)
  499.                     (suspend-emacs) t)
  500.                    (t (ding) t))))))
  501.       result))
  502.     (if (not ispell:keep-choices-win) (bury-buffer "*Choices*"))))
  503.  
  504. (defun ispell-choose-help ()
  505.   (let ((help-1 "[r]eplace word;  [a]ccept for this session;  [i]nsert into private dictionary;")
  506.     (help-2 "[l]ook a word up in alternate dictionary;  e[x]it;  [q]uit session."))
  507.     (if (and (boundp 'epoch::version)
  508.          (equal epoch::version
  509.             "Epoch 3.1"))
  510.     ;; Enlarging the minibuffer crashes Epoch 3.1
  511.     (with-output-to-temp-buffer "*Ispell Help*"
  512.       (princ help-1)
  513.       (princ "\n")
  514.       (princ help-2))
  515.       (save-window-excursion
  516.     (select-window (minibuffer-window))
  517.     (save-excursion
  518.       (message help-2)
  519.       (enlarge-window 1)
  520.       (message help-1)
  521.       (sit-for 5)
  522.       (erase-buffer)))))
  523.   )
  524.  
  525. (defun lookup-words (word)
  526.   "Look up word in dictionary contained in the
  527.   ispell:alternate-dictionary variable.  A '*' is used for wild cards.
  528.   If no wild cards, LOOK is used if it exists.
  529.   Otherwise the variable ispell:grep-command contains the command used to search
  530.   for the words (usually egrep)."
  531.   (save-excursion
  532.     (set-buffer (get-buffer-create " *ispell-tmp*"))
  533.     (erase-buffer)
  534.     (let ((look-p (and ispell:look-p
  535.                ;; Only use look for an exact match.
  536.                (not (string-match "\\*" word))))
  537.       status)
  538.       (message "Starting \"%s\" process..." (if look-p "look" "egrep"))
  539.       (if look-p
  540.       nil
  541.     ; convert * to .*
  542.     (insert "^" word "$")
  543.     (while (search-backward "*" nil t) (insert "."))
  544.     (setq word (buffer-string))
  545.     (erase-buffer))
  546.       (setq status
  547.         (if look-p
  548.         (call-process ispell:look-command nil t nil
  549.                   "-df" word ispell:alternate-dictionary)
  550.           (call-process "egrep" nil t nil "-i" word
  551.                 ispell:alternate-dictionary)))
  552.       (if (stringp status)
  553.       (error "%s exited with signal %s"
  554.          (if look-p ispell:look-command "egrep") status))
  555.       (let ((result '())
  556.         p)
  557.     (goto-char (point-max))
  558.     (or (bobp) (= (preceding-char) ?\n) (insert ?\n))
  559.     (while (not (bobp))
  560.       (setq p (point))
  561.       (forward-line -1)
  562.       (setq result (cons (buffer-substring (point) (1- p)) result)))
  563.     result))))
  564.  
  565.  
  566. ;;; "ispell:filter" is a list of output lines from the generating function.
  567. ;;;   Each full line (ending with \n) is a separate item on the list.
  568. ;;; "output" can contain multiple lines, part of a line, or both.
  569. ;;; "start" and "end" are used to keep bounds on lines when "output" contains
  570. ;;;   multiple lines.
  571. ;;; "ispell:filter-continue" is true when we have received only part of
  572. ;;;   a line as output from a generating function ("output" did not end with a \n).
  573. ;;; NOTE THAT THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH A \n!
  574. ;;;   This is the case when a process dies or fails -- see lookup-words.
  575. ;;;   the default behavior in this case is to treat the next input as fresh input
  576. (defun ispell-filter (process output)
  577.   "Output filter function for ispell, grep, and look."
  578.   (let ((start 0)
  579.     (continue t)
  580.     end)
  581.     (while continue
  582.       (setq end (string-match "\n" output start)) ; get text up to the newline.
  583.       ;; If we get out of sync and ispell:filter-continue is asserted when we are not
  584.       ;; continuing, treat the next item as a separate list.
  585.       ;; When ispell:filter-continue is asserted, ispell:filter *should* always be a list!
  586.       (if (and ispell:filter-continue ispell:filter (listp ispell:filter)) ; Continue with same line (item)?
  587.       (setcar ispell:filter (concat (car ispell:filter) ;Add it to the prev item
  588.                     (substring output start end)))
  589.     (setq ispell:filter (cons (substring output start end) ; This is a new line and item.
  590.                   ispell:filter)))
  591.       (if (null end)                ; We've completed reading the output.
  592.       (setq ispell:filter-continue t continue nil) ; We didn't finish with the line.
  593.     (setq ispell:filter-continue nil end (1+ end)) ; Get new item next time.
  594.     (if (= end (length output))        ; No more lines in output
  595.         (setq continue nil)            ;  so we can exit the filter.
  596.       (setq start end))))))            ; Move start to next line of input.
  597.  
  598.  
  599. (defun highlight-spelling-error (start end &optional highlight)
  600.   "Highlight a word by toggling inverse-video.
  601.   highlights word from START to END.
  602.   When the optional third arg HIGHLIGHT is set, the word is drawn in inverse
  603.   video, otherwise the word is drawn in normal video mode."
  604.   (cond
  605.    ((string-match "Lucid" emacs-version)
  606.     (highlight-spelling-error-lucid start end highlight))
  607.    ((string-match "^19\\." emacs-version)
  608.     (highlight-spelling-error-v19 start end highlight))
  609.    (t
  610.     ;; else 
  611.   (let ((modified (buffer-modified-p))        ; leave buffer unmodified if highlight modifies it.
  612.     (text (buffer-substring start end))    ; Save highlight region
  613.     (inhibit-quit t)            ; don't process interrupt until this function exits
  614.     (buffer-undo-list nil))            ; We're not doing anything permanent here, so dont'
  615.                             ;  clutter the undo-list with it.
  616.     (delete-region start end)
  617.     (insert-char ?  (- end start))        ; white out region to mimimize amount of redisplay
  618.     (sit-for 0)                    ; update display
  619.     (if highlight (setq inverse-video (not inverse-video))) ; toggle inverse-video
  620.     (delete-region start end)            ; delete whitespace
  621.     (insert text)                ; insert text in inverse video.
  622.     (sit-for 0)                    ; update display showing inverse video.
  623.     (if highlight (setq inverse-video (not inverse-video))) ; toggle inverse-video
  624.     (set-buffer-modified-p modified)))))    ; don't modify if flag not set.
  625.  
  626. (defun highlight-spelling-error-lucid (start end &optional highlight)
  627.   (if highlight
  628.       (isearch-highlight start end)
  629.     (isearch-dehighlight t))
  630.   (sit-for 0))
  631.  
  632. (defun highlight-spelling-error-v19 (start end &optional highlight)
  633.   (if highlight
  634.       (setq ispell-saved-selection (cons selection-begin selection-end)
  635.         selection-begin (set-marker (make-marker) start)
  636.         selection-end (set-marker (make-marker) end))
  637.     (setq selection-begin (car ispell-saved-selection)
  638.       selection-end (cdr ispell-saved-selection)
  639.       ispell-saved-selection nil))
  640.   (sit-for 0))
  641.  
  642.  
  643. (defun overlay-window (height)
  644.   "Create a (usually small) window with HEIGHT lines and avoid
  645. recentering."
  646.   (save-excursion
  647.     (let ((oldot (save-excursion (beginning-of-line) (point)))
  648.       (top (save-excursion (move-to-window-line height) (point)))
  649.       newin)
  650.       (if (< oldot top) (setq top oldot))
  651.       (setq newin (split-window-vertically height))
  652.       (set-window-start newin top))))
  653.  
  654.  
  655. (defun ispell-parse-output (output)
  656.   "Parse the OUTPUT string of 'ispell' and return:
  657.  1) T for an exact match.
  658.  2) A string containing the root word for a match via suffix removal.
  659.  3) A list of possible correct spellings of the format:
  660.     '(\"original-word\" offset miss-list guess-list)
  661.     original-word is a string of the possibly misspelled word.
  662.     offset is an integer of the line offset of the word.
  663.     miss-list and guess-list are possibly null list of guesses and misses."
  664.   (cond
  665.    ((string= output "") t)            ; for startup with pipes...
  666.    ((string= output "*") t)            ; exact match
  667.    ((string= (substring output 0 1) "+")    ; found cuz of rootword
  668.     (substring output 2))            ; return root word
  669.    (t                        ; need to process &,?, and #'s
  670.     (let ((type (substring output 0 1))        ; &, ?, or #
  671.       (original-word (substring output 2 (string-match " " output 2)))
  672.       (cur-count 0)                ; contains current number of misses + guesses
  673.       count miss-list guess-list)
  674.       (setq output (substring output (match-end 0))) ; skip over original misspelling
  675.       (if (string= type "#")
  676.       (setq count 0)            ; no misses for type #
  677.     (setq count (string-to-int output))    ; get number of misses.
  678.     (setq output (substring output (1+ (string-match " " output 1)))))
  679.       (let ((offset (string-to-int output)))
  680.       (if (string= type "#")            ; No miss or guess list.
  681.       (setq output nil)
  682.     (setq output (substring output (1+ (string-match " " output 1)))))
  683.       (while output
  684.     (let ((end (string-match ",\\|\\($\\)" output))) ; end of next miss/guess.
  685.       (setq cur-count (1+ cur-count))
  686.       (if (> cur-count count)
  687.           (setq guess-list (cons (substring output 0 end) guess-list))
  688.         (setq miss-list (cons (substring output 0 end) miss-list)))
  689.       (if (match-end 1)            ; True only when at end of line.
  690.           (setq output nil)            ; no more misses or guesses
  691.         (setq output (substring output (+ end 2))))))
  692.       (list original-word offset miss-list guess-list))))))
  693.  
  694.  
  695. (defun check-ispell-version ()
  696.   ;; This is a little wasteful as we actually launch ispell twice: once
  697.   ;; to make sure it's the right version, and once for real.  But people
  698.   ;; get confused by version mismatches *all* the time (and I've got the
  699.   ;; email to prove it) so I think this is worthwhile.  And the -version
  700.   ;; option is the only way I can think of to do this that works with
  701.   ;; all versions.
  702.   (save-excursion
  703.     (set-buffer (get-buffer-create " *ispell-tmp*"))
  704.     (erase-buffer)
  705.     (let ((status (call-process ispell:program-name nil t nil "-version"))
  706.       (case-fold-search t))
  707.       (goto-char (point-min))
  708.       (cond ((not (memq status '(0 nil)))
  709.          (error "%s exited with %s %s" ispell:program-name
  710.             (if (stringp status) "signal" "code") status))
  711.         ((not (re-search-forward
  712.            (concat "\\b" (regexp-quote ispell:required-version) "\\b")
  713.            nil t))
  714.          (error "version mismatch: ispell.el is for %s, %s is %s"
  715.             ispell:required-version
  716.             ispell:program-name
  717.             (if (re-search-forward "version \\([0-9][0-9.]+\\)\\b"
  718.                        nil t)
  719.             (buffer-substring (match-beginning 1) (match-end 1))
  720.               "an unknown version"))))
  721.       (kill-buffer (current-buffer)))))
  722.  
  723. (defun ispell-init-process ()
  724.   "Check status of 'ispell' process and start if necessary."
  725.   (if (and ispell-process
  726.        (eq (process-status ispell-process) 'run))
  727.       (setq ispell:filter nil ispell:filter-continue nil)
  728.     (message "Starting new ispell process...")
  729.     (sit-for 0)
  730.     (check-ispell-version)
  731.     (setq ispell-process
  732.       (apply 'start-process
  733.          "ispell" nil ispell:program-name
  734.          "-a";; accept single input lines
  735.          "-m";; make root/affix combinations not in the dict
  736.          (let ((args (ispell:get-ispell-args)))
  737.            (if ispell:dictionary ; maybe use other dict
  738.                (setq args
  739.                  (append (list "-d" ispell:dictionary)
  740.                      args)))
  741.            args))
  742.       ispell:filter nil
  743.       ispell:filter-continue nil)
  744.     (set-process-filter ispell-process 'ispell-filter)
  745.     (accept-process-output ispell-process)    ; Get version ID line
  746.     (setq ispell:filter nil)            ; Discard version ID line
  747.     (process-send-string ispell-process "!\n")    ; Put into terse mode -- save processing & parsing time!
  748.     (process-kill-without-query ispell-process)))
  749.  
  750. (defun ispell-kill-ispell (&optional no-error)
  751.   "Kill current ispell process (so that you may start a fresh one)."
  752.   ;; With NO-ERROR, just return non-nil if there was no ispell
  753.   ;; running.
  754.   (interactive)
  755.   (if (not (and ispell-process
  756.         (eq (process-status ispell-process) 'run)))
  757.       (or no-error
  758.       (error "There is no ispell process running!"))
  759.     (kill-process ispell-process)
  760.     (message "Killed ispell process.")
  761.     nil))
  762.  
  763. (defun ispell-change-dictionary (dict)
  764.   "Change ispell:dictionary (q.v.) and kill old ispell process.
  765. A new one will be started as soon as necessary.
  766.  
  767. By just answering RET you can find out what the current dictionary is."
  768.   (interactive
  769.    (list (completing-read "Use new ispell dictionary (type SPC to complete): "
  770.               ispell:dictionary-alist
  771.               nil t)))
  772.   ;; Like info.el, we also rely on completing-read's bug of returning
  773.   ;; "" even if this is not in the table:
  774.   (if (equal dict "")
  775.       (setq dict nil))
  776.   (if (equal dict ispell:dictionary)
  777.       (message "(No change, using %s dictionary)"
  778.            (if dict dict "default"))
  779.     (setq ispell:dictionary dict)
  780.     (ispell-kill-ispell t)
  781.     (message "(Next ispell command will use %s dictionary)"
  782.          (if dict dict "default")))
  783.   )
  784.  
  785. ;;; Requires ispell version 2.1.02 or later.
  786. ;;; Ispell processes the file and no UNIX filters are used.
  787. ;;; This allows tex and nroff files to be processed well (ispell knows about them).
  788. ;;; Spelling of comments are checked when ispell:check-comments is non-nil.
  789. (defun ispell-region (reg-start reg-end)
  790.   "Interactively check a region for spelling errors."
  791.   (interactive "*r")
  792.   (ispell-init-process)
  793.   (if (memq major-mode '(plain-TeX-mode plain-tex-mode TeX-mode tex-mode LaTeX-mode latex-mode))
  794.       (process-send-string ispell-process "+\n")    ; set ispell mode to tex
  795.     (process-send-string ispell-process "-\n"))        ; set ispell mode to normal (nroff)
  796.   (unwind-protect
  797.   (save-excursion
  798.     (message "Spelling %s..."
  799.          (if (and (= reg-start (point-min)) (= reg-end (point-max)))
  800.          (buffer-name) "region"))
  801.     (sit-for 0)
  802.     ;; must be top level now, not inside ispell-choose for keeping window around.
  803.     (save-window-excursion
  804.     (if ispell:keep-choices-win
  805.     (let ((window-min-height 2))
  806.       (setq ispell:keep-choices-win 2)    ; This now keeps the window size.
  807.       (overlay-window 2)
  808.       (switch-to-buffer (get-buffer-create "*Choices*"))
  809.       (setq mode-line-format "--  %b  --")
  810.       (erase-buffer)
  811.       (select-window (next-window))))
  812.     (goto-char reg-start)
  813.     (while (and (not ispell:quit) (< (point) reg-end))
  814.       (let ((start (point))
  815.         (offset-change 0)
  816.         (end (save-excursion (end-of-line) (min (point) reg-end)))
  817.         (ispell-casechars (ispell:get-casechars))
  818.         string)
  819.     (cond ((eolp)                ; if at end of line, just go to next.
  820.            (forward-char 1))
  821.           ((and (null ispell:check-comments)
  822.             comment-start        ; skip comments that start on the line.
  823.             (search-forward comment-start end t)) ; a comment is on this line.
  824.            (if (= (- (point) start) (length comment-start)) ; comments starts line.
  825.            (if (string= "" comment-end) ; skip to next line over comment
  826.                (beginning-of-line 2)
  827.              (search-forward comment-end reg-end 'limit)) ; Skip to end of comment
  828.          ;; Comment starts later on line.
  829.          ;; Only send string if it contains "casechars" before comment.
  830.          (let ((limit (- (point) (length comment-start)))) 
  831.            (goto-char start)
  832.            (if (re-search-forward ispell-casechars limit t)
  833.              (setq string (concat "^" (buffer-substring start limit) "\n")))
  834.            (goto-char limit))))
  835.           ((and (null ispell:check-tib)
  836.             (re-search-forward ispell:tib-ref-beginning end t))
  837.            ;; Skip to end of tib ref, not necessarily on this line
  838.            (or (re-search-forward ispell:tib-ref-end reg-end 'move)
  839.            (error "No end for tib reference %s"
  840.               (buffer-substring (point) end)))
  841.            (let (limit)
  842.          (goto-char (match-end 0)) ; end of tib ref
  843.          (skip-chars-forward " \t\f\n" reg-end)
  844.          ;; maybe we skipped several lines, need new `start' and `end'
  845.          (setq start (point)
  846.                end (save-excursion (end-of-line)
  847.                        (min (point) reg-end))
  848.                limit (if (re-search-forward ispell:tib-ref-beginning
  849.                             end 'move)
  850.                  (match-beginning 0)
  851.                    end))
  852.          ;; Only send string if it contains "casechars"
  853.          (goto-char start)
  854.          (if (re-search-forward ispell-casechars limit t)
  855.              (progn
  856.                (setq string (concat "^"
  857.                         (buffer-substring start
  858.                                   limit)
  859.                         "\n"))
  860.                (goto-char limit)))))
  861.           ((looking-at "[---#@*+!%~^]")    ; looking at the special ispell characters..
  862.            (forward-char 1))        ; skip over it.
  863.           ((re-search-forward ispell-casechars end t) ; text exists...
  864.            (setq string (concat "^" (buffer-substring start end) "\n"))
  865.            (goto-char end))
  866.           (t (beginning-of-line 2)))    ; empty line, skip it.
  867.     (setq end (point))            ; use "end" to track end of region to check.
  868.     (if string                ; there is something to spell!
  869.         (let (poss)
  870.           ;; send string to spell process and get input.
  871.           (process-send-string ispell-process string)
  872.           (while (progn
  873.                (accept-process-output ispell-process)
  874.                (not (string= "" (car ispell:filter)))))    ;Last item of output contains a blank line.
  875.           ;; parse all inputs from the stream one word at a time.
  876.           (setq ispell:filter (nreverse (cdr ispell:filter))) ; remove blank item.
  877.           (while (and (not ispell:quit) ispell:filter)
  878.         (setq poss (ispell-parse-output (car ispell:filter)))
  879.         (if (listp poss)        ; spelling error occurred.
  880.             (let* ((word-start (+ start offset-change (car (cdr poss))))
  881.                (word-end (+ word-start (length (car poss))))
  882.                replace)
  883.               ;; debug debug debug
  884.               (if ispell:keep-choices-win (sit-for 0))
  885.               (goto-char word-start)
  886.               (if (/= word-end (progn
  887.                      (re-search-forward (car poss) word-end t)
  888.                      (point)))
  889.               ;; This usually occurs due to pipe problems with the filter.
  890.               (error "***ispell misalignment: word \"%s\" point %d; please retry."
  891.                  (car poss) word-start))
  892.               (unwind-protect
  893.               (progn
  894.                 (if ispell:highlight-p
  895.                 (highlight-spelling-error word-start word-end t) ; highlight word
  896.                   (sit-for 0))    ; otherwise, update screen.
  897.                 (setq replace (ispell-choose (car (cdr (cdr poss)))
  898.                              (car (cdr (cdr (cdr poss))))
  899.                              (car poss))))
  900.             ;; protected
  901.             (if ispell:highlight-p
  902.                 (highlight-spelling-error word-start word-end))) ; un-highlight
  903.               (goto-char word-start)
  904.               (if replace
  905.               (if (listp replace)    ; re-check all list replacements; otherwise exit.
  906.                   (progn
  907.                 ;; quit parsing this line, redo rest when re-checking new word.
  908.                 (setq ispell:filter nil)
  909.                 ;; adjust regions
  910.                 (let ((change (- (length (car replace)) (length (car poss)))))
  911.                   (setq reg-end (+ reg-end change))
  912.                   (setq offset-change (+ offset-change change)))
  913.                 (delete-region word-start word-end)
  914.                 (insert (car replace))
  915.                 (backward-char (length (car replace)))
  916.                 (setq end (point))) ; reposition within region to recheck spelling.
  917.                 (delete-region word-start word-end)
  918.                 (insert replace)
  919.                 (let ((change (- (length replace) (length (car poss)))))
  920.                   (setq reg-end (+ reg-end change)
  921.                     offset-change (+ offset-change change)
  922.                     end (+ end change))))
  923.             ;; This prevents us from pointing out the word that was just accepted
  924.             ;; (via 'i' or 'a') if it follows on the same line. (The one drawback of
  925.             ;; processing an entire line.)  Redo check following the accepted word.
  926.             (cond ((and (not (null ispell:pdict-modified-p)) (listp ispell:pdict-modified-p))
  927.                    ;; We have accepted or inserted a word.  Re-check line.
  928.                    (setq ispell:pdict-modified-p (car ispell:pdict-modified-p)) ; fix update flag
  929.                    (setq ispell:filter nil) ; don't continue check.
  930.                    (setq end word-end)))) ; reposition to check line following accepted word.
  931.               (message "continuing spelling check...")
  932.               (sit-for 0)))
  933.         (setq ispell:filter (cdr ispell:filter))))) ; finished with this check.
  934.     (goto-char end)))))
  935.   (progn
  936.     (if (get-buffer "*Choices*")
  937.     (kill-buffer "*Choices*"))
  938.     (ispell-pdict-save)
  939.     (if ispell:quit (setq ispell:quit nil))
  940.     (message "Spell done."))))
  941.  
  942.  
  943. (defun ispell-buffer () 
  944.   "Check the current buffer for spelling errors interactively."
  945.   (interactive)
  946.   (ispell-region (point-min) (point-max)))
  947.  
  948. ;; Interactive word completion.
  949. ;; Some code and many ideas tweaked from Peterson's spell-dict.el.
  950. ;; Ashwin Ram <Ram@yale>, 8/14/87.
  951.  
  952. ;; Ported from ispell 2 to ispell 3 by Sebastian Kremer <sk@thp.uni-koeln.de>
  953. ;; 7-Aug-1991 13:44
  954.  
  955. (defun ispell-complete-word ()
  956.    "Look up word before point in dictionary (see the variable
  957. ispell:alternate-dictionary) and try to complete it.  If in the
  958. middle of a word, replace the entire word."
  959.    (interactive)
  960.    (let* ((current-word (buffer-substring (save-excursion
  961.                         (forward-word -1) (point))
  962.                                           (point)))
  963.           (in-word (looking-at "\\w"))
  964.       (ispell:filter-continue t)
  965.           (possibilities
  966.          (or (string= current-word "") ; Will give you every word
  967.          (setq ispell:filter (lookup-words current-word))
  968.          (if (not (null ispell:filter))
  969.              (ispell-parse-output (car ispell:filter))
  970.            '())))
  971.  
  972.       (ispell:keep-choices-win nil)
  973.       (replacement (ispell-choose possibilities nil current-word)))
  974.      (cond (replacement
  975.         (if in-word (kill-word 1));; Replace the whole word.
  976.         (search-backward current-word)
  977.         (replace-match replacement)))));; To preserve capitalization etc.
  978.