home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34src.zip
/
me3
/
mutt
/
package
/
spell.mut
< prev
next >
Wrap
Lisp/Scheme
|
1995-01-14
|
4KB
|
148 lines
;; Spelling correction interface for Emacs.
;; Copyright (C) 1985 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;; Ported to Mutt2 4/92 2/93 C Durland
;; Check spelling of every word in the buffer.
;; For each incorrect word, you are asked for the correct spelling and then
;; put into a query-replace to fix some or all occurrences. If you do not
;; want to change a word, just give the same word as its "correct"
;; spelling; then the query replace is skipped.
(include me.mh)
(defun spell-region
{
(save-point {{ (spell-check-region THE-DOT THE-MARK "region") }})
})
(defun spell-buffer
{
(save-point
{{
(int mark1)
(mark1 (create-mark))
(beginning-of-buffer)(set-mark mark1)
(end-of-buffer)
(spell-check-region mark1 THE-DOT "buffer")
}})
})
;; Check spelling of word at or before point.
;; If it is not correct, ask user for the correct spelling and
;; query-replace the entire buffer to substitute it.
(defun spell-word
{
(save-point
{{
(int mark1 mark2 bag)
(mark1 (create-mark))(mark2 (create-mark))
(bag (create-bag))
(if (not (looking-at '\<')) (forward-word -1))
(set-mark mark1) (forward-word 1) (set-mark mark2)
(append-to-bag bag APPEND-REGION mark1 mark2)
(spell-check-region mark1 mark2 (concat "\"" (bag-to-string bag) "\""))
}})
})
;; Like spell-buffer but applies only to region.
;; From program, applies from START to END.
;; Notes:
;; Spell is case sensitive. The same (misspelled) word with different
;; case will be rejected twice.
;; !!! need case matching qr
(defun spell-check-region (int mark1 mark2) (string description) HIDDEN
{
(int buffer curbuf bag case-fold-state)
(string word newword)
(msg "Checking spelling of " description "...")
(case-fold-state (case-fold-search))
(curbuf (current-buffer))
(bag (create-bag))
(buffer (create-buffer "*temp*"))
(append-to-bag bag APPEND-REGION mark1 mark2)
(append-to-bag bag APPEND-TEXT "^J")
(current-buffer buffer)
(OS-filter "spell" bag -1 TRUE) ;; generate a list of bad words
; (update)
(current-line 1)
(msg "Checking spelling of " description "... "
(if (EoB) "correct" "not correct"))
; (case-fold-search t)
; (case-replace t)
(while (not (EoB))
{
(looking-at '.+')
(word (get-matched '&'))
(ask-user)(prime-ask word)
(newword (ask "Replacement for " word ": "))
(prime-ask)
(if (== "-" newword) { (forward-line -1)(continue) })
(if (and (!= newword "") (!= word newword))
{
(current-buffer curbuf) (beginning-of-buffer) (case-fold-search 0)
(re-query-replace (concat '\<' word '\>') newword)
(case-fold-search case-fold-state)
(current-buffer buffer)
})
(forward-line 1)
})
(current-buffer curbuf)
})
;; Check spelling of string supplied as argument.
(defun spell-string ; (string s)
{
(int bag1 bag2)
(string s)
(s (ask "Spell string: "))
(bag1 (create-bag))
(bag2 (create-bag))
(append-to-bag bag1 APPEND-TEXT s)
(append-to-bag bag1 APPEND-TEXT "^J")
(OS-filter "spell" bag1 bag2)
; (update)
(msg "\"" s "\" is "
(if (== 0 (length-of (bag-to-string bag2))) "correct." "incorrect."))
(free-bag bag1 bag2)
})