home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-18.59-src.tgz / emacs-18.59-src.tar / fsf / emacs18 / lisp / spell.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  5KB  |  133 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 free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. (defvar spell-command "spell"
  22.   "*Command to run the spell program.")
  23.  
  24. (defvar spell-filter nil
  25.   "*Filter function to process text before passing it to spell program.
  26. This function might remove text-processor commands.
  27. nil means don't alter the text before checking it.")
  28.  
  29. (defun spell-buffer ()
  30.   "Check spelling of every word in the buffer.
  31. For each incorrect word, you are asked for the correct spelling
  32. and then put into a query-replace to fix some or all occurrences.
  33. If you do not want to change a word, just give the same word
  34. as its \"correct\" spelling; then the query replace is skipped."
  35.   (interactive)
  36.   (spell-region (point-min) (point-max) "buffer"))
  37.  
  38. (defun spell-word ()
  39.   "Check spelling of word at or before point.
  40. If it is not correct, ask user for the correct spelling
  41. and query-replace the entire buffer to substitute it."
  42.   (interactive)
  43.   (let (beg end spell-filter)
  44.     (save-excursion
  45.      (if (not (looking-at "\\<"))
  46.      (forward-word -1))
  47.      (setq beg (point))
  48.      (forward-word 1)
  49.      (setq end (point)))
  50.     (spell-region beg end (buffer-substring beg end))))
  51.  
  52. (defun spell-region (start end &optional description)
  53.   "Like spell-buffer but applies only to region.
  54. Used in a program, applies from START to END.
  55. DESCRIPTION is an optional string naming the unit being checked:
  56. for example, \"word\"."
  57.   (interactive "r")
  58.   (let ((filter spell-filter)
  59.     (buf (get-buffer-create " *temp*")))
  60.     (save-excursion
  61.      (set-buffer buf)
  62.      (widen)
  63.      (erase-buffer))
  64.     (message "Checking spelling of %s..." (or description "region"))
  65.     (if (and (null filter) (= ?\n (char-after (1- end))))
  66.     (if (string= "spell" spell-command)
  67.         (call-process-region start end "spell" nil buf)
  68.       (call-process-region start end shell-file-name
  69.                    nil buf nil "-c" spell-command))
  70.       (let ((oldbuf (current-buffer)))
  71.     (save-excursion
  72.      (set-buffer buf)
  73.      (insert-buffer-substring oldbuf start end)
  74.      (or (bolp) (insert ?\n))
  75.      (if filter (funcall filter))
  76.      (if (string= "spell" spell-command)
  77.          (call-process-region (point-min) (point-max) "spell" t buf)
  78.        (call-process-region (point-min) (point-max) shell-file-name
  79.                 t buf nil "-c" spell-command)))))
  80.     (message "Checking spelling of %s...%s"
  81.          (or description "region")
  82.          (if (save-excursion
  83.           (set-buffer buf)
  84.           (> (buffer-size) 0))
  85.          "not correct"
  86.            "correct"))
  87.     (let (word newword
  88.       (case-fold-search t)
  89.       (case-replace t))
  90.       (while (save-excursion
  91.           (set-buffer buf)
  92.           (> (buffer-size) 0))
  93.     (save-excursion
  94.      (set-buffer buf)
  95.      (goto-char (point-min))
  96.      (setq word (downcase
  97.              (buffer-substring (point)
  98.                        (progn (end-of-line) (point)))))
  99.      (forward-char 1)
  100.      (delete-region (point-min) (point))
  101.      (setq newword
  102.            (read-input (concat "`" word
  103.                    "' not recognized; edit a replacement: ")
  104.                word))
  105.      (flush-lines (concat "^" (regexp-quote word) "$")))
  106.     (if (not (equal word newword))
  107.         (progn
  108.          (goto-char (point-min))
  109.          (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
  110.                    newword)))))))
  111.  
  112.  
  113. (defun spell-string (string)
  114.   "Check spelling of string supplied as argument."
  115.   (interactive "sSpell string: ")
  116.   (let ((buf (get-buffer-create " *temp*")))
  117.     (save-excursion
  118.      (set-buffer buf)
  119.      (widen)
  120.      (erase-buffer)
  121.      (insert string "\n")
  122.      (if (string= "spell" spell-command)
  123.      (call-process-region (point-min) (point-max) "spell"
  124.                   t t)
  125.        (call-process-region (point-min) (point-max) shell-file-name
  126.                 t t nil "-c" spell-command))
  127.      (if (= 0 (buffer-size))
  128.      (message "%s is correct" string)
  129.        (goto-char (point-min))
  130.        (while (search-forward "\n" nil t)
  131.      (replace-match " "))
  132.        (message "%sincorrect" (buffer-substring 1 (point-max)))))))
  133.