Otherware/Otherware_1_SB_Development.iso/amiga/utility/text/ispell.lha/autofix.el

Lisp/Scheme | 1992-07-04 | 12KB | 289 lines

;; ** WARNING ** WARNING ** WARNING ** WARNING ** WARNING ** WARNING **

;; This will ONLY work with the ispell.el in the >> local << directory of
;; HUGE.  It will NOT work with vanilla emacs ispell.el.  Make sure that
;; emacs/lisp/local is in your load path before emacs/lisp, or explicitly
;; load the local version of ispell.  It will fail otherwise.

;; Also, your ispell must be working correctly in order for this to work.

;; ***************************************************************************
;;
;; DESCRIPTION: Minor mode to fix misspelled words as they are typed.
;; AUTHOR     : Steve Koren
;; DATE       : 27 Apr Pr
;; VERSION    : 1.1
;; STATUS     : Experimental beta version
;;
;; This code is provided under the GNU liscence, and may be freely
;; distributed and copied provided that further distribution is not
;; restricted.  There is no warrenty on this software; it is provided free
;; of charge and therefor "as-is".
;;
;; This ELISP code provides a minor mode for automatically fixing some
;; types of spelling and typing mistakes on English words in real time as
;; they are typed.  It can also beep passively upon spelling errors
;; without making any modifications to the text.

;; When a word delimiter is typed (usually space or punctuation), the
;; previous word is looked up in the dictionary via ispell.  If
;; autofix-autochange is t and there is only one suggested replacement
;; for the misspelled word, then the replacement is substituted
;; automatically with no further action required, and emacs beeps to
;; signal this fact.  When there is only one suggestion it is right most
;; of the time, and the word will be fixed with no further effort on your
;; part.  If autofix-autochange is nil, then no word replacements are
;; performed, but emacs will still beep after any misspelled words.
;;
;; autofix-mode likes a fast machine since it looks up every word you type
;; as you type it.  The overhead is unnoticeable on an HP-720.  A 68030
;; or better will probably do.
;;
;; Although the minor mode must remap the local definitions of the word
;; delimiters (space, ".", etc), it makes a heroic effort to use the
;; original definition of the key after it is called.  Thus, it should
;; coexist peacefully with other minor modes and custom keymaps which
;; themselves define mappings for various keys.  It does this by saving
;; the original local keymap when autofix-mode is started, and then
;; rebinding the keys to its needs.  When a rebound key is used, the
;; standard autofix lookup is performed, and then the definition of the
;; key from the saved keymap is used.

;; ***************************************************************************


;; ***************************************************************************
;; variables to store state of minor mode
;; ***************************************************************************

(defvar autofix-mode        nil "t if autofix mode is active, else nil")
(defvar autofix-old-map     nil "autofix-mode original local keymap")

(defvar autofix-break-chars " \t\r.,;?!"
  "*autofix will check words after these characters are typed")

(defvar autofix-autochange t
  "*t if autofix-mode should auto-change misspelled words.  nil to just beep")

(defvar autofix-be-silent nil
  "*t if autofix-mode should be quiet (not beep) for misspellings")

(defvar autofix-be-aggressive nil
  "* if autofix-mode should be aggressive in finding replacements")

