charles@hpcvcd.HP (Charles Brown) (12/19/86)
The following is a spell package I wrote for unipress/gosling emacs.
The package supports convenient maintainance of a personal dictionary.
You may need to make small modifications to make it work on your
system. For instance, it makes use of an mlisp function (case) which
is like the case function in Pascal. I do not have permission from
the author to post (case). It should not be too hard to create one
or else change this package to remove it. I have left (case) in
because it makes the code much more readable.
Another program which is referenced here is "correct". "correct" is a
program which was posted to net.sources years ago. It takes a word
and makes guesses about other words that are close to it in spelling.
The program doesn't work all that well because it doesn't have access
to the dictionary source to "spell". (new-spell) will work fine
without "correct". It just won't be able to suggest alternate
spellings. The correction feature is of questionable usefulness
anyway because it is so slow. If you want it anyway, I can mail it
to you.
If you have enhancements, bug fixes, etc., mail them to me and I may
post an update in the future.
Charles Brown hplabs!hp-pcd!charles
;-------------------------------------------------------------
; Source File=< /tmp/nfa14800 >
; Last Edit Date=< Fri Dec 19 10:19:16 1986 >
; Program name: new-spell
; Purpose: provide spelling correction
; Author: Charles Brown (charles)
; Creation Date: Wed Feb 5 14:32:50 1986
; Computer: HP-UX hpcvcd 05.01 B 9030X 2304A00581
; Environment:
; Programs:
; correct
; emacs
; spell
; spellin
; sort
; uniq
; Environmental variables:
; $D_SPELL Dictionary file for spell.
; Recommend: $HOME/spell.dict
; $A_SPELL File containing words added to
; standard dictionary to make the
; dictionary file $D_SPELL.
; Recommend: $HOME/spell.add
; $H_SPELL History file. Recommend: /dev/null
; Usage:
; <esc>xspell
; Explanation:
; The file $D_SPELL is used by the unix programs spell
; and correct to determine what words are acceptable.
; If you use the 'a' command, the current word is added
; to the file $A_SPELL. When emacs spell completes, it
; uses spellin to merge the contents of $A_SPELL with
; the dictionary /usr/lib/spell/hlista into the
; dictionary $D_SPELL.
;
; When a word is found in error. It is displayed in the
; minibuf with the line:
; <word>? n=next r=replace q=query-replace a=add x=examples
; Actually there are more choices:
; ' ', n, N, ^N Next: skip this word.
; r, R, ^R Replace: global substitute of this
; string retaining case.
; q, Q, ^Q Replace: global query substitute of
; this string retaining case.
; a, A Add: Add this word to your personal
; dictionary.
; e Edit: Recursive edit.
; x, X, ^X Examples: List alternative spellings.
; ^G, ^C Exit spell. (Note: ^C different below)
; In example mode, the minibuf shows an alternate spelling in
; the minibuf with the line:
; <alternate>: n=next r=replace q=query a=add x=examples b=back-word f=forward-word c=clear
; In addition to the choices above, there are:
; c, C, ^C Clear: Throw away examples.
; b, B, ^B Back-word: Back up one word in the
; examples list.
; f, F, ^F Forward-word: Move forward one word
; in the examples list.
; Replace and query-replace prompts with the string to replace to if
; you have not asked for examples. If you have asked for
; examples, it will use the currently selected example.
; Buffers:
; "-spell Buffer"
; "-spell-dictionary"
; "-spell-examples"
; "-spell-add"
; Bugs:
; It is possible to insert the same word twice into the
; directory.
; Query replace does not show its message properly.
;-------------------------------------------------------------
; Revisions:
;Charles Brown Fri Feb 21 10:51:23 1986
; -ignore ^s
;Charles Brown Tue Mar 11 16:27:21 1986
; -turn off stack-trace-on-error before searching for word.
;Charles Brown Thu Mar 13 18:19:47 1986
; -If $D_SPELL is defined but does not exist, create it.
; (end revisions)
;-------------------------------------------------------------
(defun
(spell
word action continue-buffer current-buffer
replace-word replace-defined continue-word help-string
system-dicta system-dictb add-dictionary
can-add personal-dict dictionary-changed
old-case-fold-search old-stack-trace-on-error
dictionary-exists
(setq current-buffer (current-buffer-name))
(message (concat "Looking for spelling errors in " current-buffer
"..."))
(sit-for 0)
(setq system-dicta "/usr/lib/spell/hlista")
(setq system-dictb "/usr/lib/spell/hlistb")
(setq continue-buffer 1)
(setq dictionary-changed 0)
(setq personal-dict system-dicta)
(setq old-stack-trace-on-error stack-trace-on-error)
(setq stack-trace-on-error 0)
(error-occured
(setq personal-dict (getenv "D_SPELL"))
)
(setq stack-trace-on-error old-stack-trace-on-error)
(if (|
(= personal-dict system-dicta)
(= personal-dict system-dictb)
)
(setq can-add 0)
(progn
(setq dictionary-exists (file-exists personal-dict))
(if (! dictionary-exists)
(progn
(temp-use-buffer "-spell-dictionary")
(insert-file system-dicta)
(write-named-file personal-dict)
(delete-buffer "-spell-dictionary")
(setq can-add 1)
)
(if (= 1 dictionary-exists)
(setq can-add 1)
(setq can-add 0)
)
)
)
)
(setq add-dictionary "")
(setq old-stack-trace-on-error stack-trace-on-error)
(setq stack-trace-on-error 0)
(if (error-occured
(setq stack-trace-on-error 0)
(setq add-dictionary (getenv "A_SPELL"))
)
(setq can-add 0)
)
(setq stack-trace-on-error old-stack-trace-on-error)
(temp-use-buffer "-spell Buffer")
(setq needs-checkpointing 0)
(erase-buffer)
(set-mark)
(yank-buffer current-buffer)
(case-region-lower)
(filter-region "spell")
(error-occured
(while continue-buffer
(save-excursion
(temp-use-buffer "-spell Buffer")
(beginning-of-file)
(set-mark)
(end-of-line)
(setq word (region-to-string))
(setq old-stack-trace-on-error stack-trace-on-error)
(setq stack-trace-on-error 0)
(forward-character)
(setq stack-trace-on-error old-stack-trace-on-error)
(erase-region)
(setq buffer-is-modified 0)
)
(temp-use-buffer current-buffer)
(beginning-of-file)
(error-occured
(setq old-case-fold-search case-fold-search)
(setq case-fold-search 1)
(setq old-stack-trace-on-error stack-trace-on-error)
(setq stack-trace-on-error 0)
(re-search-forward
(concat "\\b" word "\\b")
)
(setq case-fold-search old-case-fold-search)
(setq stack-trace-on-error old-stack-trace-on-error)
)
(setq replace-defined 0)
(setq continue-word 1)
(while (& continue-word continue-buffer)
(if replace-defined
(setq help-string
(concat replace-word
": n=next r=replace"
" q=query"
" a=add x=examples"
" b=back-word f=forward-word"
" c=clear"
)
)
(setq help-string
(concat word
"? n=next r=replace"
" q=query-replace"
" a=add x=examples"
)
)
)
(message help-string)
(setq action '^G')
(error-occured
(setq action (get-tty-character))
)
(case action
'^S' (novalue)
'^Q' (novalue)
'^L' (redraw-display)
' ' (setq continue-word 0)
'n' (setq continue-word 0)
'N' (setq continue-word 0)
'^N' (setq continue-word 0)
'r' (-find-replace)
'R' (-find-replace)
'^R' (-find-replace)
'q' (-find-query)
'Q' (-find-query)
'^Q' (-find-query)
'a' (-find-add)
'A' (-find-add)
'e' (recursive-edit)
'x' (-find-examples)
'X' (-find-examples)
'^X' (-find-examples)
'^G' (setq continue-buffer 0)
OTHERWISE
(if replace-defined
(case action
'c' (setq replace-defined 0)
'C' (setq replace-defined 0)
'^C' (setq replace-defined 0)
'b' (-find-back-word)
'B' (-find-back-word)
'^B' (-find-back-word)
'f' (-find-forward-word)
'F' (-find-forward-word)
'^F' (-find-forward-word)
OTHERWISE
(send-string-to-terminal "\")
)
(if (= action '^C')
(setq continue-buffer 0)
(send-string-to-terminal "\")
)
)
)
(novalue)
)
(novalue)
)
(novalue)
)
(if dictionary-changed
(-update-dictionary)
)
(message "Done.")
(novalue)
)
)
(defun
(-find-examples
(temp-use-buffer "-spell-examples")
(setq needs-checkpointing 0)
(erase-buffer)
(set-mark)
(insert-string (concat "correct " word))
(newline)
(message (concat "getting alternatives to " word "..."))
(sit-for 0)
(filter-region "sh")
(if (= (bobp) (eobp))
(progn
(set-mark)
(insert-string "No Alternate Found: use c to clear")
)
(progn
(beginning-of-file)
(set-mark)
(end-of-line)
)
)
(setq replace-word (region-to-string))
(setq buffer-is-modified 0)
(setq replace-defined 1)
)
(-find-back-word
(temp-use-buffer "-spell-examples")
(error-occured
(previous-line)
)
(beginning-of-line)
(set-mark)
(end-of-line)
(setq replace-word (region-to-string))
)
(-find-forward-word
(temp-use-buffer "-spell-examples")
(error-occured
(next-line)
)
(beginning-of-line)
(set-mark)
(end-of-line)
(setq replace-word (region-to-string))
)
)
(defun
(-find-replace old-case-fold old-replace-case
(setq old-case-fold case-fold-search)
(setq case-fold-search 1)
(setq old-replace-case replace-case)
(setq replace-case 1)
(error-occured
(temp-use-buffer current-buffer)
(save-excursion
(if (| (= replace-word "") (! replace-defined))
(setq replace-word (get-tty-string "change to: "))
)
(beginning-of-file)
(re-replace-string
(concat "\\b" word "\\b") replace-word
)
)
)
(setq case-fold-search old-case-fold)
(setq replace-case old-replace-case)
)
(-find-query old-case-fold old-replace-case oldf-stack-trace-on-error
(setq old-case-fold case-fold-search)
(setq case-fold-search 1)
(setq old-replace-case replace-case)
(setq replace-case 1)
(setq oldf-stack-trace-on-error stack-trace-on-error)
(setq stack-trace-on-error 0)
(error-occured
(temp-use-buffer current-buffer)
(save-excursion
(if (| (= replace-word "") (! replace-defined))
(setq replace-word (get-tty-string "change to: "))
)
(message "' '=yes n=no .=last !=all ^G=quit r=edit")
(beginning-of-file)
(re-query-replace-string
(concat "\\b" word "\\b") replace-word
)
)
)
(setq case-fold-search old-case-fold)
(setq replace-case old-replace-case)
(setq stack-trace-on-error oldf-stack-trace-on-error)
)
(-find-add
(if can-add
(progn
(message (concat "Adding " word " to dictionary."))
(sit-for 0)
(if (! (file-exists add-dictionary))
(progn
(temp-use-buffer "-spell-add")
(erase-buffer)
(insert-string word)
(case-word-lower)
(newline)
(write-named-file add-dictionary)
(delete-buffer "-spell-add")
)
(progn
(temp-use-buffer "-spell-add")
(erase-buffer)
(insert-file add-dictionary)
(beginning-of-file)
(set-mark)
(insert-string word)
(case-word-lower)
(newline)
(end-of-file)
(filter-region "sort")
(write-named-file add-dictionary)
(delete-buffer "-spell-add")
)
)
(setq dictionary-changed 1)
)
(progn
(message (concat "Unable to add "
word " to dictionary.")
)
(send-string-to-terminal "\^G")
(sit-for 30)
)
)
(novalue)
)
(-update-dictionary spellin
(setq spellin "/usr/lib/spell/spellin")
(message "Updating Dictionary...")
(sit-for 0)
(temp-use-buffer "-spell-add")
(setq needs-checkpointing 0)
(erase-buffer)
(set-mark)
(insert-string "uniq ")
(insert-string " < ")
(insert-string add-dictionary)
(insert-string " | ")
(insert-string spellin)
(insert-string " ")
(insert-string system-dicta)
(insert-string " > ")
(insert-string personal-dict)
(newline)
(filter-region "sh")
(setq buffer-is-modified 0)
)
)
---------------that all-------------------------