lisp/dabbrev.el

   1 ;;; dabbrev.el --- dynamic abbreviation package for GNU Emacs.
   2
   3 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
   4
   5 ;; Last-Modified: 16 Mar 1992
   6 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
   7
   8 ;; Maintainer: FSF
   9 ;; Keywords: abbrev
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28
  29 ; DABBREVS - "Dynamic abbreviations" hack, originally written by Don Morrison
  30 ; for Twenex Emacs.  Converted to mlisp by Russ Fish.  Supports the table
  31 ; feature to avoid hitting the same expansion on re-expand, and the search
  32 ; size limit variable.  Bugs fixed from the Twenex version are flagged by
  33 ; comments starting with ;;; .
  34 ;
  35 ; converted to Emacs Lisp by Spencer Thomas.
  36 ; Thoroughly cleaned up by Richard Stallman.
  37 ;
  38 ; If anyone feels like hacking at it, Bob Keller (Keller@Utah-20) first
  39 ; suggested the beast, and has some good ideas for its improvement, but
  40 ; doesn't know TECO (the lucky devil...).  One thing that should definitely
  41 ; be done is adding the ability to search some other buffer(s) if you can?t
  42 ; find the expansion you want in the current one.
  43
  44 ;;; Code:
  45
  46 ;; (defun dabbrevs-help ()
  47 ;;   "Give help about dabbrevs."
  48 ;;   (interactive)
  49 ;;   (&info "emacs" "dabbrevs") ; Select the specific info node.
  50 ;; )
  51 (defvar dabbrevs-limit nil
  52   "*Limits region searched by `dabbrevs-expand' to this many chars away.")
  53 (make-variable-buffer-local 'dabbrevs-limit)
  54
  55 (defvar dabbrevs-backward-only nil
  56   "*If non-NIL, `dabbrevs-expand' only looks backwards.")
  57
  58 ; State vars for dabbrevs-re-expand.
  59 (defvar last-dabbrevs-table nil
  60   "Table of expansions seen so far (local)")
  61 (make-variable-buffer-local 'last-dabbrevs-table)
  62
  63 (defvar last-dabbrevs-abbreviation ""
  64   "Last string we tried to expand (local).")
  65 (make-variable-buffer-local 'last-dabbrevs-abbreviation)
  66
  67 (defvar last-dabbrevs-direction 0
  68   "Direction of last dabbrevs search (local)")
  69 (make-variable-buffer-local 'last-dabbrevs-direction)
  70
  71 (defvar last-dabbrevs-abbrev-location nil
  72   "Location last abbreviation began (local).")
  73 (make-variable-buffer-local 'last-dabbrevs-abbrev-location)
  74
  75 (defvar last-dabbrevs-expansion nil
  76     "Last expansion of an abbreviation. (local)")
  77 (make-variable-buffer-local 'last-dabbrevs-expansion)
  78
  79 (defvar last-dabbrevs-expansion-location nil
  80   "Location the last expansion was found. (local)")
  81 (make-variable-buffer-local 'last-dabbrevs-expansion-location)
  82
  83 ;;;###autoload
  84 (defun dabbrev-expand (arg)
  85   "Expand previous word \"dynamically\".
  86 Expands to the most recent, preceding word for which this is a prefix.
  87 If no suitable preceding word is found, words following point are considered.
  88
  89 If `case-fold-search' and `case-replace' are non-nil (usually true)
  90 then the substituted word may be case-adjusted to match the abbreviation
  91 that you had typed.  This takes place if the substituted word, as found,
  92 is all lower case, or if it is at the beginning of a sentence and only
  93 its first letter was upper case.
  94
  95 A positive prefix arg N says to take the Nth backward DISTINCT
  96 possibility.  A negative argument says search forward.  The variable
  97 `dabbrev-backward-only' may be used to limit the direction of search to
  98 backward if set non-nil.
  99
 100 If the cursor has not moved from the end of the previous expansion and
 101 no argument is given, replace the previously-made expansion
 102 with the next possible expansion not yet tried."
 103   (interactive "*P")
 104   (let (abbrev expansion old which loc n pattern
 105         (do-case (and case-fold-search case-replace)))
 106     ;; abbrev -- the abbrev to expand
 107     ;; expansion -- the expansion found (eventually) or nil until then
 108     ;; old -- the text currently in the buffer
 109     ;;    (the abbrev, or the previously-made expansion)
 110     ;; loc -- place where expansion is found
 111     ;;    (to start search there for next expansion if requested later)
 112     ;; do-case -- non-nil if should transform case when substituting.
 113     (save-excursion
 114       (if (and (null arg)
 115                (eq last-command this-command)
 116                last-dabbrevs-abbrev-location)
 117           (progn
 118             (setq abbrev last-dabbrevs-abbreviation)
 119             (setq old last-dabbrevs-expansion)
 120             (setq which last-dabbrevs-direction))
 121         (setq which (if (null arg)
 122                         (if dabbrevs-backward-only 1 0)
 123                         (prefix-numeric-value arg)))
 124         (setq loc (point))
 125         (forward-word -1)
 126         (setq last-dabbrevs-abbrev-location (point)) ; Original location.
 127         (setq abbrev (buffer-substring (point) loc))
 128         (setq old abbrev)
 129         (setq last-dabbrevs-expansion-location nil)
 130         (setq last-dabbrev-table nil))          ; Clear table of things seen.
 131
 132       (setq pattern (concat "\\b" (regexp-quote abbrev) "\\(\\sw\\|\\s_\\)+"))
 133       ;; Try looking backward unless inhibited.
 134       (if (>= which 0)
 135           (progn
 136             (setq n (max 1 which))
 137             (if last-dabbrevs-expansion-location
 138                 (goto-char last-dabbrevs-expansion-location))
 139             (while (and (> n 0)
 140                         (setq expansion (dabbrevs-search pattern t do-case)))
 141               (setq loc (point-marker))
 142               (setq last-dabbrev-table (cons expansion last-dabbrev-table))
 143               (setq n (1- n)))
 144             (or expansion
 145                 (setq last-dabbrevs-expansion-location nil))
 146             (setq last-dabbrevs-direction (min 1 which))))
 147
 148       (if (and (<= which 0) (not expansion)) ; Then look forward.
 149           (progn
 150             (setq n (max 1 (- which)))
 151             (if last-dabbrevs-expansion-location
 152                 (goto-char last-dabbrevs-expansion-location))
 153             (while (and (> n 0)
 154                         (setq expansion (dabbrevs-search pattern nil do-case)))
 155               (setq loc (point-marker))
 156               (setq last-dabbrev-table (cons expansion last-dabbrev-table))
 157               (setq n (1- n)))
 158             (setq last-dabbrevs-direction -1))))
 159
 160     (if (not expansion)
 161         (let ((first (string= abbrev old)))
 162           (setq last-dabbrevs-abbrev-location nil)
 163           (if (not first)
 164               (progn (undo-boundary)
 165                      (search-backward old)
 166                      (if (eq major-mode 'picture-mode)
 167                          (picture-replace-match abbrev t 'literal)
 168                        (replace-match abbrev t 'literal))))
 169           (error (if first
 170                      "No dynamic expansion for \"%s\" found."
 171                      "No further dynamic expansions for \"%s\" found.")
 172                  abbrev))
 173       ;; Success: stick it in and return.
 174       (undo-boundary)
 175       (search-backward old)
 176       ;; Make case of replacement conform to case of abbreviation
 177       ;; provided (1) that kind of thing is enabled in this buffer
 178       ;; and (2) the replacement itself is all lower case.
 179       ;; First put back the original abbreviation with its original
 180       ;; case pattern.
 181       (save-excursion
 182         (if (eq major-mode 'picture-mode)
 183             (picture-replace-match abbrev t 'literal)
 184           (replace-match abbrev t 'literal)))
 185       (search-forward abbrev)
 186       (let ((do-case (and do-case
 187                           (string= (substring expansion 1)
 188                                    (downcase (substring expansion 1))))))
 189         ;; First put back the original abbreviation with its original
 190         ;; case pattern.
 191         (save-excursion
 192           (replace-match abbrev t 'literal))
 193 ;;; This used to be necessary, but no longer,
 194 ;;; because now point is preserved correctly above.
 195 ;;;     (search-forward abbrev)
 196         (if (eq major-mode 'picture-mode)
 197             (picture-replace-match (if do-case (downcase expansion) expansion)
 198                                    (not do-case)
 199                                    'literal)
 200           (replace-match (if do-case (downcase expansion) expansion)
 201                          (not do-case)
 202                          'literal)))
 203       ;; Save state for re-expand.
 204       (setq last-dabbrevs-abbreviation abbrev)
 205       (setq last-dabbrevs-expansion expansion)
 206       (setq last-dabbrevs-expansion-location loc))))
 207
 208 ;;;###autoload (define-key esc-map "/" 'dabbrev-expand)
 209
 210
 211 ;; Search function used by dabbrevs library.
 212 ;; First arg is string to find as prefix of word.  Second arg is
 213 ;; t for reverse search, nil for forward.  Variable dabbrevs-limit
 214 ;; controls the maximum search region size.
 215
 216 ;; Table of expansions already seen is examined in buffer last-dabbrev-table,
 217 ;; so that only distinct possibilities are found by dabbrevs-re-expand.
 218 ;; Note that to prevent finding the abbrev itself it must have been
 219 ;; entered in the table.
 220
 221 ;; IGNORE-CASE non-nil means treat case as insignificant while
 222 ;; looking for a match and when comparing with previous matches.
 223 ;; Also if that's non-nil and the match is found at the beginning of a sentence
 224 ;; and is in lower case except for the initial
 225 ;; then it is converted to all lower case for return.
 226
 227 ;; Value is the expansion, or nil if not found.  After a successful
 228 ;; search, point is left right after the expansion found.
 229
 230 (defun dabbrevs-search (pattern reverse ignore-case)
 231   (let (missing result (case-fold-search ignore-case))
 232     (save-restriction       ; Uses restriction for limited searches.
 233       (if dabbrevs-limit
 234           (narrow-to-region last-dabbrevs-abbrev-location
 235                             (+ (point)
 236                                (* dabbrevs-limit (if reverse -1 1)))))
 237       ;; Keep looking for a distinct expansion.
 238       (setq result nil)
 239       (setq missing nil)
 240       (while  (and (not result) (not missing))
 241         ; Look for it, leave loop if search fails.
 242         (setq missing
 243               (not (if reverse
 244                        (re-search-backward pattern nil t)
 245                        (re-search-forward pattern nil t))))
 246
 247         (if (not missing)
 248             (progn
 249               (setq result (buffer-substring (match-beginning 0)
 250                                              (match-end 0)))
 251               (let* ((test last-dabbrev-table))
 252                 (while (and test
 253                             (not
 254                              (if ignore-case
 255                                  (string= (downcase (car test))
 256                                           (downcase result))
 257                                (string= (car test) result))))
 258                   (setq test (cdr test)))
 259                 (if test (setq result nil)))))) ; if already in table, ignore
 260       (if result
 261           (save-excursion
 262             (let ((beg (match-beginning 0)))
 263               (goto-char beg)
 264               (and ignore-case
 265                    (string= (substring result 1)
 266                             (downcase (substring result 1)))
 267                    (if (string= paragraph-start
 268                                 (concat "^$\\|" page-delimiter))
 269                        (and (re-search-backward sentence-end nil t)
 270                             (= (match-end 0) beg))
 271                      (forward-char 1)
 272                      (backward-sentence)
 273                      (= (point) beg))
 274                    (setq result (downcase result))))))
 275       result)))
 276
 277 (provide 'dabbrev)
 278
 279 ;;; dabbrev.el ends here