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