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