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