(make-variable-buffer-local 'autofix-mode)
(make-variable-buffer-local 'autofix-old-map)

;; ***************************************************************************
;; Add our minor mode to the minor-mode-alist if its not there already
;; ***************************************************************************

(or (assq 'autofix-mode minor-mode-alist)
    (setq minor-mode-alist
          (cons '(autofix-mode " AutoFix") minor-mode-alist)))


;; ***************************************************************************
;; Function to turn on and off our minor mode
;; ***************************************************************************

(defun autofix-mode (arg)
  "Toggle auto-fix mode.

With arg, turn auto-fix mode on iff arg is positive.

In auto-fix mode, typing a space or punctuation character spell
checks the previous word, beeps if not found in the dictionary,
and inserts a correction if there is only one available and
autofix-autochange is t.  For example, \"definision\" will be
changed to \"definition\".  autofix-mode words best with text
oriented major modes such as text-mode.

Note: Since this mode depends on ispell, your ispell must be working
correctly in order for autofix-mode to work.

Suggestion: If there are commonly misspelled words which autofix is
unable to correct, put them in a mode specific abbreviation table
and turn on abbrev-mode in addition to autofix-mode.

The following variables are used by autofix-mode and can be set
in a .emacs file:

  autofix-break-chars  - A string of characters which autofix
                         will change the definition of in the local
                         keymap.  The original definitions are
                         called after autofix does its work.  Also,
                         autofix-mode restores the original keymap
                         after it is turned off.

  autofix-be-silent    - Set this to t to stop autofix from
                         beeping.  Automatic changes will still be
                         made.  Defaults to nil.

  autofix-autochange   - Set this to nil to stop autofix from
                         making corrections if it finds a reasonable
                         substitution for the misspelled word.  It
                         will then only beep for misspellings.
                         Defaults to t.

  autofix-be-aggressive- Set to t if autofix should be more
                         aggressive when finding word replacements.
                         When being aggressive, autofix will replace
                         words even if it sees more than one
                         possible replacement.  It will pick the
                         first one, which may or may not be correct.
                         Defaults to nil.  Use with caution.
"

  (interactive "P")

  ; -- set the autofix-mode variable appropriately ---------------------------

  (setq autofix-mode
    (if (null arg) (not autofix-mode)
      (> (prefix-numeric-value arg) 0)))

  ; -- if we have a local keymap, fix it up ----------------------------------

  (if (current-local-map)
      (if autofix-mode
          ; -- install the new meanings --------------------------------------
          (progn
            ; -- save the original keymap so we can restore it later ---------
            (setq autofix-old-map (current-local-map))

            ; -- now make a new local keymap we can mess with ----------------
            (use-local-map (copy-keymap (current-local-map)))

            (let ((x 0))
              (while (< x (length autofix-break-chars))
                (define-key (current-local-map)
                  (substring autofix-break-chars x (+ x 1))
                  'afix-rt-check
                )
                (setq x (+ x 1))
              )
            )
          )

        ; -- restore the old keymap ------------------------------------------
        (use-local-map autofix-old-map)
      )
  )

  ; -- no-op, but updates the mode line --------------------------------

  (set-buffer-modified-p (buffer-modified-p))
)

;; ***************************************************************************
;; load ispell if it is not loaded.  Ispell has no (provide) so we have to do
;; it this way.  Also, we attempt to check for the right ispell.
;; ***************************************************************************

(if (not (boundp 'ispell-syntax-table))  ;; load ispell if not loaded
    (load-library "ispell"))

(if (not (boundp 'ispell-syntax-table))  ;; check for proper version
    (error "Wrong version of ispell - no syntax table!"))


;; ***************************************************************************
;; If the previous character is a word element, the word is looked up via
;; afix-word.
;; Changed 28 Apr 92 to stop trying to check numbers.
;; ***************************************************************************

(defun afix-rt-check ()

  "Checks the previous word in the dictionary using afix-word."

  (interactive)

  ; -- here we call afix-word if necessary -----------------------------------

  (if (> (point) 1)
      (if (= (char-syntax (preceding-char)) ?w)
          (if (or (< (preceding-char) ?0) (> (preceding-char) ?9))
              (afix-word)
          )
      )
  )

  ; -- Here we perform the action the key was supposed to have.  This is -----
  ; -- done by first looking for a local keybinding, and if found, -----------
  ; -- executing that.  If there is no local binding, use the global one. ----

  (let ((cmd (lookup-key autofix-old-map (char-to-string last-input-char))))
    (if cmd
        (call-interactively cmd)
      (call-interactively (global-key-binding
                           (char-to-string last-input-char)))
    )
  )
)


;; ***************************************************************************
;; This code is basically lifted verbatim from ispell.el, but the interactive
;; functions have been replaced with either t or beep, accordingly.  I
;; neither know nor want to know how it works.  I just modified it enough
;; to do what is needed.
;; ***************************************************************************

(defun afix-word ()
   "Check spelling of word at or before dot."
   (interactive)
   (let* ((current-syntax (syntax-table))
          start end word poss replace)
      (unwind-protect
            (save-excursion
               (set-syntax-table ispell-syntax-table)            ;; Ensure syntax table is reasonable
               (if (not (looking-at "\\w"))
                   (re-search-backward "\\w" (point-min) 'stay)) ;; Move backward for word if not already on one
               (re-search-backward "\\W" (point-min) 'stay)      ;; Move to start of word
               (or (re-search-forward "\\w+" nil t)              ;; Find start and end of word
                   (error "No word to check."))
               (setq start (match-beginning 0)
                     end (match-end 0)
                     word (buffer-substring start end)))
         (set-syntax-table current-syntax))
      (ispell-init-process)   ;; erases ispell output buffer

      (if (boundp 'amiga-initialized)
          ;; -- use amiga ispell ARexx port ----------------------------------
          (setq poss (ispell-parse-output (amiga-ispell-lookup word)))

        ;; -- else use Unix ispell process -----------------------------------

        (save-excursion
          (set-buffer ispell-out-name)
          (send-string ispell-process (concat word "\n"))
          (while (progn            ;; Wait until we have a complete line
                   (goto-char (point-max))
                   (/= (preceding-char) ?\n))
            (accept-process-output ispell-process))
          (goto-char (point-min))
          (setq poss (ispell-parse-output
                      (buffer-substring (point)
                                        (progn (end-of-line) (point))))))
        )

      (cond ((eq poss t)
             t)
            ((stringp poss)
             t)
            ((null poss)
             (or autofix-be-silent (beep)))
            (t (if (and autofix-autochange
                        (or autofix-be-aggressive (= (length poss) 1)))
                   (progn (backward-kill-word 1)
                          (insert (car poss))
                   )
               )
               (or autofix-be-silent (beep))
            ))

      poss))