home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / dabbrev.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  9.3 KB  |  242 lines
  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. If `case-fold-search' and `case-replace' are non-nil (usually true)
  81. then the substituted word may be case-adjusted to match the abbreviation
  82. that you had typed.  This takes place if the substituted word, as found,
  83. is all lower case, or if it is at the beginning of a sentence and only
  84. its first letter was upper case.
  85.  
  86. A positive prefix argument, N, says to take the Nth backward DISTINCT
  87. possibility.  A negative argument says search forward.  The variable
  88. dabbrev-backward-only may be used to limit the direction of search to
  89. backward if set non-nil.
  90.  
  91. If the cursor has not moved from the end of the previous expansion and
  92. no argument is given, replace the previously-made expansion
  93. with the next possible expansion not yet tried."
  94.   (interactive "*P")
  95.   (let (abbrev expansion old which loc n pattern
  96.     (do-case (and case-fold-search case-replace)))
  97.     ;; abbrev -- the abbrev to expand
  98.     ;; expansion -- the expansion found (eventually) or nil until then
  99.     ;; old -- the text currently in the buffer
  100.     ;;    (the abbrev, or the previously-made expansion)
  101.     ;; loc -- place where expansion is found
  102.     ;;    (to start search there for next expansion if requested later)
  103.     ;; do-case -- non-nil if should transform case when substituting.
  104.     (save-excursion
  105.       (if (and (null arg)
  106.            (eq last-command this-command)
  107.            last-dabbrevs-abbrev-location)
  108.       (progn
  109.         (setq abbrev last-dabbrevs-abbreviation)
  110.         (setq old last-dabbrevs-expansion)
  111.         (setq which last-dabbrevs-direction))
  112.     (setq which (if (null arg)
  113.             (if dabbrevs-backward-only 1 0)
  114.                 (prefix-numeric-value arg)))
  115.     (setq loc (point))
  116.     (forward-word -1)
  117.     (setq last-dabbrevs-abbrev-location (point)) ; Original location.
  118.     (setq abbrev (buffer-substring (point) loc))
  119.     (setq old abbrev)
  120.     (setq last-dabbrevs-expansion-location nil)
  121.     (setq last-dabbrev-table nil))      ; Clear table of things seen.
  122.  
  123.       (setq pattern (concat "\\b" (regexp-quote abbrev) "\\(\\sw\\|\\s_\\)+"))
  124.       ;; Try looking backward unless inhibited.
  125.       (if (>= which 0)
  126.       (progn 
  127.         (setq n (max 1 which))
  128.         (if last-dabbrevs-expansion-location
  129.         (goto-char last-dabbrevs-expansion-location))
  130.         (while (and (> n 0)
  131.             (setq expansion (dabbrevs-search pattern t do-case)))
  132.           (setq loc (point-marker))
  133.           (setq last-dabbrev-table (cons expansion last-dabbrev-table))
  134.           (setq n (1- n)))
  135.         (or expansion
  136.         (setq last-dabbrevs-expansion-location nil))
  137.         (setq last-dabbrevs-direction (min 1 which))))
  138.  
  139.       (if (and (<= which 0) (not expansion)) ; Then look forward.
  140.       (progn 
  141.         (setq n (max 1 (- which)))
  142.         (if last-dabbrevs-expansion-location
  143.         (goto-char last-dabbrevs-expansion-location))
  144.         (while (and (> n 0)
  145.             (setq expansion (dabbrevs-search pattern nil do-case)))
  146.           (setq loc (point-marker))
  147.           (setq last-dabbrev-table (cons expansion last-dabbrev-table))
  148.           (setq n (1- n)))
  149.         (setq last-dabbrevs-direction -1))))
  150.  
  151.     (if (not expansion)
  152.     (let ((first (string= abbrev old)))
  153.       (setq last-dabbrevs-abbrev-location nil)
  154.       (if (not first)
  155.           (progn (undo-boundary)
  156.              (delete-backward-char (length old))
  157.              (insert abbrev)))
  158.       (error (if first
  159.              "No dynamic expansion for \"%s\" found."
  160.              "No further dynamic expansions for \"%s\" found.")
  161.          abbrev))
  162.       ;; Success: stick it in and return.
  163.       (undo-boundary)
  164.       (search-backward old)
  165.       ;; Make case of replacement conform to case of abbreviation
  166.       ;; provided (1) that kind of thing is enabled in this buffer
  167.       ;; and (2) the replacement itself is all lower case.
  168.       (replace-match expansion
  169.              (not (and do-case
  170.                    (string= expansion (downcase expansion))))
  171.              'literal)
  172.       ;; Save state for re-expand.
  173.       (setq last-dabbrevs-abbreviation abbrev)
  174.       (setq last-dabbrevs-expansion expansion)
  175.       (setq last-dabbrevs-expansion-location loc))))
  176.  
  177. ;; Search function used by dabbrevs library.  
  178. ;; First arg is string to find as prefix of word.  Second arg is
  179. ;; t for reverse search, nil for forward.  Variable dabbrevs-limit
  180. ;; controls the maximum search region size.
  181.  
  182. ;; Table of expansions already seen is examined in buffer last-dabbrev-table,
  183. ;; so that only distinct possibilities are found by dabbrevs-re-expand.
  184. ;; Note that to prevent finding the abbrev itself it must have been
  185. ;; entered in the table.
  186.  
  187. ;; IGNORE-CASE non-nil means treat case as insignificant while
  188. ;; looking for a match and when comparing with previous matches.
  189. ;; Also if that's non-nil and the match is found at the beginning of a sentence
  190. ;; and is in lower case except for the initial
  191. ;; then it is converted to all lower case for return.
  192.  
  193. ;; Value is the expansion, or nil if not found.  After a successful
  194. ;; search, point is left right after the expansion found.
  195.  
  196. (defun dabbrevs-search (pattern reverse ignore-case)
  197.   (let (missing result (case-fold-search ignore-case))
  198.     (save-restriction         ; Uses restriction for limited searches.
  199.       (if dabbrevs-limit
  200.       (narrow-to-region last-dabbrevs-abbrev-location
  201.                 (+ (point)
  202.                    (* dabbrevs-limit (if reverse -1 1)))))
  203.       ;; Keep looking for a distinct expansion.
  204.       (setq result nil)
  205.       (setq missing nil)
  206.       (while  (and (not result) (not missing))
  207.     ; Look for it, leave loop if search fails.
  208.     (setq missing
  209.           (not (if reverse
  210.                (re-search-backward pattern nil t)
  211.                (re-search-forward pattern nil t))))
  212.  
  213.     (if (not missing)
  214.         (progn
  215.           (setq result (buffer-substring (match-beginning 0)
  216.                          (match-end 0)))
  217.           (let* ((test last-dabbrev-table))
  218.         (while (and test
  219.                 (not
  220.                  (if ignore-case
  221.                  (string= (downcase (car test))
  222.                       (downcase result))
  223.                    (string= (car test) result))))
  224.           (setq test (cdr test)))
  225.         (if test (setq result nil))))))    ; if already in table, ignore
  226.       (if result
  227.       (save-excursion
  228.         (let ((beg (match-beginning 0)))
  229.           (goto-char beg)
  230.           (and ignore-case
  231.            (string= (substring result 1)
  232.                 (downcase (substring result 1)))
  233.            (if (string= paragraph-start
  234.                 (concat "^$\\|" page-delimiter))
  235.                (and (re-search-backward sentence-end nil t)
  236.                 (= (match-end 0) beg))
  237.              (forward-char 1)
  238.              (backward-sentence)
  239.              (= (point) beg))
  240.            (setq result (downcase result))))))
  241.       result)))
  242.