lisp/textmodes/ispell4.el

   1 ;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 3.
   2
   3 ;;Copyright (C) 1990, 1991 Free Software Foundation, Inc.
   4 ;;
   5 ;;This file is part of GNU ISPELL.
   6 ;;
   7 ;;GNU ISPELL is free software; you can redistribute it and/or modify
   8 ;;it under the terms of the GNU General Public License as published by
   9 ;;the Free Software Foundation; either version 2, or (at your option)
  10 ;;any later version.
  11 ;;
  12 ;;GNU ISPELL is distributed in the hope that it will be useful,
  13 ;;but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;GNU General Public License for more details.
  16 ;;
  17 ;;You should have received a copy of the GNU General Public License
  18 ;;along with GNU ISPELL; see the file COPYING.  If not, write to
  19 ;;the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 (defvar ispell-have-new-look t
  22   "T if default 'look' program has the -r flag.")
  23
  24 (defvar ispell-enable-tex-parser nil
  25   "T to enable experimental tex parser in ispell for tex buffers.")
  26
  27 (defvar ispell-process nil "The process running ISPELL")
  28 (defvar ispell-next-message nil
  29   "An integer telling where in the *ispell* buffer where
  30 to look for the next message from the ISPELL program.")
  31
  32 ;Each marker in this list points to the start of a word that
  33 ;ispell thought was bad last time it did the :file command.
  34 ;Notice that if the user accepts or inserts a word into his
  35 ;private dictionary, then some "good" words will be on the list.
  36 ;We would like to deal with this by looking up the words again just before
  37 ;presenting them to the user, but that is too slow on machines
  38 ;without the select system call.  Therefore, see the variable
  39 ;ispell-recently-accepted.
  40 (defvar ispell-bad-words nil
  41   "A list of markers corresponding to the output of the ISPELL :file command.")
  42
  43 ;list of words that the user has accepted, but that might still
  44 ;be on the bad-words list
  45 (defvar ispell-recently-accepted nil)
  46
  47 ;t when :dump command needed
  48 (defvar ispell-dump-needed nil)
  49
  50 (defun ispell-flush-bad-words ()
  51   (while ispell-bad-words
  52     (if (markerp (car ispell-bad-words))
  53         (set-marker (car ispell-bad-words) nil))
  54     (setq ispell-bad-words (cdr ispell-bad-words)))
  55   (setq ispell-recently-accepted nil))
  56
  57 (defun kill-ispell ()
  58   "Kill the ispell process.
  59 Any changes the your private dictionay
  60 that have not already been dumped will be lost."
  61   (interactive)
  62   (if ispell-process
  63       (delete-process ispell-process))
  64   (setq ispell-process nil)
  65   (ispell-flush-bad-words))
  66
  67 (put 'ispell-startup-error 'error-conditions
  68      '(ispell-startup-error error))
  69 (put 'ispell-startup-error 'error-message
  70      "Problem starting ispell - see buffer *ispell*")
  71
  72 (defun start-ispell ()
  73   "Start an ispell subprocess; check the version; and display the greeting."
  74   (message "Starting ispell ...")
  75   (let ((buf (get-buffer "*ispell*")))
  76     (if buf
  77         (kill-buffer buf)))
  78   (condition-case err
  79       (setq ispell-process (start-process "ispell" "*ispell*" "ispell" "-S"))
  80     (file-error (signal 'ispell-startup-error nil)))
  81   (process-kill-without-query ispell-process)
  82   (buffer-disable-undo (process-buffer ispell-process))
  83   (accept-process-output ispell-process)
  84   (let (last-char)
  85     (save-excursion
  86       (set-buffer (process-buffer ispell-process))
  87       (bury-buffer (current-buffer))
  88       (setq last-char (- (point-max) 1))
  89       (while (not (eq (char-after last-char) ?=))
  90         (cond ((not (eq (process-status ispell-process) 'run))
  91                (kill-ispell)
  92                (signal 'ispell-startup-error nil)))
  93         (accept-process-output ispell-process)
  94         (setq last-char (- (point-max) 1)))
  95       (goto-char (point-min))
  96       (let ((greeting (read (current-buffer))))
  97         (if (not (= (car greeting) 1))
  98             (error "Bad ispell version: wanted 1, got %d" (car greeting)))
  99         (message (car (cdr greeting))))
 100       (delete-region (point-min) last-char))))
 101
 102 ;leaves buffer set to *ispell*, point at '='
 103 (defun ispell-sync (intr)
 104   "Make sure ispell is ready for a command."
 105   (if (or (null ispell-process)
 106           (not (eq (process-status ispell-process) 'run)))
 107       (start-ispell))
 108   (if intr
 109       (interrupt-process ispell-process))
 110   (let (last-char)
 111     (set-buffer (process-buffer ispell-process))
 112     (bury-buffer (current-buffer))
 113     (setq last-char (- (point-max) 1))
 114     (while (not (eq (char-after last-char) ?=))
 115       (accept-process-output ispell-process)
 116       (setq last-char (- (point-max) 1)))
 117     (goto-char last-char)))
 118
 119 (defun ispell-cmd (&rest strings)
 120   "Send a command to ispell.  Choices are:
 121
 122 word            any word is checked for spelling.  Result is
 123
 124                         nil                     not found
 125                         t                       spelled ok
 126                         list of strings         near misses
 127
 128 :file filename  scan the named file, and print the file offsets of
 129                 any misspelled words
 130
 131 :insert word    put word in private dictonary
 132
 133 :accept word    don't complain about word any more this session
 134
 135 :dump           write out the current private dictionary, if necessary.
 136
 137 :reload         reread ~/ispell.words
 138
 139 :tex
 140 :troff
 141 :generic        set type of parser to use when scanning whole files
 142 "
 143   (save-excursion
 144     (ispell-sync t)
 145     (set-buffer (process-buffer ispell-process))
 146     (bury-buffer (current-buffer))
 147     (erase-buffer)
 148     (setq ispell-next-message (point-min))
 149     (while strings
 150       (process-send-string ispell-process (car strings))
 151       (setq strings (cdr strings)))
 152     (process-send-string ispell-process "\n")
 153     (accept-process-output ispell-process)
 154     (ispell-sync nil)))
 155
 156 (defun ispell-dump ()
 157   (cond (ispell-dump-needed
 158          (setq ispell-dump-needed nil)
 159          (ispell-cmd ":dump"))))
 160
 161 (defun ispell-insert (word)
 162   (ispell-cmd ":insert " word)
 163   (if ispell-bad-words
 164       (setq ispell-recently-accepted (cons word ispell-recently-accepted)))
 165   (setq ispell-dump-needed t))
 166
 167 (defun ispell-accept (word)
 168   (ispell-cmd ":accept " word)
 169   (if ispell-bad-words
 170       (setq ispell-recently-accepted (cons word ispell-recently-accepted))))
 171
 172
 173 (defun ispell-next-message ()
 174   "Return the next message sent by the ispell subprocess."
 175   (save-excursion
 176     (set-buffer (process-buffer ispell-process))
 177     (bury-buffer (current-buffer))
 178     (save-restriction
 179       (goto-char ispell-next-message)
 180       (narrow-to-region (point)
 181                         (progn (forward-sexp 1) (point)))
 182       (setq ispell-next-message (point))
 183       (goto-char (point-min))
 184       (read (current-buffer)))))
 185
 186 (defun ispell-tex-buffer-p ()
 187   (memq major-mode '(plain-TeX-mode LaTeX-mode)))
 188
 189 ;;;###autoload
 190 (defun ispell (&optional buf start end)
 191   "Run ispell over current buffer's visited file.
 192 First the file is scanned for misspelled words, then ispell
 193 enters a loop with the following commands for every misspelled word:
 194
 195 DIGIT   Near miss selector.  If the misspelled word is close to
 196         some words in the dictionary, they are offered as near misses.
 197 r       Replace.  Replace the word with a string you type.  Each word
 198         of your new string is also checked.
 199 i       Insert.  Insert this word in your private dictonary (kept in
 200         `$HOME/ispell.words').
 201 a       Accept.  Accept this word for the rest of this editing session,
 202         but don't put it in your private dictonary.
 203 l       Lookup.  Look for a word in the dictionary by fast binary
 204         search, or search for a regular expression in the dictionary
 205         using grep.
 206 SPACE   Accept the word this time, but complain if it is seen again.
 207 q, \\[keyboard-quit]    Leave the command loop.  You can come back later with \\[ispell-next]."
 208   (interactive)
 209   (if (null start)
 210       (setq start 0))
 211   (if (null end)
 212       (setq end 0))
 213
 214   (if (null buf)
 215       (setq buf (current-buffer)))
 216   (setq buf (get-buffer buf))
 217   (if (null buf)
 218       (error "Can't find buffer"))
 219   (save-excursion
 220     (set-buffer buf)
 221     (let ((filename buffer-file-name)
 222           (delete-temp nil))
 223       (unwind-protect
 224           (progn
 225             (cond ((null filename)
 226                    (setq filename (make-temp-name "/usr/tmp/ispell"))
 227                    (setq delete-temp t)
 228                    (write-region (point-min) (point-max) filename))
 229                   ((and (buffer-modified-p buf)
 230                         (y-or-n-p (format "Save file %s? " filename)))
 231                    (save-buffer)))
 232             (message "Ispell scanning file...")
 233             (if (and ispell-enable-tex-parser
 234                      (ispell-tex-buffer-p))
 235                 (ispell-cmd ":tex")
 236               (ispell-cmd ":generic"))
 237             (ispell-cmd (format ":file %s %d %d" filename start end)))
 238         (if delete-temp
 239             (condition-case ()
 240                 (delete-file filename)
 241               (file-error nil)))))
 242     (message "Parsing ispell output ...")
 243     (ispell-flush-bad-words)
 244     (let (pos bad-words)
 245       (while (numberp (setq pos (ispell-next-message)))
 246         ;;ispell may check the words on the line following the end
 247         ;;of the region - therefore, don't record anything out of range
 248         (if (or (= end 0)
 249                 (< pos end))
 250             (setq bad-words (cons (set-marker (make-marker) (+ pos 1))
 251                                   bad-words))))
 252       (setq bad-words (cons pos bad-words))
 253       (setq ispell-bad-words (nreverse bad-words))))
 254   (cond ((not (markerp (car ispell-bad-words)))
 255          (setq ispell-bad-words nil)
 256          (message "No misspellings."))
 257         (t
 258          (message "Ispell parsing done.")
 259          (ispell-next))))
 260
 261 ;;;###autoload
 262 (fset 'ispell-buffer 'ispell)
 263
 264 (defun ispell-next ()
 265   "Resume command loop for most recent ispell command."
 266   (interactive)
 267   (unwind-protect
 268       (catch 'quit
 269         (save-window-excursion
 270           (save-excursion
 271             (let (next)
 272               (while (markerp (setq next (car ispell-bad-words)))
 273                 (switch-to-buffer (marker-buffer next))
 274                 (push-mark)
 275                 (ispell-point next "at saved position.")
 276                 (setq ispell-bad-words (cdr ispell-bad-words))
 277                 (set-marker next nil))))))
 278     (cond ((null ispell-bad-words)
 279            (error "Ispell has not yet been run."))
 280           ((markerp (car ispell-bad-words))
 281            (message (substitute-command-keys
 282                        "Type \\[ispell-next] to continue.")))
 283           ((eq (car ispell-bad-words) nil)
 284            (setq ispell-bad-words nil)
 285            (message "No more misspellings (but checker was interrupted.)"))
 286           ((eq (car ispell-bad-words) t)
 287            (setq ispell-bad-words nil)
 288            (message "Ispell done."))
 289           (t
 290            (setq ispell-bad-words nil)
 291            (message "Bad ispell internal list"))))
 292   (ispell-dump))
 293
 294
 295 ;;;###autoload
 296 (defun ispell-word ()
 297   "Check the spelling of the word under the cursor.
 298 See `ispell' for more information."
 299   (interactive)
 300   (condition-case err
 301       (catch 'quit
 302         (save-window-excursion
 303           (ispell-point (point) "at point."))
 304         (ispell-dump))
 305     (ispell-startup-error
 306      (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
 307             (load-library "spell")
 308             (define-key esc-map "$" 'spell-word)
 309             (spell-word))))))
 310 ;;;###autoload
 311 (define-key esc-map "$" 'ispell-word)
 312
 313 ;;;###autoload
 314 (defun ispell-region (start &optional end)
 315   "Check the spelling for all of the words in the region."
 316   (interactive "r")
 317   (ispell (current-buffer) start end))
 318
 319 (defun ispell-letterp (c)
 320   (and c
 321        (or (and (>= c ?A) (<= c ?Z))
 322            (and (>= c ?a) (<= c ?z))
 323            (>= c 128))))
 324
 325 (defun ispell-letter-or-quotep (c)
 326   (and c
 327        (or (and (>= c ?A) (<= c ?Z))
 328            (and (>= c ?a) (<= c ?z))
 329            (= c ?')
 330            (>= c 128))))
 331
 332 (defun ispell-find-word-start ()
 333   ;;backward to a letter
 334   (if (not (ispell-letterp (char-after (point))))
 335       (while (and (not (bobp))
 336                   (not (ispell-letterp (char-after (- (point) 1)))))
 337         (backward-char)))
 338   ;;backward to beginning of word
 339   (while (ispell-letter-or-quotep (char-after (- (point) 1)))
 340     (backward-char))
 341   (skip-chars-forward "'"))
 342
 343 (defun ispell-find-word-end ()
 344   (while (ispell-letter-or-quotep (char-after (point)))
 345     (forward-char))
 346   (skip-chars-backward "'"))
 347
 348 (defun ispell-next-word ()
 349   (while (and (not (eobp))
 350               (not (ispell-letterp (char-after (point)))))
 351     (forward-char)))
 352
 353 ;if end is nil, then do one word at start
 354 ;otherwise, do all words from the beginning of the word where
 355 ;start points, to the end of the word where end points
 356 (defun ispell-point (start message)
 357   (let ((wend (make-marker))
 358         rescan
 359         end)
 360   (save-excursion
 361     (goto-char start)
 362     (ispell-find-word-start)            ;find correct word start
 363     (setq start (point-marker))
 364     (ispell-find-word-end)              ;now find correct end
 365     (setq end (point-marker))
 366     (if (>= start end)
 367         (error "No word %s" message))
 368     (while (< start end)
 369       (goto-char start)
 370       (ispell-find-word-end)            ;find end of current word
 371                                         ;could be before 'end' if
 372                                         ;user typed replacement
 373                                         ;that is more than one word
 374       (set-marker wend (point))
 375       (setq rescan nil)
 376       (setq word (buffer-substring start wend))
 377       (cond ((ispell-still-bad word)
 378              (goto-char start);just to show user where we are working
 379              (sit-for 0)
 380              (message (format "Ispell checking %s" word))
 381              (ispell-cmd word)
 382              (let ((message (ispell-next-message)))
 383                (cond ((eq message t)
 384                       (message "%s: ok" word))
 385                      ((or (null message)
 386                           (consp message))
 387                       (setq rescan
 388                             (ispell-command-loop word start wend message)))
 389                      (t
 390                       (error "unknown ispell response %s" message))))))
 391       (cond ((null rescan)
 392              (goto-char wend)
 393              (ispell-next-word)
 394              (set-marker start (point)))))
 395     ;;clear the choices buffer; otherwise it's hard for the user to tell
 396     ;;when we get back to the command loop
 397     (let ((buf (get-buffer "*ispell choices*")))
 398       (cond (buf
 399              (set-buffer buf)
 400              (erase-buffer))))
 401     (set-marker start nil)
 402     (set-marker end nil)
 403     (set-marker wend nil))))
 404
 405 (defun ispell-still-bad (word)
 406   (let ((words ispell-recently-accepted)
 407         (ret t)
 408         (case-fold-search t))
 409     (while words
 410       (cond ((eq (string-match (car words) word) 0)
 411              (setq ret nil)
 412              (setq words nil)))
 413       (setq words (cdr words)))
 414     ret))
 415
 416 (defun ispell-show-choices (word message first-line)
 417   ;;if there is only one window on the screen, make the ispell
 418   ;;messages winow be small.  otherwise just use the other window
 419   (let* ((selwin (selected-window))
 420          (resize (eq selwin (next-window)))
 421          (buf (get-buffer-create "*ispell choices*"))
 422          w)
 423     (setq w (display-buffer buf))
 424     (buffer-disable-undo buf)
 425     (if resize
 426         (unwind-protect
 427             (progn
 428               (select-window w)
 429               (enlarge-window (- 6 (window-height w))))
 430           (select-window selwin)))
 431     (save-excursion
 432       (set-buffer buf)
 433       (bury-buffer buf)
 434       (set-window-point w (point-min))
 435       (set-window-start w (point-min))
 436       (erase-buffer)
 437       (insert first-line "\n")
 438       (insert
 439        "SPC skip; A accept; I insert; DIGIT select; R replace; \
 440 L lookup; Q quit\n")
 441       (cond ((not (null message))
 442              (let ((i 0))
 443                (while (< i 3)
 444                  (let ((j 0))
 445                    (while (< j 3)
 446                      (let* ((n (+ (* j 3) i))
 447                             (choice (nth n message)))
 448                        (cond (choice
 449                               (let ((str (format "%d %s" n choice)))
 450                                 (insert str)
 451                                 (insert-char ?  (- 20 (length str)))))))
 452                      (setq j (+ j 1))))
 453                  (insert "\n")
 454                  (setq i (+ i 1)))))))))
 455
 456 (defun ispell-command-loop (word start end message)
 457   (let ((flag t)
 458         (rescan nil)
 459         first-line)
 460     (if (null message)
 461         (setq first-line (concat "No near misses for '" word "'"))
 462       (setq first-line (concat "Near misses for '" word "'")))
 463     (while flag
 464       (ispell-show-choices word message first-line)
 465       (message "Ispell command: ")
 466       (let ((c (downcase (read-char)))
 467             replacement)
 468         (cond ((and (>= c ?0)
 469                     (<= c ?9)
 470                     (setq replacement (nth (- c ?0) message)))
 471                (ispell-replace start end replacement)
 472                (setq flag nil))
 473               ((= c ?q)
 474                (throw 'quit nil))
 475               ((= c ? )
 476                (setq flag nil))
 477               ((= c ?r)
 478                (ispell-replace start end (read-string "Replacement: "))
 479                (setq rescan t)
 480                (setq flag nil))
 481               ((= c ?i)
 482                (ispell-insert word)
 483                (setq flag nil))
 484               ((= c ?a)
 485                (ispell-accept word)
 486                (setq flag nil))
 487               ((= c ?l)
 488                (let ((val (ispell-do-look word)))
 489                  (setq first-line (car val))
 490                  (setq message (cdr val))))
 491               ((= c ??)
 492                (message
 493                 "Type 'C-h d ispell' to the emacs main loop for more help")
 494                (sit-for 2))
 495               (t
 496                (message "Bad ispell command")
 497                (sit-for 2)))))
 498     rescan))
 499
 500 (defun ispell-do-look (bad-word)
 501   (let (regex buf words)
 502     (cond ((null ispell-have-new-look)
 503            (setq regex (read-string "Lookup: ")))
 504           (t
 505            (setq regex (read-string "Lookup (regex): " "^"))))
 506     (setq buf (get-buffer-create "*ispell look*"))
 507     (save-excursion
 508       (set-buffer buf)
 509       (delete-region (point-min) (point-max))
 510       (if ispell-have-new-look
 511           (call-process "look" nil buf nil "-r" regex)
 512         (call-process "look" nil buf nil regex))
 513       (goto-char (point-min))
 514       (forward-line 10)
 515       (delete-region (point) (point-max))
 516       (goto-char (point-min))
 517       (while (not (= (point-min) (point-max)))
 518         (end-of-line)
 519         (setq words (cons (buffer-substring (point-min) (point)) words))
 520         (forward-line)
 521         (delete-region (point-min) (point)))
 522       (kill-buffer buf)
 523       (cons (format "Lookup '%s'" regex)
 524             (reverse words)))))
 525
 526 (defun ispell-replace (start end new)
 527   (goto-char start)
 528   (insert new)
 529   (delete-region (point) end))
 530
 531 (defun reload-ispell ()
 532   "Tell ispell to re-read your private dictionary."
 533   (interactive)
 534   (ispell-cmd ":reload"))
 535
 536 (define-key esc-map "$" 'ispell-word)
 537 ;; This conflicts with set-selective-display.  What should we do???
 538 ;;(define-key ctl-x-map "$" 'ispell-next)
 539
 540 (defun batch-make-ispell ()
 541   (byte-compile-file "ispell.el")
 542   (find-file "ispell.texinfo")
 543   (let ((old-dir default-directory)
 544         (default-directory "/tmp"))
 545     (texinfo-format-buffer))
 546   (Info-validate)
 547   (if (get-buffer " *problems in info file*")
 548       (kill-emacs 1))
 549   (write-region (point-min) (point-max) "ispell.info"))
 550
 551 ;;; ispell.el ends here