dmj@uw-june.UUCP (03/08/86)
The following code is an interactive spelling checker for
Unipress(Gosling's) Emacs-264. Just position the cursor
on or to the right of the word in question and invoke the
function "ask". The first time it starts two processes,
so is somewhat slow. But they stay around and after that
it is fast.
===========
(declare-global w-u-t ask-status)
(setq ask-status 0)
; ask-status 1 acceptor spelling error
; 2 rejector spelling error
; 4 acceptor working
; 8 rejector working
; 1024 confusion
(defun
(find-word
(save-excursion
; note the REs consider '&' OK inside
; words. Hence AT&T is a word. To defeat
; this, just remove the &s from the REs.
(if (! (error-occurred
(re-search-reverse "[^\'a-zA-Z&]\\([a-zA-Z][\'a-zA-Z&]*\\)")
; for hyphens, use:
; "[^-\'a-zA-Z&]\\([a-zA-Z][-\'a-zA-Z&]*\\)"
)
)
(novalue)
(progn
(beginning-of-file)
(! (looking-at "\\([a-zA-Z][\'a-zA-Z&]*\\)"))
; for hyphens, use: "\\([a-zA-Z][-\'a-zA-Z&]*\\))"
)
(error-message "No word found")
)
(region-around-match 1)
(re-search-reverse "[a-zA-Z]")
(forward-character)
(region-to-string)
)
)
(ask (if (>= ask-status 4)
(progn
(error-occurred (kill-process "Spell acceptor"))
(error-occurred (kill-process "Spell rejector"))
(setq ask-status 0)
(error-message "Ask was confused, so I killed its processes. Try again.")
)
)
(setq ask-status 0)
(setq w-u-t (find-word))
(if (= (length w-u-t) 1)
(progn
(message "\"" w-u-t "\" is spelled OK")
(sit-for 0)
)
(progn acstat rjstat
(setq acstat (process-status "Spell acceptor"))
(setq rjstat (process-status "Spell rejector"))
(if (| (< acstat 1)
(< rjstat 1)
)
(progn
(message "\"" w-u-t "\" ...")
(sit-for 0)
)
)
(save-excursion
(temp-use-buffer "Spell rejector")
(setq needs-checkpointing 0)
(erase-buffer)
(set-mark)
(if (!= rjstat 1)
(start-filtered-process
"/usr/lib/spell /usr/dict/hstop /dev/null"
"Spell rejector"
"spell-rejector-filter"
)
)
(temp-use-buffer "Spell acceptor")
(setq needs-checkpointing 0)
(erase-buffer)
(set-mark)
(if (!= acstat 1)
(start-filtered-process
"/usr/lib/spell /usr/dict/hlista /dev/null"
"Spell acceptor"
"spell-acceptor-filter"
)
)
)
(setq ask-status 12)
(string-to-process "Spell rejector" (concat w-u-t "\n<\n"))
(string-to-process "Spell acceptor" (concat w-u-t "\n<\n"))
)
)
(novalue)
)
(spell-rejector-filter str
(save-excursion
(temp-use-buffer "Spell rejector")
(insert-string (process-output))
(setq str (region-to-string))
(if (< (% ask-status 16) 8); are we supposed to be idle ?
(setq ask-status 1024)
(progn
(if (= (substr str -2 1) "<")
(progn (setq ask-status (- ask-status 8))
(if (!= str (concat w-u-t "\n<\n"))
(setq ask-status (+ ask-status 2))
)
)
)
)
)
)
(spell-result-check)
)
(spell-acceptor-filter str
(save-excursion
(temp-use-buffer "Spell acceptor")
(insert-string (process-output))
(setq str (region-to-string))
(if (< (% ask-status 8) 4); are we supposed to be idle?
(setq ask-status 1024)
(progn
(if (= (substr str -2 1) "<")
(progn (setq ask-status (- ask-status 4))
(if (!= (substr str 1 1) "<")
(setq ask-status (+ ask-status 1))
)
)
)
)
)
)
(spell-result-check)
)
(spell-result-check
(if (= ask-status 0)
(progn
(message "\""w-u-t "\" is spelled OK")
(sit-for 0)
)
(< ask-status 4)
(progn
(send-string-to-terminal "\007")
(message "\"" w-u-t "\" is misspelled")
(sit-for 0)
)
)
)
)