diff options
| author | Dave Love | 1999-12-20 23:09:55 +0000 |
|---|---|---|
| committer | Dave Love | 1999-12-20 23:09:55 +0000 |
| commit | ffb0203dbf2c9474ee68b003ab75090fc6b459c0 (patch) | |
| tree | 5e724a839af35b9fce5b62af39c12b82523362ed | |
| parent | 2c56e4a415d5a09762258b583c3a6db33c0c57f4 (diff) | |
| download | emacs-ffb0203dbf2c9474ee68b003ab75090fc6b459c0.tar.gz emacs-ffb0203dbf2c9474ee68b003ab75090fc6b459c0.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/textmodes/ispell4.el | 1114 |
1 files changed, 0 insertions, 1114 deletions
diff --git a/lisp/textmodes/ispell4.el b/lisp/textmodes/ispell4.el deleted file mode 100644 index 78b6cc1b958..00000000000 --- a/lisp/textmodes/ispell4.el +++ /dev/null | |||
| @@ -1,1114 +0,0 @@ | |||
| 1 | ;;; ispell4.el --- this is the GNU EMACS interface to GNU ISPELL version 4. | ||
| 2 | |||
| 3 | ;; Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: wp | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 12 | ;; any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 22 | ;; Boston, MA 02111-1307, USA. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; This package provides a graceful interface to ispell, the GNU | ||
| 27 | ;; spelling checker. | ||
| 28 | |||
| 29 | ;;; Code: | ||
| 30 | |||
| 31 | (defgroup ispell4 nil | ||
| 32 | "Interface to GNU ISPELL version 4." | ||
| 33 | :prefix "ispell-" | ||
| 34 | :group 'applications) | ||
| 35 | |||
| 36 | (defcustom ispell-have-new-look t | ||
| 37 | "Non-nil means use the `-r' option when running `look'." | ||
| 38 | :type 'boolean | ||
| 39 | :group 'ispell4) | ||
| 40 | |||
| 41 | (defvar ispell-enable-tex-parser nil | ||
| 42 | "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.") | ||
| 43 | |||
| 44 | (defvar ispell-process nil "The process running Ispell") | ||
| 45 | (defvar ispell-next-message nil | ||
| 46 | "An integer: where in `*ispell*' buffer to find next message from Ispell.") | ||
| 47 | |||
| 48 | (defcustom ispell-command "ispell" | ||
| 49 | "Command for running Ispell." | ||
| 50 | :type 'string | ||
| 51 | :group 'ispell4) | ||
| 52 | |||
| 53 | (defcustom ispell-command-options nil | ||
| 54 | "*String (or list of strings) to pass to Ispell as command arguments. | ||
| 55 | You can specify your private dictionary via the -p <filename> option. | ||
| 56 | The -S option is always passed to Ispell as the last parameter, | ||
| 57 | and need not be mentioned here." | ||
| 58 | :type '(repeat string) | ||
| 59 | :group 'ispell4) | ||
| 60 | |||
| 61 | (defcustom ispell-look-command "look" | ||
| 62 | "*Command for running look." | ||
| 63 | :type 'string | ||
| 64 | :group 'ispell4) | ||
| 65 | |||
| 66 | ;Each marker in this list points to the start of a word that | ||
| 67 | ;ispell thought was bad last time it did the :file command. | ||
| 68 | ;Notice that if the user accepts or inserts a word into his | ||
| 69 | ;private dictionary, then some "good" words will be on the list. | ||
| 70 | ;We would like to deal with this by looking up the words again just before | ||
| 71 | ;presenting them to the user, but that is too slow on machines | ||
| 72 | ;without the select system call. Therefore, see the variable | ||
| 73 | ;ispell-recently-accepted. | ||
| 74 | (defvar ispell-bad-words nil | ||
| 75 | "A list of markers reflecting the output of the Ispell `:file' command.") | ||
| 76 | |||
| 77 | ;list of words that the user has accepted, but that might still | ||
| 78 | ;be on the bad-words list | ||
| 79 | (defvar ispell-recently-accepted nil) | ||
| 80 | |||
| 81 | ;; Non-nil means we have started showing an alternatives window. | ||
| 82 | ;; This is the window config from before then. | ||
| 83 | (defvar ispell-window-configuration nil) | ||
| 84 | |||
| 85 | ;t when :dump command needed | ||
| 86 | (defvar ispell-dump-needed nil) | ||
| 87 | |||
| 88 | (defun ispell-flush-bad-words () | ||
| 89 | (while ispell-bad-words | ||
| 90 | (if (markerp (car ispell-bad-words)) | ||
| 91 | (set-marker (car ispell-bad-words) nil)) | ||
| 92 | (setq ispell-bad-words (cdr ispell-bad-words))) | ||
| 93 | (setq ispell-recently-accepted nil)) | ||
| 94 | |||
| 95 | (defun kill-ispell () | ||
| 96 | "Kill the Ispell process. | ||
| 97 | Any changes in your private dictionary | ||
| 98 | that have not already been dumped will be lost." | ||
| 99 | (interactive) | ||
| 100 | (if ispell-process | ||
| 101 | (delete-process ispell-process)) | ||
| 102 | (setq ispell-process nil) | ||
| 103 | (ispell-flush-bad-words)) | ||
| 104 | |||
| 105 | (put 'ispell-startup-error 'error-conditions | ||
| 106 | '(ispell-startup-error error)) | ||
| 107 | (put 'ispell-startup-error 'error-message | ||
| 108 | "Problem starting ispell - see buffer *ispell*") | ||
| 109 | |||
| 110 | ;; Start an ispell subprocess; check the version; and display the greeting. | ||
| 111 | |||
| 112 | (defun start-ispell () | ||
| 113 | (message "Starting ispell ...") | ||
| 114 | (let ((buf (get-buffer "*ispell*"))) | ||
| 115 | (if buf | ||
| 116 | (kill-buffer buf))) | ||
| 117 | (condition-case err | ||
| 118 | (setq ispell-process | ||
| 119 | (apply 'start-process "ispell" "*ispell*" ispell-command | ||
| 120 | (append (if (listp ispell-command-options) | ||
| 121 | ispell-command-options | ||
| 122 | (list ispell-command-options)) | ||
| 123 | '("-S")))) | ||
| 124 | (file-error (signal 'ispell-startup-error nil))) | ||
| 125 | (process-kill-without-query ispell-process) | ||
| 126 | (buffer-disable-undo (process-buffer ispell-process)) | ||
| 127 | (accept-process-output ispell-process) | ||
| 128 | (let (last-char) | ||
| 129 | (save-excursion | ||
| 130 | (set-buffer (process-buffer ispell-process)) | ||
| 131 | (bury-buffer (current-buffer)) | ||
| 132 | (setq last-char (- (point-max) 1)) | ||
| 133 | (while (not (eq (char-after last-char) ?=)) | ||
| 134 | (cond ((not (eq (process-status ispell-process) 'run)) | ||
| 135 | (kill-ispell) | ||
| 136 | (signal 'ispell-startup-error nil))) | ||
| 137 | (accept-process-output ispell-process) | ||
| 138 | (setq last-char (- (point-max) 1))) | ||
| 139 | (goto-char (point-min)) | ||
| 140 | (let ((greeting (read (current-buffer)))) | ||
| 141 | (if (not (= (car greeting) 1)) | ||
| 142 | (error "Bad ispell version: wanted 1, got %d" (car greeting))) | ||
| 143 | (message "%s" (car (cdr greeting)))) | ||
| 144 | (delete-region (point-min) last-char)))) | ||
| 145 | |||
| 146 | ;; Make sure ispell is ready for a command. | ||
| 147 | ;; Leaves buffer set to *ispell*, point at '='. | ||
| 148 | |||
| 149 | (defun ispell-sync (intr) | ||
| 150 | (if (or (null ispell-process) | ||
| 151 | (not (eq (process-status ispell-process) 'run))) | ||
| 152 | (start-ispell)) | ||
| 153 | (if intr | ||
| 154 | (interrupt-process ispell-process)) | ||
| 155 | (let (last-char) | ||
| 156 | (set-buffer (process-buffer ispell-process)) | ||
| 157 | (bury-buffer (current-buffer)) | ||
| 158 | (setq last-char (- (point-max) 1)) | ||
| 159 | (while (not (eq (char-after last-char) ?=)) | ||
| 160 | (accept-process-output ispell-process) | ||
| 161 | (setq last-char (- (point-max) 1))) | ||
| 162 | (goto-char last-char))) | ||
| 163 | |||
| 164 | ;; Send a command to ispell. Choices are: | ||
| 165 | ;; | ||
| 166 | ;; WORD Check spelling of WORD. Result is | ||
| 167 | ;; | ||
| 168 | ;; nil not found | ||
| 169 | ;; t spelled ok | ||
| 170 | ;; list of strings near misses | ||
| 171 | ;; | ||
| 172 | ;; :file FILENAME scan the named file, and print the file offsets of | ||
| 173 | ;; any misspelled words | ||
| 174 | ;; | ||
| 175 | ;; :insert WORD put word in private dictionary | ||
| 176 | ;; | ||
| 177 | ;; :accept WORD don't complain about word any more this session | ||
| 178 | ;; | ||
| 179 | ;; :dump write out the current private dictionary, if necessary. | ||
| 180 | ;; | ||
| 181 | ;; :reload reread private dictionary (default: `~/ispell.words') | ||
| 182 | ;; | ||
| 183 | ;; :tex | ||
| 184 | ;; :troff | ||
| 185 | ;; :generic set type of parser to use when scanning whole files | ||
| 186 | |||
| 187 | (defun ispell-cmd (&rest strings) | ||
| 188 | (save-excursion | ||
| 189 | (ispell-sync t) | ||
| 190 | (set-buffer (process-buffer ispell-process)) | ||
| 191 | (bury-buffer (current-buffer)) | ||
| 192 | (erase-buffer) | ||
| 193 | (setq ispell-next-message (point-min)) | ||
| 194 | (while strings | ||
| 195 | (process-send-string ispell-process (car strings)) | ||
| 196 | (setq strings (cdr strings))) | ||
| 197 | (process-send-string ispell-process "\n") | ||
| 198 | (accept-process-output ispell-process) | ||
| 199 | (ispell-sync nil))) | ||
| 200 | |||
| 201 | (defun ispell-dump () | ||
| 202 | (cond (ispell-dump-needed | ||
| 203 | (setq ispell-dump-needed nil) | ||
| 204 | (ispell-cmd ":dump")))) | ||
| 205 | |||
| 206 | (defun ispell-insert (word) | ||
| 207 | (ispell-cmd ":insert " word) | ||
| 208 | (if ispell-bad-words | ||
| 209 | (setq ispell-recently-accepted (cons word ispell-recently-accepted))) | ||
| 210 | (setq ispell-dump-needed t)) | ||
| 211 | |||
| 212 | (defun ispell-accept (word) | ||
| 213 | (ispell-cmd ":accept " word) | ||
| 214 | (if ispell-bad-words | ||
| 215 | (setq ispell-recently-accepted (cons word ispell-recently-accepted)))) | ||
| 216 | |||
| 217 | ;; Return the next message sent by the Ispell subprocess. | ||
| 218 | |||
| 219 | (defun ispell-next-message () | ||
| 220 | (save-excursion | ||
| 221 | (set-buffer (process-buffer ispell-process)) | ||
| 222 | (bury-buffer (current-buffer)) | ||
| 223 | (save-restriction | ||
| 224 | (goto-char ispell-next-message) | ||
| 225 | (narrow-to-region (point) | ||
| 226 | (progn (forward-sexp 1) (point))) | ||
| 227 | (setq ispell-next-message (point)) | ||
| 228 | (goto-char (point-min)) | ||
| 229 | (read (current-buffer))))) | ||
| 230 | |||
| 231 | (defun ispell-tex-buffer-p () | ||
| 232 | (memq major-mode '(plain-tex-mode latex-mode slitex-mode))) | ||
| 233 | |||
| 234 | (defvar ispell-menu-map (make-sparse-keymap "Spell")) | ||
| 235 | (defalias 'ispell-menu-map ispell-menu-map) | ||
| 236 | |||
| 237 | (define-key ispell-menu-map [ispell-complete-word-interior-frag] | ||
| 238 | '("Complete Interior Fragment" . ispell-complete-word-interior-frag)) | ||
| 239 | |||
| 240 | (define-key ispell-menu-map [ispell-complete-word] | ||
| 241 | '("Complete Word" . ispell-complete-word)) | ||
| 242 | |||
| 243 | (define-key ispell-menu-map [reload-ispell] | ||
| 244 | '("Reload Dictionary" . reload-ispell)) | ||
| 245 | |||
| 246 | (define-key ispell-menu-map [ispell-next] | ||
| 247 | '("Continue Check" . ispell-next)) | ||
| 248 | |||
| 249 | (define-key ispell-menu-map [ispell-message] | ||
| 250 | '("Check Message" . ispell-message)) | ||
| 251 | |||
| 252 | (define-key ispell-menu-map [ispell-word] | ||
| 253 | '("Check Word" . ispell-word)) | ||
| 254 | |||
| 255 | (define-key ispell-menu-map [ispell-region] | ||
| 256 | '("Check Region" . ispell-region)) | ||
| 257 | |||
| 258 | (define-key ispell-menu-map [ispell-buffer] | ||
| 259 | '("Check Buffer" . ispell)) | ||
| 260 | |||
| 261 | ;;;autoload | ||
| 262 | (defun ispell (&optional buf start end) | ||
| 263 | "Run Ispell over current buffer's visited file. | ||
| 264 | First the file is scanned for misspelled words, then Ispell | ||
| 265 | enters a loop with the following commands for every misspelled word: | ||
| 266 | |||
| 267 | DIGIT Near miss selector. If the misspelled word is close to | ||
| 268 | some words in the dictionary, they are offered as near misses. | ||
| 269 | r Replace. Replace the word with a string you type. Each word | ||
| 270 | of your new string is also checked. | ||
| 271 | i Insert. Insert this word in your private dictionary (by default, | ||
| 272 | `$HOME/ispell.words'). | ||
| 273 | a Accept. Accept this word for the rest of this editing session, | ||
| 274 | but don't put it in your private dictionary. | ||
| 275 | l Lookup. Look for a word in the dictionary by fast binary | ||
| 276 | search, or search for a regular expression in the dictionary | ||
| 277 | using grep. | ||
| 278 | SPACE Accept the word this time, but complain if it is seen again. | ||
| 279 | q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]." | ||
| 280 | (interactive) | ||
| 281 | (if (null start) | ||
| 282 | (setq start 0)) | ||
| 283 | (if (null end) | ||
| 284 | (setq end 0)) | ||
| 285 | |||
| 286 | (if (null buf) | ||
| 287 | (setq buf (current-buffer))) | ||
| 288 | (setq buf (get-buffer buf)) | ||
| 289 | (if (null buf) | ||
| 290 | (error "Can't find buffer")) | ||
| 291 | ;; Deactivate the mark, because we'll do it anyway if we change something, | ||
| 292 | ;; and a region highlight while in the Ispell loop is distracting. | ||
| 293 | (deactivate-mark) | ||
| 294 | (save-excursion | ||
| 295 | (set-buffer buf) | ||
| 296 | (let ((filename buffer-file-name) | ||
| 297 | (delete-temp nil)) | ||
| 298 | (unwind-protect | ||
| 299 | (progn | ||
| 300 | (cond ((or (null filename) | ||
| 301 | (find-file-name-handler buffer-file-name nil)) | ||
| 302 | (setq filename (make-temp-name "/usr/tmp/ispell")) | ||
| 303 | (setq delete-temp t) | ||
| 304 | (write-region (point-min) (point-max) filename)) | ||
| 305 | ((and (buffer-modified-p buf) | ||
| 306 | (y-or-n-p (format "Save file %s? " filename))) | ||
| 307 | (save-buffer))) | ||
| 308 | (message "Ispell scanning file...") | ||
| 309 | (if (and ispell-enable-tex-parser | ||
| 310 | (ispell-tex-buffer-p)) | ||
| 311 | (ispell-cmd ":tex") | ||
| 312 | (ispell-cmd ":generic")) | ||
| 313 | (ispell-cmd (format ":file %s %d %d" filename start end))) | ||
| 314 | (if delete-temp | ||
| 315 | (condition-case () | ||
| 316 | (delete-file filename) | ||
| 317 | (file-error nil))))) | ||
| 318 | (message "Parsing ispell output ...") | ||
| 319 | (ispell-flush-bad-words) | ||
| 320 | (let (pos bad-words) | ||
| 321 | (while (numberp (setq pos (ispell-next-message))) | ||
| 322 | ;;ispell may check the words on the line following the end | ||
| 323 | ;;of the region - therefore, don't record anything out of range | ||
| 324 | (if (or (= end 0) | ||
| 325 | (< pos end)) | ||
| 326 | (setq bad-words (cons (set-marker (make-marker) (+ pos 1)) | ||
| 327 | bad-words)))) | ||
| 328 | (setq bad-words (cons pos bad-words)) | ||
| 329 | (setq ispell-bad-words (nreverse bad-words)))) | ||
| 330 | (cond ((not (markerp (car ispell-bad-words))) | ||
| 331 | (setq ispell-bad-words nil) | ||
| 332 | (message "No misspellings.") | ||
| 333 | t) | ||
| 334 | (t | ||
| 335 | (message "Ispell parsing done.") | ||
| 336 | (ispell-next)))) | ||
| 337 | |||
| 338 | ;;;autoload | ||
| 339 | (defalias 'ispell-buffer 'ispell) | ||
| 340 | |||
| 341 | (defun ispell-next () | ||
| 342 | "Resume command loop for most recent Ispell command. | ||
| 343 | Return value is t unless exit is due to typing `q'." | ||
| 344 | (interactive) | ||
| 345 | (setq ispell-window-configuration nil) | ||
| 346 | (prog1 | ||
| 347 | (unwind-protect | ||
| 348 | (catch 'ispell-quit | ||
| 349 | ;; There used to be a save-excursion here, | ||
| 350 | ;; but that was annoying: it's better if point doesn't move | ||
| 351 | ;; when you type q. | ||
| 352 | (let (next) | ||
| 353 | (while (markerp (setq next (car ispell-bad-words))) | ||
| 354 | (switch-to-buffer (marker-buffer next)) | ||
| 355 | (push-mark) | ||
| 356 | (ispell-point next "at saved position.") | ||
| 357 | (setq ispell-bad-words (cdr ispell-bad-words)) | ||
| 358 | (set-marker next nil))) | ||
| 359 | t) | ||
| 360 | (ispell-dehighlight) | ||
| 361 | (if ispell-window-configuration | ||
| 362 | (set-window-configuration ispell-window-configuration)) | ||
| 363 | (cond ((null ispell-bad-words) | ||
| 364 | (error "Ispell has not yet been run")) | ||
| 365 | ((markerp (car ispell-bad-words)) | ||
| 366 | (message "%s" | ||
| 367 | (substitute-command-keys | ||
| 368 | "Type \\[ispell-next] to continue"))) | ||
| 369 | ((eq (car ispell-bad-words) nil) | ||
| 370 | (setq ispell-bad-words nil) | ||
| 371 | (message "No more misspellings (but checker was interrupted)")) | ||
| 372 | ((eq (car ispell-bad-words) t) | ||
| 373 | (setq ispell-bad-words nil) | ||
| 374 | (message "Ispell done")) | ||
| 375 | (t | ||
| 376 | (setq ispell-bad-words nil) | ||
| 377 | (message "Bad ispell internal list")))) | ||
| 378 | (ispell-dump))) | ||
| 379 | |||
| 380 | ;;;autoload | ||
| 381 | (defun ispell-word (&optional resume) | ||
| 382 | "Check the spelling of the word under the cursor. | ||
| 383 | See the command `ispell' for more information. | ||
| 384 | With a prefix argument, resume handling of the previous Ispell command." | ||
| 385 | (interactive "P") | ||
| 386 | (if resume | ||
| 387 | (ispell-next) | ||
| 388 | (condition-case err | ||
| 389 | (unwind-protect | ||
| 390 | (catch 'ispell-quit | ||
| 391 | (save-window-excursion | ||
| 392 | (ispell-point (point) "at point.")) | ||
| 393 | (ispell-dump)) | ||
| 394 | (ispell-dehighlight)) | ||
| 395 | (ispell-startup-error | ||
| 396 | (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ") | ||
| 397 | (load-library "spell") | ||
| 398 | (define-key esc-map "$" 'spell-word) | ||
| 399 | (spell-word))))))) | ||
| 400 | |||
| 401 | ;;;autoload (define-key esc-map "$" 'ispell-word) | ||
| 402 | |||
| 403 | ;;;autoload | ||
| 404 | (defun ispell-region (start &optional end) | ||
| 405 | "Check the spelling for all of the words in the region." | ||
| 406 | (interactive "r") | ||
| 407 | (ispell (current-buffer) start end)) | ||
| 408 | |||
| 409 | (defun ispell-letterp (c) | ||
| 410 | (and c | ||
| 411 | (or (and (>= c ?A) (<= c ?Z)) | ||
| 412 | (and (>= c ?a) (<= c ?z)) | ||
| 413 | (>= c 128)))) | ||
| 414 | |||
| 415 | (defun ispell-letter-or-quotep (c) | ||
| 416 | (and c | ||
| 417 | (or (and (>= c ?A) (<= c ?Z)) | ||
| 418 | (and (>= c ?a) (<= c ?z)) | ||
| 419 | (= c ?') | ||
| 420 | (>= c 128)))) | ||
| 421 | |||
| 422 | (defun ispell-find-word-start () | ||
| 423 | ;;backward to a letter | ||
| 424 | (if (not (ispell-letterp (char-after (point)))) | ||
| 425 | (while (and (not (bobp)) | ||
| 426 | (not (ispell-letterp (char-after (- (point) 1))))) | ||
| 427 | (backward-char))) | ||
| 428 | ;;backward to beginning of word | ||
| 429 | (while (ispell-letter-or-quotep (char-after (- (point) 1))) | ||
| 430 | (backward-char)) | ||
| 431 | (skip-chars-forward "'")) | ||
| 432 | |||
| 433 | (defun ispell-find-word-end () | ||
| 434 | (while (ispell-letter-or-quotep (char-after (point))) | ||
| 435 | (forward-char)) | ||
| 436 | (skip-chars-backward "'")) | ||
| 437 | |||
| 438 | (defun ispell-next-word () | ||
| 439 | (while (and (not (eobp)) | ||
| 440 | (not (ispell-letterp (char-after (point))))) | ||
| 441 | (forward-char))) | ||
| 442 | |||
| 443 | ;if end is nil, then do one word at start | ||
| 444 | ;otherwise, do all words from the beginning of the word where | ||
| 445 | ;start points, to the end of the word where end points | ||
| 446 | (defun ispell-point (start message) | ||
| 447 | (let ((wend (make-marker)) | ||
| 448 | rescan | ||
| 449 | end) | ||
| 450 | ;; There used to be a save-excursion here, | ||
| 451 | ;; but that was annoying: it's better if point doesn't move | ||
| 452 | ;; when you type q. | ||
| 453 | (goto-char start) | ||
| 454 | (ispell-find-word-start) ;find correct word start | ||
| 455 | (setq start (point-marker)) | ||
| 456 | (ispell-find-word-end) ;now find correct end | ||
| 457 | (setq end (point-marker)) | ||
| 458 | ;; Do nothing if we don't find a word. | ||
| 459 | (if (< start end) | ||
| 460 | (while (< start end) | ||
| 461 | (goto-char start) | ||
| 462 | (ispell-find-word-end) ;find end of current word | ||
| 463 | ;could be before 'end' if | ||
| 464 | ;user typed replacement | ||
| 465 | ;that is more than one word | ||
| 466 | (set-marker wend (point)) | ||
| 467 | (setq rescan nil) | ||
| 468 | (setq word (buffer-substring start wend)) | ||
| 469 | (cond ((ispell-still-bad word) | ||
| 470 | ;;; This just causes confusion. -- rms. | ||
| 471 | ;;; (goto-char start) | ||
| 472 | ;;; (sit-for 0) | ||
| 473 | (message "Ispell checking %s" word) | ||
| 474 | (ispell-cmd word) | ||
| 475 | (let ((message (ispell-next-message))) | ||
| 476 | (cond ((eq message t) | ||
| 477 | (message "%s: ok" word)) | ||
| 478 | ((or (null message) | ||
| 479 | (consp message)) | ||
| 480 | (setq rescan | ||
| 481 | (ispell-command-loop word start wend message))) | ||
| 482 | (t | ||
| 483 | (error "unknown ispell response %s" message)))))) | ||
| 484 | (cond ((null rescan) | ||
| 485 | (goto-char wend) | ||
| 486 | (ispell-next-word) | ||
| 487 | (set-marker start (point)))))) | ||
| 488 | ;;clear the choices buffer; otherwise it's hard for the user to tell | ||
| 489 | ;;when we get back to the command loop | ||
| 490 | (let ((buf (get-buffer "*ispell choices*"))) | ||
| 491 | (cond (buf | ||
| 492 | (set-buffer buf) | ||
| 493 | (erase-buffer)))) | ||
| 494 | (set-marker start nil) | ||
| 495 | (set-marker end nil) | ||
| 496 | (set-marker wend nil))) | ||
| 497 | |||
| 498 | (defun ispell-still-bad (word) | ||
| 499 | (let ((words ispell-recently-accepted) | ||
| 500 | (ret t) | ||
| 501 | (case-fold-search t)) | ||
| 502 | (while words | ||
| 503 | (cond ((eq (string-match (car words) word) 0) | ||
| 504 | (setq ret nil) | ||
| 505 | (setq words nil))) | ||
| 506 | (setq words (cdr words))) | ||
| 507 | ret)) | ||
| 508 | |||
| 509 | (defun ispell-show-choices (word message first-line) | ||
| 510 | ;;if there is only one window on the frame, make the ispell | ||
| 511 | ;;messages winow be small. otherwise just use the other window | ||
| 512 | (let* ((selwin (selected-window)) | ||
| 513 | (resize (eq selwin (next-window))) | ||
| 514 | (buf (get-buffer-create "*ispell choices*")) | ||
| 515 | w) | ||
| 516 | (or ispell-window-configuration | ||
| 517 | (setq ispell-window-configuration (current-window-configuration))) | ||
| 518 | (setq w (display-buffer buf)) | ||
| 519 | (buffer-disable-undo buf) | ||
| 520 | (if resize | ||
| 521 | (unwind-protect | ||
| 522 | (progn | ||
| 523 | (select-window w) | ||
| 524 | (enlarge-window (- 6 (window-height w)))) | ||
| 525 | (select-window selwin))) | ||
| 526 | (save-excursion | ||
| 527 | (set-buffer buf) | ||
| 528 | (bury-buffer buf) | ||
| 529 | (set-window-point w (point-min)) | ||
| 530 | (set-window-start w (point-min)) | ||
| 531 | (erase-buffer) | ||
| 532 | (insert first-line "\n") | ||
| 533 | (insert | ||
| 534 | "SPC skip; A accept; I insert; DIGIT select; R replace; \ | ||
| 535 | L lookup; Q quit\n") | ||
| 536 | (cond ((not (null message)) | ||
| 537 | (let ((i 0)) | ||
| 538 | (while (< i 3) | ||
| 539 | (let ((j 0)) | ||
| 540 | (while (< j 3) | ||
| 541 | (let* ((n (+ (* j 3) i)) | ||
| 542 | (choice (nth n message))) | ||
| 543 | (cond (choice | ||
| 544 | (let ((str (format "%d %s" n choice))) | ||
| 545 | (insert str) | ||
| 546 | (insert-char ? (- 20 (length str))))))) | ||
| 547 | (setq j (+ j 1)))) | ||
| 548 | (insert "\n") | ||
| 549 | (setq i (+ i 1))))))))) | ||
| 550 | |||
| 551 | (defun ispell-command-loop (word start end message) | ||
| 552 | (let ((flag t) | ||
| 553 | (rescan nil) | ||
| 554 | first-line) | ||
| 555 | (if (null message) | ||
| 556 | (setq first-line (concat "No near misses for '" word "'")) | ||
| 557 | (setq first-line (concat "Near misses for '" word "'"))) | ||
| 558 | (ispell-highlight start end) | ||
| 559 | (while flag | ||
| 560 | (ispell-show-choices word message first-line) | ||
| 561 | (message "Ispell command: ") | ||
| 562 | (undo-boundary) | ||
| 563 | (let ((c (downcase (read-char))) | ||
| 564 | replacement) | ||
| 565 | (cond ((and (>= c ?0) | ||
| 566 | (<= c ?9) | ||
| 567 | (setq replacement (nth (- c ?0) message))) | ||
| 568 | (ispell-replace start end replacement) | ||
| 569 | (setq flag nil)) | ||
| 570 | ((= c ?q) | ||
| 571 | (throw 'ispell-quit nil)) | ||
| 572 | ((= c (nth 3 (current-input-mode))) | ||
| 573 | (keyboard-quit)) | ||
| 574 | ((= c ? ) | ||
| 575 | (setq flag nil)) | ||
| 576 | ((= c ?r) | ||
| 577 | (ispell-replace start end (read-string "Replacement: ")) | ||
| 578 | (setq rescan t) | ||
| 579 | (setq flag nil)) | ||
| 580 | ((= c ?i) | ||
| 581 | (ispell-insert word) | ||
| 582 | (setq flag nil)) | ||
| 583 | ((= c ?a) | ||
| 584 | (ispell-accept word) | ||
| 585 | (setq flag nil)) | ||
| 586 | ((= c ?l) | ||
| 587 | (let ((val (ispell-do-look word))) | ||
| 588 | (setq first-line (car val)) | ||
| 589 | (setq message (cdr val)))) | ||
| 590 | ((= c ??) | ||
| 591 | (message | ||
| 592 | "Type 'C-h d ispell' to the emacs main loop for more help") | ||
| 593 | (sit-for 2)) | ||
| 594 | (t | ||
| 595 | (message "Bad ispell command") | ||
| 596 | (sit-for 2))))) | ||
| 597 | rescan)) | ||
| 598 | |||
| 599 | (defun ispell-do-look (bad-word) | ||
| 600 | (let (regex buf words) | ||
| 601 | (cond ((null ispell-have-new-look) | ||
| 602 | (setq regex (read-string "Lookup: "))) | ||
| 603 | (t | ||
| 604 | (setq regex (read-string "Lookup (regex): " "^")))) | ||
| 605 | (setq buf (get-buffer-create "*ispell look*")) | ||
| 606 | (save-excursion | ||
| 607 | (set-buffer buf) | ||
| 608 | (delete-region (point-min) (point-max)) | ||
| 609 | (if ispell-have-new-look | ||
| 610 | (call-process ispell-look-command nil buf nil "-r" regex) | ||
| 611 | (call-process ispell-look-command nil buf nil regex)) | ||
| 612 | (goto-char (point-min)) | ||
| 613 | (forward-line 10) | ||
| 614 | (delete-region (point) (point-max)) | ||
| 615 | (goto-char (point-min)) | ||
| 616 | (while (not (= (point-min) (point-max))) | ||
| 617 | (end-of-line) | ||
| 618 | (setq words (cons (buffer-substring (point-min) (point)) words)) | ||
| 619 | (forward-line) | ||
| 620 | (delete-region (point-min) (point))) | ||
| 621 | (kill-buffer buf) | ||
| 622 | (cons (format "Lookup '%s'" regex) | ||
| 623 | (reverse words))))) | ||
| 624 | |||
| 625 | (defun ispell-replace (start end new) | ||
| 626 | (goto-char start) | ||
| 627 | (insert new) | ||
| 628 | (delete-region (point) end)) | ||
| 629 | |||
| 630 | (defun reload-ispell () | ||
| 631 | "Tell Ispell to re-read your private dictionary." | ||
| 632 | (interactive) | ||
| 633 | (ispell-cmd ":reload")) | ||
| 634 | |||
| 635 | (defun batch-make-ispell () | ||
| 636 | (byte-compile-file "ispell.el") | ||
| 637 | (find-file "ispell.texinfo") | ||
| 638 | (let ((old-dir default-directory) | ||
| 639 | (default-directory "/tmp")) | ||
| 640 | (texinfo-format-buffer)) | ||
| 641 | (Info-validate) | ||
| 642 | (if (get-buffer " *problems in info file*") | ||
| 643 | (kill-emacs 1)) | ||
| 644 | (write-region (point-min) (point-max) "ispell.info")) | ||
| 645 | |||
| 646 | (defcustom ispell-highlight t | ||
| 647 | "*Non-nil means to highlight ispell words." | ||
| 648 | :type 'boolean | ||
| 649 | :group 'ispell4) | ||
| 650 | |||
| 651 | (defvar ispell-overlay nil) | ||
| 652 | |||
| 653 | (defun ispell-dehighlight () | ||
| 654 | (and ispell-overlay | ||
| 655 | (progn | ||
| 656 | (delete-overlay ispell-overlay) | ||
| 657 | (setq ispell-overlay nil)))) | ||
| 658 | |||
| 659 | (defun ispell-highlight (start end) | ||
| 660 | (and ispell-highlight | ||
| 661 | window-system | ||
| 662 | (progn | ||
| 663 | (or ispell-overlay | ||
| 664 | (progn | ||
| 665 | (setq ispell-overlay (make-overlay start end)) | ||
| 666 | (overlay-put ispell-overlay 'face | ||
| 667 | (if (internal-find-face 'ispell) | ||
| 668 | 'ispell 'region)))) | ||
| 669 | (move-overlay ispell-overlay start end (current-buffer))))) | ||
| 670 | |||
| 671 | ;;;; ispell-complete-word | ||
| 672 | |||
| 673 | ;;; Brief Description: | ||
| 674 | ;;; Complete word fragment at point using dictionary and replace with full | ||
| 675 | ;;; word. Expansion done in current buffer like lisp-complete-symbol. | ||
| 676 | ;;; Completion of interior word fragments possible with prefix argument. | ||
| 677 | |||
| 678 | ;;; Known Problem: | ||
| 679 | ;;; Does not use private dictionary because GNU `look' does not use it. It | ||
| 680 | ;;; would be nice if GNU `look' took standard input; this would allow gzip'ed | ||
| 681 | ;;; dictionaries to be used. GNU `look' also has a bug, see | ||
| 682 | ;;; `ispell-gnu-look-still-broken-p'. | ||
| 683 | |||
| 684 | ;;; Motivation: | ||
| 685 | ;;; The `l', "regular expression look up", keymap option of ispell-word | ||
| 686 | ;;; (ispell-do-look) can only be run after finding a misspelled word. So | ||
| 687 | ;;; ispell-do-look can not be used to look for words starting with `cat' to | ||
| 688 | ;;; find `catechetical' since `cat' is a correctly spelled word. Furthermore, | ||
| 689 | ;;; ispell-do-look does not return the entire list returned by `look'. | ||
| 690 | ;;; | ||
| 691 | ;;; ispell-complete-word allows you to get a completion list from the system | ||
| 692 | ;;; dictionary and expand a word fragment at the current position in a buffer. | ||
| 693 | ;;; These examples assume ispell-complete-word is bound to M-TAB as it is in | ||
| 694 | ;;; text-mode; the `Complete Word' and `Complete Interior Fragment' entries of | ||
| 695 | ;;; the "Spell" submenu under the "Edit" menu may also be used instead of | ||
| 696 | ;;; M-TAB and C-u M-TAB, respectively. | ||
| 697 | ;;; | ||
| 698 | ;;; EXAMPLE 1: The word `Saskatchewan' needs to be spelled. The user may | ||
| 699 | ;;; type `Sas' and hit M-TAB and a completion list will be built using the | ||
| 700 | ;;; shell command `look' and displayed in the *Completions* buffer: | ||
| 701 | ;;; | ||
| 702 | ;;; Possible completions are: | ||
| 703 | ;;; sash sashay | ||
| 704 | ;;; sashayed sashed | ||
| 705 | ;;; sashes sashimi | ||
| 706 | ;;; Saskatchewan Saskatoon | ||
| 707 | ;;; sass sassafras | ||
| 708 | ;;; sassier sassing | ||
| 709 | ;;; sasswood sassy | ||
| 710 | ;;; | ||
| 711 | ;;; By viewing this list the user will hopefully be motivated to insert the | ||
| 712 | ;;; letter `k' after the `sas'. When M-TAB is hit again the word `Saskat' | ||
| 713 | ;;; will be inserted in place of `sas' (note case) since this is a unique | ||
| 714 | ;;; substring completion. The narrowed completion list can be viewed with | ||
| 715 | ;;; another M-TAB | ||
| 716 | ;;; | ||
| 717 | ;;; Possible completions are: | ||
| 718 | ;;; Saskatchewan Saskatoon | ||
| 719 | ;;; | ||
| 720 | ;;; Inserting the letter `c' and hitting M-TAB will narrow the completion | ||
| 721 | ;;; possibilities to just `Saskatchewan' and this will be inserted in the | ||
| 722 | ;;; buffer. At any point the user may click the mouse on a completion to | ||
| 723 | ;;; select it. | ||
| 724 | ;;; | ||
| 725 | ;;; EXAMPLE 2: The user has typed `Sasaquane' and M-$ (ispell-word) gives no | ||
| 726 | ;;; "near-misses" in which case you back up to `Sas' and hit M-TAB and find | ||
| 727 | ;;; the correct word as above. The `Sas' will be replaced by `Saskatchewan' | ||
| 728 | ;;; and the remaining word fragment `aquane' can be deleted. | ||
| 729 | ;;; | ||
| 730 | ;;; EXAMPLE 3: If a version of `look' is used that supports regular | ||
| 731 | ;;; expressions, then `ispell-have-new-look' should be t (its default) and | ||
| 732 | ;;; interior word fragments may also be used for the search. The word | ||
| 733 | ;;; `pneumonia' needs to be spelled. The user can only remember the | ||
| 734 | ;;; interior fragment `mon' in which case `C-u M-TAB' on `mon' gives a list | ||
| 735 | ;;; of all words containing the interior word fragment `mon'. Typing `p' | ||
| 736 | ;;; and M-TAB will narrow this list to all the words starting with `p' and | ||
| 737 | ;;; containing `mon' from which `pneumonia' can be found as above. | ||
| 738 | |||
| 739 | ;;; The user-defined variables are: | ||
| 740 | ;;; | ||
| 741 | ;;; ispell-look-command | ||
| 742 | ;;; ispell-look-dictionary | ||
| 743 | ;;; ispell-gnu-look-still-broken-p | ||
| 744 | |||
| 745 | ;;; Algorithm (some similarity to lisp-complete-symbol): | ||
| 746 | ;;; | ||
| 747 | ;;; * call-process on command ispell-look-command (default: "look") to find | ||
| 748 | ;;; words in ispell-look-dictionary matching `string' (or `regexp' if | ||
| 749 | ;;; ispell-have-new-look is t). Parse output and store results in | ||
| 750 | ;;; ispell-lookup-completions-alist. | ||
| 751 | ;;; | ||
| 752 | ;;; * Build completion list using try-completion and `string' | ||
| 753 | ;;; | ||
| 754 | ;;; * Replace `string' in buffer with matched common substring completion. | ||
| 755 | ;;; | ||
| 756 | ;;; * Display completion list only if there is no matched common substring. | ||
| 757 | ;;; | ||
| 758 | ;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when | ||
| 759 | ;;; beginning of word fragment has changed. | ||
| 760 | ;;; | ||
| 761 | ;;; * Interior fragments searches are performed similarly with the exception | ||
| 762 | ;;; that the entire fragment at point is initially removed from the buffer, | ||
| 763 | ;;; the STRING passed to try-completion and all-completions is just "" and | ||
| 764 | ;;; not the interior fragment; this allows all completions containing the | ||
| 765 | ;;; interior fragment to be shown. The location in the buffer is stored to | ||
| 766 | ;;; decide whether future completion narrowing of the current list should be | ||
| 767 | ;;; done or if a new list should be built. See interior fragment example | ||
| 768 | ;;; above. | ||
| 769 | ;;; | ||
| 770 | ;;; * Robust searches are done using a `look' with -r (regular expression) | ||
| 771 | ;;; switch if ispell-have-new-look is t. | ||
| 772 | |||
| 773 | ;;;; User-defined variables. | ||
| 774 | |||
| 775 | (defcustom ispell-look-dictionary nil | ||
| 776 | "*If non-nil then spelling dictionary as string for `ispell-complete-word'. | ||
| 777 | Overrides default dictionary file such as \"/usr/dict/words\" or GNU look's | ||
| 778 | \"${prefix}/lib/ispell/ispell.words\"" | ||
| 779 | :type '(choice (const nil) file) | ||
| 780 | :group 'ispell4) | ||
| 781 | |||
| 782 | |||
| 783 | (defcustom ispell-gnu-look-still-broken-p nil | ||
| 784 | "*t if GNU look -r can give different results with and without trailing `.*'. | ||
| 785 | Example: `look -dfr \"^ya\" foo' returns nothing, while `look -dfr \"^ya.*\" foo' | ||
| 786 | returns `yacc', where `foo' is a dictionary file containing the three lines | ||
| 787 | |||
| 788 | y | ||
| 789 | y's | ||
| 790 | yacc | ||
| 791 | |||
| 792 | Both commands should return `yacc'. If `ispell-complete-word' erroneously | ||
| 793 | states that no completions exist for a string, then setting this variable to t | ||
| 794 | will help find those completions." | ||
| 795 | :type 'boolean | ||
| 796 | :group 'ispell4) | ||
| 797 | |||
| 798 | ;;;; Internal variables. | ||
| 799 | |||
| 800 | ;;; Possible completions for last word fragment. | ||
| 801 | (defvar ispell-lookup-completions-alist nil) | ||
| 802 | |||
| 803 | ;;; Last word fragment processed by `ispell-complete-word'. | ||
| 804 | (defvar ispell-lookup-last-word nil) | ||
| 805 | |||
| 806 | ;;; Buffer local variables. | ||
| 807 | |||
| 808 | ;;; Value of interior-frag in last call to `ispell-complete-word'. | ||
| 809 | (defvar ispell-lookup-last-interior-p nil) | ||
| 810 | (make-variable-buffer-local 'ispell-lookup-last-interior-p) | ||
| 811 | (put 'ispell-lookup-last-interior-p 'permanent-local t) | ||
| 812 | |||
| 813 | ;;; Buffer position in last call to `ispell-complete-word'. | ||
| 814 | (defvar ispell-lookup-last-bow nil) | ||
| 815 | (make-variable-buffer-local 'ispell-lookup-last-bow) | ||
| 816 | (put 'ispell-lookup-last-bow 'permanent-local t) | ||
| 817 | |||
| 818 | ;;;; Interactive functions. | ||
| 819 | ;;;autoload | ||
| 820 | (defun ispell-complete-word (&optional interior-frag) | ||
| 821 | "Complete word using letters at point to word beginning using `look'. | ||
| 822 | With optional argument INTERIOR-FRAG, word fragment at point is assumed to be | ||
| 823 | an interior word fragment in which case `ispell-have-new-look' should be t. | ||
| 824 | See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'." | ||
| 825 | |||
| 826 | (interactive "P") | ||
| 827 | |||
| 828 | ;; `look' must support regexp expressions in order to perform an interior | ||
| 829 | ;; fragment search. | ||
| 830 | (if (and interior-frag (not ispell-have-new-look)) | ||
| 831 | (error (concat "Sorry, `ispell-have-new-look' is nil. " | ||
| 832 | "You also will need GNU Ispell's `look'."))) | ||
| 833 | |||
| 834 | (let* ((completion-ignore-case t) | ||
| 835 | |||
| 836 | ;; Get location of beginning of word fragment. | ||
| 837 | (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point))) | ||
| 838 | |||
| 839 | ;; Get the string to look up. | ||
| 840 | (string (buffer-substring bow (point))) | ||
| 841 | |||
| 842 | ;; Get regexp for which we search and, if necessary, an interior word | ||
| 843 | ;; fragment. | ||
| 844 | (regexp (if interior-frag | ||
| 845 | (concat "^.*" string ".*") | ||
| 846 | ;; If possible use fast binary search: no trailing `.*'. | ||
| 847 | (concat "^" string | ||
| 848 | (if ispell-gnu-look-still-broken-p ".*")))) | ||
| 849 | |||
| 850 | ;; We want all completions for case of interior fragments so set | ||
| 851 | ;; prefix to an empty string. | ||
| 852 | (prefix (if interior-frag "" string)) | ||
| 853 | |||
| 854 | ;; Are we continuing from a previous interior fragment search? | ||
| 855 | ;; Check last value of interior-word and if the point has moved. | ||
| 856 | (continuing-an-interior-frag-p | ||
| 857 | (and ispell-lookup-last-interior-p | ||
| 858 | (equal ispell-lookup-last-bow bow))) | ||
| 859 | |||
| 860 | ;; Are we starting a unique word fragment search? Always t for | ||
| 861 | ;; interior word fragment search. | ||
| 862 | (new-unique-string-p | ||
| 863 | (or interior-frag (null ispell-lookup-last-word) | ||
| 864 | (let ((case-fold-search t)) | ||
| 865 | ;; Can we locate last word fragment as a substring of current | ||
| 866 | ;; word fragment? If the last word fragment is larger than | ||
| 867 | ;; the current string then we will have to rebuild the list | ||
| 868 | ;; later. | ||
| 869 | (not (string-match | ||
| 870 | (concat "^" ispell-lookup-last-word) string))))) | ||
| 871 | |||
| 872 | completion) | ||
| 873 | |||
| 874 | ;; Check for perfect completion already. That is, maybe the user has hit | ||
| 875 | ;; M-x ispell-complete-word one too many times? | ||
| 876 | (if (string-equal string "") | ||
| 877 | (if (string-equal (concat ispell-lookup-last-word " ") | ||
| 878 | (buffer-substring | ||
| 879 | (save-excursion (forward-word -1) (point)) (point))) | ||
| 880 | (error "Perfect match already") | ||
| 881 | (error "No word fragment at point"))) | ||
| 882 | |||
| 883 | ;; Create list of words from system dictionary starting with `string' if | ||
| 884 | ;; new string and not continuing from a previous interior fragment search. | ||
| 885 | (if (and (not continuing-an-interior-frag-p) new-unique-string-p) | ||
| 886 | (setq ispell-lookup-completions-alist | ||
| 887 | (ispell-lookup-build-list string regexp))) | ||
| 888 | |||
| 889 | ;; Check for a completion of `string' in the list and store `string' and | ||
| 890 | ;; other variables for the next call. | ||
| 891 | (setq completion (try-completion prefix ispell-lookup-completions-alist) | ||
| 892 | ispell-lookup-last-word string | ||
| 893 | ispell-lookup-last-interior-p interior-frag | ||
| 894 | ispell-lookup-last-bow bow) | ||
| 895 | |||
| 896 | ;; Test the completion status. | ||
| 897 | (cond | ||
| 898 | |||
| 899 | ;; * Guess is a perfect match. | ||
| 900 | ((eq completion t) | ||
| 901 | (insert " ") | ||
| 902 | (message "Perfect match.")) | ||
| 903 | |||
| 904 | ;; * No possibilities. | ||
| 905 | ((null completion) | ||
| 906 | (message "Can't find completion for \"%s\"" string) | ||
| 907 | (beep)) | ||
| 908 | |||
| 909 | ;; * Replace string fragment with matched common substring completion. | ||
| 910 | ((and (not (string-equal completion "")) | ||
| 911 | ;; Fold case so a completion list is built when `string' and common | ||
| 912 | ;; substring differ only in case. | ||
| 913 | (let ((case-fold-search t)) | ||
| 914 | (not (string-match (concat "^" completion "$") string)))) | ||
| 915 | (search-backward string bow) | ||
| 916 | (replace-match completion nil t) ; FIXEDCASE doesn't work? or LITERAL? | ||
| 917 | (message "Proposed unique substring. Repeat for completions list.")) | ||
| 918 | |||
| 919 | ;; * String is a common substring completion already. Make list. | ||
| 920 | (t | ||
| 921 | (message "Making completion list...") | ||
| 922 | (if (string-equal completion "") (delete-region bow (point))) | ||
| 923 | (let ((list (all-completions prefix ispell-lookup-completions-alist))) | ||
| 924 | (with-output-to-temp-buffer "*Completions*" | ||
| 925 | (display-completion-list list))) | ||
| 926 | (message "Making completion list...done"))))) | ||
| 927 | |||
| 928 | ;;;autoload | ||
| 929 | (defun ispell-complete-word-interior-frag () | ||
| 930 | "Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG. | ||
| 931 | A completion list is built for word fragment at point which is assumed to be | ||
| 932 | an interior word fragment. `ispell-have-new-look' should be t." | ||
| 933 | (interactive) | ||
| 934 | (ispell-complete-word t)) | ||
| 935 | |||
| 936 | ;;;; Internal Function. | ||
| 937 | |||
| 938 | ;;; Build list of words using ispell-look-command from dictionary | ||
| 939 | ;;; ispell-look-dictionary (if this is a non-nil string). Look for words | ||
| 940 | ;;; starting with STRING if ispell-have-new-look is nil or look for REGEXP if | ||
| 941 | ;;; ispell-have-new-look is t. Returns result as an alist suitable for use by | ||
| 942 | ;;; try-completion, all-completions, and completing-read. | ||
| 943 | (defun ispell-lookup-build-list (string regexp) | ||
| 944 | (save-excursion | ||
| 945 | (message "Building list...") | ||
| 946 | (set-buffer (get-buffer-create " *ispell look*")) | ||
| 947 | (erase-buffer) | ||
| 948 | |||
| 949 | (if (stringp ispell-look-dictionary) | ||
| 950 | (if ispell-have-new-look | ||
| 951 | (call-process ispell-look-command nil t nil "-fr" regexp | ||
| 952 | ispell-look-dictionary) | ||
| 953 | (call-process ispell-look-command nil t nil "-f" string | ||
| 954 | ispell-look-dictionary)) | ||
| 955 | (if ispell-have-new-look | ||
| 956 | (call-process ispell-look-command nil t nil "-fr" regexp) | ||
| 957 | (call-process ispell-look-command nil t nil "-f" string))) | ||
| 958 | |||
| 959 | ;; Build list for try-completion and all-completions by storing each line | ||
| 960 | ;; of output starting from bottom of buffer and deleting upwards. | ||
| 961 | (let (list) | ||
| 962 | (goto-char (point-min)) | ||
| 963 | (while (not (= (point-min) (point-max))) | ||
| 964 | (end-of-line) | ||
| 965 | (setq list (cons (buffer-substring (point-min) (point)) list)) | ||
| 966 | (forward-line) | ||
| 967 | (delete-region (point-min) (point))) | ||
| 968 | |||
| 969 | ;; Clean. | ||
| 970 | (erase-buffer) | ||
| 971 | (message "Building list...done") | ||
| 972 | |||
| 973 | ;; Make the list into an alist and return. | ||
| 974 | (mapcar 'list (nreverse list))))) | ||
| 975 | |||
| 976 | ;; Return regexp-quote of STRING if STRING is non-empty. | ||
| 977 | ;; Otherwise return an unmatchable regexp. | ||
| 978 | (defun ispell-non-empty-string (string) | ||
| 979 | (if (or (not string) (string-equal string "")) | ||
| 980 | "\\'\\`" ; An unmatchable string if string is null. | ||
| 981 | (regexp-quote string))) | ||
| 982 | |||
| 983 | (defcustom ispell-message-cite-regexp "^ \\|^\t" | ||
| 984 | "*Regular expression to match lines cited from one message into another." | ||
| 985 | :type 'regexp | ||
| 986 | :group 'ispell4) | ||
| 987 | |||
| 988 | (defcustom ispell-message-text-end | ||
| 989 | (concat "^\\(" (mapconcat (function identity) | ||
| 990 | '( | ||
| 991 | ;; Matches postscript files. | ||
| 992 | "%!PS-Adobe-2.0" | ||
| 993 | ;; Matches uuencoded text | ||
| 994 | "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM" | ||
| 995 | ;; Matches shell files (esp. auto-decoding) | ||
| 996 | "#! /bin/sh" | ||
| 997 | ;; Matches difference listing | ||
| 998 | "diff -c .*\n\\*\\*\\* .*\n--- " | ||
| 999 | ;; Matches "--------------------- cut here" | ||
| 1000 | "[-=]+\\s cut here") | ||
| 1001 | "\\|") | ||
| 1002 | "\\)") | ||
| 1003 | "*End of text which will be checked in ispell-message. | ||
| 1004 | If it is a string, limit at first occurrence of that regular expression. | ||
| 1005 | Otherwise, it must be a function which is called to get the limit." | ||
| 1006 | :type '(choice string function) | ||
| 1007 | :group 'ispell4) | ||
| 1008 | |||
| 1009 | (defcustom ispell-message-limit (* 100 80) | ||
| 1010 | "*Ispell-message will check no more than this number of characters." | ||
| 1011 | :type 'integer | ||
| 1012 | :group 'ispell4) | ||
| 1013 | |||
| 1014 | ;;;autoload | ||
| 1015 | (defun ispell-message () | ||
| 1016 | "Check the spelling of a mail message or news post. | ||
| 1017 | Don't check spelling of message headers (except subject) or included messages. | ||
| 1018 | |||
| 1019 | To spell-check whenever a message is sent, include this line in .emacs: | ||
| 1020 | (setq news-inews-hook (setq mail-send-hook 'ispell-message)) | ||
| 1021 | |||
| 1022 | Or you can bind the function to C-c i in gnus or mail with: | ||
| 1023 | (setq mail-mode-hook (setq news-reply-mode-hook | ||
| 1024 | (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))))" | ||
| 1025 | (interactive) | ||
| 1026 | (save-excursion | ||
| 1027 | (let (non-internal-message | ||
| 1028 | (old-case-fold-search case-fold-search) | ||
| 1029 | (case-fold-search nil)) | ||
| 1030 | |||
| 1031 | ;; Don't spell-check the headers. | ||
| 1032 | (rfc822-goto-eoh) | ||
| 1033 | (forward-line 1) | ||
| 1034 | (setq non-internal-message (looking-at "")) | ||
| 1035 | |||
| 1036 | (let* ((cite-regexp ;Prefix of inserted text | ||
| 1037 | (cond | ||
| 1038 | ((featurep 'supercite) ; sc 3.0 | ||
| 1039 | (concat "\\(" (sc-cite-regexp) "\\)" "\\|" | ||
| 1040 | (ispell-non-empty-string sc-reference-tag-string))) | ||
| 1041 | ((featurep 'sc) ; sc 2.3 | ||
| 1042 | (concat "\\(" sc-cite-regexp "\\)" "\\|" | ||
| 1043 | (ispell-non-empty-string sc-reference-tag-string))) | ||
| 1044 | (non-internal-message ; Assume nn sent us this message. | ||
| 1045 | (concat "In [a-zA-Z.]+ you write:" "\\|" | ||
| 1046 | "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|" | ||
| 1047 | " *> *")) | ||
| 1048 | ((equal major-mode 'news-reply-mode) ;Gnus | ||
| 1049 | (concat "In article <" "\\|" | ||
| 1050 | (if mail-yank-prefix | ||
| 1051 | (ispell-non-empty-string mail-yank-prefix) | ||
| 1052 | ispell-message-cite-regexp))) | ||
| 1053 | ((boundp 'vm-included-text-prefix) ; VM mail message | ||
| 1054 | (concat "[^,;&+=]+ writes:" "\\|" | ||
| 1055 | (ispell-non-empty-string vm-included-text-prefix) | ||
| 1056 | )) | ||
| 1057 | ((boundp 'mh-ins-buf-prefix) ; mh mail message | ||
| 1058 | (ispell-non-empty-string mh-ins-buf-prefix)) | ||
| 1059 | (mail-yank-prefix ; vanilla mail message. | ||
| 1060 | (ispell-non-empty-string mail-yank-prefix)) | ||
| 1061 | (t ispell-message-cite-regexp))) | ||
| 1062 | (continue t) | ||
| 1063 | (limit | ||
| 1064 | (min | ||
| 1065 | (+ (point-min) ispell-message-limit) | ||
| 1066 | (point-max) | ||
| 1067 | (save-excursion | ||
| 1068 | (cond | ||
| 1069 | ((not ispell-message-text-end) (point-max)) | ||
| 1070 | ((char-or-string-p ispell-message-text-end) | ||
| 1071 | (if (re-search-forward ispell-message-text-end nil 'end) | ||
| 1072 | (match-beginning 0) | ||
| 1073 | (point-max))) | ||
| 1074 | (t (funcall ispell-message-text-end)))))) | ||
| 1075 | (search-limit ; Search limit which won't stop in middle of citation | ||
| 1076 | (+ limit (length cite-regexp))) | ||
| 1077 | ) | ||
| 1078 | ;; Check the subject | ||
| 1079 | (save-excursion | ||
| 1080 | (let ((case-fold-search t) | ||
| 1081 | (message-begin (point))) | ||
| 1082 | (goto-char (point-min)) | ||
| 1083 | ;; "\\s *" matches newline if subject is empty | ||
| 1084 | (if (and (re-search-forward "^Subject:[\t ]*" message-begin t) | ||
| 1085 | (not (looking-at "re\\>"))) | ||
| 1086 | (setq continue | ||
| 1087 | (ispell-region (- (point) 1) | ||
| 1088 | (progn | ||
| 1089 | (end-of-line) | ||
| 1090 | (while (looking-at "\n[ \t]") | ||
| 1091 | (end-of-line 2)) | ||
| 1092 | (point)))) | ||
| 1093 | ))) | ||
| 1094 | |||
| 1095 | ;; Check the body. | ||
| 1096 | (while (and (< (point) limit) continue) | ||
| 1097 | ;; Skip across text cited from other messages. | ||
| 1098 | (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp)) | ||
| 1099 | (< (point) limit)) | ||
| 1100 | (forward-line 1)) | ||
| 1101 | (if (< (point) limit) | ||
| 1102 | ;; Check the next batch of lines that *aren't* cited. | ||
| 1103 | (let ((start (point))) | ||
| 1104 | (if (re-search-forward | ||
| 1105 | (concat "^\\(" cite-regexp "\\)") search-limit 'end) | ||
| 1106 | (beginning-of-line)) | ||
| 1107 | (if (> (point) limit) (goto-char limit)) | ||
| 1108 | (let ((case-fold-search old-case-fold-search)) | ||
| 1109 | (save-excursion | ||
| 1110 | (setq continue (ispell-region (- start 1) (point)))))))))))) | ||
| 1111 | |||
| 1112 | (provide 'ispell) | ||
| 1113 | |||
| 1114 | ;;; ispell4.el ends here | ||