Annotation of 43BSDReno/contrib/emacs-18.55/lisp/spell.el, revision 1.1.1.1

1.1       root        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)))))))

unix.superglobalmegacorp.com

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