home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34exe.zip / mutt / package / spell.mut < prev    next >
Lisp/Scheme  |  1995-01-14  |  4KB  |  148 lines
  1. ;; Spelling correction interface for Emacs.
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. ;; Ported to Mutt2 4/92 2/93 C Durland
  22.  
  23. ;; Check spelling of every word in the buffer.
  24. ;; For each incorrect word, you are asked for the correct spelling and then
  25. ;; put into a query-replace to fix some or all occurrences.  If you do not
  26. ;; want to change a word, just give the same word as its "correct"
  27. ;; spelling; then the query replace is skipped.
  28.  
  29. (include me.mh)
  30.  
  31. (defun spell-region
  32. {
  33.   (save-point {{ (spell-check-region THE-DOT THE-MARK "region") }})
  34. })
  35.  
  36. (defun spell-buffer
  37. {
  38.   (save-point
  39.     {{
  40.       (int mark1)
  41.  
  42.       (mark1 (create-mark))
  43.       (beginning-of-buffer)(set-mark mark1)
  44.       (end-of-buffer)
  45.       (spell-check-region mark1 THE-DOT "buffer")
  46.     }})
  47. })
  48.  
  49. ;; Check spelling of word at or before point.
  50. ;; If it is not correct, ask user for the correct spelling and
  51. ;;   query-replace the entire buffer to substitute it.
  52. (defun spell-word
  53. {
  54.   (save-point
  55.     {{
  56.       (int mark1 mark2 bag)
  57.  
  58.       (mark1 (create-mark))(mark2 (create-mark))
  59.       (bag (create-bag))
  60.  
  61.       (if (not (looking-at '\<')) (forward-word -1))
  62.  
  63.       (set-mark mark1) (forward-word 1) (set-mark mark2)
  64.  
  65.       (append-to-bag bag APPEND-REGION mark1 mark2)
  66.       (spell-check-region mark1 mark2 (concat "\"" (bag-to-string bag) "\""))
  67.     }})
  68. })
  69.  
  70. ;; Like spell-buffer but applies only to region.
  71. ;; From program, applies from START to END.
  72. ;; Notes:
  73. ;;   Spell is case sensitive.  The same (misspelled) word with different
  74. ;;     case will be rejected twice.
  75. ;; !!! need case matching qr
  76. (defun spell-check-region (int mark1 mark2) (string description) HIDDEN
  77. {
  78.   (int buffer curbuf bag case-fold-state)
  79.   (string word newword)
  80.  
  81.   (msg "Checking spelling of " description  "...")
  82.  
  83.   (case-fold-state (case-fold-search))
  84.   (curbuf (current-buffer))
  85.  
  86.   (bag (create-bag))
  87.   (buffer (create-buffer "*temp*"))
  88.  
  89.   (append-to-bag bag APPEND-REGION mark1 mark2)
  90.   (append-to-bag bag APPEND-TEXT "^J")
  91.  
  92.   (current-buffer buffer)
  93.  
  94.   (OS-filter "spell" bag -1 TRUE)    ;; generate a list of bad words
  95. ;  (update)
  96.  
  97. (current-line 1)
  98.   (msg "Checking spelling of " description "... "
  99.       (if (EoB) "correct" "not correct"))
  100.  
  101. ;      (case-fold-search t)
  102. ;      (case-replace t)
  103.  
  104.   (while (not (EoB))
  105.     {
  106.       (looking-at '.+')
  107.       (word (get-matched '&'))
  108.       (ask-user)(prime-ask word)
  109.       (newword (ask "Replacement for " word ": "))
  110.       (prime-ask)
  111.       (if (== "-" newword) { (forward-line -1)(continue) })
  112.       (if (and (!= newword "") (!= word newword))
  113.         {
  114.       (current-buffer curbuf) (beginning-of-buffer) (case-fold-search 0)
  115.       (re-query-replace (concat '\<' word '\>') newword)
  116.       (case-fold-search case-fold-state)
  117.  
  118.       (current-buffer buffer)
  119.     })
  120.       (forward-line 1)
  121.     })
  122.  
  123.   (current-buffer curbuf)
  124. })
  125.  
  126. ;; Check spelling of string supplied as argument.
  127. (defun spell-string ; (string s)
  128. {
  129.   (int bag1 bag2)
  130.   (string s)
  131.  
  132.   (s (ask "Spell string: "))
  133.  
  134.   (bag1 (create-bag))
  135.   (bag2 (create-bag))
  136.  
  137.   (append-to-bag bag1 APPEND-TEXT s)
  138.   (append-to-bag bag1 APPEND-TEXT "^J")
  139.  
  140.   (OS-filter "spell" bag1 bag2)
  141. ;  (update)
  142.  
  143.   (msg "\"" s "\" is "
  144.     (if (== 0 (length-of (bag-to-string bag2))) "correct." "incorrect."))
  145.  
  146.   (free-bag bag1 bag2)
  147. })
  148.