|
|
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.