home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / spell.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  5KB  |  134 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.  
  22. (defvar spell-command "spell"
  23.   "*Command to run the spell program.")
  24.  
  25. (defvar spell-filter nil
  26.   "*Filter function to process text before passing it to spell program.
  27. This function might remove text-processor commands.
  28. nil means don't alter the text before checking it.")
  29.  
  30. (defun spell-buffer ()
  31.   "Check spelling of every word in the buffer.
  32. For each incorrect word, you are asked for the correct spelling
  33. and then put into a query-replace to fix some or all occurrences.
  34. If you do not want to change a word, just give the same word
  35. as its \"correct\" spelling; then the query replace is skipped."
  36.   (interactive)
  37.   (spell-region (point-min) (point-max) "buffer"))
  38.  
  39. (defun spell-word ()
  40.   "Check spelling of word at or before point.
  41. If it is not correct, ask user for the correct spelling
  42. and query-replace the entire buffer to substitute it."
  43.   (interactive)
  44.   (let (beg end spell-filter)
  45.     (save-excursion
  46.      (if (not (looking-at "\\<"))
  47.      (forward-word -1))
  48.      (setq beg (point))
  49.      (forward-word 1)
  50.      (setq end (point)))
  51.     (spell-region beg end (buffer-substring beg end))))
  52.  
  53. (defun spell-region (start end &optional description)
  54.   "Like spell-buffer but applies only to region.
  55. Used in a program, applies from START to END.
  56. DESCRIPTION is an optional string naming the unit being checked:
  57. for example, \"word\"."
  58.   (interactive "r")
  59.   (let ((filter spell-filter)
  60.     (buf (get-buffer-create " *temp*")))
  61.     (save-excursion
  62.      (set-buffer buf)
  63.      (widen)
  64.      (erase-buffer))
  65.     (message "Checking spelling of %s..." (or description "region"))
  66.     (if (and (null filter) (= ?\n (char-after (1- end))))
  67.     (if (string= "spell" spell-command)
  68.         (call-process-region start end "spell" nil buf)
  69.       (call-process-region start end shell-file-name
  70.                    nil buf nil "-c" spell-command))
  71.       (let ((oldbuf (current-buffer)))
  72.     (save-excursion
  73.      (set-buffer buf)
  74.      (insert-buffer-substring oldbuf start end)
  75.      (or (bolp) (insert ?\n))
  76.      (if filter (funcall filter))
  77.      (if (string= "spell" spell-command)
  78.          (call-process-region (point-min) (point-max) "spell" t buf)
  79.        (call-process-region (point-min) (point-max) shell-file-name
  80.                 t buf nil "-c" spell-command)))))
  81.     (message "Checking spelling of %s...%s"
  82.          (or description "region")
  83.          (if (save-excursion
  84.           (set-buffer buf)
  85.           (> (buffer-size) 0))
  86.          "not correct"
  87.            "correct"))
  88.     (let (word newword
  89.       (case-fold-search t)
  90.       (case-replace t))
  91.       (while (save-excursion
  92.           (set-buffer buf)
  93.           (> (buffer-size) 0))
  94.     (save-excursion
  95.      (set-buffer buf)
  96.      (goto-char (point-min))
  97.      (setq word (downcase
  98.              (buffer-substring (point)
  99.                        (progn (end-of-line) (point)))))
  100.      (forward-char 1)
  101.      (delete-region (point-min) (point))
  102.      (setq newword
  103.            (read-input (concat "`" word
  104.                    "' not recognized; edit a replacement: ")
  105.                word))
  106.      (flush-lines (concat "^" (regexp-quote word) "$")))
  107.     (if (not (equal word newword))
  108.         (progn
  109.          (goto-char (point-min))
  110.          (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
  111.                    newword)))))))
  112.  
  113.  
  114. (defun spell-string (string)
  115.   "Check spelling of string supplied as argument."
  116.   (interactive "sSpell string: ")
  117.   (let ((buf (get-buffer-create " *temp*")))
  118.     (save-excursion
  119.      (set-buffer buf)
  120.      (widen)
  121.      (erase-buffer)
  122.      (insert string "\n")
  123.      (if (string= "spell" spell-command)
  124.      (call-process-region (point-min) (point-max) "spell"
  125.                   t t)
  126.        (call-process-region (point-min) (point-max) shell-file-name
  127.                 t t nil "-c" spell-command))
  128.      (if (= 0 (buffer-size))
  129.      (message "%s is correct" string)
  130.        (goto-char (point-min))
  131.        (while (search-forward "\n" nil t)
  132.      (replace-match " "))
  133.        (message "%sincorrect" (buffer-substring 1 (point-max)))))))
  134.