Annotation of GNUtools/emacs/lisp/dabbrev.el, revision 1.1.1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.