Mercurial > hg > xemacs-beta

comparison lisp/packages/dabbrev.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children cca96a509cfe
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
5 ;; Maintainer: Lars Lindberg <Lars.Lindberg@sypro.cap.se> 5 ;; Maintainer: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
6 ;; Created: 16 Mars 1992 6 ;; Created: 16 Mars 1992
7 ;; Lindberg's last update version: 5.7 7 ;; Lindberg's last update version: 5.7
8 ;; Keywords: abbrev expand completion 8 ;; Keywords: abbrev expand completion
9 9
10 ;; This program is free software; you can redistribute it and/or modify 10 ;; This file is part of XEmacs.
11 ;; it under the terms of the GNU General Public License as published by 11
12 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2 of the License, or 14 ;; the Free Software Foundation; either version 2 of the License, or
13 ;; (at your option) any later version. 15 ;; (at your option) any later version.
14 ;; 16 ;;
15 ;; This program is distributed in the hope that it will be useful, 17 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; GNU General Public License for more details. 20 ;; General Public License for more details.
19 ;; 21 ;;
20 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; if not, write to the Free Software 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, MA
23 25 ;; 02111-1307, USA.
24 ;;; Synched up with: FSF 19.30. 26
27 ;;; Synched up with: FSF 19.34.
25 28
26 ;;; Commentary: 29 ;;; Commentary:
27 30
28 ;; The purpose with this package is to let you write just a few 31 ;; The purpose with this package is to let you write just a few
29 ;; characters of words you've written earlier to be able to expand 32 ;; characters of words you've written earlier to be able to expand
41 ;; dabbrev-case-fold-search nil t 44 ;; dabbrev-case-fold-search nil t
42 ;; dabbrev-case-replace nil t 45 ;; dabbrev-case-replace nil t
43 ;; 46 ;;
44 ;; Set the variables you want special for your mode like this: 47 ;; Set the variables you want special for your mode like this:
45 ;; (set (make-local-variable 'dabbrev-case-replace) nil) 48 ;; (set (make-local-variable 'dabbrev-case-replace) nil)
46 ;; Then you don't interfer with other modes. 49 ;; Then you don't interfere with other modes.
47 ;; 50 ;;
48 ;; If your mode handles buffers that refers to other buffers 51 ;; If your mode handles buffers that refers to other buffers
49 ;; (i.e. compilation-mode, gud-mode), then try to set 52 ;; (i.e. compilation-mode, gud-mode), then try to set
50 ;; `dabbrev-select-buffers-function' or `dabbrev-friend-buffer-function' 53 ;; `dabbrev-select-buffers-function' or `dabbrev-friend-buffer-function'
51 ;; to a function that point out those buffers. 54 ;; to a function that point out those buffers.
90 ;; [hawley] Bob Hawley <rth1@quartet.mt.att.com> 93 ;; [hawley] Bob Hawley <rth1@quartet.mt.att.com>
91 ;; ... and to all the people who have participated in the beta tests. 94 ;; ... and to all the people who have participated in the beta tests.
92 95
93 ;;; Code: 96 ;;; Code:
94 97
95 ;;;---------------------------------------------------------------- 98 ;;----------------------------------------------------------------
96 ;;;---------------------------------------------------------------- 99 ;; Customization variables
97 ;;; Customization variables 100 ;;----------------------------------------------------------------
98 ;;;----------------------------------------------------------------
99 ;;;----------------------------------------------------------------
100 (defvar dabbrev-backward-only nil 101 (defvar dabbrev-backward-only nil
101 "*If non-nil, `dabbrev-expand' only looks backwards.") 102 "*If non-nil, `dabbrev-expand' only looks backwards.")
102 103
103 (defvar dabbrev-limit nil 104 (defvar dabbrev-limit nil
104 "*Limits region searched by `dabbrev-expand' to this many chars away.") 105 "*Limits region searched by `dabbrev-expand' to this many chars away.")
106 (defvar dabbrev-abbrev-skip-leading-regexp nil 107 (defvar dabbrev-abbrev-skip-leading-regexp nil
107 "*Regexp for skipping leading characters of an abbreviation. 108 "*Regexp for skipping leading characters of an abbreviation.
108 109
109 Example: Set this to \"\\\\$\" for programming languages 110 Example: Set this to \"\\\\$\" for programming languages
110 in which variable names may appear with or without a leading `$'. 111 in which variable names may appear with or without a leading `$'.
111 (For example, in Makefiles.) 112 \(For example, in Makefiles.)
112 113
113 Set this to nil if no characters should be skipped.") 114 Set this to nil if no characters should be skipped.")
114 115
115 ;; XEmacs change: The old defaults are just too obnoxious. Rarely 116 ;; XEmacs change: The old defaults are just too obnoxious. Rarely
116 ;; do you actually want the case-folding behavior here, even though 117 ;; do you actually want the case-folding behavior here, even though
216 "If non-nil, a list of buffers which dabbrev should search. 217 "If non-nil, a list of buffers which dabbrev should search.
217 If this variable is non-nil, dabbrev will only look in these buffers. 218 If this variable is non-nil, dabbrev will only look in these buffers.
218 It will not even look in the current buffer if it is not a member of 219 It will not even look in the current buffer if it is not a member of
219 this list.") 220 this list.")
220 221
221 ;;;---------------------------------------------------------------- 222 ;;----------------------------------------------------------------
222 ;;;---------------------------------------------------------------- 223 ;; Internal variables
223 ;;; Internal variables 224 ;;----------------------------------------------------------------
224 ;;;----------------------------------------------------------------
225 ;;;----------------------------------------------------------------
226 225
227 ;; Last obarray of completions in `dabbrev-completion' 226 ;; Last obarray of completions in `dabbrev-completion'
228 (defvar dabbrev--last-obarray nil) 227 (defvar dabbrev--last-obarray nil)
229 228
230 ;; Table of expansions seen so far 229 ;; Table of expansions seen so far
255 (defvar dabbrev--last-buffer-found nil) 254 (defvar dabbrev--last-buffer-found nil)
256 255
257 ;; The buffer we last did a completion in. 256 ;; The buffer we last did a completion in.
258 (defvar dabbrev--last-completion-buffer nil) 257 (defvar dabbrev--last-completion-buffer nil)
259 258
259 ;; Non-nil means we should upcase
260 ;; when copying successive words.
261 (defvar dabbrev--last-case-pattern nil)
262
260 ;; Same as dabbrev-check-other-buffers, but is set for every expand. 263 ;; Same as dabbrev-check-other-buffers, but is set for every expand.
261 (defvar dabbrev--check-other-buffers dabbrev-check-other-buffers) 264 (defvar dabbrev--check-other-buffers dabbrev-check-other-buffers)
262 265
263 ;; The regexp for recognizing a character in an abbreviation. 266 ;; The regexp for recognizing a character in an abbreviation.
264 (defvar dabbrev--abbrev-char-regexp nil) 267 (defvar dabbrev--abbrev-char-regexp nil)
265 268
266 ;;;---------------------------------------------------------------- 269 ;;----------------------------------------------------------------
267 ;;;---------------------------------------------------------------- 270 ;; Macros
268 ;;; Macros 271 ;;----------------------------------------------------------------
269 ;;;----------------------------------------------------------------
270 ;;;----------------------------------------------------------------
271 272
272 ;;; Get the buffer that mini-buffer was activated from 273 ;;; Get the buffer that mini-buffer was activated from
273 (defsubst dabbrev--minibuffer-origin () 274 (defsubst dabbrev--minibuffer-origin ()
274 (car (cdr (buffer-list)))) 275 (car (cdr (buffer-list))))
275 276
295 (set-window-configuration wconfig) 296 (set-window-configuration wconfig)
296 (set-buffer buffer) 297 (set-buffer buffer)
297 (goto-char point) 298 (goto-char point)
298 (dabbrev--substitute-expansion nil init (extent-string extent)))) 299 (dabbrev--substitute-expansion nil init (extent-string extent))))
299 300
300 ;;;---------------------------------------------------------------- 301 ;;----------------------------------------------------------------
301 ;;;---------------------------------------------------------------- 302 ;; Exported functions
302 ;;; Exported functions 303 ;;----------------------------------------------------------------
303 ;;;----------------------------------------------------------------
304 ;;;----------------------------------------------------------------
305 304
306 ;; XEmacs changes: 305 ;; XEmacs changes:
307 ;;;###autoload 306 ;;;###autoload
308 (define-key global-map [(meta /)] 'dabbrev-expand) 307 (define-key global-map [(meta /)] 'dabbrev-expand)
309 ;;;??? Do we want this? 308 ;;;??? Do we want this?
356 ;; New abbreviation to expand. 355 ;; New abbreviation to expand.
357 ;;-------------------------------- 356 ;;--------------------------------
358 (setq dabbrev--last-abbreviation abbrev) 357 (setq dabbrev--last-abbreviation abbrev)
359 ;; Find all expansion 358 ;; Find all expansion
360 (let ((completion-list 359 (let ((completion-list
361 (dabbrev--find-all-expansions abbrev ignore-case-p))) 360 (dabbrev--find-all-expansions abbrev ignore-case-p))
361 (completion-ignore-case ignore-case-p))
362 ;; Make an obarray with all expansions 362 ;; Make an obarray with all expansions
363 (setq my-obarray (make-vector (length completion-list) 0)) 363 (setq my-obarray (make-vector (length completion-list) 0))
364 (or (> (length my-obarray) 0) 364 (or (> (length my-obarray) 0)
365 (error "No dynamic expansion for \"%s\" found%s" 365 (error "No dynamic expansion for \"%s\" found%s"
366 abbrev 366 abbrev
411 (set-marker (make-marker) (point)) 411 (set-marker (make-marker) (point))
412 init 412 init
413 (current-window-configuration)))) 413 (current-window-configuration))))
414 (with-output-to-temp-buffer " *Completions*" 414 (with-output-to-temp-buffer " *Completions*"
415 (display-completion-list (all-completions init my-obarray) 415 (display-completion-list (all-completions init my-obarray)
416 :activate-callback
416 'dabbrev--extent-clicked-on 417 'dabbrev--extent-clicked-on
417 arg))) 418 :user-data arg)))
418 (message "Making completion list...done"))) 419 (message "Making completion list...done")))
419 (and (window-minibuffer-p (selected-window)) 420 (and (window-minibuffer-p (selected-window))
420 (message nil)))) 421 (message nil))))
421 422
422 ;;;###autoload 423 ;;;###autoload
439 The variable `dabbrev-backward-only' may be used to limit the 440 The variable `dabbrev-backward-only' may be used to limit the
440 direction of search to backward if set non-nil. 441 direction of search to backward if set non-nil.
441 442
442 See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." 443 See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
443 (interactive "*P") 444 (interactive "*P")
444 (let (abbrev expansion old direction (orig-point (point))) 445 (let (abbrev record-case-pattern
446 expansion old direction (orig-point (point)))
445 ;; abbrev -- the abbrev to expand 447 ;; abbrev -- the abbrev to expand
446 ;; expansion -- the expansion found (eventually) or nil until then 448 ;; expansion -- the expansion found (eventually) or nil until then
447 ;; old -- the text currently in the buffer 449 ;; old -- the text currently in the buffer
448 ;; (the abbrev, or the previously-made expansion) 450 ;; (the abbrev, or the previously-made expansion)
449 (save-excursion 451 (save-excursion
484 (re-search-forward 486 (re-search-forward
485 (concat "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)")) 487 (concat "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)"))
486 (setq expansion 488 (setq expansion
487 (buffer-substring dabbrev--last-expansion-location 489 (buffer-substring dabbrev--last-expansion-location
488 (point))) 490 (point)))
491 (if dabbrev--last-case-pattern
492 (setq expansion (upcase expansion)))
489 493
490 ;; Record the end of this expansion, in case we repeat this. 494 ;; Record the end of this expansion, in case we repeat this.
491 (setq dabbrev--last-expansion-location (point))) 495 (setq dabbrev--last-expansion-location (point)))
492 ;; Indicate that dabbrev--last-expansion-location is 496 ;; Indicate that dabbrev--last-expansion-location is
493 ;; at the end of the expansion. 497 ;; at the end of the expansion.
497 (dabbrev--reset-global-variables) 501 (dabbrev--reset-global-variables)
498 (setq direction (if (null arg) 502 (setq direction (if (null arg)
499 (if dabbrev-backward-only 1 0) 503 (if dabbrev-backward-only 1 0)
500 (prefix-numeric-value arg))) 504 (prefix-numeric-value arg)))
501 (setq abbrev (dabbrev--abbrev-at-point)) 505 (setq abbrev (dabbrev--abbrev-at-point))
506 (setq record-case-pattern t)
502 (setq old nil))) 507 (setq old nil)))
503 508
504 ;;-------------------------------- 509 ;;--------------------------------
505 ;; Find the expansion 510 ;; Find the expansion
506 ;;-------------------------------- 511 ;;--------------------------------
536 (setq dabbrev--last-expansion-location 541 (setq dabbrev--last-expansion-location
537 (copy-marker dabbrev--last-expansion-location))) 542 (copy-marker dabbrev--last-expansion-location)))
538 ;; Success: stick it in and return. 543 ;; Success: stick it in and return.
539 (setq buffer-undo-list (cons orig-point buffer-undo-list)) 544 (setq buffer-undo-list (cons orig-point buffer-undo-list))
540 (dabbrev--substitute-expansion old abbrev expansion) 545 (dabbrev--substitute-expansion old abbrev expansion)
546
547 ;; If we are not copying successive words now,
548 ;; set dabbrev--last-case-pattern.
549 (and record-case-pattern
550 (setq dabbrev--last-case-pattern
551 (and (eval dabbrev-case-fold-search)
552 (not dabbrev-upcase-means-case-search)
553 (equal abbrev (upcase abbrev)))))
554
541 ;; Save state for re-expand. 555 ;; Save state for re-expand.
542 (setq dabbrev--last-expansion expansion) 556 (setq dabbrev--last-expansion expansion)
543 (setq dabbrev--last-abbreviation abbrev) 557 (setq dabbrev--last-abbreviation abbrev)
544 (setq dabbrev--last-abbrev-location (point-marker)))))) 558 (setq dabbrev--last-abbrev-location (point-marker))))))
545 559
546 ;;;---------------------------------------------------------------- 560 ;;----------------------------------------------------------------
547 ;;;---------------------------------------------------------------- 561 ;; Local functions
548 ;;; Local functions 562 ;;----------------------------------------------------------------
549 ;;;----------------------------------------------------------------
550 ;;;----------------------------------------------------------------
551 563
552 ;;; Checks if OTHER-BUFFER has the same major mode as current buffer. 564 ;;; Checks if OTHER-BUFFER has the same major mode as current buffer.
553 (defun dabbrev--same-major-mode-p (other-buffer) 565 (defun dabbrev--same-major-mode-p (other-buffer)
554 (eq major-mode 566 (eq major-mode
555 (save-excursion 567 (save-excursion
777 (string= abbrev (downcase abbrev))) 789 (string= abbrev (downcase abbrev)))
778 (eval dabbrev-case-replace)))) 790 (eval dabbrev-case-replace))))
779 (and nil use-case-replace 791 (and nil use-case-replace
780 (setq old (concat abbrev (or old ""))) 792 (setq old (concat abbrev (or old "")))
781 (setq expansion (concat abbrev expansion))) 793 (setq expansion (concat abbrev expansion)))
794 ;; If the given abbrev is mixed case and its case pattern
795 ;; matches the start of the expansion,
796 ;; copy the expansion's case
797 ;; instead of downcasing all the rest.
798 (if (and (string= abbrev
799 (substring expansion 0 (length abbrev)))
800 (not (string= abbrev (downcase abbrev)))
801 (not (string= abbrev (upcase abbrev))))
802 (setq use-case-replace nil))
803 (if (equal abbrev " ")
804 (setq use-case-replace nil))
805 (if use-case-replace
806 (setq expansion (downcase expansion)))
782 (if old 807 (if old
783 (save-excursion 808 (save-excursion
784 (search-backward old)) 809 (search-backward old))
785 ;;(store-match-data (list (point-marker) (point-marker))) 810 ;;(store-match-data (list (point-marker) (point-marker)))
786 (search-backward abbrev)) 811 (search-backward abbrev))
795 ;;;---------------------------------------------------------------- 820 ;;;----------------------------------------------------------------
796 ;;; Search function used by dabbrevs library. 821 ;;; Search function used by dabbrevs library.
797 822
798 ;;; ABBREV is string to find as prefix of word. Second arg, REVERSE, 823 ;;; ABBREV is string to find as prefix of word. Second arg, REVERSE,
799 ;;; is t for reverse search, nil for forward. Variable dabbrev-limit 824 ;;; is t for reverse search, nil for forward. Variable dabbrev-limit
800 ;;; controls the maximum search region size. Third argment IGNORE-CASE 825 ;;; controls the maximum search region size. Third argument IGNORE-CASE
801 ;;; non-nil means treat case as insignificant while looking for a match 826 ;;; non-nil means treat case as insignificant while looking for a match
802 ;;; and when comparing with previous matches. Also if that's non-nil 827 ;;; and when comparing with previous matches. Also if that's non-nil
803 ;;; and the match is found at the beginning of a sentence and is in 828 ;;; and the match is found at the beginning of a sentence and is in
804 ;;; lower case except for the initial then it is converted to all lower 829 ;;; lower case except for the initial then it is converted to all lower
805 ;;; case for return. 830 ;;; case for return.
858 (let ((result 883 (let ((result
859 (buffer-substring (match-beginning 0) (match-end 0)))) 884 (buffer-substring (match-beginning 0) (match-end 0))))
860 (setq dabbrev--last-table 885 (setq dabbrev--last-table
861 (cons found-string dabbrev--last-table)) 886 (cons found-string dabbrev--last-table))
862 (if (and ignore-case (eval dabbrev-case-replace)) 887 (if (and ignore-case (eval dabbrev-case-replace))
888 ;; XEmacs: FSF has just `result', which makes absolutely
889 ;; no sense in this context
863 (downcase result) 890 (downcase result)
864 result))))))) 891 result)))))))
865 892
866 (provide 'dabbrev) 893 (provide 'dabbrev)
867 894
868 ;; dabbrev.el ends here 895 ;; dabbrev.el ends here
869
870