Annotation of 43BSD/contrib/emacs/lisp/spell.el, revision 1.1.1.1

1.1       root        1: ;; Spelling correction interface for Emacs.
                      2: ;; Copyright (C) 1985 Richard M. Stallman.
                      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: (defun spell-buffer ()
                     23:   "Check spelling of every word in the buffer.
                     24: For each incorrect word, you are asked for the correct spelling
                     25: and then put into a query-replace to fix some or all occurrences.
                     26: If you do not want to change a word, just give the same word
                     27: as its \"correct\" spelling; then the query replace is skipped."
                     28:   (interactive)
                     29:   (spell-region (point-min) (point-max) "buffer"))
                     30: 
                     31: (defun spell-word ()
                     32:   "Check spelling of word at or before point.
                     33: If it is not correct, ask user for the correct spelling
                     34: and query-replace the entire buffer to substitute it."
                     35:   (interactive)
                     36:   (let (beg end)
                     37:     (save-excursion
                     38:      (if (not (looking-at "\\<"))
                     39:         (forward-word -1))
                     40:      (setq beg (point))
                     41:      (forward-word 1)
                     42:      (setq end (point)))
                     43:     (spell-region beg end (buffer-substring beg end))))
                     44: 
                     45: (defun spell-region (start end &optional description)
                     46:   "Like spell-buffer but applies only to region.
                     47: From program, applies from START to END."
                     48:   (interactive "r")
                     49:   (let ((buf (get-buffer-create " *temp*")))
                     50:     (save-excursion
                     51:      (set-buffer buf)
                     52:      (widen)
                     53:      (erase-buffer))
                     54:     (message "Checking spelling of %s..." (or description "region"))
                     55:     (if (= ?\n (char-after (1- end)))
                     56:        (call-process-region start end "spell"
                     57:                             nil buf)
                     58:       (let ((oldbuf (current-buffer)))
                     59:        (save-excursion
                     60:         (set-buffer buf)
                     61:         (insert-buffer-substring oldbuf start end)
                     62:         (insert ?\n)
                     63:         (call-process-region (point-min) (point-max) "spell"
                     64:                              t buf))))
                     65:     (message "Checking spelling of %s...%s"
                     66:             (or description "region")
                     67:             (if (save-excursion
                     68:                  (set-buffer buf)
                     69:                  (> (buffer-size) 0))
                     70:                 "not correct"
                     71:               "correct"))
                     72:     (let (word newword
                     73:          (case-fold-search t)
                     74:          (case-replace t))
                     75:       (while (save-excursion
                     76:              (set-buffer buf)
                     77:              (> (buffer-size) 0))
                     78:        (save-excursion
                     79:         (set-buffer buf)
                     80:         (goto-char (point-min))
                     81:         (setq word (buffer-substring (point)
                     82:                                      (progn (end-of-line) (point))))
                     83:         (forward-char 1)
                     84:         (delete-region (point-min) (point))
                     85:         (setq newword (read-input (concat "Replacement for " word ": ")
                     86:                                   word))
                     87:         (flush-lines (concat "^" (regexp-quote word) "$")))
                     88:        (if (not (equal word newword))
                     89:            (progn
                     90:             (goto-char (point-min))
                     91:             (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
                     92:                                   newword)))))))
                     93: 
                     94: 
                     95: (defun spell-string (string)
                     96:   "Check spelling of string supplied as argument."
                     97:   (interactive "sSpell string: ")
                     98:   (let ((buf (get-buffer-create " *temp*")))
                     99:     (save-excursion
                    100:      (set-buffer buf)
                    101:      (widen)
                    102:      (erase-buffer)
                    103:      (insert string "\n")
                    104:      (call-process-region (point-min) (point-max) "spell"
                    105:                          t t)
                    106:      (if (= 0 (buffer-size))
                    107:         (message "%s is correct" string)
                    108:        (goto-char (point-min))
                    109:        (while (search-forward "\n" nil t)
                    110:         (replace-match " "))
                    111:        (message "%sincorrect" (buffer-substring 1 (point-max)))))))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.