[bpt/emacs.git] / lisp / dabbrev.el

;;; dabbrev.el --- dynamic abbreviation package for GNU Emacs.

;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; Last-Modified: 16 Mar 1992
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: abbrev

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

; DABBREVS - "Dynamic abbreviations" hack, originally written by Don Morrison
; for Twenex Emacs.  Converted to mlisp by Russ Fish.  Supports the table
; feature to avoid hitting the same expansion on re-expand, and the search
; size limit variable.  Bugs fixed from the Twenex version are flagged by
; comments starting with ;;; .
; 
; converted to Emacs Lisp by Spencer Thomas.
; Thoroughly cleaned up by Richard Stallman.
;  
; If anyone feels like hacking at it, Bob Keller (Keller@Utah-20) first
; suggested the beast, and has some good ideas for its improvement, but
; doesn't know TECO (the lucky devil...).  One thing that should definitely
; be done is adding the ability to search some other buffer(s) if you can?t
; find the expansion you want in the current one.

;;; Code:

;; (defun dabbrevs-help ()
;;   "Give help about dabbrevs."
;;   (interactive)
;;   (&info "emacs" "dabbrevs")	; Select the specific info node.
;; )
(defvar dabbrevs-limit nil
  "*Limits region searched by `dabbrevs-expand' to this many chars away.")
