Auto Spell Mode

[David Vinayak Wallace <Gumby@mcc.com>]

Auto-spell-mode sounded like a good idea so I wrote one.  It acts like
word-abbrev mode (and in fact is careful to run after abbrevs).  If you
type a word which is not in any of your spell dictionaries it beeps at
you (you have to type m-$ manually to correct it.  You can guess why!).

It also, by analogy to word-abbrev it defines c-X c-+ which adds the
word before the point to the dicionary of your choice.

Please mail me (or this list) any extensions or improvements.

;;; -*- Syntax: Zetalisp; Mode: LISP; Package: ZWEI; Base: 8 -*-

;;; &begin(documentation,sage)

;;;; @Heading <Auto-Spell mode>

;;; When enabled, checks as you type for words unknown to the system
;;; speller.  Beeps when you type one.  Uses wordab's rules for deciding
;;; when to check.

;;; This mode is smart about abbrev mode (for those of you who use it to
;;; fix your common typing errors).

;;; Please send fixes, changes, extensions, etc to Gumby@AI.AI.MIT.EDU

;;; &end(documentation,sage)

;;; Poached from system 99's abbrev mode.
(defminor com-auto-spell-mode auto-spell-mode "Spell" 3
	  "Minor mode in which insertion spells text.
A positive argument turns the mode on, zero turns it off;
no argument toggles." ()
  (progn					; this lacks an UNDO!
    (prepare-for-spell-command))
  ;; By analogy with wordab:
  (set-comtab *standard-control-x-comtab* '(#\control-+ com-add-spelling))
  (command-hook 'auto-spell-hook *post-command-hook*))

;;; Make sure this gets run AFTER the abbreviation hook, if any:
(eval-when (load eval)
  (setf (cl:get 'auto-spell-hook 'command-hook-priority)
	(1+ (cl:get 'expand-abbrev-hook 'command-hook-priority))))

(defun auto-spell-hook (ignore)
  (when (and (expand-p *last-command-char*)
	     (not *numeric-arg-p*)
	     (= (word-syntax (bp-char-before (point))) word-alphabetic))
    ;; IWBNI symbolics abstracted M-$ so we could use or alter its word-finder!
    (let ((word (bound-word (point))))
      (when word
	(unless (word-in-dictionaries-p word)
	  (beep))))))

(defprop auto-spell-hook document-auto-spell-hook hook-documentation-function)
(defun document-auto-spell-hook (ignore char)
  (when (expand-p char)
    (format t "Checks spelling of previous word to see if it appears in the ~@
               spelling dictionary.~%Beeps if not.~%")))

(defcom com-add-spelling "Adds word before cursor to spelling dictionary.
Arg means delete it." ()    
  (let ((word (bound-word (point))))		; see comment above!
    (if (not word)
	(barf "Not on a word.")
      ;; Ripped from com-add and delete-word-to-spell-dictionary:
      (multiple-value-bind (name dictionary)
	  (prompt-for-spell-dictionary
	    (format nil "Name of dictionary to ~:[add~;delete~] /"~A/" ~@*~:[to~;from~]:"
		    *numeric-arg-p* word))
	(when dictionary
	  (if *numeric-arg-p*
	      (cond ((spell:encode-string
		       (string-upcase word)
		       (array-active-length word)
		       #'spell:delete-word
		       dictionary)
		     (typein-line "Deleted /"~A/" from dictionary ~A." word name))
		    (t
		     (barf "The word /"~A/" was not found in dictionary ~A." word name))))
	  (cond ((spell:encode-string
		   (string-upcase word)
		   (array-active-length word)
		   #'spell:lookup-word
		   dictionary)
		 (barf "The word /"~A/" was already in dictionary ~A." word name))
		(t
		 (spell:encode-string
		   (string-upcase word)
		   (array-active-length word)
		   #'spell:add-word
		   dictionary)
		 (typein-line "Added /"~A/" to dictionary ~A." word name))))))
    dis-none))

(eval-when (load eval)
  (set-comtab *standard-comtab* () '(("Auto Spell Mode" . com-auto-spell-mode))))