1 ;;; completion.el --- dynamic word-completion code
2 ;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc.
6 ;; Author: Jim Salem <alem@bbnplanet.com> of Thinking Machines Inc.
7 ;; (ideas suggested by Brewster Kahle)
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27 ;;; What to put in .emacs
28 ;;;-----------------------
29 ;;; (load "completion")
30 ;;; (initialize-completions)
32 ;;;---------------------------------------------------------------------------
33 ;;; Documentation [Slightly out of date]
34 ;;;---------------------------------------------------------------------------
35 ;;; (also check the documentation string of the functions)
40 ;;; After you type a few characters, pressing the "complete" key inserts
41 ;;; the rest of the word you are likely to type.
43 ;;; This watches all the words that you type and remembers them. When
44 ;;; typing a new word, pressing "complete" (meta-return) "completes" the
45 ;;; word by inserting the most recently used word that begins with the
46 ;;; same characters. If you press meta-return repeatedly, it cycles
47 ;;; through all the words it knows about.
49 ;;; If you like the completion then just continue typing, it is as if you
50 ;;; entered the text by hand. If you want the inserted extra characters
51 ;;; to go away, type control-w or delete. More options are described below.
53 ;;; The guesses are made in the order of the most recently "used". Typing
54 ;;; in a word and then typing a separator character (such as a space) "uses"
55 ;;; the word. So does moving a cursor over the word. If no words are found,
56 ;;; it uses an extended version of the dabbrev style completion.
58 ;;; You automatically save the completions you use to a file between
61 ;;; Completion enables programmers to enter longer, more descriptive
62 ;;; variable names while typing fewer keystrokes than they normally would.
65 ;;; Full documentation
66 ;;;---------------------
68 ;;; A "word" is any string containing characters with either word or symbol
69 ;;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.]
70 ;;; Unless you change the constants, you must type at least three characters
71 ;;; for the word to be recognized. Only words longer than 6 characters are
74 ;;; When you load this file, completion will be on. I suggest you use the
75 ;;; compiled version (because it is noticeably faster).
77 ;;; M-X completion-mode toggles whether or not new words are added to the
78 ;;; database by changing the value of enable-completion.
80 ;;; SAVING/LOADING COMPLETIONS
81 ;;; Completions are automatically saved from one session to another
82 ;;; (unless save-completions-flag or enable-completion is nil).
83 ;;; Loading this file (or calling initialize-completions) causes EMACS
84 ;;; to load a completions database for a saved completions file
85 ;;; (default: ~/.completions). When you exit, EMACS saves a copy of the
86 ;;; completions that you
87 ;;; often use. When you next start, EMACS loads in the saved completion file.
89 ;;; The number of completions saved depends loosely on
90 ;;; *saved-completions-decay-factor*. Completions that have never been
91 ;;; inserted via "complete" are not saved. You are encouraged to experiment
92 ;;; with different functions (see compute-completion-min-num-uses).
94 ;;; Some completions are permanent and are always saved out. These
95 ;;; completions have their num-uses slot set to T. Use
96 ;;; add-permanent-completion to do this
98 ;;; Completions are saved only if enable-completion is T. The number of old
99 ;;; versions kept of the saved completions file is controlled by
100 ;;; completions-file-versions-kept.
102 ;;; COMPLETE KEY OPTIONS
103 ;;; The complete function takes a numeric arguments.
104 ;;; control-u :: leave the point at the beginning of the completion rather
106 ;;; a number :: rotate through the possible completions by that amount
107 ;;; `-' :: same as -1 (insert previous completion)
109 ;;; HOW THE DATABASE IS MAINTAINED
112 ;;; UPDATING THE DATABASE MANUALLY
113 ;;; m-x kill-completion
114 ;;; kills the completion at point.
115 ;;; m-x add-completion
116 ;;; m-x add-permanent-completion
118 ;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
119 ;;; m-x add-completions-from-buffer
120 ;;; Parses all the definition names from a C or LISP mode buffer and
121 ;;; adds them to the completion database.
123 ;;; m-x add-completions-from-lisp-file
124 ;;; Parses all the definition names from a C or Lisp mode file and
125 ;;; adds them to the completion database.
127 ;;; UPDATING THE DATABASE FROM A TAGS TABLE
128 ;;; m-x add-completions-from-tags-table
129 ;;; Adds completions from the current tags-table-buffer.
131 ;;; HOW A COMPLETION IS FOUND
135 ;;; Completion is string case independent if case-fold-search has its
136 ;;; normal default of T. Also when the completion is inserted the case of the
137 ;;; entry is coerced appropriately.
138 ;;; [E.G. APP --> APPROPRIATELY app --> appropriately
139 ;;; App --> Appropriately]
142 ;;; The form `(initialize-completions)' initializes the completion system by
143 ;;; trying to load in the user's completions. After the first cal, further
144 ;;; calls have no effect so one should be careful not to put the form in a
145 ;;; site's standard site-init file.
147 ;;;---------------------------------------------------------------------------
151 ;;;---------------------------------------------------------------------------
152 ;;; Functions you might like to call
153 ;;;---------------------------------------------------------------------------
155 ;;; add-completion string &optional num-uses
156 ;;; Adds a new string to the database
158 ;;; add-permanent-completion string
159 ;;; Adds a new string to the database with num-uses = T
162 ;;; kill-completion string
163 ;;; Kills the completion from the database.
165 ;;; clear-all-completions
166 ;;; Clears the database
168 ;;; list-all-completions
169 ;;; Returns a list of all completions.
172 ;;; next-completion string &optional index
173 ;;; Returns a completion entry that starts with string.
175 ;;; find-exact-completion string
176 ;;; Returns a completion entry that exactly matches string.
179 ;;; Inserts a completion at point
181 ;;; initialize-completions
182 ;;; Loads the completions file and sets up so that exiting emacs will
185 ;;; save-completions-to-file &optional filename
186 ;;; load-completions-from-file &optional filename
188 ;;;-----------------------------------------------
190 ;;;-----------------------------------------------
192 ;;; get-completion-list string
194 ;;; These things are for manipulating the structure
195 ;;; make-completion string num-uses
196 ;;; completion-num-uses completion
197 ;;; completion-string completion
198 ;;; set-completion-num-uses completion num-uses
199 ;;; set-completion-string completion string
203 ;;;-----------------------------------------------
204 ;;; To Do :: (anybody ?)
205 ;;;-----------------------------------------------
207 ;;; Implement Lookup and keyboard interface in C
208 ;;; Add package prefix smarts (for Common Lisp)
209 ;;; Add autoprompting of possible completions after every keystroke (fast
210 ;;; terminals only !)
211 ;;; Add doc. to texinfo
214 ;;;-----------------------------------------------
216 ;;;-----------------------------------------------
217 ;;; Sometime in '84 Brewster implemented a somewhat buggy version for
218 ;;; Symbolics LISPMs.
219 ;;; Jan. '85 Jim became enamored of the idea and implemented a faster,
220 ;;; more robust version.
221 ;;; With input from many users at TMC, (rose, craig, and gls come to mind),
222 ;;; the current style of interface was developed.
223 ;;; 9/87, Jim and Brewster took terminals home. Yuck. After
224 ;;; complaining for a while Brewster implemented a subset of the current
225 ;;; LISPM version for GNU Emacs.
226 ;;; 8/88 After complaining for a while (and with sufficient
227 ;;; promised rewards), Jim reimplemented a version of GNU completion
228 ;;; superior to that of the LISPM version.
230 ;;;-----------------------------------------------
232 ;;;-----------------------------------------------
233 ;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
234 ;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
236 ;;;-----------------------------------------------
238 ;;;-----------------------------------------------
239 ;;; From version 9 to 10
240 ;;; - Allowance for non-integral *completion-version* nos.
241 ;;; - Fix cmpl-apply-as-top-level for keyboard macros
242 ;;; - Fix broken completion merging (in save-completions-to-file)
243 ;;; - More misc. fixes for version 19.0 of emacs
245 ;;; From Version 8 to 9
246 ;;; - Ported to version 19.0 of emacs (backcompatible with version 18)
247 ;;; - Added add-completions-from-tags-table (with thanks to eero@media-lab)
249 ;;; From Version 7 to 8
250 ;;; - Misc. changes to comments
251 ;;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e
252 ;;; - cdabbrev now checks all the visible window buffers and the "other buffer"
253 ;;; - `%' is now a symbol character rather than a separator (except in C mode)
255 ;;; From Version 6 to 7
256 ;;; - Fixed bug with saving out .completion file the first time
258 ;;; From Version 5 to 6
259 ;;; - removed statistics recording
260 ;;; - reworked advise to handle autoloads
261 ;;; - Fixed fortran mode support
262 ;;; - Added new cursor motion triggers
264 ;;; From Version 4 to 5
265 ;;; - doesn't bother saving if nothing has changed
266 ;;; - auto-save if haven't used for a 1/2 hour
267 ;;; - save period extended to two weeks
268 ;;; - minor fix to capitalization code
269 ;;; - added *completion-auto-save-period* to variables recorded.
270 ;;; - added reenter protection to cmpl-record-statistics-filter
271 ;;; - added backup protection to save-completions-to-file (prevents
272 ;;; problems with disk full errors)
276 ;;;---------------------------------------------------------------------------
277 ;;; User changeable parameters
278 ;;;---------------------------------------------------------------------------
280 (defvar enable-completion t
281 "*Non-nil means enable recording and saving of completions.
282 If nil, no new words added to the database or saved to the init file.")
284 (defvar save-completions-flag t
285 "*Non-nil means save most-used completions when exiting Emacs.
286 See also `saved-completions-retention-time'.")
288 (defvar save-completions-file-name
(convert-standard-filename "~/.completions")
289 "*The filename to save completions to.")
291 (defvar save-completions-retention-time
336
292 "*Discard a completion if unused for this many hours.
293 \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
294 will not be saved unless these are used. Default is two weeks.")
296 (defvar completion-on-separator-character nil
297 "*Non-nil means separator characters mark previous word as used.
298 This means the word will be saved as a completion.")
300 (defvar completions-file-versions-kept kept-new-versions
301 "*Number of versions to keep for the saved completions file.")
303 (defvar completion-prompt-speed-threshold
4800
304 "*Minimum output speed at which to display next potential completion.")
306 (defvar completion-cdabbrev-prompt-flag nil
307 "*If non-nil, the next completion prompt does a cdabbrev search.
308 This can be time consuming.")
310 (defvar completion-search-distance
15000
311 "*How far to search in the buffer when looking for completions.
312 In number of characters. If nil, search the whole buffer.")
314 (defvar completions-merging-modes
'(lisp c
)
315 "*List of modes {`c' or `lisp'} for automatic completions merging.
316 Definitions from visited files which have these modes
317 are automatically added to the completion database.")
319 ;;;(defvar *record-cmpl-statistics-p* nil
320 ;;; "*If non-nil, record completion statistics.")
322 ;;;(defvar *completion-auto-save-period* 1800
323 ;;; "*The period in seconds to wait for emacs to be idle before autosaving
324 ;;;the completions. Default is a 1/2 hour.")
326 (defconst completion-min-length nil
;; defined below in eval-when
327 "*The minimum length of a stored completion.
328 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
330 (defconst completion-max-length nil
;; defined below in eval-when
331 "*The maximum length of a stored completion.
332 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
334 (defconst completion-prefix-min-length nil
;; defined below in eval-when
335 "The minimum length of a completion search string.
336 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
338 (defmacro eval-when-compile-load-eval
(&rest body
)
339 ;; eval everything before expanding
344 (defvar completion-gensym-counter
0)
345 (defun completion-gensym (&optional arg
)
346 "Generate a new uninterned symbol.
347 The name is made by appending a number to PREFIX, default \"G\"."
348 (let ((prefix (if (stringp arg
) arg
"G"))
349 (num (if (integerp arg
) arg
350 (prog1 completion-gensym-counter
351 (setq completion-gensym-counter
(1+ completion-gensym-counter
))))))
352 (make-symbol (format "%s%d" prefix num
)))))
354 (defmacro completion-dolist
(spec &rest body
)
355 "(completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list.
356 Evaluate BODY with VAR bound to each `car' from LIST, in turn.
357 Then evaluate RESULT to get return value, default nil."
358 (let ((temp (completion-gensym "--dolist-temp--")))
359 (append (list 'let
(list (list temp
(nth 1 spec
)) (car spec
))
360 (append (list 'while temp
361 (list 'setq
(car spec
) (list 'car temp
)))
362 body
(list (list 'setq temp
365 (cons (list 'setq
(car spec
) nil
) (cdr (cdr spec
)))
368 (defun completion-eval-when ()
369 (eval-when-compile-load-eval
370 ;; These vars. are defined at both compile and load time.
371 (setq completion-min-length
6)
372 (setq completion-max-length
200)
373 (setq completion-prefix-min-length
3)))
375 (completion-eval-when)
377 ;;;---------------------------------------------------------------------------
378 ;;; Internal Variables
379 ;;;---------------------------------------------------------------------------
381 (defvar cmpl-initialized-p nil
382 "Set to t when the completion system is initialized.
383 Indicates that the old completion file has been read in.")
385 (defvar cmpl-completions-accepted-p nil
386 "Set to t as soon as the first completion has been accepted.
387 Used to decide whether to save completions.")
389 (defvar cmpl-preceding-syntax
)
391 (defvar completion-string
)
393 ;;;---------------------------------------------------------------------------
395 ;;;---------------------------------------------------------------------------
397 ;;;-----------------------------------------------
399 ;;;-----------------------------------------------
401 (defun minibuffer-window-selected-p ()
402 "True iff the current window is the minibuffer."
403 (window-minibuffer-p (selected-window)))
405 ;; This used to be `(eval form)'. Eval FORM at run time now.
406 (defmacro cmpl-read-time-eval
(form)
409 ;;;-----------------------------------------------
410 ;;; String case coercion
411 ;;;-----------------------------------------------
413 (defun cmpl-string-case-type (string)
414 "Returns :capitalized, :up, :down, :mixed, or :neither."
415 (let ((case-fold-search nil
))
416 (cond ((string-match "[a-z]" string
)
417 (cond ((string-match "[A-Z]" string
)
418 (cond ((and (> (length string
) 1)
419 (null (string-match "[A-Z]" string
1)))
425 (cond ((string-match "[A-Z]" string
)
431 ;;; (cmpl-string-case-type "123ABCDEF456") --> :up
432 ;;; (cmpl-string-case-type "123abcdef456") --> :down
433 ;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
434 ;;; (cmpl-string-case-type "123456") --> :neither
435 ;;; (cmpl-string-case-type "Abcde123") --> :capitalized
437 (defun cmpl-coerce-string-case (string case-type
)
438 (cond ((eq case-type
':down
) (downcase string
))
439 ((eq case-type
':up
) (upcase string
))
440 ((eq case-type
':capitalized
)
441 (setq string
(downcase string
))
442 (aset string
0 (logand ?
\337 (aref string
0)))
447 (defun cmpl-merge-string-cases (string-to-coerce given-string
)
448 (let ((string-case-type (cmpl-string-case-type string-to-coerce
))
450 (cond ((memq string-case-type
'(:down
:up
:capitalized
))
451 ;; Found string is in a standard case. Coerce to a type based on
453 (cmpl-coerce-string-case string-to-coerce
454 (cmpl-string-case-type given-string
))
457 ;; If the found string is in some unusual case, just insert it
463 ;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
464 ;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
465 ;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
466 ;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
469 (defun cmpl-hours-since-origin ()
470 (let ((time (current-time)))
472 (+ (* (/ (car time
) 3600.0) (lsh 1 16))
473 (/ (nth 2 time
) 3600.0)))))
475 ;;;---------------------------------------------------------------------------
476 ;;; "Symbol" parsing functions
477 ;;;---------------------------------------------------------------------------
478 ;;; The functions symbol-before-point, symbol-under-point, etc. quickly return
479 ;;; an appropriate symbol string. The strategy is to temporarily change
480 ;;; the syntax table to enable fast symbol searching. There are three classes
481 ;;; of syntax in these "symbol" syntax tables ::
483 ;;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
484 ;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).
485 ;;; syntax (? ) - everything else
487 ;;; Thus by judicious use of scan-sexps and forward-word, we can get
488 ;;; the word we want relatively fast and without consing.
490 ;;; Why do we need a separate category for "symbol chars to ignore at ends" ?
491 ;;; For example, in LISP we want starting :'s trimmed
492 ;;; so keyword argument specifiers also define the keyword completion. And,
493 ;;; for example, in C we want `.' appearing in a structure ref. to
494 ;;; be kept intact in order to store the whole structure ref.; however, if
495 ;;; it appears at the end of a symbol it should be discarded because it is
496 ;;; probably used as a period.
498 ;;; Here is the default completion syntax ::
499 ;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
500 ;;; Symbol chars to ignore at ends :: _ : . -
501 ;;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
502 ;;; , ? <Everything else>
504 ;;; Mode specific differences and notes ::
506 ;;; Symbol chars :: ! & ? = ^
509 ;;; Separator chars :: + * / : %
510 ;;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator
511 ;;; char., however, we wanted to have completion symbols include pointer
512 ;;; references. For example, "foo->bar" is a symbol as far as completion is
516 ;;; Separator chars :: + - * / :
518 ;;; Pathname diffs ->
519 ;;; Symbol chars :: .
520 ;;; Of course there is no pathname "mode" and in fact we have not implemented
521 ;;; this table. However, if there was such a mode, this is what it would look
524 ;;;-----------------------------------------------
525 ;;; Table definitions
526 ;;;-----------------------------------------------
528 (defun cmpl-make-standard-completion-syntax-table ()
529 (let ((table (make-syntax-table)) ;; default syntax is whitespace
534 (modify-syntax-entry (+ ?a i
) "_" table
)
535 (modify-syntax-entry (+ ?A i
) "_" table
)
540 (modify-syntax-entry (+ ?
0 i
) "_" table
)
543 (let ((symbol-chars '(?
@ ?
/ ?
\\ ?
* ?
+ ?~ ?$ ?
< ?
> ?%
))
544 (symbol-chars-ignore '(?_ ?- ?
: ?.
))
546 (completion-dolist (char symbol-chars
)
547 (modify-syntax-entry char
"_" table
))
548 (completion-dolist (char symbol-chars-ignore
)
549 (modify-syntax-entry char
"w" table
)
554 (defconst cmpl-standard-syntax-table
(cmpl-make-standard-completion-syntax-table))
556 (defun cmpl-make-lisp-completion-syntax-table ()
557 (let ((table (copy-syntax-table cmpl-standard-syntax-table
))
558 (symbol-chars '(?
! ?
& ?? ?
= ?^
))
560 (completion-dolist (char symbol-chars
)
561 (modify-syntax-entry char
"_" table
))
564 (defun cmpl-make-c-completion-syntax-table ()
565 (let ((table (copy-syntax-table cmpl-standard-syntax-table
))
566 (separator-chars '(?
+ ?
* ?
/ ?
: ?%
))
568 (completion-dolist (char separator-chars
)
569 (modify-syntax-entry char
" " table
))
572 (defun cmpl-make-fortran-completion-syntax-table ()
573 (let ((table (copy-syntax-table cmpl-standard-syntax-table
))
574 (separator-chars '(?
+ ?- ?
* ?
/ ?
:))
576 (completion-dolist (char separator-chars
)
577 (modify-syntax-entry char
" " table
))
580 (defconst cmpl-lisp-syntax-table
(cmpl-make-lisp-completion-syntax-table))
581 (defconst cmpl-c-syntax-table
(cmpl-make-c-completion-syntax-table))
582 (defconst cmpl-fortran-syntax-table
(cmpl-make-fortran-completion-syntax-table))
584 (defvar cmpl-syntax-table cmpl-standard-syntax-table
585 "This variable holds the current completion syntax table.")
586 (make-variable-buffer-local 'cmpl-syntax-table
)
588 ;;;-----------------------------------------------
589 ;;; Installing the appropriate mode tables
590 ;;;-----------------------------------------------
592 (add-hook 'lisp-mode-hook
594 (setq cmpl-syntax-table cmpl-lisp-syntax-table
)))
596 (add-hook 'c-mode-hook
598 (setq cmpl-syntax-table cmpl-c-syntax-table
)))
600 (add-hook 'fortran-mode-hook
602 (setq cmpl-syntax-table cmpl-fortran-syntax-table
)
603 (completion-setup-fortran-mode)))
605 ;;;-----------------------------------------------
607 ;;;-----------------------------------------------
608 (defvar cmpl-symbol-start nil
609 "Holds first character of symbol, after any completion symbol function.")
610 (defvar cmpl-symbol-end nil
611 "Holds last character of symbol, after any completion symbol function.")
612 ;;; These are temp. vars. we use to avoid using let.
613 ;;; Why ? Small speed improvement.
614 (defvar cmpl-saved-syntax nil
)
615 (defvar cmpl-saved-point nil
)
617 (defun symbol-under-point ()
618 "Returns the symbol that the point is currently on.
619 But only if it is longer than `completion-min-length'."
620 (setq cmpl-saved-syntax
(syntax-table))
623 (set-syntax-table cmpl-syntax-table
)
625 ;; Cursor is on following-char and after preceding-char
626 ((memq (char-syntax (following-char)) '(?w ?_
))
627 (setq cmpl-saved-point
(point)
628 cmpl-symbol-start
(scan-sexps (1+ cmpl-saved-point
) -
1)
629 cmpl-symbol-end
(scan-sexps cmpl-saved-point
1))
630 ;; Remove chars to ignore at the start.
631 (cond ((= (char-syntax (char-after cmpl-symbol-start
)) ?w
)
632 (goto-char cmpl-symbol-start
)
634 (setq cmpl-symbol-start
(point))
635 (goto-char cmpl-saved-point
)
637 ;; Remove chars to ignore at the end.
638 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end
))) ?w
)
639 (goto-char cmpl-symbol-end
)
641 (setq cmpl-symbol-end
(point))
642 (goto-char cmpl-saved-point
)
644 ;; Return completion if the length is reasonable.
645 (if (and (<= (cmpl-read-time-eval completion-min-length
)
646 (- cmpl-symbol-end cmpl-symbol-start
))
647 (<= (- cmpl-symbol-end cmpl-symbol-start
)
648 (cmpl-read-time-eval completion-max-length
)))
649 (buffer-substring cmpl-symbol-start cmpl-symbol-end
)))))
650 (set-syntax-table cmpl-saved-syntax
)))
652 ;;; tests for symbol-under-point
653 ;;; `^' indicates cursor pos. where value is returned
655 ;;; ^^^^^^^^^^^^^^^^ --> simple-word-test
656 ;;; _harder_word_test_
657 ;;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test
660 ;;; /foo/bar/quux.hello
661 ;;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
664 (defun symbol-before-point ()
665 "Returns a string of the symbol immediately before point.
666 Returns nil if there isn't one longer than `completion-min-length'."
667 ;; This is called when a word separator is typed so it must be FAST !
668 (setq cmpl-saved-syntax
(syntax-table))
671 (set-syntax-table cmpl-syntax-table
)
672 ;; Cursor is on following-char and after preceding-char
673 (cond ((= (setq cmpl-preceding-syntax
(char-syntax (preceding-char))) ?_
)
674 ;; Number of chars to ignore at end.
675 (setq cmpl-symbol-end
(point)
676 cmpl-symbol-start
(scan-sexps cmpl-symbol-end -
1)
678 ;; Remove chars to ignore at the start.
679 (cond ((= (char-syntax (char-after cmpl-symbol-start
)) ?w
)
680 (goto-char cmpl-symbol-start
)
682 (setq cmpl-symbol-start
(point))
683 (goto-char cmpl-symbol-end
)
685 ;; Return value if long enough.
686 (if (>= cmpl-symbol-end
688 (cmpl-read-time-eval completion-min-length
)))
689 (buffer-substring cmpl-symbol-start cmpl-symbol-end
))
691 ((= cmpl-preceding-syntax ?w
)
692 ;; chars to ignore at end
693 (setq cmpl-saved-point
(point)
694 cmpl-symbol-start
(scan-sexps cmpl-saved-point -
1))
695 ;; take off chars. from end
697 (setq cmpl-symbol-end
(point))
698 ;; remove chars to ignore at the start
699 (cond ((= (char-syntax (char-after cmpl-symbol-start
)) ?w
)
700 (goto-char cmpl-symbol-start
)
702 (setq cmpl-symbol-start
(point))
705 (goto-char cmpl-saved-point
)
706 ;; Return completion if the length is reasonable
707 (if (and (<= (cmpl-read-time-eval completion-min-length
)
708 (- cmpl-symbol-end cmpl-symbol-start
))
709 (<= (- cmpl-symbol-end cmpl-symbol-start
)
710 (cmpl-read-time-eval completion-max-length
)))
711 (buffer-substring cmpl-symbol-start cmpl-symbol-end
)))))
712 (set-syntax-table cmpl-saved-syntax
)))
714 ;;; tests for symbol-before-point
715 ;;; `^' indicates cursor pos. where value is returned
720 ;;; ^ --> simple-word-test
721 ;;; _harder_word_test_
722 ;;; ^ --> harder_word_test
723 ;;; ^ --> harder_word_test
728 (defun symbol-under-or-before-point ()
729 ;;; This could be made slightly faster but it is better to avoid
730 ;;; copying all the code.
731 ;;; However, it is only used by the completion string prompter.
732 ;;; If it comes into common use, it could be rewritten.
734 (setq cmpl-saved-syntax
(syntax-table))
737 (set-syntax-table cmpl-syntax-table
)
738 (char-syntax (following-char)))
739 (set-syntax-table cmpl-saved-syntax
)))
741 (symbol-under-point))
743 (symbol-before-point))))
746 (defun symbol-before-point-for-complete ()
747 ;; "Returns a string of the symbol immediately before point
748 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the
750 ;; Cursor is on following-char and after preceding-char
751 (setq cmpl-saved-syntax
(syntax-table))
754 (set-syntax-table cmpl-syntax-table
)
755 (cond ((memq (setq cmpl-preceding-syntax
(char-syntax (preceding-char)))
757 (setq cmpl-symbol-end
(point)
758 cmpl-symbol-start
(scan-sexps cmpl-symbol-end -
1)
760 ;; Remove chars to ignore at the start.
761 (cond ((= (char-syntax (char-after cmpl-symbol-start
)) ?w
)
762 (goto-char cmpl-symbol-start
)
764 (setq cmpl-symbol-start
(point))
765 (goto-char cmpl-symbol-end
)
767 ;; Return completion if the length is reasonable.
768 (if (and (<= (cmpl-read-time-eval
769 completion-prefix-min-length
)
770 (- cmpl-symbol-end cmpl-symbol-start
))
771 (<= (- cmpl-symbol-end cmpl-symbol-start
)
772 (cmpl-read-time-eval completion-max-length
)))
773 (buffer-substring cmpl-symbol-start cmpl-symbol-end
)))))
774 ;; Restore syntax table.
775 (set-syntax-table cmpl-saved-syntax
)))
777 ;;; tests for symbol-before-point-for-complete
778 ;;; `^' indicates cursor pos. where value is returned
783 ;;; ^ --> simple-word-test
784 ;;; _harder_word_test_
785 ;;; ^ --> harder_word_test
786 ;;; ^ --> harder_word_test_
793 ;;;---------------------------------------------------------------------------
794 ;;; Statistics Recording
795 ;;;---------------------------------------------------------------------------
797 ;;; Note that the guts of this has been turned off. The guts
798 ;;; are in completion-stats.el.
800 ;;;-----------------------------------------------
801 ;;; Conditionalizing code on *record-cmpl-statistics-p*
802 ;;;-----------------------------------------------
803 ;;; All statistics code outside this block should use this
804 (defmacro cmpl-statistics-block
(&rest body
))
805 ;;; "Only executes body if we are recording statistics."
807 ;;; (list* '*record-cmpl-statistics-p* body)
810 ;;;-----------------------------------------------
811 ;;; Completion Sources
812 ;;;-----------------------------------------------
815 (defconst cmpl-source-unknown
0)
816 (defconst cmpl-source-init-file
1)
817 (defconst cmpl-source-file-parsing
2)
818 (defconst cmpl-source-separator
3)
819 (defconst cmpl-source-cursor-moves
4)
820 (defconst cmpl-source-interactive
5)
821 (defconst cmpl-source-cdabbrev
6)
822 (defconst num-cmpl-sources
7)
823 (defvar current-completion-source cmpl-source-unknown
)
827 ;;;---------------------------------------------------------------------------
828 ;;; Completion Method #2: dabbrev-expand style
829 ;;;---------------------------------------------------------------------------
831 ;;; This method is used if there are no useful stored completions. It is
832 ;;; based on dabbrev-expand with these differences :
833 ;;; 1) Faster (we don't use regexps)
834 ;;; 2) case coercion handled correctly
835 ;;; This is called cdabbrev to differentiate it.
836 ;;; We simply search backwards through the file looking for words which
837 ;;; start with the same letters we are trying to complete.
840 (defvar cdabbrev-completions-tried nil
)
841 ;;; "A list of all the cdabbrev completions since the last reset.")
843 (defvar cdabbrev-current-point
0)
844 ;;; "The current point position the cdabbrev search is at.")
846 (defvar cdabbrev-current-window nil
)
847 ;;; "The current window we are looking for cdabbrevs in. T if looking in
848 ;;; (other-buffer), NIL if no more cdabbrevs.")
850 (defvar cdabbrev-wrapped-p nil
)
851 ;;; "T if the cdabbrev search has wrapped around the file.")
853 (defvar cdabbrev-abbrev-string
"")
854 (defvar cdabbrev-start-point
0)
855 (defvar cdabbrev-stop-point
)
857 ;;; Test strings for cdabbrev
858 ;;; cdat-upcase ;;same namestring
860 ;;; cdat2 ;;too short
861 ;;; cdat-1-2-3-4 ;;ok
862 ;;; a-cdat-1 ;;doesn't start correctly
866 (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried
)
867 "Resets the cdabbrev search to search for abbrev-string.
868 INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore
870 (setq cdabbrev-abbrev-string abbrev-string
871 cdabbrev-completions-tried
872 (cons (downcase abbrev-string
) initial-completions-tried
)
874 (reset-cdabbrev-window t
)
877 (defun set-cdabbrev-buffer ()
878 ;; cdabbrev-current-window must not be NIL
879 (set-buffer (if (eq cdabbrev-current-window t
)
881 (window-buffer cdabbrev-current-window
)))
885 (defun reset-cdabbrev-window (&optional initializep
)
886 "Resets the cdabbrev search to search for abbrev-string."
889 (setq cdabbrev-current-window
(selected-window))
891 ((eq cdabbrev-current-window t
)
892 ;; Everything has failed
893 (setq cdabbrev-current-window nil
))
894 (cdabbrev-current-window
895 (setq cdabbrev-current-window
(next-window cdabbrev-current-window
))
896 (if (eq cdabbrev-current-window
(selected-window))
897 ;; No more windows, try other buffer.
898 (setq cdabbrev-current-window t
)))
900 (if cdabbrev-current-window
902 (set-cdabbrev-buffer)
903 (setq cdabbrev-current-point
(point)
904 cdabbrev-start-point cdabbrev-current-point
906 (if completion-search-distance
908 (- cdabbrev-start-point completion-search-distance
))
910 cdabbrev-wrapped-p nil
)
913 (defun next-cdabbrev ()
914 "Return the next possible cdabbrev expansion or nil if there isn't one.
915 `reset-cdabbrev' must've been called already.
916 This is sensitive to `case-fold-search'."
917 ;; note that case-fold-search affects the behavior of this function
918 ;; Bug: won't pick up an expansion that starts at the top of buffer
919 (if cdabbrev-current-window
923 downcase-expansion tried-list syntax saved-point-2
)
927 ;; Switch to current completion buffer
928 (set-cdabbrev-buffer)
929 ;; Save current buffer state
930 (setq saved-point
(point)
931 saved-syntax
(syntax-table))
932 ;; Restore completion state
933 (set-syntax-table cmpl-syntax-table
)
934 (goto-char cdabbrev-current-point
)
935 ;; Loop looking for completions
937 ;; This code returns t if it should loop again
939 (;; search for the string
940 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t
)
941 ;; return nil if the completion is valid
944 ;; does it start with a separator char ?
945 (or (= (setq syntax
(char-syntax (preceding-char))) ?
)
947 ;; symbol char to ignore at end. Are we at end ?
949 (setq saved-point-2
(point))
952 (= (char-syntax (preceding-char)) ?
)
953 (goto-char saved-point-2
)
955 ;; is the symbol long enough ?
956 (setq expansion
(symbol-under-point))
957 ;; have we not tried this one before
959 ;; See if we've already used it
960 (setq tried-list cdabbrev-completions-tried
961 downcase-expansion
(downcase expansion
))
962 (while (and tried-list
963 (not (string-equal downcase-expansion
965 ;; Already tried, don't choose this one
966 (setq tried-list
(cdr tried-list
))
968 ;; at this point tried-list will be nil if this
969 ;; expansion has not yet been tried
976 ;; If already wrapped, then we've failed completely
980 (goto-char (setq cdabbrev-current-point
981 (if completion-search-distance
982 (min (point-max) (+ cdabbrev-start-point completion-search-distance
))
985 (setq cdabbrev-wrapped-p t
))
990 (setq cdabbrev-completions-tried
991 (cons downcase-expansion cdabbrev-completions-tried
)
992 cdabbrev-current-point
(point))))
994 (set-syntax-table saved-syntax
)
995 (goto-char saved-point
)
997 ;; If no expansion, go to next window
999 (t (reset-cdabbrev-window)
1000 (next-cdabbrev))))))
1002 ;;; The following must be eval'd in the minibuffer ::
1003 ;;; (reset-cdabbrev "cdat")
1004 ;;; (next-cdabbrev) --> "cdat-simple"
1005 ;;; (next-cdabbrev) --> "cdat-1-2-3-4"
1006 ;;; (next-cdabbrev) --> "CDAT-UPCASE"
1007 ;;; (next-cdabbrev) --> "cdat-wrapping"
1008 ;;; (next-cdabbrev) --> "cdat_start_sym"
1009 ;;; (next-cdabbrev) --> nil
1010 ;;; (next-cdabbrev) --> nil
1011 ;;; (next-cdabbrev) --> nil
1017 ;;;---------------------------------------------------------------------------
1018 ;;; Completion Database
1019 ;;;---------------------------------------------------------------------------
1021 ;;; We use two storage modes for the two search types ::
1022 ;;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions
1023 ;;; Used by search-completion-next
1024 ;;; the value of the symbol is nil or a cons of head and tail pointers
1025 ;;; 2) Interning {cmpl-obarray} to see if it's in the database
1026 ;;; Used by find-exact-completion, completion-in-database-p
1027 ;;; The value of the symbol is the completion entry
1029 ;;; bad things may happen if this length is changed due to the way
1030 ;;; GNU implements obarrays
1031 (defconst cmpl-obarray-length
511)
1033 (defvar cmpl-prefix-obarray
(make-vector cmpl-obarray-length
0)
1034 "An obarray used to store the downcased completion prefixes.
1035 Each symbol is bound to a list of completion entries.")
1037 (defvar cmpl-obarray
(make-vector cmpl-obarray-length
0)
1038 "An obarray used to store the downcased completions.
1039 Each symbol is bound to a single completion entry.")
1041 ;;;-----------------------------------------------
1042 ;;; Completion Entry Structure Definition
1043 ;;;-----------------------------------------------
1045 ;;; A completion entry is a LIST of string, prefix-symbol num-uses, and
1046 ;;; last-use-time (the time the completion was last used)
1047 ;;; last-use-time is T if the string should be kept permanently
1048 ;;; num-uses is incremented every time the completion is used.
1050 ;;; We chose lists because (car foo) is faster than (aref foo 0) and the
1051 ;;; creation time is about the same.
1055 (defmacro completion-string
(completion-entry)
1056 (list 'car completion-entry
))
1058 (defmacro completion-num-uses
(completion-entry)
1059 ;; "The number of times it has used. Used to decide whether to save
1061 (list 'car
(list 'cdr completion-entry
)))
1063 (defmacro completion-last-use-time
(completion-entry)
1064 ;; "The time it was last used. In hours since origin. Used to decide
1065 ;; whether to save it. T if one should always save it."
1066 (list 'nth
2 completion-entry
))
1068 (defmacro completion-source
(completion-entry)
1069 (list 'nth
3 completion-entry
))
1072 (defmacro set-completion-string
(completion-entry string
)
1073 (list 'setcar completion-entry string
))
1075 (defmacro set-completion-num-uses
(completion-entry num-uses
)
1076 (list 'setcar
(list 'cdr completion-entry
) num-uses
))
1078 (defmacro set-completion-last-use-time
(completion-entry last-use-time
)
1079 (list 'setcar
(list 'cdr
(list 'cdr completion-entry
)) last-use-time
))
1082 (defun make-completion (string)
1083 "Returns a list of a completion entry."
1084 (list (list string
0 nil current-completion-source
)))
1087 ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
1088 ;; (list 'car (list 'cdr completion-entry)))
1092 ;;;-----------------------------------------------
1093 ;;; Prefix symbol entry definition
1094 ;;;-----------------------------------------------
1095 ;;; A cons of (head . tail)
1099 (defmacro cmpl-prefix-entry-head
(prefix-entry)
1100 (list 'car prefix-entry
))
1102 (defmacro cmpl-prefix-entry-tail
(prefix-entry)
1103 (list 'cdr prefix-entry
))
1107 (defmacro set-cmpl-prefix-entry-head
(prefix-entry new-head
)
1108 (list 'setcar prefix-entry new-head
))
1110 (defmacro set-cmpl-prefix-entry-tail
(prefix-entry new-tail
)
1111 (list 'setcdr prefix-entry new-tail
))
1115 (defun make-cmpl-prefix-entry (completion-entry-list)
1116 "Makes a new prefix entry containing only completion-entry."
1117 (cons completion-entry-list completion-entry-list
))
1119 ;;;-----------------------------------------------
1120 ;;; Completion Database - Utilities
1121 ;;;-----------------------------------------------
1123 (defun clear-all-completions ()
1124 "Initializes the completion storage. All existing completions are lost."
1126 (setq cmpl-prefix-obarray
(make-vector cmpl-obarray-length
0))
1127 (setq cmpl-obarray
(make-vector cmpl-obarray-length
0))
1128 (cmpl-statistics-block
1129 (record-clear-all-completions))
1132 (defvar completions-list-return-value
)
1134 (defun list-all-completions ()
1135 "Returns a list of all the known completion entries."
1136 (let ((completions-list-return-value nil
))
1137 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray
)
1138 completions-list-return-value
))
1140 (defun list-all-completions-1 (prefix-symbol)
1141 (if (boundp prefix-symbol
)
1142 (setq completions-list-return-value
1143 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol
))
1144 completions-list-return-value
))))
1146 (defun list-all-completions-by-hash-bucket ()
1147 "Return list of lists of known completion entries, organized by hash bucket."
1148 (let ((completions-list-return-value nil
))
1149 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray
)
1150 completions-list-return-value
))
1152 (defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
1153 (if (boundp prefix-symbol
)
1154 (setq completions-list-return-value
1155 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol
))
1156 completions-list-return-value
))))
1159 ;;;-----------------------------------------------
1160 ;;; Updating the database
1161 ;;;-----------------------------------------------
1163 ;;; These are the internal functions used to update the datebase
1166 (defvar completion-to-accept nil
)
1167 ;;"Set to a string that is pending its acceptance."
1168 ;; this checked by the top level reading functions
1170 (defvar cmpl-db-downcase-string nil
)
1171 ;; "Setup by find-exact-completion, etc. The given string, downcased."
1172 (defvar cmpl-db-symbol nil
)
1173 ;; "The interned symbol corresponding to cmpl-db-downcase-string.
1174 ;; Set up by cmpl-db-symbol."
1175 (defvar cmpl-db-prefix-symbol nil
)
1176 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."
1177 (defvar cmpl-db-entry nil
)
1178 (defvar cmpl-db-debug-p nil
1179 "Set to T if you want to debug the database.")
1182 (defun find-exact-completion (string)
1183 "Returns the completion entry for string or nil.
1184 Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'."
1185 (and (boundp (setq cmpl-db-symbol
1186 (intern (setq cmpl-db-downcase-string
(downcase string
))
1188 (symbol-value cmpl-db-symbol
)
1191 (defun find-cmpl-prefix-entry (prefix-string)
1192 "Returns the prefix entry for string.
1193 Sets `cmpl-db-prefix-symbol'.
1194 Prefix-string must be exactly `completion-prefix-min-length' long
1195 and downcased. Sets up `cmpl-db-prefix-symbol'."
1196 (and (boundp (setq cmpl-db-prefix-symbol
1197 (intern prefix-string cmpl-prefix-obarray
)))
1198 (symbol-value cmpl-db-prefix-symbol
)))
1200 (defvar inside-locate-completion-entry nil
)
1201 ;; used to trap lossage in silent error correction
1203 (defun locate-completion-entry (completion-entry prefix-entry
)
1204 "Locates the completion entry.
1205 Returns a pointer to the element before the completion entry or nil if
1206 the completion entry is at the head.
1207 Must be called after `find-exact-completion'."
1208 (let ((prefix-list (cmpl-prefix-entry-head prefix-entry
))
1212 ((not (eq (car prefix-list
) completion-entry
))
1213 ;; not already at head
1214 (while (and prefix-list
1215 (not (eq completion-entry
1216 (car (setq next-prefix-list
(cdr prefix-list
)))
1218 (setq prefix-list next-prefix-list
))
1221 ;; Didn't find it. Database is messed up.
1223 ;; not found, error if debug mode
1224 (error "Completion entry exists but not on prefix list - %s"
1226 (inside-locate-completion-entry
1227 ;; recursive error: really scrod
1228 (locate-completion-db-error))
1231 (set cmpl-db-symbol nil
)
1233 (locate-completion-entry-retry completion-entry
)
1236 (defun locate-completion-entry-retry (old-entry)
1237 (let ((inside-locate-completion-entry t
))
1238 (add-completion (completion-string old-entry
)
1239 (completion-num-uses old-entry
)
1240 (completion-last-use-time old-entry
))
1241 (let* ((cmpl-entry (find-exact-completion (completion-string old-entry
)))
1244 (find-cmpl-prefix-entry
1245 (substring cmpl-db-downcase-string
1246 0 completion-prefix-min-length
))))
1248 (if (and cmpl-entry pref-entry
)
1250 (locate-completion-entry cmpl-entry pref-entry
)
1252 (locate-completion-db-error))
1255 (defun locate-completion-db-error ()
1256 ;; recursive error: really scrod
1257 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.")
1261 (defun add-completion-to-tail-if-new (string)
1262 "If STRING is not in the database add it to appropriate prefix list.
1263 STRING is added to the end of the appropriate prefix list with
1264 num-uses = 0. The database is unchanged if it is there. STRING must be
1265 longer than `completion-prefix-min-length'.
1266 This must be very fast.
1267 Returns the completion entry."
1268 (or (find-exact-completion string
)
1270 (let (;; create an entry
1271 (entry (make-completion string
))
1273 (prefix-entry (find-cmpl-prefix-entry
1274 (substring cmpl-db-downcase-string
0
1275 (cmpl-read-time-eval
1276 completion-prefix-min-length
))))
1278 ;; The next two forms should happen as a unit (atomically) but
1279 ;; no fatal errors should result if that is not the case.
1281 ;; These two should be atomic, but nothing fatal will happen
1283 (setcdr (cmpl-prefix-entry-tail prefix-entry
) entry
)
1284 (set-cmpl-prefix-entry-tail prefix-entry entry
))
1286 (set cmpl-db-prefix-symbol
(make-cmpl-prefix-entry entry
))
1289 (cmpl-statistics-block
1290 (note-added-completion))
1292 (set cmpl-db-symbol
(car entry
))
1295 (defun add-completion-to-head (completion-string)
1296 "If COMPLETION-STRING is not in the database, add it to prefix list.
1297 We add COMPLETION-STRING to the head of the appropriate prefix list,
1298 or it to the head of the list.
1299 COMPLETION-STRING must be longer than `completion-prefix-min-length'.
1300 Updates the saved string with the supplied string.
1301 This must be very fast.
1302 Returns the completion entry."
1303 ;; Handle pending acceptance
1304 (if completion-to-accept
(accept-completion))
1305 ;; test if already in database
1306 (if (setq cmpl-db-entry
(find-exact-completion completion-string
))
1308 (let* ((prefix-entry (find-cmpl-prefix-entry
1309 (substring cmpl-db-downcase-string
0
1310 (cmpl-read-time-eval
1311 completion-prefix-min-length
))))
1312 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry
))
1313 (cmpl-ptr (cdr splice-ptr
))
1316 (set-completion-string cmpl-db-entry completion-string
)
1317 ;; move to head (if necessary)
1319 ;; These should all execute atomically but it is not fatal if
1322 (or (setcdr splice-ptr
(cdr cmpl-ptr
))
1323 ;; fix up tail if necessary
1324 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr
))
1325 ;; splice in at head
1326 (setcdr cmpl-ptr
(cmpl-prefix-entry-head prefix-entry
))
1327 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr
)
1331 (let (;; create an entry
1332 (entry (make-completion completion-string
))
1334 (prefix-entry (find-cmpl-prefix-entry
1335 (substring cmpl-db-downcase-string
0
1336 (cmpl-read-time-eval
1337 completion-prefix-min-length
))))
1340 ;; Splice in at head
1341 (setcdr entry
(cmpl-prefix-entry-head prefix-entry
))
1342 (set-cmpl-prefix-entry-head prefix-entry entry
))
1344 ;; Start new prefix entry
1345 (set cmpl-db-prefix-symbol
(make-cmpl-prefix-entry entry
))
1348 (cmpl-statistics-block
1349 (note-added-completion))
1350 ;; Add it to the symbol
1351 (set cmpl-db-symbol
(car entry
))
1354 (defun delete-completion (completion-string)
1355 "Deletes the completion from the database.
1356 String must be longer than `completion-prefix-min-length'."
1357 ;; Handle pending acceptance
1358 (if completion-to-accept
(accept-completion))
1359 (if (setq cmpl-db-entry
(find-exact-completion completion-string
))
1361 (let* ((prefix-entry (find-cmpl-prefix-entry
1362 (substring cmpl-db-downcase-string
0
1363 (cmpl-read-time-eval
1364 completion-prefix-min-length
))))
1365 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry
))
1367 ;; delete symbol reference
1368 (set cmpl-db-symbol nil
)
1369 ;; remove from prefix list
1372 (or (setcdr splice-ptr
(cdr (cdr splice-ptr
)))
1373 ;; fix up tail if necessary
1374 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr
))
1378 (or (set-cmpl-prefix-entry-head
1379 prefix-entry
(cdr (cmpl-prefix-entry-head prefix-entry
)))
1380 ;; List is now empty
1381 (set cmpl-db-prefix-symbol nil
))
1383 (cmpl-statistics-block
1384 (note-completion-deleted))
1386 (error "Unknown completion `%s'" completion-string
)
1390 ;;; - Add and Find -
1391 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1392 ;;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
1393 ;;; (find-exact-completion "bana") --> nil
1394 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1395 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1396 ;;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
1397 ;;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
1398 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1399 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1400 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1401 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1402 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1405 ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1406 ;;; (delete-completion "banner")
1407 ;;; (find-exact-completion "banner") --> nil
1408 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1409 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1410 ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1411 ;;; (delete-completion "banana")
1412 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
1413 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1414 ;;; (delete-completion "banner")
1415 ;;; (delete-completion "banish")
1416 ;;; (find-cmpl-prefix-entry "ban") --> nil
1417 ;;; (delete-completion "banner") --> error
1420 ;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
1421 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1422 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1423 ;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
1424 ;;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
1425 ;;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
1429 ;;;---------------------------------------------------------------------------
1430 ;;; Database Update :: Interface level routines
1431 ;;;---------------------------------------------------------------------------
1433 ;;; These lie on top of the database ref. functions but below the standard
1434 ;;; user interface level
1437 (defun interactive-completion-string-reader (prompt)
1438 (let* ((default (symbol-under-or-before-point))
1441 (format "%s: (default: %s) " prompt default
)
1442 (format "%s: " prompt
))
1444 (read (completing-read new-prompt cmpl-obarray
))
1446 (if (zerop (length read
)) (setq read
(or default
"")))
1450 (defun check-completion-length (string)
1451 (if (< (length string
) completion-min-length
)
1452 (error "The string `%s' is too short to be saved as a completion"
1456 (defun add-completion (string &optional num-uses last-use-time
)
1457 "Add STRING to completion list, or move it to head of list.
1458 The completion is altered appropriately if num-uses and/or last-use-time is
1460 (interactive (interactive-completion-string-reader "Completion to add"))
1461 (check-completion-length string
)
1462 (let* ((current-completion-source (if (interactive-p)
1463 cmpl-source-interactive
1464 current-completion-source
))
1465 (entry (add-completion-to-head string
)))
1467 (if num-uses
(set-completion-num-uses entry num-uses
))
1469 (set-completion-last-use-time entry last-use-time
))
1472 (defun add-permanent-completion (string)
1473 "Add STRING if it isn't already listed, and mark it permanent."
1475 (interactive-completion-string-reader "Completion to add permanently"))
1476 (let ((current-completion-source (if (interactive-p)
1477 cmpl-source-interactive
1478 current-completion-source
))
1480 (add-completion string nil t
)
1483 (defun kill-completion (string)
1484 (interactive (interactive-completion-string-reader "Completion to kill"))
1485 (check-completion-length string
)
1486 (delete-completion string
)
1489 (defun accept-completion ()
1490 "Accepts the pending completion in `completion-to-accept'.
1491 This bumps num-uses. Called by `add-completion-to-head' and
1492 `completion-search-reset'."
1493 (let ((string completion-to-accept
)
1494 ;; if this is added afresh here, then it must be a cdabbrev
1495 (current-completion-source cmpl-source-cdabbrev
)
1498 (setq completion-to-accept nil
)
1499 (setq entry
(add-completion-to-head string
))
1500 (set-completion-num-uses entry
(1+ (completion-num-uses entry
)))
1501 (setq cmpl-completions-accepted-p t
)
1504 (defun use-completion-under-point ()
1505 "Add the completion symbol underneath the point into the completion buffer."
1506 (let ((string (and enable-completion
(symbol-under-point)))
1507 (current-completion-source cmpl-source-cursor-moves
))
1508 (if string
(add-completion-to-head string
))))
1510 (defun use-completion-before-point ()
1511 "Add the completion symbol before point into the completion buffer."
1512 (let ((string (and enable-completion
(symbol-before-point)))
1513 (current-completion-source cmpl-source-cursor-moves
))
1514 (if string
(add-completion-to-head string
))))
1516 (defun use-completion-under-or-before-point ()
1517 "Add the completion symbol before point into the completion buffer."
1518 (let ((string (and enable-completion
(symbol-under-or-before-point)))
1519 (current-completion-source cmpl-source-cursor-moves
))
1520 (if string
(add-completion-to-head string
))))
1522 (defun use-completion-before-separator ()
1523 "Add the completion symbol before point into the completion buffer.
1524 Completions added this way will automatically be saved if
1525 `completion-on-separator-character' is non-nil."
1526 (let ((string (and enable-completion
(symbol-before-point)))
1527 (current-completion-source cmpl-source-separator
)
1529 (cmpl-statistics-block
1530 (note-separator-character string
)
1533 (setq entry
(add-completion-to-head string
))
1534 (if (and completion-on-separator-character
1535 (zerop (completion-num-uses entry
)))
1537 (set-completion-num-uses entry
1)
1538 (setq cmpl-completions-accepted-p t
)))))
1542 ;;; - Add and Find -
1543 ;;; (add-completion "banana" 5 10)
1544 ;;; (find-exact-completion "banana") --> ("banana" 5 10 0)
1545 ;;; (add-completion "banana" 6)
1546 ;;; (find-exact-completion "banana") --> ("banana" 6 10 0)
1547 ;;; (add-completion "banish")
1548 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1551 ;;; (setq completion-to-accept "banana")
1552 ;;; (accept-completion)
1553 ;;; (find-exact-completion "banana") --> ("banana" 7 10)
1554 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1555 ;;; (setq completion-to-accept "banish")
1556 ;;; (add-completion "banner")
1557 ;;; (car (find-cmpl-prefix-entry "ban"))
1558 ;;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
1561 ;;; (kill-completion "banish")
1562 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
1565 ;;;---------------------------------------------------------------------------
1566 ;;; Searching the database
1567 ;;;---------------------------------------------------------------------------
1568 ;;; Functions outside this block must call completion-search-reset followed
1569 ;;; by calls to completion-search-next or completion-search-peek
1572 ;;; Status variables
1573 ;; Commented out to improve loading speed
1574 (defvar cmpl-test-string
"")
1575 ;; "The current string used by completion-search-next."
1576 (defvar cmpl-test-regexp
"")
1577 ;; "The current regexp used by completion-search-next.
1578 ;; (derived from cmpl-test-string)"
1579 (defvar cmpl-last-index
0)
1580 ;; "The last index that completion-search-next was called with."
1581 (defvar cmpl-cdabbrev-reset-p nil
)
1582 ;; "Set to t when cdabbrevs have been reset."
1583 (defvar cmpl-next-possibilities nil
)
1584 ;; "A pointer to the element BEFORE the next set of possible completions.
1585 ;; cadr of this is the cmpl-next-possibility"
1586 (defvar cmpl-starting-possibilities nil
)
1587 ;; "The initial list of starting possibilities."
1588 (defvar cmpl-next-possibility nil
)
1589 ;; "The cached next possibility."
1590 (defvar cmpl-tried-list nil
)
1591 ;; "A downcased list of all the completions we have tried."
1594 (defun completion-search-reset (string)
1595 "Set up the for completion searching for STRING.
1596 STRING must be longer than `completion-prefix-min-length'."
1597 (if completion-to-accept
(accept-completion))
1598 (setq cmpl-starting-possibilities
1599 (cmpl-prefix-entry-head
1600 (find-cmpl-prefix-entry
1601 (downcase (substring string
0 completion-prefix-min-length
))))
1602 cmpl-test-string string
1603 cmpl-test-regexp
(concat (regexp-quote string
) "."))
1604 (completion-search-reset-1)
1607 (defun completion-search-reset-1 ()
1608 (setq cmpl-next-possibilities cmpl-starting-possibilities
1609 cmpl-next-possibility nil
1610 cmpl-cdabbrev-reset-p nil
1615 (defun completion-search-next (index)
1616 "Return the next completion entry.
1617 If INDEX is out of sequence, reset and start from the top.
1618 If there are no more entries, try cdabbrev and returns only a string."
1620 ((= index
(setq cmpl-last-index
(1+ cmpl-last-index
)))
1621 (completion-search-peek t
))
1623 (completion-search-reset-1)
1624 (setq cmpl-last-index index
)
1625 ;; reverse the possibilities list
1626 (setq cmpl-next-possibilities
(reverse cmpl-starting-possibilities
))
1627 ;; do a "normal" search
1628 (while (and (completion-search-peek nil
)
1629 (< (setq index
(1+ index
)) 0))
1630 (setq cmpl-next-possibility nil
)
1632 (cond ((not cmpl-next-possibilities
))
1633 ;; If no more possibilities, leave it that way
1634 ((= -
1 cmpl-last-index
)
1635 ;; next completion is at index 0. reset next-possibility list
1636 ;; to start at beginning
1637 (setq cmpl-next-possibilities cmpl-starting-possibilities
))
1639 ;; otherwise point to one before current
1640 (setq cmpl-next-possibilities
1641 (nthcdr (- (length cmpl-starting-possibilities
)
1642 (length cmpl-next-possibilities
))
1643 cmpl-starting-possibilities
))
1646 ;; non-negative index, reset and search
1648 (completion-search-reset-1)
1649 (setq cmpl-last-index index
)
1650 (while (and (completion-search-peek t
)
1651 (not (< (setq index
(1- index
)) 0)))
1652 (setq cmpl-next-possibility nil
)
1656 cmpl-next-possibility
1657 (setq cmpl-next-possibility nil
)
1661 (defun completion-search-peek (use-cdabbrev)
1662 "Returns the next completion entry without actually moving the pointers.
1663 Calling this again or calling `completion-search-next' results in the same
1664 string being returned. Depends on `case-fold-search'.
1665 If there are no more entries, try cdabbrev and then return only a string."
1667 ;; return the cached value if we have it
1668 (cmpl-next-possibility)
1669 ((and cmpl-next-possibilities
1670 ;; still a few possibilities left
1673 (and (not (eq 0 (string-match cmpl-test-regexp
1674 (completion-string (car cmpl-next-possibilities
)))))
1675 (setq cmpl-next-possibilities
(cdr cmpl-next-possibilities
))
1677 cmpl-next-possibilities
1680 (setq cmpl-next-possibility
(car cmpl-next-possibilities
)
1681 cmpl-tried-list
(cons (downcase (completion-string cmpl-next-possibility
))
1683 cmpl-next-possibilities
(cdr cmpl-next-possibilities
)
1685 cmpl-next-possibility
)
1687 ;; unsuccessful, use cdabbrev
1688 (cond ((not cmpl-cdabbrev-reset-p
)
1689 (reset-cdabbrev cmpl-test-string cmpl-tried-list
)
1690 (setq cmpl-cdabbrev-reset-p t
)
1692 (setq cmpl-next-possibility
(next-cdabbrev))
1694 ;; Completely unsuccessful, return nil
1698 ;;; - Add and Find -
1699 ;;; (add-completion "banana")
1700 ;;; (completion-search-reset "ban")
1701 ;;; (completion-search-next 0) --> "banana"
1703 ;;; - Discrimination -
1704 ;;; (add-completion "cumberland")
1705 ;;; (add-completion "cumberbund")
1707 ;;; (completion-search-reset "cumb")
1708 ;;; (completion-search-peek t) --> "cumberbund"
1709 ;;; (completion-search-next 0) --> "cumberbund"
1710 ;;; (completion-search-peek t) --> "cumberland"
1711 ;;; (completion-search-next 1) --> "cumberland"
1712 ;;; (completion-search-peek nil) --> nil
1713 ;;; (completion-search-next 2) --> "cumbering" {cdabbrev}
1714 ;;; (completion-search-next 3) --> nil or "cumming"{depends on context}
1715 ;;; (completion-search-next 1) --> "cumberland"
1716 ;;; (completion-search-peek t) --> "cumbering" {cdabbrev}
1719 ;;; (completion-search-next 1) --> "cumberland"
1720 ;;; (setq completion-to-accept "cumberland")
1721 ;;; (completion-search-reset "foo")
1722 ;;; (completion-search-reset "cum")
1723 ;;; (completion-search-next 0) --> "cumberland"
1726 ;;; (kill-completion "cumberland")
1728 ;;; (completion-search-reset "cum")
1729 ;;; (completion-search-next 0) --> "cumberbund"
1730 ;;; (completion-search-next 1) --> "cummings"
1732 ;;; - Ignoring Capitalization -
1733 ;;; (completion-search-reset "CuMb")
1734 ;;; (completion-search-next 0) --> "cumberbund"
1738 ;;;-----------------------------------------------
1740 ;;;-----------------------------------------------
1742 (defun completion-mode ()
1743 "Toggles whether or not to add new words to the completion database."
1745 (setq enable-completion
(not enable-completion
))
1746 (message "Completion mode is now %s." (if enable-completion
"ON" "OFF"))
1749 (defvar cmpl-current-index
0)
1750 (defvar cmpl-original-string nil
)
1751 (defvar cmpl-last-insert-location -
1)
1752 (defvar cmpl-leave-point-at-start nil
)
1754 (defun complete (&optional arg
)
1755 "Fill out a completion of the word before point.
1756 Point is left at end. Consecutive calls rotate through all possibilities.
1758 control-u :: leave the point at the beginning of the completion rather
1760 a number :: rotate through the possible completions by that amount
1761 `-' :: same as -1 (insert previous completion)
1762 {See the comments at the top of `completion.el' for more info.}"
1764 ;;; Set up variables
1765 (cond ((eq last-command this-command
)
1767 (delete-region cmpl-last-insert-location
(point))
1768 ;; get next completion
1769 (setq cmpl-current-index
(+ cmpl-current-index
(or arg
1)))
1772 (if (not cmpl-initialized-p
)
1773 (initialize-completions)) ;; make sure everything's loaded
1774 (cond ((consp current-prefix-arg
) ;; control-u
1776 (setq cmpl-leave-point-at-start t
)
1779 (setq cmpl-leave-point-at-start nil
)
1782 (setq cmpl-original-string
(symbol-before-point-for-complete))
1783 (cond ((not cmpl-original-string
)
1784 (setq this-command
'failed-complete
)
1785 (error "To complete, point must be after a symbol at least %d character long"
1786 completion-prefix-min-length
)))
1788 (setq cmpl-current-index
(if current-prefix-arg arg
0))
1790 (cmpl-statistics-block
1791 (note-complete-entered-afresh cmpl-original-string
))
1793 (completion-search-reset cmpl-original-string
)
1794 ;; erase what we've got
1795 (delete-region cmpl-symbol-start cmpl-symbol-end
)
1798 ;; point is at the point to insert the new symbol
1799 ;; Get the next completion
1800 (let* ((print-status-p
1801 (and (>= baud-rate completion-prompt-speed-threshold
)
1802 (not (minibuffer-window-selected-p))))
1803 (insert-point (point))
1804 (entry (completion-search-next cmpl-current-index
))
1807 ;; entry is either a completion entry or a string (if cdabbrev)
1811 ;; Setup for proper case
1812 (setq string
(if (stringp entry
)
1813 entry
(completion-string entry
)))
1814 (setq string
(cmpl-merge-string-cases
1815 string cmpl-original-string
))
1819 (setq completion-to-accept string
)
1820 ;; fixup and cache point
1821 (cond (cmpl-leave-point-at-start
1822 (setq cmpl-last-insert-location
(point))
1823 (goto-char insert-point
))
1825 (setq cmpl-last-insert-location insert-point
))
1828 (cmpl-statistics-block
1829 (note-complete-inserted entry cmpl-current-index
))
1830 ;; Done ! cmpl-stat-complete-successful
1831 ;;display the next completion
1833 ((and print-status-p
1834 ;; This updates the display and only prints if there
1838 (completion-search-peek
1839 completion-cdabbrev-prompt-flag
)))
1840 (setq string
(if (stringp entry
)
1841 entry
(completion-string entry
)))
1842 (setq string
(cmpl-merge-string-cases
1843 string cmpl-original-string
))
1844 (message "Next completion: %s" string
)
1847 (t;; none found, insert old
1848 (insert cmpl-original-string
)
1849 ;; Don't accept completions
1850 (setq completion-to-accept nil
)
1852 ;; This used to call cmpl19-sit-for, an undefined function.
1853 ;; I hope that sit-for does the right thing; I don't know -- rms.
1854 (if (and print-status-p
(sit-for 0))
1855 (message "No %scompletions."
1856 (if (eq this-command last-command
) "more " "")))
1858 (cmpl-statistics-block
1859 (record-complete-failed cmpl-current-index
))
1860 ;; Pretend that we were never here
1861 (setq this-command
'failed-complete
)
1864 ;;;-----------------------------------------------
1865 ;;; "Complete" Key Keybindings
1866 ;;;-----------------------------------------------
1868 (global-set-key "\M-\r" 'complete
)
1869 (global-set-key [?\C-
\r] 'complete
)
1870 (define-key function-key-map
[C-return
] [?\C-
\r])
1873 ;;; (add-completion "cumberland")
1874 ;;; (add-completion "cumberbund")
1881 ;;;---------------------------------------------------------------------------
1882 ;;; Parsing definitions from files into the database
1883 ;;;---------------------------------------------------------------------------
1885 ;;;-----------------------------------------------
1886 ;;; Top Level functions ::
1887 ;;;-----------------------------------------------
1890 (defun add-completions-from-file (file)
1891 "Parse possible completions from a file and add them to data base."
1892 (interactive "fFile: ")
1893 (setq file
(expand-file-name file
))
1894 (let* ((buffer (get-file-buffer file
))
1895 (buffer-already-there-p buffer
)
1897 (if (not buffer-already-there-p
)
1898 (let ((completions-merging-modes nil
))
1899 (setq buffer
(find-file-noselect file
))))
1903 (add-completions-from-buffer)
1905 (if (not buffer-already-there-p
)
1906 (kill-buffer buffer
)))))
1908 (defun add-completions-from-buffer ()
1910 (let ((current-completion-source cmpl-source-file-parsing
)
1912 (cmpl-statistics-block
1913 (aref completion-add-count-vector cmpl-source-file-parsing
)))
1916 (cond ((memq major-mode
'(emacs-lisp-mode lisp-mode
))
1917 (add-completions-from-lisp-buffer)
1920 ((memq major-mode
'(c-mode))
1921 (add-completions-from-c-buffer)
1925 (error "Cannot parse completions in %s buffers"
1928 (cmpl-statistics-block
1929 (record-cmpl-parse-file
1931 (- (aref completion-add-count-vector cmpl-source-file-parsing
)
1936 (defun cmpl-find-file-hook ()
1937 (cond (enable-completion
1938 (cond ((and (memq major-mode
'(emacs-lisp-mode lisp-mode
))
1939 (memq 'lisp completions-merging-modes
)
1941 (add-completions-from-buffer))
1942 ((and (memq major-mode
'(c-mode))
1943 (memq 'c completions-merging-modes
)
1945 (add-completions-from-buffer)
1949 (add-hook 'find-file-hooks
'cmpl-find-file-hook
)
1951 ;;;-----------------------------------------------
1952 ;;; Tags Table Completions
1953 ;;;-----------------------------------------------
1955 (defun add-completions-from-tags-table ()
1956 ;; Inspired by eero@media-lab.media.mit.edu
1957 "Add completions from the current tags table."
1959 (visit-tags-table-buffer) ;this will prompt if no tags-table
1961 (goto-char (point-min))
1965 (search-forward "\177")
1967 (and (setq string
(symbol-under-point))
1968 (add-completion-to-tail-if-new string
))
1975 ;;;-----------------------------------------------
1976 ;;; Lisp File completion parsing
1977 ;;;-----------------------------------------------
1978 ;;; This merely looks for phrases beginning with (def.... or
1979 ;;; (package:def ... and takes the next word.
1981 ;;; We tried using forward-lines and explicit searches but the regexp technique
1982 ;;; was faster. (About 100K characters per second)
1984 (defconst *lisp-def-regexp
*
1985 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
1986 "A regexp that searches for lisp definition form."
1990 ;;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
1991 ;;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
1992 ;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
1993 ;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
1995 ;;; Parses all the definition names from a Lisp mode buffer and adds them to
1996 ;;; the completion database.
1997 (defun add-completions-from-lisp-buffer ()
1999 ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second
2002 (goto-char (point-min))
2005 (re-search-forward *lisp-def-regexp
*)
2006 (and (setq string
(symbol-under-point))
2007 (add-completion-to-tail-if-new string
))
2013 ;;;-----------------------------------------------
2014 ;;; C file completion parsing
2015 ;;;-----------------------------------------------
2017 ;;; Looks for #define or [<storage class>] [<type>] <name>{,<name>}
2018 ;;; or structure, array or pointer defs.
2019 ;;; It gets most of the definition names.
2021 ;;; As you might suspect by now, we use some symbol table hackery
2023 ;;; Symbol separator chars (have whitespace syntax) --> , ; * = (
2024 ;;; Opening char --> [ {
2025 ;;; Closing char --> ] }
2026 ;;; opening and closing must be skipped over
2027 ;;; Whitespace chars (have symbol syntax)
2028 ;;; Everything else has word syntax
2030 (defun cmpl-make-c-def-completion-syntax-table ()
2031 (let ((table (make-syntax-table))
2032 (whitespace-chars '(? ?
\n ?
\t ?
\f ?
\v ?
\r))
2033 ;; unfortunately the ?( causes the parens to appear unbalanced
2034 (separator-chars '(?
, ?
* ?
= ?\
( ?\
;
2037 ;; default syntax is whitespace
2040 (modify-syntax-entry i
"w" table
)
2042 (completion-dolist (char whitespace-chars
)
2043 (modify-syntax-entry char
"_" table
))
2044 (completion-dolist (char separator-chars
)
2045 (modify-syntax-entry char
" " table
))
2046 (modify-syntax-entry ?\
[ "(]" table
)
2047 (modify-syntax-entry ?\
{ "(}" table
)
2048 (modify-syntax-entry ?\
] ")[" table
)
2049 (modify-syntax-entry ?\
} "){" table
)
2052 (defconst cmpl-c-def-syntax-table
(cmpl-make-c-def-completion-syntax-table))
2055 (defconst *c-def-regexp
*
2056 ;; This stops on lines with possible definitions
2058 ;; This stops after the symbol to add.
2059 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
2060 ;; This stops before the symbol to add. {Test cases in parens. below}
2061 ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)"
2062 ;; this simple version picks up too much extraneous stuff
2063 ;; "\n\\(\\w\\|\\s_\\|#\\)\\B"
2064 "A regexp that searches for a definition form."
2067 ;(defconst *c-cont-regexp*
2068 ; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)"
2069 ; "This regexp should be used in a looking-at to parse for lists of variables.")
2071 ;(defconst *c-struct-regexp*
2072 ; "\\(*\\|\\s \\)*\\b"
2073 ; "This regexp should be used to test whether a symbol follows a structure definition.")
2075 ;(defun test-c-def-regexp (regexp string)
2076 ; (and (eq 0 (string-match regexp string)) (match-end 0))
2080 ;;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
2081 ;;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
2082 ;;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
2083 ;;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
2084 ;;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
2085 ;;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
2086 ;;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
2087 ;;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
2088 ;;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
2089 ;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
2090 ;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
2092 ;;; Parses all the definition names from a C mode buffer and adds them to the
2093 ;;; completion database.
2094 (defun add-completions-from-c-buffer ()
2096 ;; Sun 3/280-- 1250 lines/sec.
2098 (let (string next-point char
2099 (saved-syntax (syntax-table))
2102 (goto-char (point-min))
2103 (catch 'finish-add-completions
2106 ;; we loop here only when scan-sexps fails
2107 ;; (i.e. unbalance exps.)
2108 (set-syntax-table cmpl-c-def-syntax-table
)
2111 (re-search-forward *c-def-regexp
*)
2113 ((= (preceding-char) ?
#)
2114 ;; preprocessor macro, see if it's one we handle
2115 (setq string
(buffer-substring (point) (+ (point) 6)))
2116 (cond ((or (string-equal string
"define")
2117 (string-equal string
"ifdef ")
2119 ;; skip forward over definition symbol
2120 ;; and add it to database
2121 (and (forward-word 2)
2122 (setq string
(symbol-before-point))
2124 (add-completion-to-tail-if-new string
)
2128 (setq next-point
(point))
2131 ;; scan to next separator char.
2132 (setq next-point
(scan-sexps next-point
1))
2134 ;; position the point on the word we want to add
2135 (goto-char next-point
)
2136 (while (= (setq char
(following-char)) ?
*)
2137 ;; handle pointer ref
2138 ;; move to next separator char.
2140 (setq next-point
(scan-sexps (point) 1)))
2144 (if (setq string
(symbol-under-point))
2145 ;; (push string foo)
2146 (add-completion-to-tail-if-new string
)
2147 ;; Local TMC hack (useful for parsing paris.h)
2148 (if (and (looking-at "_AP") ;; "ansi prototype"
2152 (symbol-under-point))
2154 (add-completion-to-tail-if-new string
)
2158 (goto-char next-point
)
2159 ;; (push (format "%c" (following-char)) foo)
2160 (if (= (char-syntax char
) ?\
()
2161 ;; if on an opening delimiter, go to end
2162 (while (= (char-syntax char
) ?\
()
2163 (setq next-point
(scan-sexps next-point
1)
2164 char
(char-after next-point
))
2167 ;; Current char is an end char.
2168 (setq next-point nil
)
2171 (search-failed ;;done
2172 (throw 'finish-add-completions t
)
2175 ;; Check for failure in scan-sexps
2176 (if (or (string-equal (nth 1 e
)
2177 "Containing expression ends prematurely")
2178 (string-equal (nth 1 e
) "Unbalanced parentheses"))
2179 ;; unbalanced paren., keep going
2182 (message "Error parsing C buffer for completions--please send bug report")
2183 (throw 'finish-add-completions t
)
2186 (set-syntax-table saved-syntax
)
2190 ;;;---------------------------------------------------------------------------
2192 ;;;---------------------------------------------------------------------------
2194 ;;; The version of save-completions-to-file called at kill-emacs time.
2195 (defun kill-emacs-save-completions ()
2196 (if (and save-completions-flag enable-completion cmpl-initialized-p
)
2198 ((not cmpl-completions-accepted-p
)
2199 (message "Completions database has not changed - not writing."))
2201 (save-completions-to-file)))))
2203 ;; There is no point bothering to change this again
2204 ;; unless the package changes so much that it matters
2205 ;; for people that have saved completions.
2206 (defconst completion-version
"11")
2208 (defconst saved-cmpl-file-header
2209 ";;; Completion Initialization file.
2211 ;;; Format is (<string> . <last-use-time>)
2212 ;;; <string> is the completion
2213 ;;; <last-use-time> is the time the completion was last used
2214 ;;; If it is t, the completion will never be pruned from the file.
2215 ;;; Otherwise it is in hours since origin.
2218 (defun completion-backup-filename (filename)
2219 (concat filename
".BAK"))
2221 (defun save-completions-to-file (&optional filename
)
2222 "Save completions in init file FILENAME.
2223 If file name is not specified, use `save-completions-file-name'."
2225 (setq filename
(expand-file-name (or filename save-completions-file-name
)))
2226 (if (file-writable-p filename
)
2228 (if (not cmpl-initialized-p
)
2229 (initialize-completions));; make sure everything's loaded
2230 (message "Saving completions to file %s" filename
)
2232 (let* ((delete-old-versions t
)
2233 (kept-old-versions 0)
2234 (kept-new-versions completions-file-versions-kept
)
2236 (current-time (cmpl-hours-since-origin))
2240 (backup-filename (completion-backup-filename filename
))
2244 (get-buffer-create " *completion-save-buffer*")
2245 (set-buffer " *completion-save-buffer*")
2246 (setq buffer-file-name filename
)
2248 (if (not (verify-visited-file-modtime (current-buffer)))
2250 ;; file has changed on disk. Bring us up-to-date
2251 (message "Completion file has changed. Merging. . .")
2252 (load-completions-from-file filename t
)
2253 (message "Merging finished. Saving completions to file %s" filename
)))
2255 ;; prepare the buffer to be modified
2256 (clear-visited-file-modtime)
2259 (insert (format saved-cmpl-file-header completion-version
))
2260 (completion-dolist (completion (list-all-completions))
2261 (setq total-in-db
(1+ total-in-db
))
2262 (setq last-use-time
(completion-last-use-time completion
))
2263 ;; Update num uses and maybe write completion to a file
2264 (cond ((or;; Write to file if
2266 (and (eq last-use-time t
)
2267 (setq total-perm
(1+ total-perm
)))
2269 (if (> (completion-num-uses completion
) 0)
2271 (setq last-use-time current-time
)
2272 ;; or it was saved before and
2274 ;; save-completions-retention-time is nil
2275 (or (not save-completions-retention-time
)
2276 ;; or time since last use is < ...retention-time*
2277 (< (- current-time last-use-time
)
2278 save-completions-retention-time
))
2281 (setq total-saved
(1+ total-saved
))
2282 (insert (prin1-to-string (cons (completion-string completion
)
2283 last-use-time
)) "\n")
2288 (let ((file-exists-p (file-exists-p filename
)))
2291 ;; If file exists . . .
2292 ;; Save a backup(so GNU doesn't screw us when we're out of disk)
2293 ;; (GNU leaves a 0 length file if it gets a disk full error!)
2295 ;; If backup doesn't exit, Rename current to backup
2296 ;; {If backup exists the primary file is probably messed up}
2297 (or (file-exists-p backup-filename
)
2298 (rename-file filename backup-filename
))
2299 ;; Copy the backup back to the current name
2300 ;; (so versioning works)
2301 (copy-file backup-filename filename t
)))
2305 ;; If successful, remove backup
2306 (delete-file backup-filename
)))
2308 (set-buffer-modified-p nil
)
2309 (message "Couldn't save completion file `%s'" filename
)
2311 ;; Reset accepted-p flag
2312 (setq cmpl-completions-accepted-p nil
)
2314 (cmpl-statistics-block
2315 (record-save-completions total-in-db total-perm total-saved
))
2318 ;;;(defun autosave-completions ()
2319 ;;; (if (and save-completions-flag enable-completion cmpl-initialized-p
2320 ;;; *completion-auto-save-period*
2321 ;;; (> cmpl-emacs-idle-time *completion-auto-save-period*)
2322 ;;; cmpl-completions-accepted-p)
2323 ;;; (save-completions-to-file)))
2325 ;;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions)
2327 (defun load-completions-from-file (&optional filename no-message-p
)
2328 "Loads a completion init file FILENAME.
2329 If file is not specified, then use `save-completions-file-name'."
2331 (setq filename
(expand-file-name (or filename save-completions-file-name
)))
2332 (let* ((backup-filename (completion-backup-filename filename
))
2333 (backup-readable-p (file-readable-p backup-filename
))
2335 (if backup-readable-p
(setq filename backup-filename
))
2336 (if (file-readable-p filename
)
2338 (if (not no-message-p
)
2339 (message "Loading completions from %sfile %s . . ."
2340 (if backup-readable-p
"backup " "") filename
))
2342 (get-buffer-create " *completion-save-buffer*")
2343 (set-buffer " *completion-save-buffer*")
2344 (setq buffer-file-name filename
)
2345 ;; prepare the buffer to be modified
2346 (clear-visited-file-modtime)
2349 (let ((insert-okay-p nil
)
2350 (buffer (current-buffer))
2351 (current-time (cmpl-hours-since-origin))
2352 string num-uses entry last-use-time
2353 cmpl-entry cmpl-last-use-time
2354 (current-completion-source cmpl-source-init-file
)
2356 (cmpl-statistics-block
2357 (aref completion-add-count-vector cmpl-source-file-parsing
)))
2358 (total-in-file 0) (total-perm 0)
2360 ;; insert the file into a buffer
2362 (progn (insert-file-contents filename t
)
2363 (setq insert-okay-p t
))
2366 (message "File error trying to load completion file %s."
2371 (goto-char (point-min))
2375 (setq entry
(read buffer
))
2376 (setq total-in-file
(1+ total-in-file
))
2379 (stringp (setq string
(car entry
)))
2381 ((eq (setq last-use-time
(cdr entry
)) 'T
)
2382 ;; handle case sensitivity
2383 (setq total-perm
(1+ total-perm
))
2384 (setq last-use-time t
))
2385 ((eq last-use-time t
)
2386 (setq total-perm
(1+ total-perm
)))
2387 ((integerp last-use-time
))
2391 (setq cmpl-last-use-time
2392 (completion-last-use-time
2394 (add-completion-to-tail-if-new string
))
2396 (if (or (eq last-use-time t
)
2397 (and (> last-use-time
1000);;backcompatibility
2398 (not (eq cmpl-last-use-time t
))
2399 (or (not cmpl-last-use-time
)
2401 (> last-use-time cmpl-last-use-time
))
2403 ;; update last-use-time
2404 (set-completion-last-use-time cmpl-entry last-use-time
)
2408 (message "Error: invalid saved completion - %s"
2409 (prin1-to-string entry
))
2410 ;; try to get back in sync
2411 (search-forward "\n(")
2414 (message "End of file while reading completions.")
2417 (if (= (point) (point-max))
2418 (if (not no-message-p
)
2419 (message "Loading completions from file %s . . . Done."
2421 (message "End of file while reading completions.")
2425 (cmpl-statistics-block
2426 (record-load-completions
2427 total-in-file total-perm
2428 (- (aref completion-add-count-vector cmpl-source-init-file
)
2433 (defun initialize-completions ()
2434 "Load the default completions file.
2435 Also sets up so that exiting emacs will automatically save the file."
2437 (cond ((not cmpl-initialized-p
)
2438 (load-completions-from-file)
2440 (setq cmpl-initialized-p t
)
2444 ;;;-----------------------------------------------
2445 ;;; Kill EMACS patch
2446 ;;;-----------------------------------------------
2448 (add-hook 'kill-emacs-hook
2450 (kill-emacs-save-completions)
2451 (cmpl-statistics-block
2452 (record-cmpl-kill-emacs))))
2454 ;;;-----------------------------------------------
2455 ;;; Kill region patch
2456 ;;;-----------------------------------------------
2458 (defun completion-kill-region (&optional beg end
)
2459 "Kill between point and mark.
2460 The text is deleted but saved in the kill ring.
2461 The command \\[yank] can retrieve it from there.
2462 /(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
2464 This is the primitive for programs to kill text (as opposed to deleting it).
2465 Supply two arguments, character numbers indicating the stretch of text
2467 Any command that calls this function is a \"kill command\".
2468 If the previous command was also a kill command,
2469 the text killed this time appends to the text killed last time
2470 to make one entry in the kill ring.
2471 Patched to remove the most recent completion."
2473 (cond ((eq last-command
'complete
)
2474 (delete-region (point) cmpl-last-insert-location
)
2475 (insert cmpl-original-string
)
2476 (setq completion-to-accept nil
)
2477 (cmpl-statistics-block
2478 (record-complete-failed)))
2480 (kill-region beg end
))))
2482 (global-set-key "\C-w" 'completion-kill-region
)
2484 ;;;-----------------------------------------------
2485 ;;; Patches to self-insert-command.
2486 ;;;-----------------------------------------------
2488 ;;; Need 2 versions: generic separator chars. and space (to get auto fill
2491 ;;; All common separators (eg. space "(" ")" """) characters go through a
2492 ;;; function to add new words to the list of words to complete from:
2493 ;;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
2494 ;;; If the character before this was an alpha-numeric then this adds the
2495 ;;; symbol before point to the completion list (using ADD-COMPLETION).
2497 (defun completion-separator-self-insert-command (arg)
2499 (use-completion-before-separator)
2500 (self-insert-command arg
)
2503 (defun completion-separator-self-insert-autofilling (arg)
2505 (use-completion-before-separator)
2506 (self-insert-command arg
)
2507 (and auto-fill-function
2508 (funcall auto-fill-function
))
2511 ;;;-----------------------------------------------
2513 ;;;-----------------------------------------------
2515 ;;; Note that because of the way byte compiling works, none of
2516 ;;; the functions defined with this macro get byte compiled.
2518 (defmacro def-completion-wrapper
(function-name type
&optional new-name
)
2519 "Add a call to update the completion database before function execution.
2520 TYPE is the type of the wrapper to be added. Can be :before or :under."
2521 (cond ((eq type
':separator
)
2522 (list 'put
(list 'quote function-name
) ''completion-function
2523 ''use-completion-before-separator
))
2525 (list 'put
(list 'quote function-name
) ''completion-function
2526 ''use-completion-before-point
))
2527 ((eq type
':backward-under
)
2528 (list 'put
(list 'quote function-name
) ''completion-function
2529 ''use-completion-backward-under
))
2530 ((eq type
':backward
)
2531 (list 'put
(list 'quote function-name
) ''completion-function
2532 ''use-completion-backward
))
2534 (list 'put
(list 'quote function-name
) ''completion-function
2535 ''use-completion-under-point
))
2536 ((eq type
':under-or-before
)
2537 (list 'put
(list 'quote function-name
) ''completion-function
2538 ''use-completion-under-or-before-point
))
2539 ((eq type
':minibuffer-separator
)
2540 (list 'put
(list 'quote function-name
) ''completion-function
2541 ''use-completion-minibuffer-separator
))))
2543 (defun use-completion-minibuffer-separator ()
2544 (let ((cmpl-syntax-table cmpl-standard-syntax-table
))
2545 (use-completion-before-separator)))
2547 (defun use-completion-backward-under ()
2548 (use-completion-under-point)
2549 (if (eq last-command
'complete
)
2550 ;; probably a failed completion if you have to back up
2551 (cmpl-statistics-block (record-complete-failed))))
2553 (defun use-completion-backward ()
2554 (if (eq last-command
'complete
)
2555 ;; probably a failed completion if you have to back up
2556 (cmpl-statistics-block (record-complete-failed))))
2558 (defun completion-before-command ()
2559 (funcall (or (and (symbolp this-command
)
2560 (get this-command
'completion-function
))
2561 'use-completion-under-or-before-point
)))
2562 (add-hook 'pre-command-hook
'completion-before-command
)
2565 ;;;---------------------------------------------------------------------------
2566 ;;; Patches to standard keymaps insert completions
2567 ;;;---------------------------------------------------------------------------
2569 ;;;-----------------------------------------------
2571 ;;;-----------------------------------------------
2572 ;;; We've used the completion syntax table given as a guide.
2574 ;;; Global separator chars.
2575 ;;; We left out <tab> because there are too many special cases for it. Also,
2576 ;;; in normal coding it's rarely typed after a word.
2577 (global-set-key " " 'completion-separator-self-insert-autofilling
)
2578 (global-set-key "!" 'completion-separator-self-insert-command
)
2579 (global-set-key "%" 'completion-separator-self-insert-command
)
2580 (global-set-key "^" 'completion-separator-self-insert-command
)
2581 (global-set-key "&" 'completion-separator-self-insert-command
)
2582 (global-set-key "(" 'completion-separator-self-insert-command
)
2583 (global-set-key ")" 'completion-separator-self-insert-command
)
2584 (global-set-key "=" 'completion-separator-self-insert-command
)
2585 (global-set-key "`" 'completion-separator-self-insert-command
)
2586 (global-set-key "|" 'completion-separator-self-insert-command
)
2587 (global-set-key "{" 'completion-separator-self-insert-command
)
2588 (global-set-key "}" 'completion-separator-self-insert-command
)
2589 (global-set-key "[" 'completion-separator-self-insert-command
)
2590 (global-set-key "]" 'completion-separator-self-insert-command
)
2591 (global-set-key ";" 'completion-separator-self-insert-command
)
2592 (global-set-key "\"" 'completion-separator-self-insert-command
)
2593 (global-set-key "'" 'completion-separator-self-insert-command
)
2594 (global-set-key "#" 'completion-separator-self-insert-command
)
2595 (global-set-key "," 'completion-separator-self-insert-command
)
2596 (global-set-key "?" 'completion-separator-self-insert-command
)
2598 ;;; We include period and colon even though they are symbol chars because :
2599 ;;; - in text we want to pick up the last word in a sentence.
2600 ;;; - in C pointer refs. we want to pick up the first symbol
2601 ;;; - it won't make a difference for lisp mode (package names are short)
2602 (global-set-key "." 'completion-separator-self-insert-command
)
2603 (global-set-key ":" 'completion-separator-self-insert-command
)
2606 (define-key lisp-mode-map
"!" 'self-insert-command
)
2607 (define-key lisp-mode-map
"&" 'self-insert-command
)
2608 (define-key lisp-mode-map
"%" 'self-insert-command
)
2609 (define-key lisp-mode-map
"?" 'self-insert-command
)
2610 (define-key lisp-mode-map
"=" 'self-insert-command
)
2611 (define-key lisp-mode-map
"^" 'self-insert-command
)
2614 (defun completion-c-mode-hook ()
2615 (def-completion-wrapper electric-c-semi
:separator
)
2616 (define-key c-mode-map
"+" 'completion-separator-self-insert-command
)
2617 (define-key c-mode-map
"*" 'completion-separator-self-insert-command
)
2618 (define-key c-mode-map
"/" 'completion-separator-self-insert-command
))
2619 ;; Do this either now or whenever C mode is loaded.
2620 (if (featurep 'cc-mode
)
2621 (completion-c-mode-hook)
2622 (add-hook 'c-mode-hook
'completion-c-mode-hook
))
2624 ;;; FORTRAN mode diffs. (these are defined when fortran is called)
2625 (defun completion-setup-fortran-mode ()
2626 (define-key fortran-mode-map
"+" 'completion-separator-self-insert-command
)
2627 (define-key fortran-mode-map
"-" 'completion-separator-self-insert-command
)
2628 (define-key fortran-mode-map
"*" 'completion-separator-self-insert-command
)
2629 (define-key fortran-mode-map
"/" 'completion-separator-self-insert-command
)
2632 ;;;-----------------------------------------------
2633 ;;; End of line chars.
2634 ;;;-----------------------------------------------
2635 (def-completion-wrapper newline
:separator
)
2636 (def-completion-wrapper newline-and-indent
:separator
)
2637 (def-completion-wrapper comint-send-input
:separator
)
2638 (def-completion-wrapper exit-minibuffer
:minibuffer-separator
)
2639 (def-completion-wrapper eval-print-last-sexp
:separator
)
2640 (def-completion-wrapper eval-last-sexp
:separator
)
2641 ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
2643 ;;;-----------------------------------------------
2645 ;;;-----------------------------------------------
2647 (def-completion-wrapper next-line
:under-or-before
)
2648 (def-completion-wrapper previous-line
:under-or-before
)
2649 (def-completion-wrapper beginning-of-buffer
:under-or-before
)
2650 (def-completion-wrapper end-of-buffer
:under-or-before
)
2651 (def-completion-wrapper beginning-of-line
:under-or-before
)
2652 (def-completion-wrapper end-of-line
:under-or-before
)
2653 (def-completion-wrapper forward-char
:under-or-before
)
2654 (def-completion-wrapper forward-word
:under-or-before
)
2655 (def-completion-wrapper forward-sexp
:under-or-before
)
2656 (def-completion-wrapper backward-char
:backward-under
)
2657 (def-completion-wrapper backward-word
:backward-under
)
2658 (def-completion-wrapper backward-sexp
:backward-under
)
2660 (def-completion-wrapper delete-backward-char
:backward
)
2661 (def-completion-wrapper delete-backward-char-untabify
:backward
)
2669 (cmpl-statistics-block
2670 (record-completion-file-loaded))
2672 ;;; completion.el ends here