|
|
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)))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.