(make-variable-buffer-local 'dabbrevs-limit)

(defvar dabbrevs-backward-only nil
  "*If non-NIL, `dabbrevs-expand' only looks backwards.")

; State vars for dabbrevs-re-expand.
(defvar last-dabbrevs-table nil
  "Table of expansions seen so far (local)")
(make-variable-buffer-local 'last-dabbrevs-table)

(defvar last-dabbrevs-abbreviation ""
  "Last string we tried to expand (local).")
(make-variable-buffer-local 'last-dabbrevs-abbreviation)

(defvar last-dabbrevs-direction 0
  "Direction of last dabbrevs search (local)")
(make-variable-buffer-local 'last-dabbrevs-direction)

(defvar last-dabbrevs-abbrev-location nil
  "Location last abbreviation began (local).")
(make-variable-buffer-local 'last-dabbrevs-abbrev-location)

(defvar last-dabbrevs-expansion nil
    "Last expansion of an abbreviation. (local)")
(make-variable-buffer-local 'last-dabbrevs-expansion)

(defvar last-dabbrevs-expansion-location nil
  "Location the last expansion was found. (local)")
(make-variable-buffer-local 'last-dabbrevs-expansion-location)

;;;###autoload
(defun dabbrev-expand (arg)
  "Expand previous word \"dynamically\".
Expands to the most recent, preceding word for which this is a prefix.
If no suitable preceding word is found, words following point are considered.

If `case-fold-search' and `case-replace' are non-nil (usually true)
then the substituted word may be case-adjusted to match the abbreviation
that you had typed.  This takes place if the substituted word, as found,
is all lower case, or if it is at the beginning of a sentence and only
its first letter was upper case.

A positive prefix arg N says to take the Nth backward DISTINCT
possibility.  A negative argument says search forward.  The variable
`dabbrev-backward-only' may be used to limit the direction of search to
backward if set non-nil.

If the cursor has not moved from the end of the previous expansion and
no argument is given, replace the previously-made expansion
with the next possible expansion not yet tried."
  (interactive "*P")
  (let (abbrev expansion old which loc n pattern
	(do-case (and case-fold-search case-replace)))
    ;; abbrev -- the abbrev to expand
    ;; expansion -- the expansion found (eventually) or nil until then
    ;; old -- the text currently in the buffer
    ;;    (the abbrev, or the previously-made expansion)
    ;; loc -- place where expansion is found
    ;;    (to start search there for next expansion if requested later)
    ;; do-case -- non-nil if should transform case when substituting.
    (save-excursion
      (if (and (null arg)
	       (eq last-command this-command)
	       last-dabbrevs-abbrev-location)
	  (progn
	    (setq abbrev last-dabbrevs-abbreviation)
	    (setq old last-dabbrevs-expansion)
	    (setq which last-dabbrevs-direction))
	(setq which (if (null arg)
			(if dabbrevs-backward-only 1 0)
		        (prefix-numeric-value arg)))
	(setq loc (point))
	(forward-word -1)
	(setq last-dabbrevs-abbrev-location (point)) ; Original location.
	(setq abbrev (buffer-substring (point) loc))
	(setq old abbrev)
	(setq last-dabbrevs-expansion-location nil)
	(setq last-dabbrev-table nil))  	; Clear table of things seen.

      (setq pattern (concat "\\b" (regexp-quote abbrev) "\\(\\sw\\|\\s_\\)+"))
      ;; Try looking backward unless inhibited.
      (if (>= which 0)
	  (progn 
	    (setq n (max 1 which))
	    (if last-dabbrevs-expansion-location
		(goto-char last-dabbrevs-expansion-location))
	    (while (and (> n 0)
			(setq expansion (dabbrevs-search pattern t do-case)))
	      (setq loc (point-marker))
	      (setq last-dabbrev-table (cons expansion last-dabbrev-table))
	      (setq n (1- n)))
	    (or expansion
		(setq last-dabbrevs-expansion-location nil))
	    (setq last-dabbrevs-direction (min 1 which))))

      (if (and (<= which 0) (not expansion)) ; Then look forward.
	  (progn 
	    (setq n (max 1 (- which)))
	    (if last-dabbrevs-expansion-location
		(goto-char last-dabbrevs-expansion-location))
	    (while (and (> n 0)
			(setq expansion (dabbrevs-search pattern nil do-case)))
	      (setq loc (point-marker))
	      (setq last-dabbrev-table (cons expansion last-dabbrev-table))
	      (setq n (1- n)))
	    (setq last-dabbrevs-direction -1))))

    (if (not expansion)
	(let ((first (string= abbrev old)))
	  (setq last-dabbrevs-abbrev-location nil)
	  (if (not first)
	      (progn (undo-boundary)
		     (search-backward old)
		     (if (eq major-mode 'picture-mode)
			 (picture-replace-match abbrev t 'literal)
		       (replace-match abbrev t 'literal))))
	  (error (if first
		     "No dynamic expansion for \"%s\" found."
		     "No further dynamic expansions for \"%s\" found.")
		 abbrev))
      ;; Success: stick it in and return.
      (undo-boundary)
      (search-backward old)
      ;; Make case of replacement conform to case of abbreviation
      ;; provided (1) that kind of thing is enabled in this buffer
      ;; and (2) the replacement itself is all lower case.
      ;; First put back the original abbreviation with its original
      ;; case pattern.
      (save-excursion
	(if (eq major-mode 'picture-mode)
	    (picture-replace-match abbrev t 'literal)
	  (replace-match abbrev t 'literal)))
      (search-forward abbrev)
      (let ((do-case (and do-case
			  (string= (substring expansion 1)
				   (downcase (substring expansion 1))))))
	;; First put back the original abbreviation with its original
	;; case pattern.
	(save-excursion
	  (replace-match abbrev t 'literal))
;;; This used to be necessary, but no longer, 
;;; because now point is preserved correctly above.
;;;	(search-forward abbrev)
	(if (eq major-mode 'picture-mode)
	    (picture-replace-match (if do-case (downcase expansion) expansion)
				   (not do-case)
				   'literal)
	  (replace-match (if do-case (downcase expansion) expansion)
			 (not do-case)
			 'literal)))
      ;; Save state for re-expand.
      (setq last-dabbrevs-abbreviation abbrev)
      (setq last-dabbrevs-expansion expansion)
      (setq last-dabbrevs-expansion-location loc))))

;;;###autoload (define-key esc-map "/" 'dabbrev-expand)


;; Search function used by dabbrevs library.  
;; First arg is string to find as prefix of word.  Second arg is
;; t for reverse search, nil for forward.  Variable dabbrevs-limit
;; controls the maximum search region size.

;; Table of expansions already seen is examined in buffer last-dabbrev-table,
;; so that only distinct possibilities are found by dabbrevs-re-expand.
;; Note that to prevent finding the abbrev itself it must have been
;; entered in the table.

;; IGNORE-CASE non-nil means treat case as insignificant while
;; looking for a match and when comparing with previous matches.
;; Also if that's non-nil and the match is found at the beginning of a sentence
;; and is in lower case except for the initial
;; then it is converted to all lower case for return.

;; Value is the expansion, or nil if not found.  After a successful
;; search, point is left right after the expansion found.

(defun dabbrevs-search (pattern reverse ignore-case)
  (let (missing result (case-fold-search ignore-case))
    (save-restriction 	    ; Uses restriction for limited searches.
      (if dabbrevs-limit
	  (narrow-to-region last-dabbrevs-abbrev-location
			    (+ (point)
			       (* dabbrevs-limit (if reverse -1 1)))))
      ;; Keep looking for a distinct expansion.
      (setq result nil)
      (setq missing nil)
      (while  (and (not result) (not missing))
	; Look for it, leave loop if search fails.
	(setq missing
	      (not (if reverse
		       (re-search-backward pattern nil t)
		       (re-search-forward pattern nil t))))

	(if (not missing)
	    (progn
	      (setq result (buffer-substring (match-beginning 0)
					     (match-end 0)))
	      (let* ((test last-dabbrev-table))
		(while (and test
			    (not
			     (if ignore-case
				 (string= (downcase (car test))
					  (downcase result))
			       (string= (car test) result))))
		  (setq test (cdr test)))
		(if test (setq result nil))))))	; if already in table, ignore
      (if result
	  (save-excursion
	    (let ((beg (match-beginning 0)))
	      (goto-char beg)
	      (and ignore-case
		   (string= (substring result 1)
			    (downcase (substring result 1)))
		   (if (string= paragraph-start
				(concat "^$\\|" page-delimiter))
		       (and (re-search-backward sentence-end nil t)
			    (= (match-end 0) beg))
		     (forward-char 1)
		     (backward-sentence)
		     (= (point) beg))
		   (setq result (downcase result))))))
      result)))

(provide 'dabbrev)

;;; dabbrev.el ends here
Commit	Line	Data
c0274f38 ER	1	;;; dabbrev.el --- dynamic abbreviation package for GNU Emacs.
c0274f38 ER	2
3a801d0c	3	;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
e5167999	4
3a801d0c	5	;; Last-Modified: 16 Mar 1992
2f790b20 JB	6	;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
2f790b20 JB	7
3a801d0c	8	;; Maintainer: FSF
e9571d2a	9	;; Keywords: abbrev
3a801d0c	10
2f790b20 JB	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
e5167999	15	;; the Free Software Foundation; either version 2, or (at your option)
2f790b20 JB	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
e5167999	27	;;; Commentary:
2f790b20 JB	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	;
fc68affa	35	; converted to Emacs Lisp by Spencer Thomas.
2f790b20 JB	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
e5167999	40	; doesn't know TECO (the lucky devil...). One thing that should definitely
2f790b20 JB	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
e5167999 ER	44	;;; Code:
e5167999 ER	45
2f790b20 JB	46	;; (defun dabbrevs-help ()
	47	;; "Give help about dabbrevs."
	48	;; (interactive)
	49	;; (&info "emacs" "dabbrevs") ; Select the specific info node.
	50	;; )
2f790b20 JB	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)
0fc2d006 RS	165	(search-backward old)
	166	(if (eq major-mode 'picture-mode)
	167	(picture-replace-match abbrev t 'literal)
	168	(replace-match abbrev t 'literal))))
2f790b20 JB	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
0fc2d006 RS	182	(if (eq major-mode 'picture-mode)
	183	(picture-replace-match abbrev t 'literal)
	184	(replace-match abbrev t 'literal)))
2f790b20 JB	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))
9b54f268 RS	193	;;; This used to be necessary, but no longer,
	194	;;; because now point is preserved correctly above.
	195	;;; (search-forward abbrev)
0fc2d006 RS	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)))
2f790b20 JB	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
5f5d794a	208	;;;###autoload (define-key esc-map "/" 'dabbrev-expand)
2f790b20 JB	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)))
49116ac0	276
01987a6b	277	(provide 'dabbrev)
49116ac0	278
c0274f38	279	;;; dabbrev.el ends here