1 ;;; completion.el --- dynamic word-completion code
3 ;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2011 Free Software Foundation, Inc.
6 ;; Keywords: abbrev convenience
7 ;; Author: Jim Salem <alem@bbnplanet.com> of Thinking Machines Inc.
8 ;; (ideas suggested by Brewster Kahle)
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; What to put in .emacs
28 ;;-----------------------
29 ;; (dynamic-completion-mode)
31 ;;---------------------------------------------------------------------------
32 ;; Documentation [Slightly out of date]
33 ;;---------------------------------------------------------------------------
34 ;; (also check the documentation string of the functions)
39 ;; After you type a few characters, pressing the "complete" key inserts
40 ;; the rest of the word you are likely to type.
42 ;; This watches all the words that you type and remembers them. When
43 ;; typing a new word, pressing "complete" (meta-return) "completes" the
44 ;; word by inserting the most recently used word that begins with the
45 ;; same characters. If you press meta-return repeatedly, it cycles
46 ;; through all the words it knows about.
48 ;; If you like the completion then just continue typing, it is as if you
49 ;; entered the text by hand. If you want the inserted extra characters
50 ;; to go away, type control-w or delete. More options are described below.
52 ;; The guesses are made in the order of the most recently "used". Typing
53 ;; in a word and then typing a separator character (such as a space) "uses"
54 ;; the word. So does moving a cursor over the word. If no words are found,
55 ;; it uses an extended version of the dabbrev style completion.
57 ;; You automatically save the completions you use to a file between
60 ;; Completion enables programmers to enter longer, more descriptive
61 ;; variable names while typing fewer keystrokes than they normally would.
65 ;;---------------------
67 ;; A "word" is any string containing characters with either word or symbol
68 ;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.]
69 ;; Unless you change the constants, you must type at least three characters
70 ;; for the word to be recognized. Only words longer than 6 characters are
73 ;; When you load this file, completion will be on. I suggest you use the
74 ;; compiled version (because it is noticeably faster).
76 ;; M-x completion-mode toggles whether or not new words are added to the
77 ;; database by changing the value of enable-completion.
79 ;; SAVING/LOADING COMPLETIONS
80 ;; Completions are automatically saved from one session to another
81 ;; (unless save-completions-flag or enable-completion is nil).
82 ;; Activating this minor-mode (calling completion-initialize) loads
83 ;; a completions database for a saved completions file
84 ;; (default: ~/.completions). When you exit, Emacs saves a copy of the
85 ;; completions that you often use. When you next start, Emacs loads in
86 ;; the saved completion file.
88 ;; The number of completions saved depends loosely on
89 ;; *saved-completions-decay-factor*. Completions that have never been
90 ;; inserted via "complete" are not saved. You are encouraged to experiment
91 ;; with different functions (see compute-completion-min-num-uses).
93 ;; Some completions are permanent and are always saved out. These
94 ;; completions have their num-uses slot set to T. Use
95 ;; add-permanent-completion to do this
97 ;; Completions are saved only if enable-completion is T. The number of old
98 ;; versions kept of the saved completions file is controlled by
99 ;; completions-file-versions-kept.
101 ;; COMPLETE KEY OPTIONS
102 ;; The complete function takes a numeric arguments.
103 ;; control-u :: leave the point at the beginning of the completion rather
105 ;; a number :: rotate through the possible completions by that amount
106 ;; `-' :: same as -1 (insert previous completion)
108 ;; HOW THE DATABASE IS MAINTAINED
111 ;; UPDATING THE DATABASE MANUALLY
112 ;; m-x kill-completion
113 ;; kills the completion at point.
114 ;; m-x add-completion
115 ;; m-x add-permanent-completion
117 ;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
118 ;; m-x add-completions-from-buffer
119 ;; Parses all the definition names from a C or LISP mode buffer and
120 ;; adds them to the completion database.
122 ;; m-x add-completions-from-lisp-file
123 ;; Parses all the definition names from a C or Lisp mode file and
124 ;; adds them to the completion database.
126 ;; UPDATING THE DATABASE FROM A TAGS TABLE
127 ;; m-x add-completions-from-tags-table
128 ;; Adds completions from the current tags-table-buffer.
130 ;; HOW A COMPLETION IS FOUND
134 ;; Completion is string case independent if case-fold-search has its
135 ;; normal default of T. Also when the completion is inserted the case of the
136 ;; entry is coerced appropriately.
137 ;; [E.G. APP --> APPROPRIATELY app --> appropriately
138 ;; App --> Appropriately]
141 ;; The form `(completion-initialize)' initializes the completion system by
142 ;; trying to load in the user's completions. After the first call, further
143 ;; calls have no effect so one should be careful not to put the form in a
144 ;; site's standard site-init file.
146 ;;---------------------------------------------------------------------------
150 ;;---------------------------------------------------------------------------
151 ;; Functions you might like to call
152 ;;---------------------------------------------------------------------------
154 ;; add-completion string &optional num-uses
155 ;; Adds a new string to the database
157 ;; add-permanent-completion string
158 ;; Adds a new string to the database with num-uses = T
161 ;; kill-completion string
162 ;; Kills the completion from the database.
164 ;; clear-all-completions
165 ;; Clears the database
167 ;; list-all-completions
168 ;; Returns a list of all completions.
171 ;; next-completion string &optional index
172 ;; Returns a completion entry that starts with string.
174 ;; find-exact-completion string
175 ;; Returns a completion entry that exactly matches string.
178 ;; Inserts a completion at point
180 ;; completion-initialize
181 ;; Loads the completions file and sets up so that exiting emacs will
184 ;; save-completions-to-file &optional filename
185 ;; load-completions-from-file &optional filename
187 ;;-----------------------------------------------
189 ;;-----------------------------------------------
191 ;; get-completion-list string
193 ;; These things are for manipulating the structure
194 ;; make-completion string num-uses
195 ;; completion-num-uses completion
196 ;; completion-string completion
197 ;; set-completion-num-uses completion num-uses
198 ;; set-completion-string completion string
202 ;;-----------------------------------------------
203 ;; To Do :: (anybody ?)
204 ;;-----------------------------------------------
206 ;; Implement Lookup and keyboard interface in C
207 ;; Add package prefix smarts (for Common Lisp)
208 ;; Add autoprompting of possible completions after every keystroke (fast
210 ;; Add doc. to texinfo
213 ;;-----------------------------------------------
215 ;;-----------------------------------------------
216 ;; Sometime in '84 Brewster implemented a somewhat buggy version for
218 ;; Jan. '85 Jim became enamored of the idea and implemented a faster,
219 ;; more robust version.
220 ;; With input from many users at TMC, (rose, craig, and gls come to mind),
221 ;; the current style of interface was developed.
222 ;; 9/87, Jim and Brewster took terminals home. Yuck. After
223 ;; complaining for a while Brewster implemented a subset of the current
224 ;; LISPM version for GNU Emacs.
225 ;; 8/88 After complaining for a while (and with sufficient
226 ;; promised rewards), Jim reimplemented a version of GNU completion
227 ;; superior to that of the LISPM version.
229 ;;-----------------------------------------------
231 ;;-----------------------------------------------
232 ;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
233 ;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
235 ;;-----------------------------------------------
237 ;;-----------------------------------------------
238 ;; From version 9 to 10
239 ;; - Allowance for non-integral *completion-version* nos.
240 ;; - Fix cmpl-apply-as-top-level for keyboard macros
241 ;; - Fix broken completion merging (in save-completions-to-file)
242 ;; - More misc. fixes for version 19.0 of emacs
244 ;; From Version 8 to 9
245 ;; - Ported to version 19.0 of emacs (backcompatible with version 18)
246 ;; - Added add-completions-from-tags-table (with thanks to eero@media-lab)
248 ;; From Version 7 to 8
249 ;; - Misc. changes to comments
250 ;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e
251 ;; - cdabbrev now checks all the visible window buffers and the "other buffer"
252 ;; - `%' is now a symbol character rather than a separator (except in C mode)
254 ;; From Version 6 to 7
255 ;; - Fixed bug with saving out .completion file the first time
257 ;; From Version 5 to 6
258 ;; - removed statistics recording
259 ;; - reworked advise to handle autoloads
260 ;; - Fixed fortran mode support
261 ;; - Added new cursor motion triggers
263 ;; From Version 4 to 5
264 ;; - doesn't bother saving if nothing has changed
265 ;; - auto-save if haven't used for a 1/2 hour
266 ;; - save period extended to two weeks
267 ;; - minor fix to capitalization code
268 ;; - added *completion-auto-save-period* to variables recorded.
269 ;; - added reenter protection to cmpl-record-statistics-filter
270 ;; - added backup protection to save-completions-to-file (prevents
271 ;; problems with disk full errors)
275 ;;---------------------------------------------------------------------------
276 ;; User changeable parameters
277 ;;---------------------------------------------------------------------------
279 (defgroup completion nil
280 "Dynamic word-completion code."
285 (defcustom enable-completion t
286 "Non-nil means enable recording and saving of completions.
287 If nil, no new words are added to the database or saved to the init file."
291 (defcustom save-completions-flag t
292 "Non-nil means save most-used completions when exiting Emacs.
293 See also `save-completions-retention-time'."
297 (defcustom save-completions-file-name
298 (locate-user-emacs-file "completions" ".completions")
299 "The filename to save completions to."
303 (defcustom save-completions-retention-time 336
304 "Discard a completion if unused for this many hours.
305 \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
306 will not be saved unless these are used. Default is two weeks."
310 (defcustom completion-on-separator-character nil
311 "Non-nil means separator characters mark previous word as used.
312 This means the word will be saved as a completion."
316 (defcustom completions-file-versions-kept kept-new-versions
317 "Number of versions to keep for the saved completions file."
321 (defcustom completion-prompt-speed-threshold 4800
322 "Minimum output speed at which to display next potential completion."
326 (defcustom completion-cdabbrev-prompt-flag nil
327 "If non-nil, the next completion prompt does a cdabbrev search.
328 This can be time consuming."
332 (defcustom completion-search-distance 15000
333 "How far to search in the buffer when looking for completions.
334 In number of characters. If nil, search the whole buffer."
338 (defcustom completions-merging-modes '(lisp c)
339 "List of modes {`c' or `lisp'} for automatic completions merging.
340 Definitions from visited files which have these modes
341 are automatically added to the completion database."
342 :type '(set (const lisp) (const c))
345 ;;(defvar *record-cmpl-statistics-p* nil
346 ;; "*If non-nil, record completion statistics.")
348 ;;(defvar *completion-auto-save-period* 1800
349 ;; "*The period in seconds to wait for emacs to be idle before autosaving
350 ;;the completions. Default is a 1/2 hour.")
352 (defvar completion-min-length 6
353 "*The minimum length of a stored completion.
354 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
356 (defvar completion-max-length 200
357 "*The maximum length of a stored completion.
358 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
360 (defvar completion-prefix-min-length 3
361 "The minimum length of a completion search string.
362 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
364 ;;---------------------------------------------------------------------------
365 ;; Internal Variables
366 ;;---------------------------------------------------------------------------
368 (defvar cmpl-initialized-p nil
369 "Set to t when the completion system is initialized.
370 Indicates that the old completion file has been read in.")
372 (defvar cmpl-completions-accepted-p nil
373 "Set to t as soon as the first completion has been accepted.
374 Used to decide whether to save completions.")
376 (defvar cmpl-preceding-syntax)
378 (defvar completion-string)
380 ;;---------------------------------------------------------------------------
382 ;;---------------------------------------------------------------------------
384 ;;-----------------------------------------------
385 ;; String case coercion
386 ;;-----------------------------------------------
388 (defun cmpl-string-case-type (string)
389 "Return :capitalized, :up, :down, :mixed, or :neither for case of STRING."
390 (let ((case-fold-search nil))
391 (cond ((string-match "[[:lower:]]" string)
392 (cond ((string-match "[[:upper:]]" string)
393 (cond ((and (> (length string) 1)
394 (null (string-match "[[:upper:]]" string 1)))
400 (cond ((string-match "[[:upper:]]" string)
405 ;; (cmpl-string-case-type "123ABCDEF456") --> :up
406 ;; (cmpl-string-case-type "123abcdef456") --> :down
407 ;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
408 ;; (cmpl-string-case-type "123456") --> :neither
409 ;; (cmpl-string-case-type "Abcde123") --> :capitalized
411 (defun cmpl-coerce-string-case (string case-type)
412 (cond ((eq case-type :down) (downcase string))
413 ((eq case-type :up) (upcase string))
414 ((eq case-type :capitalized)
415 (setq string (downcase string))
416 (aset string 0 (logand ?\337 (aref string 0)))
420 (defun cmpl-merge-string-cases (string-to-coerce given-string)
421 (let ((string-case-type (cmpl-string-case-type string-to-coerce)))
422 (cond ((memq string-case-type '(:down :up :capitalized))
423 ;; Found string is in a standard case. Coerce to a type based on
425 (cmpl-coerce-string-case string-to-coerce
426 (cmpl-string-case-type given-string)))
428 ;; If the found string is in some unusual case, just insert it
433 ;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
434 ;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
435 ;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
436 ;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
439 (defun cmpl-hours-since-origin ()
440 (let ((time (current-time)))
441 (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600)))
443 ;;---------------------------------------------------------------------------
444 ;; "Symbol" parsing functions
445 ;;---------------------------------------------------------------------------
446 ;; The functions symbol-before-point, symbol-under-point, etc. quickly return
447 ;; an appropriate symbol string. The strategy is to temporarily change
448 ;; the syntax table to enable fast symbol searching. There are three classes
449 ;; of syntax in these "symbol" syntax tables ::
451 ;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
452 ;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).
453 ;; syntax (? ) - everything else
455 ;; Thus by judicious use of scan-sexps and forward-word, we can get
456 ;; the word we want relatively fast and without consing.
458 ;; Why do we need a separate category for "symbol chars to ignore at ends" ?
459 ;; For example, in LISP we want starting :'s trimmed
460 ;; so keyword argument specifiers also define the keyword completion. And,
461 ;; for example, in C we want `.' appearing in a structure ref. to
462 ;; be kept intact in order to store the whole structure ref.; however, if
463 ;; it appears at the end of a symbol it should be discarded because it is
464 ;; probably used as a period.
466 ;; Here is the default completion syntax ::
467 ;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
468 ;; Symbol chars to ignore at ends :: _ : . -
469 ;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
470 ;; , ? <Everything else>
472 ;; Mode specific differences and notes ::
474 ;; Symbol chars :: ! & ? = ^
477 ;; Separator chars :: + * / : %
478 ;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator
479 ;; char., however, we wanted to have completion symbols include pointer
480 ;; references. For example, "foo->bar" is a symbol as far as completion is
484 ;; Separator chars :: + - * / :
488 ;; Of course there is no pathname "mode" and in fact we have not implemented
489 ;; this table. However, if there was such a mode, this is what it would look
492 ;;-----------------------------------------------
494 ;;-----------------------------------------------
496 (defconst completion-standard-syntax-table
497 (let ((table (make-syntax-table))
499 ;; Default syntax is whitespace.
502 (modify-syntax-entry i " " table)
507 (modify-syntax-entry (+ ?a i) "_" table)
508 (modify-syntax-entry (+ ?A i) "_" table)
513 (modify-syntax-entry (+ ?0 i) "_" table)
516 (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%))
517 (symbol-chars-ignore '(?_ ?- ?: ?.)))
518 (dolist (char symbol-chars)
519 (modify-syntax-entry char "_" table))
520 (dolist (char symbol-chars-ignore)
521 (modify-syntax-entry char "w" table)))
524 (defvar completion-syntax-table completion-standard-syntax-table
525 "This variable holds the current completion syntax table.")
526 (make-variable-buffer-local 'completion-syntax-table)
528 ;;-----------------------------------------------
530 ;;-----------------------------------------------
531 (defvar cmpl-symbol-start nil
532 "Holds first character of symbol, after any completion symbol function.")
533 (defvar cmpl-symbol-end nil
534 "Holds last character of symbol, after any completion symbol function.")
536 (defun symbol-under-point ()
537 "Return the symbol that the point is currently on.
538 But only if it is longer than `completion-min-length'."
539 (with-syntax-table completion-syntax-table
540 (when (memq (char-syntax (following-char)) '(?w ?_))
541 ;; Cursor is on following-char and after preceding-char
542 (let ((saved-point (point)))
543 (setq cmpl-symbol-start (scan-sexps (1+ saved-point) -1)
544 cmpl-symbol-end (scan-sexps saved-point 1))
545 ;; Remove chars to ignore at the start.
546 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
547 (goto-char cmpl-symbol-start)
549 (setq cmpl-symbol-start (point))
550 (goto-char saved-point)))
551 ;; Remove chars to ignore at the end.
552 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
553 (goto-char cmpl-symbol-end)
555 (setq cmpl-symbol-end (point))
556 (goto-char saved-point)))
557 ;; Return completion if the length is reasonable.
558 (if (and (<= completion-min-length
559 (- cmpl-symbol-end cmpl-symbol-start))
560 (<= (- cmpl-symbol-end cmpl-symbol-start)
561 completion-max-length))
562 (buffer-substring-no-properties
563 cmpl-symbol-start cmpl-symbol-end))))))
565 ;; tests for symbol-under-point
566 ;; `^' indicates cursor pos. where value is returned
568 ;; ^^^^^^^^^^^^^^^^ --> simple-word-test
569 ;; _harder_word_test_
570 ;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test
573 ;; /foo/bar/quux.hello
574 ;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
577 (defun symbol-before-point ()
578 "Return a string of the symbol immediately before point.
579 Returns nil if there isn't one longer than `completion-min-length'."
580 ;; This is called when a word separator is typed so it must be FAST !
581 (with-syntax-table completion-syntax-table
582 ;; Cursor is on following-char and after preceding-char
583 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
584 ;; Number of chars to ignore at end.
585 (setq cmpl-symbol-end (point)
586 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
587 ;; Remove chars to ignore at the start.
588 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
589 (goto-char cmpl-symbol-start)
591 (setq cmpl-symbol-start (point))
592 (goto-char cmpl-symbol-end)))
593 ;; Return value if long enough.
594 (if (>= cmpl-symbol-end
595 (+ cmpl-symbol-start completion-min-length))
596 (buffer-substring-no-properties
597 cmpl-symbol-start cmpl-symbol-end)))
598 ((= cmpl-preceding-syntax ?w)
599 ;; chars to ignore at end
600 (let ((saved-point (point)))
601 (setq cmpl-symbol-start (scan-sexps saved-point -1))
602 ;; take off chars. from end
604 (setq cmpl-symbol-end (point))
605 ;; remove chars to ignore at the start
606 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
607 (goto-char cmpl-symbol-start)
609 (setq cmpl-symbol-start (point))))
611 (goto-char saved-point)
612 ;; Return completion if the length is reasonable
613 (if (and (<= completion-min-length
614 (- cmpl-symbol-end cmpl-symbol-start))
615 (<= (- cmpl-symbol-end cmpl-symbol-start)
616 completion-max-length))
617 (buffer-substring-no-properties
618 cmpl-symbol-start cmpl-symbol-end)))))))
620 ;; tests for symbol-before-point
621 ;; `^' indicates cursor pos. where value is returned
626 ;; ^ --> simple-word-test
627 ;; _harder_word_test_
628 ;; ^ --> harder_word_test
629 ;; ^ --> harder_word_test
634 (defun symbol-under-or-before-point ()
635 ;; This could be made slightly faster but it is better to avoid
636 ;; copying all the code.
637 ;; However, it is only used by the completion string prompter.
638 ;; If it comes into common use, it could be rewritten.
639 (if (memq (with-syntax-table completion-syntax-table
640 (char-syntax (following-char)))
643 (symbol-before-point)))
646 (defun symbol-before-point-for-complete ()
647 ;; "Returns a string of the symbol immediately before point
648 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the
650 ;; Cursor is on following-char and after preceding-char
651 (with-syntax-table completion-syntax-table
652 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
654 (setq cmpl-symbol-end (point)
655 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
656 ;; Remove chars to ignore at the start.
657 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
658 (goto-char cmpl-symbol-start)
660 (setq cmpl-symbol-start (point))
661 (goto-char cmpl-symbol-end)))
662 ;; Return completion if the length is reasonable.
663 (if (and (<= completion-prefix-min-length
664 (- cmpl-symbol-end cmpl-symbol-start))
665 (<= (- cmpl-symbol-end cmpl-symbol-start)
666 completion-max-length))
667 (buffer-substring-no-properties
668 cmpl-symbol-start cmpl-symbol-end))))))
670 ;; tests for symbol-before-point-for-complete
671 ;; `^' indicates cursor pos. where value is returned
676 ;; ^ --> simple-word-test
677 ;; _harder_word_test_
678 ;; ^ --> harder_word_test
679 ;; ^ --> harder_word_test_
686 ;;---------------------------------------------------------------------------
687 ;; Statistics Recording
688 ;;---------------------------------------------------------------------------
690 ;; Note that the guts of this has been turned off. The guts
691 ;; are in completion-stats.el.
693 ;;-----------------------------------------------
694 ;; Conditionalizing code on *record-cmpl-statistics-p*
695 ;;-----------------------------------------------
696 ;; All statistics code outside this block should use this
697 (defmacro cmpl-statistics-block (&rest body))
698 ;; "Only executes body if we are recording statistics."
700 ;; (list* '*record-cmpl-statistics-p* body)
703 ;;-----------------------------------------------
704 ;; Completion Sources
705 ;;-----------------------------------------------
708 (defconst cmpl-source-unknown 0)
709 (defconst cmpl-source-init-file 1)
710 (defconst cmpl-source-file-parsing 2)
711 (defconst cmpl-source-separator 3)
712 (defconst cmpl-source-cursor-moves 4)
713 (defconst cmpl-source-interactive 5)
714 (defconst cmpl-source-cdabbrev 6)
715 (defconst num-cmpl-sources 7)
716 (defvar current-completion-source cmpl-source-unknown)
720 ;;---------------------------------------------------------------------------
721 ;; Completion Method #2: dabbrev-expand style
722 ;;---------------------------------------------------------------------------
724 ;; This method is used if there are no useful stored completions. It is
725 ;; based on dabbrev-expand with these differences :
726 ;; 1) Faster (we don't use regexps)
727 ;; 2) case coercion handled correctly
728 ;; This is called cdabbrev to differentiate it.
729 ;; We simply search backwards through the file looking for words which
730 ;; start with the same letters we are trying to complete.
733 (defvar cdabbrev-completions-tried nil)
734 ;; "A list of all the cdabbrev completions since the last reset.")
736 (defvar cdabbrev-current-point 0)
737 ;; "The current point position the cdabbrev search is at.")
739 (defvar cdabbrev-current-window nil)
740 ;; "The current window we are looking for cdabbrevs in.
741 ;; Return t if looking in (other-buffer), nil if no more cdabbrevs.")
743 (defvar cdabbrev-wrapped-p nil)
744 ;; "Return t if the cdabbrev search has wrapped around the file.")
746 (defvar cdabbrev-abbrev-string "")
747 (defvar cdabbrev-start-point 0)
748 (defvar cdabbrev-stop-point)
750 ;; Test strings for cdabbrev
751 ;; cdat-upcase ;;same namestring
755 ;; a-cdat-1 ;;doesn't start correctly
759 (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried)
760 "Reset the cdabbrev search to search for ABBREV-STRING.
761 INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore
763 (setq cdabbrev-abbrev-string abbrev-string
764 cdabbrev-completions-tried
765 (cons (downcase abbrev-string) initial-completions-tried))
766 (reset-cdabbrev-window t))
768 (defun set-cdabbrev-buffer ()
769 ;; cdabbrev-current-window must not be nil
770 (set-buffer (if (eq cdabbrev-current-window t)
772 (window-buffer cdabbrev-current-window))))
775 (defun reset-cdabbrev-window (&optional initializep)
776 "Reset the cdabbrev search to search for abbrev-string."
779 (setq cdabbrev-current-window (selected-window)))
780 ((eq cdabbrev-current-window t)
781 ;; Everything has failed
782 (setq cdabbrev-current-window nil))
783 (cdabbrev-current-window
784 (setq cdabbrev-current-window (next-window cdabbrev-current-window))
785 (if (eq cdabbrev-current-window (selected-window))
786 ;; No more windows, try other buffer.
787 (setq cdabbrev-current-window t))))
788 (if cdabbrev-current-window
790 (set-cdabbrev-buffer)
791 (setq cdabbrev-current-point (point)
792 cdabbrev-start-point cdabbrev-current-point
794 (if completion-search-distance
796 (- cdabbrev-start-point completion-search-distance))
798 cdabbrev-wrapped-p nil))))
800 (defun next-cdabbrev ()
801 "Return the next possible cdabbrev expansion or nil if there isn't one.
802 `reset-cdabbrev' must've been called already.
803 This is sensitive to `case-fold-search'."
804 ;; note that case-fold-search affects the behavior of this function
805 ;; Bug: won't pick up an expansion that starts at the top of buffer
806 (if cdabbrev-current-window
810 downcase-expansion tried-list syntax saved-point-2)
814 ;; Switch to current completion buffer
815 (set-cdabbrev-buffer)
816 ;; Save current buffer state
817 (setq saved-point (point)
818 saved-syntax (syntax-table))
819 ;; Restore completion state
820 (set-syntax-table completion-syntax-table)
821 (goto-char cdabbrev-current-point)
822 ;; Loop looking for completions
824 ;; This code returns t if it should loop again
826 (;; search for the string
827 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t)
828 ;; return nil if the completion is valid
831 ;; does it start with a separator char ?
832 (or (= (setq syntax (char-syntax (preceding-char))) ? )
834 ;; symbol char to ignore at end. Are we at end ?
836 (setq saved-point-2 (point))
839 (= (char-syntax (preceding-char)) ? )
840 (goto-char saved-point-2)))))
841 ;; is the symbol long enough ?
842 (setq expansion (symbol-under-point))
843 ;; have we not tried this one before
845 ;; See if we've already used it
846 (setq tried-list cdabbrev-completions-tried
847 downcase-expansion (downcase expansion))
848 (while (and tried-list
849 (not (string-equal downcase-expansion
851 ;; Already tried, don't choose this one
852 (setq tried-list (cdr tried-list)))
853 ;; at this point tried-list will be nil if this
854 ;; expansion has not yet been tried
860 ;; If already wrapped, then we've failed completely
864 (goto-char (setq cdabbrev-current-point
865 (if completion-search-distance
866 (min (point-max) (+ cdabbrev-start-point completion-search-distance))
869 (setq cdabbrev-wrapped-p t))))
873 (setq cdabbrev-completions-tried
874 (cons downcase-expansion cdabbrev-completions-tried)
875 cdabbrev-current-point (point)))))
876 (set-syntax-table saved-syntax)
877 (goto-char saved-point)))
878 ;; If no expansion, go to next window
880 (t (reset-cdabbrev-window)
883 ;; The following must be eval'd in the minibuffer ::
884 ;; (reset-cdabbrev "cdat")
885 ;; (next-cdabbrev) --> "cdat-simple"
886 ;; (next-cdabbrev) --> "cdat-1-2-3-4"
887 ;; (next-cdabbrev) --> "CDAT-UPCASE"
888 ;; (next-cdabbrev) --> "cdat-wrapping"
889 ;; (next-cdabbrev) --> "cdat_start_sym"
890 ;; (next-cdabbrev) --> nil
891 ;; (next-cdabbrev) --> nil
892 ;; (next-cdabbrev) --> nil
898 ;;---------------------------------------------------------------------------
899 ;; Completion Database
900 ;;---------------------------------------------------------------------------
902 ;; We use two storage modes for the two search types ::
903 ;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions
904 ;; Used by search-completion-next
905 ;; the value of the symbol is nil or a cons of head and tail pointers
906 ;; 2) Interning {cmpl-obarray} to see if it's in the database
907 ;; Used by find-exact-completion, completion-in-database-p
908 ;; The value of the symbol is the completion entry
910 ;; bad things may happen if this length is changed due to the way
911 ;; GNU implements obarrays
912 (defconst cmpl-obarray-length 511)
914 (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
915 "An obarray used to store the downcased completion prefixes.
916 Each symbol is bound to a list of completion entries.")
918 (defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
919 "An obarray used to store the downcased completions.
920 Each symbol is bound to a single completion entry.")
922 ;;-----------------------------------------------
923 ;; Completion Entry Structure Definition
924 ;;-----------------------------------------------
926 ;; A completion entry is a LIST of string, prefix-symbol num-uses, and
927 ;; last-use-time (the time the completion was last used)
928 ;; last-use-time is t if the string should be kept permanently
929 ;; num-uses is incremented every time the completion is used.
931 ;; We chose lists because (car foo) is faster than (aref foo 0) and the
932 ;; creation time is about the same.
936 (defmacro completion-string (completion-entry)
937 (list 'car completion-entry))
939 (defmacro completion-num-uses (completion-entry)
940 ;; "The number of times it has used. Used to decide whether to save
942 (list 'car (list 'cdr completion-entry)))
944 (defmacro completion-last-use-time (completion-entry)
945 ;; "The time it was last used. In hours since origin. Used to decide
946 ;; whether to save it. t if one should always save it."
947 (list 'nth 2 completion-entry))
949 (defmacro completion-source (completion-entry)
950 (list 'nth 3 completion-entry))
953 (defmacro set-completion-string (completion-entry string)
954 (list 'setcar completion-entry string))
956 (defmacro set-completion-num-uses (completion-entry num-uses)
957 (list 'setcar (list 'cdr completion-entry) num-uses))
959 (defmacro set-completion-last-use-time (completion-entry last-use-time)
960 (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time))
963 (defun make-completion (string)
964 "Return a completion entry."
965 (list string 0 nil current-completion-source))
968 ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
969 ;; (list 'car (list 'cdr completion-entry)))
973 ;;-----------------------------------------------
974 ;; Prefix symbol entry definition
975 ;;-----------------------------------------------
976 ;; A cons of (head . tail)
980 (defalias 'cmpl-prefix-entry-head 'car)
982 (defalias 'cmpl-prefix-entry-tail 'cdr)
986 (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head)
987 (list 'setcar prefix-entry new-head))
989 (defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
990 (list 'setcdr prefix-entry new-tail))
994 (defun make-cmpl-prefix-entry (completion-entry-list)
995 "Make a new prefix entry containing only completion-entry."
996 (cons completion-entry-list completion-entry-list))
998 ;;-----------------------------------------------
999 ;; Completion Database - Utilities
1000 ;;-----------------------------------------------
1002 (defun clear-all-completions ()
1003 "Initialize the completion storage. All existing completions are lost."
1005 (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
1006 (setq cmpl-obarray (make-vector cmpl-obarray-length 0))
1007 (cmpl-statistics-block
1008 (record-clear-all-completions)))
1010 (defvar completions-list-return-value)
1012 (defun list-all-completions ()
1013 "Return a list of all the known completion entries."
1014 (let ((completions-list-return-value nil))
1015 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
1016 completions-list-return-value))
1018 (defun list-all-completions-1 (prefix-symbol)
1019 (if (boundp prefix-symbol)
1020 (setq completions-list-return-value
1021 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
1022 completions-list-return-value))))
1024 (defun list-all-completions-by-hash-bucket ()
1025 "Return list of lists of known completion entries, organized by hash bucket."
1026 (let ((completions-list-return-value nil))
1027 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
1028 completions-list-return-value))
1030 (defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
1031 (if (boundp prefix-symbol)
1032 (setq completions-list-return-value
1033 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
1034 completions-list-return-value))))
1037 ;;-----------------------------------------------
1038 ;; Updating the database
1039 ;;-----------------------------------------------
1041 ;; These are the internal functions used to update the datebase
1044 (defvar completion-to-accept nil
1045 "Set to a string that is pending its acceptance.")
1046 ;; this checked by the top level reading functions
1048 (defvar cmpl-db-downcase-string nil
1049 "Setup by `find-exact-completion', etc. The given string, downcased.")
1050 (defvar cmpl-db-symbol nil
1051 "The interned symbol corresponding to `cmpl-db-downcase-string'.
1052 Set up by `cmpl-db-symbol'.")
1053 (defvar cmpl-db-prefix-symbol nil
1054 "The interned prefix symbol corresponding to `cmpl-db-downcase-string'.")
1055 (defvar cmpl-db-entry nil)
1056 (defvar cmpl-db-debug-p nil
1057 "Set to t if you want to debug the database.")
1060 (defun find-exact-completion (string)
1061 "Return the completion entry for STRING or nil.
1062 Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'."
1063 (and (boundp (setq cmpl-db-symbol
1064 (intern (setq cmpl-db-downcase-string (downcase string))
1066 (symbol-value cmpl-db-symbol)))
1068 (defun find-cmpl-prefix-entry (prefix-string)
1069 "Return the prefix entry for string.
1070 Sets `cmpl-db-prefix-symbol'.
1071 Prefix-string must be exactly `completion-prefix-min-length' long
1072 and downcased. Sets up `cmpl-db-prefix-symbol'."
1073 (and (boundp (setq cmpl-db-prefix-symbol
1074 (intern prefix-string cmpl-prefix-obarray)))
1075 (symbol-value cmpl-db-prefix-symbol)))
1077 (defvar inside-locate-completion-entry nil)
1078 ;; used to trap lossage in silent error correction
1080 (defun locate-completion-entry (completion-entry prefix-entry)
1081 "Locate the completion entry.
1082 Returns a pointer to the element before the completion entry or nil if
1083 the completion entry is at the head.
1084 Must be called after `find-exact-completion'."
1085 (let ((prefix-list (cmpl-prefix-entry-head prefix-entry))
1088 ((not (eq (car prefix-list) completion-entry))
1089 ;; not already at head
1090 (while (and prefix-list
1091 (not (eq completion-entry
1092 (car (setq next-prefix-list (cdr prefix-list))))))
1093 (setq prefix-list next-prefix-list))
1096 ;; Didn't find it. Database is messed up.
1098 ;; not found, error if debug mode
1099 (error "Completion entry exists but not on prefix list - %s"
1101 (inside-locate-completion-entry
1102 ;; recursive error: really scrod
1103 (locate-completion-db-error))
1106 (set cmpl-db-symbol nil)
1108 (locate-completion-entry-retry completion-entry)))))))
1110 (defun locate-completion-entry-retry (old-entry)
1111 (let ((inside-locate-completion-entry t))
1112 (add-completion (completion-string old-entry)
1113 (completion-num-uses old-entry)
1114 (completion-last-use-time old-entry))
1115 (let* ((cmpl-entry (find-exact-completion (completion-string old-entry)))
1118 (find-cmpl-prefix-entry
1119 (substring cmpl-db-downcase-string
1120 0 completion-prefix-min-length)))))
1121 (if (and cmpl-entry pref-entry)
1123 (locate-completion-entry cmpl-entry pref-entry)
1125 (locate-completion-db-error)))))
1127 (defun locate-completion-db-error ()
1128 ;; recursive error: really scrod
1129 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report"))
1132 (defun add-completion-to-tail-if-new (string)
1133 "If STRING is not in the database add it to appropriate prefix list.
1134 STRING is added to the end of the appropriate prefix list with
1135 num-uses = 0. The database is unchanged if it is there. STRING must be
1136 longer than `completion-prefix-min-length'.
1137 This must be very fast.
1138 Returns the completion entry."
1139 (or (find-exact-completion string)
1141 (let (;; create an entry
1142 (entry (list (make-completion string)))
1144 (prefix-entry (find-cmpl-prefix-entry
1145 (substring cmpl-db-downcase-string 0
1146 completion-prefix-min-length))))
1147 ;; The next two forms should happen as a unit (atomically) but
1148 ;; no fatal errors should result if that is not the case.
1150 ;; These two should be atomic, but nothing fatal will happen
1152 (setcdr (cmpl-prefix-entry-tail prefix-entry) entry)
1153 (set-cmpl-prefix-entry-tail prefix-entry entry))
1155 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
1157 (cmpl-statistics-block
1158 (note-added-completion))
1160 (set cmpl-db-symbol (car entry)))))
1162 (defun add-completion-to-head (completion-string)
1163 "If COMPLETION-STRING is not in the database, add it to prefix list.
1164 We add COMPLETION-STRING to the head of the appropriate prefix list,
1165 or to the head of the list.
1166 COMPLETION-STRING must be longer than `completion-prefix-min-length'.
1167 Updates the saved string with the supplied string.
1168 This must be very fast.
1169 Returns the completion entry."
1170 ;; Handle pending acceptance
1171 (if completion-to-accept (accept-completion))
1172 ;; test if already in database
1173 (if (setq cmpl-db-entry (find-exact-completion completion-string))
1175 (let* ((prefix-entry (find-cmpl-prefix-entry
1176 (substring cmpl-db-downcase-string 0
1177 completion-prefix-min-length)))
1178 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
1179 (cmpl-ptr (cdr splice-ptr)))
1181 (set-completion-string cmpl-db-entry completion-string)
1182 ;; move to head (if necessary)
1184 ;; These should all execute atomically but it is not fatal if
1187 (or (setcdr splice-ptr (cdr cmpl-ptr))
1188 ;; fix up tail if necessary
1189 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
1190 ;; splice in at head
1191 (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
1192 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)))
1195 (let (;; create an entry
1196 (entry (list (make-completion completion-string)))
1198 (prefix-entry (find-cmpl-prefix-entry
1199 (substring cmpl-db-downcase-string 0
1200 completion-prefix-min-length))))
1202 ;; Splice in at head
1203 (setcdr entry (cmpl-prefix-entry-head prefix-entry))
1204 (set-cmpl-prefix-entry-head prefix-entry entry))
1206 ;; Start new prefix entry
1207 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
1209 (cmpl-statistics-block
1210 (note-added-completion))
1211 ;; Add it to the symbol
1212 (set cmpl-db-symbol (car entry)))))
1214 (defun delete-completion (completion-string)
1215 "Delete the completion from the database.
1216 String must be longer than `completion-prefix-min-length'."
1217 ;; Handle pending acceptance
1218 (if completion-to-accept (accept-completion))
1219 (if (setq cmpl-db-entry (find-exact-completion completion-string))
1221 (let* ((prefix-entry (find-cmpl-prefix-entry
1222 (substring cmpl-db-downcase-string 0
1223 completion-prefix-min-length)))
1224 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)))
1225 ;; delete symbol reference
1226 (set cmpl-db-symbol nil)
1227 ;; remove from prefix list
1230 (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
1231 ;; fix up tail if necessary
1232 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)))
1235 (or (set-cmpl-prefix-entry-head
1236 prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
1237 ;; List is now empty
1238 (set cmpl-db-prefix-symbol nil))))
1239 (cmpl-statistics-block
1240 (note-completion-deleted)))
1241 (error "Unknown completion `%s'" completion-string)))
1245 ;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1246 ;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
1247 ;; (find-exact-completion "bana") --> nil
1248 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1249 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1250 ;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
1251 ;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
1252 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1253 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1254 ;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1255 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1256 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1259 ;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1260 ;; (delete-completion "banner")
1261 ;; (find-exact-completion "banner") --> nil
1262 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1263 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1264 ;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1265 ;; (delete-completion "banana")
1266 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
1267 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1268 ;; (delete-completion "banner")
1269 ;; (delete-completion "banish")
1270 ;; (find-cmpl-prefix-entry "ban") --> nil
1271 ;; (delete-completion "banner") --> error
1274 ;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
1275 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1276 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1277 ;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
1278 ;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
1279 ;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
1283 ;;---------------------------------------------------------------------------
1284 ;; Database Update :: Interface level routines
1285 ;;---------------------------------------------------------------------------
1287 ;; These lie on top of the database ref. functions but below the standard
1288 ;; user interface level
1291 (defun interactive-completion-string-reader (prompt)
1292 (let* ((default (symbol-under-or-before-point))
1295 (format "%s (default %s): " prompt default)
1296 (format "%s: " prompt)))
1297 (read (completing-read new-prompt cmpl-obarray)))
1298 (if (zerop (length read)) (setq read (or default "")))
1301 (defun check-completion-length (string)
1302 (if (< (length string) completion-min-length)
1303 (error "The string `%s' is too short to be saved as a completion"
1307 (defun add-completion (string &optional num-uses last-use-time)
1308 "Add STRING to completion list, or move it to head of list.
1309 The completion is altered appropriately if NUM-USES and/or LAST-USE-TIME
1311 (interactive (interactive-completion-string-reader "Completion to add"))
1312 (check-completion-length string)
1313 (let* ((current-completion-source (if (called-interactively-p 'interactive)
1314 cmpl-source-interactive
1315 current-completion-source))
1316 (entry (add-completion-to-head string)))
1318 (if num-uses (set-completion-num-uses entry num-uses))
1320 (set-completion-last-use-time entry last-use-time))))
1322 (defun add-permanent-completion (string)
1323 "Add STRING if it isn't already listed, and mark it permanent."
1325 (interactive-completion-string-reader "Completion to add permanently"))
1326 (let ((current-completion-source (if (called-interactively-p 'interactive)
1327 cmpl-source-interactive
1328 current-completion-source)))
1329 (add-completion string nil t)))
1331 (defun kill-completion (string)
1332 (interactive (interactive-completion-string-reader "Completion to kill"))
1333 (check-completion-length string)
1334 (delete-completion string))
1336 (defun accept-completion ()
1337 "Accepts the pending completion in `completion-to-accept'.
1338 This bumps num-uses. Called by `add-completion-to-head' and
1339 `completion-search-reset'."
1340 (let ((string completion-to-accept)
1341 ;; if this is added afresh here, then it must be a cdabbrev
1342 (current-completion-source cmpl-source-cdabbrev)
1344 (setq completion-to-accept nil)
1345 (setq entry (add-completion-to-head string))
1346 (set-completion-num-uses entry (1+ (completion-num-uses entry)))
1347 (setq cmpl-completions-accepted-p t)))
1349 (defun use-completion-under-point ()
1350 "Add the completion symbol underneath the point into the completion buffer."
1351 (let ((string (and enable-completion (symbol-under-point)))
1352 (current-completion-source cmpl-source-cursor-moves))
1353 (if string (add-completion-to-head string))))
1355 (defun use-completion-before-point ()
1356 "Add the completion symbol before point into the completion buffer."
1357 (let ((string (and enable-completion (symbol-before-point)))
1358 (current-completion-source cmpl-source-cursor-moves))
1359 (if string (add-completion-to-head string))))
1361 (defun use-completion-under-or-before-point ()
1362 "Add the completion symbol before point into the completion buffer."
1363 (let ((string (and enable-completion (symbol-under-or-before-point)))
1364 (current-completion-source cmpl-source-cursor-moves))
1365 (if string (add-completion-to-head string))))
1367 (defun use-completion-before-separator ()
1368 "Add the completion symbol before point into the completion buffer.
1369 Completions added this way will automatically be saved if
1370 `completion-on-separator-character' is non-nil."
1371 (let ((string (and enable-completion (symbol-before-point)))
1372 (current-completion-source cmpl-source-separator)
1374 (cmpl-statistics-block
1375 (note-separator-character string))
1377 (setq entry (add-completion-to-head string))
1378 (if (and completion-on-separator-character
1379 (zerop (completion-num-uses entry)))
1381 (set-completion-num-uses entry 1)
1382 (setq cmpl-completions-accepted-p t)))))))
1386 ;; (add-completion "banana" 5 10)
1387 ;; (find-exact-completion "banana") --> ("banana" 5 10 0)
1388 ;; (add-completion "banana" 6)
1389 ;; (find-exact-completion "banana") --> ("banana" 6 10 0)
1390 ;; (add-completion "banish")
1391 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1394 ;; (setq completion-to-accept "banana")
1395 ;; (accept-completion)
1396 ;; (find-exact-completion "banana") --> ("banana" 7 10)
1397 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1398 ;; (setq completion-to-accept "banish")
1399 ;; (add-completion "banner")
1400 ;; (car (find-cmpl-prefix-entry "ban"))
1401 ;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
1404 ;; (kill-completion "banish")
1405 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
1408 ;;---------------------------------------------------------------------------
1409 ;; Searching the database
1410 ;;---------------------------------------------------------------------------
1411 ;; Functions outside this block must call completion-search-reset followed
1412 ;; by calls to completion-search-next or completion-search-peek
1416 ;; Commented out to improve loading speed
1417 (defvar cmpl-test-string "")
1418 ;; "The current string used by completion-search-next."
1419 (defvar cmpl-test-regexp "")
1420 ;; "The current regexp used by completion-search-next.
1421 ;; (derived from cmpl-test-string)"
1422 (defvar cmpl-last-index 0)
1423 ;; "The last index that completion-search-next was called with."
1424 (defvar cmpl-cdabbrev-reset-p nil)
1425 ;; "Set to t when cdabbrevs have been reset."
1426 (defvar cmpl-next-possibilities nil)
1427 ;; "A pointer to the element BEFORE the next set of possible completions.
1428 ;; cadr of this is the cmpl-next-possibility"
1429 (defvar cmpl-starting-possibilities nil)
1430 ;; "The initial list of starting possibilities."
1431 (defvar cmpl-next-possibility nil)
1432 ;; "The cached next possibility."
1433 (defvar cmpl-tried-list nil)
1434 ;; "A downcased list of all the completions we have tried."
1437 (defun completion-search-reset (string)
1438 "Set up the for completion searching for STRING.
1439 STRING must be longer than `completion-prefix-min-length'."
1440 (if completion-to-accept (accept-completion))
1441 (setq cmpl-starting-possibilities
1442 (cmpl-prefix-entry-head
1443 (find-cmpl-prefix-entry
1444 (downcase (substring string 0 completion-prefix-min-length))))
1445 cmpl-test-string string
1446 cmpl-test-regexp (concat (regexp-quote string) "."))
1447 (completion-search-reset-1))
1449 (defun completion-search-reset-1 ()
1450 (setq cmpl-next-possibilities cmpl-starting-possibilities
1451 cmpl-next-possibility nil
1452 cmpl-cdabbrev-reset-p nil
1454 cmpl-tried-list nil))
1456 (defun completion-search-next (index)
1457 "Return the next completion entry.
1458 If INDEX is out of sequence, reset and start from the top.
1459 If there are no more entries, try cdabbrev and return only a string."
1461 ((= index (setq cmpl-last-index (1+ cmpl-last-index)))
1462 (completion-search-peek t))
1464 (completion-search-reset-1)
1465 (setq cmpl-last-index index)
1466 ;; reverse the possibilities list
1467 (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
1468 ;; do a "normal" search
1469 (while (and (completion-search-peek nil)
1470 (< (setq index (1+ index)) 0))
1471 (setq cmpl-next-possibility nil))
1472 (cond ((not cmpl-next-possibilities))
1473 ;; If no more possibilities, leave it that way
1474 ((= -1 cmpl-last-index)
1475 ;; next completion is at index 0. reset next-possibility list
1476 ;; to start at beginning
1477 (setq cmpl-next-possibilities cmpl-starting-possibilities))
1479 ;; otherwise point to one before current
1480 (setq cmpl-next-possibilities
1481 (nthcdr (- (length cmpl-starting-possibilities)
1482 (length cmpl-next-possibilities))
1483 cmpl-starting-possibilities)))))
1485 ;; non-negative index, reset and search
1487 (completion-search-reset-1)
1488 (setq cmpl-last-index index)
1489 (while (and (completion-search-peek t)
1490 (not (< (setq index (1- index)) 0)))
1491 (setq cmpl-next-possibility nil))))
1493 cmpl-next-possibility
1494 (setq cmpl-next-possibility nil)))
1497 (defun completion-search-peek (use-cdabbrev)
1498 "Return the next completion entry without actually moving the pointers.
1499 Calling this again or calling `completion-search-next' results in the same
1500 string being returned. Depends on `case-fold-search'.
1501 If there are no more entries, try cdabbrev and then return only a string."
1503 ;; return the cached value if we have it
1504 (cmpl-next-possibility)
1505 ((and cmpl-next-possibilities
1506 ;; still a few possibilities left
1509 (and (not (eq 0 (string-match cmpl-test-regexp
1510 (completion-string (car cmpl-next-possibilities)))))
1511 (setq cmpl-next-possibilities (cdr cmpl-next-possibilities))))
1512 cmpl-next-possibilities))
1514 (setq cmpl-next-possibility (car cmpl-next-possibilities)
1515 cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility))
1517 cmpl-next-possibilities (cdr cmpl-next-possibilities))
1518 cmpl-next-possibility)
1520 ;; unsuccessful, use cdabbrev
1521 (cond ((not cmpl-cdabbrev-reset-p)
1522 (reset-cdabbrev cmpl-test-string cmpl-tried-list)
1523 (setq cmpl-cdabbrev-reset-p t)))
1524 (setq cmpl-next-possibility (next-cdabbrev)))
1525 ;; Completely unsuccessful, return nil
1530 ;; (add-completion "banana")
1531 ;; (completion-search-reset "ban")
1532 ;; (completion-search-next 0) --> "banana"
1534 ;; - Discrimination -
1535 ;; (add-completion "cumberland")
1536 ;; (add-completion "cumberbund")
1538 ;; (completion-search-reset "cumb")
1539 ;; (completion-search-peek t) --> "cumberbund"
1540 ;; (completion-search-next 0) --> "cumberbund"
1541 ;; (completion-search-peek t) --> "cumberland"
1542 ;; (completion-search-next 1) --> "cumberland"
1543 ;; (completion-search-peek nil) --> nil
1544 ;; (completion-search-next 2) --> "cumbering" {cdabbrev}
1545 ;; (completion-search-next 3) --> nil or "cumming"{depends on context}
1546 ;; (completion-search-next 1) --> "cumberland"
1547 ;; (completion-search-peek t) --> "cumbering" {cdabbrev}
1550 ;; (completion-search-next 1) --> "cumberland"
1551 ;; (setq completion-to-accept "cumberland")
1552 ;; (completion-search-reset "foo")
1553 ;; (completion-search-reset "cum")
1554 ;; (completion-search-next 0) --> "cumberland"
1557 ;; (kill-completion "cumberland")
1559 ;; (completion-search-reset "cum")
1560 ;; (completion-search-next 0) --> "cumberbund"
1561 ;; (completion-search-next 1) --> "cummings"
1563 ;; - Ignoring Capitalization -
1564 ;; (completion-search-reset "CuMb")
1565 ;; (completion-search-next 0) --> "cumberbund"
1569 ;;-----------------------------------------------
1571 ;;-----------------------------------------------
1573 (defun completion-mode ()
1574 "Toggle whether or not to add new words to the completion database."
1576 (setq enable-completion (not enable-completion))
1577 (message "Completion mode is now %s." (if enable-completion "ON" "OFF")))
1579 (defvar cmpl-current-index 0)
1580 (defvar cmpl-original-string nil)
1581 (defvar cmpl-last-insert-location -1)
1582 (defvar cmpl-leave-point-at-start nil)
1584 (defun complete (&optional arg)
1585 "Fill out a completion of the word before point.
1586 Point is left at end. Consecutive calls rotate through all possibilities.
1588 control-u :: leave the point at the beginning of the completion rather
1590 a number :: rotate through the possible completions by that amount
1591 `-' :: same as -1 (insert previous completion)
1592 {See the comments at the top of `completion.el' for more info.}"
1594 ;;; Set up variables
1595 (cond ((eq last-command this-command)
1597 (delete-region cmpl-last-insert-location (point))
1598 ;; get next completion
1599 (setq cmpl-current-index (+ cmpl-current-index (or arg 1))))
1601 (if (not cmpl-initialized-p)
1602 (completion-initialize)) ;; make sure everything's loaded
1603 (cond ((consp current-prefix-arg) ;; control-u
1605 (setq cmpl-leave-point-at-start t))
1607 (setq cmpl-leave-point-at-start nil)))
1609 (setq cmpl-original-string (symbol-before-point-for-complete))
1610 (cond ((not cmpl-original-string)
1611 (setq this-command 'failed-complete)
1612 (error "To complete, point must be after a symbol at least %d character long"
1613 completion-prefix-min-length)))
1615 (setq cmpl-current-index (if current-prefix-arg arg 0))
1617 (cmpl-statistics-block
1618 (note-complete-entered-afresh cmpl-original-string))
1620 (completion-search-reset cmpl-original-string)
1621 ;; erase what we've got
1622 (delete-region cmpl-symbol-start cmpl-symbol-end)))
1624 ;; point is at the point to insert the new symbol
1625 ;; Get the next completion
1626 (let* ((print-status-p
1627 (and (>= baud-rate completion-prompt-speed-threshold)
1628 (not (window-minibuffer-p (selected-window)))))
1629 (insert-point (point))
1630 (entry (completion-search-next cmpl-current-index))
1632 ;; entry is either a completion entry or a string (if cdabbrev)
1636 ;; Setup for proper case
1637 (setq string (if (stringp entry)
1638 entry (completion-string entry)))
1639 (setq string (cmpl-merge-string-cases
1640 string cmpl-original-string))
1644 (setq completion-to-accept string)
1645 ;; fixup and cache point
1646 (cond (cmpl-leave-point-at-start
1647 (setq cmpl-last-insert-location (point))
1648 (goto-char insert-point))
1650 (setq cmpl-last-insert-location insert-point)))
1652 (cmpl-statistics-block
1653 (note-complete-inserted entry cmpl-current-index))
1654 ;; Done ! cmpl-stat-complete-successful
1655 ;;display the next completion
1657 ((and print-status-p
1658 ;; This updates the display and only prints if there
1662 (completion-search-peek
1663 completion-cdabbrev-prompt-flag)))
1664 (setq string (if (stringp entry)
1665 entry (completion-string entry)))
1666 (setq string (cmpl-merge-string-cases
1667 string cmpl-original-string))
1668 (message "Next completion: %s" string))))
1669 (t;; none found, insert old
1670 (insert cmpl-original-string)
1671 ;; Don't accept completions
1672 (setq completion-to-accept nil)
1674 ;; This used to call cmpl19-sit-for, an undefined function.
1675 ;; I hope that sit-for does the right thing; I don't know -- rms.
1676 (if (and print-status-p (sit-for 0))
1677 (message "No %scompletions."
1678 (if (eq this-command last-command) "more " "")))
1680 (cmpl-statistics-block
1681 (record-complete-failed cmpl-current-index))
1682 ;; Pretend that we were never here
1683 (setq this-command 'failed-complete)))))
1685 ;;---------------------------------------------------------------------------
1686 ;; Parsing definitions from files into the database
1687 ;;---------------------------------------------------------------------------
1689 ;;-----------------------------------------------
1690 ;; Top Level functions ::
1691 ;;-----------------------------------------------
1694 (defun add-completions-from-file (file)
1695 "Parse possible completions from a FILE and add them to database."
1696 (interactive "fFile: ")
1697 (setq file (expand-file-name file))
1698 (let* ((buffer (get-file-buffer file))
1699 (buffer-already-there-p buffer))
1700 (if (not buffer-already-there-p)
1701 (let ((completions-merging-modes nil))
1702 (setq buffer (find-file-noselect file))))
1704 (with-current-buffer buffer
1705 (add-completions-from-buffer))
1706 (if (not buffer-already-there-p)
1707 (kill-buffer buffer)))))
1709 (defun add-completions-from-buffer ()
1711 (let ((current-completion-source cmpl-source-file-parsing)
1713 (cmpl-statistics-block
1714 (aref completion-add-count-vector cmpl-source-file-parsing)))
1716 (cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
1717 (add-completions-from-lisp-buffer)
1719 ((memq major-mode '(c-mode))
1720 (add-completions-from-c-buffer)
1723 (error "Cannot parse completions in %s buffers"
1725 (cmpl-statistics-block
1726 (record-cmpl-parse-file
1728 (- (aref completion-add-count-vector cmpl-source-file-parsing)
1732 (defun completion-find-file-hook ()
1733 (cond (enable-completion
1734 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
1735 (memq 'lisp completions-merging-modes))
1736 (add-completions-from-buffer))
1737 ((and (memq major-mode '(c-mode))
1738 (memq 'c completions-merging-modes))
1739 (add-completions-from-buffer))))))
1741 ;;-----------------------------------------------
1742 ;; Tags Table Completions
1743 ;;-----------------------------------------------
1745 (defun add-completions-from-tags-table ()
1746 ;; Inspired by eero@media-lab.media.mit.edu
1747 "Add completions from the current tags table."
1749 (visit-tags-table-buffer) ;this will prompt if no tags-table
1751 (goto-char (point-min))
1755 (search-forward "\177")
1757 (and (setq string (symbol-under-point))
1758 (add-completion-to-tail-if-new string))
1763 ;;-----------------------------------------------
1764 ;; Lisp File completion parsing
1765 ;;-----------------------------------------------
1766 ;; This merely looks for phrases beginning with (def.... or
1767 ;; (package:def ... and takes the next word.
1769 ;; We tried using forward-lines and explicit searches but the regexp technique
1770 ;; was faster. (About 100K characters per second)
1772 (defconst *lisp-def-regexp*
1773 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
1774 "A regexp that searches for Lisp definition form.")
1777 ;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
1778 ;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
1779 ;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
1780 ;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
1782 ;; Parses all the definition names from a Lisp mode buffer and adds them to
1783 ;; the completion database.
1784 (defun add-completions-from-lisp-buffer ()
1786 ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second
1789 (goto-char (point-min))
1792 (re-search-forward *lisp-def-regexp*)
1793 (and (setq string (symbol-under-point))
1794 (add-completion-to-tail-if-new string)))
1798 ;;-----------------------------------------------
1799 ;; C file completion parsing
1800 ;;-----------------------------------------------
1802 ;; Looks for #define or [<storage class>] [<type>] <name>{,<name>}
1803 ;; or structure, array or pointer defs.
1804 ;; It gets most of the definition names.
1806 ;; As you might suspect by now, we use some symbol table hackery
1808 ;; Symbol separator chars (have whitespace syntax) --> , ; * = (
1809 ;; Opening char --> [ {
1810 ;; Closing char --> ] }
1811 ;; opening and closing must be skipped over
1812 ;; Whitespace chars (have symbol syntax)
1813 ;; Everything else has word syntax
1815 (defconst completion-c-def-syntax-table
1816 (let ((table (make-syntax-table))
1817 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r))
1818 ;; unfortunately the ?( causes the parens to appear unbalanced
1819 (separator-chars '(?, ?* ?= ?\( ?\;))
1821 ;; default syntax is whitespace
1824 (modify-syntax-entry i "w" table)
1826 (dolist (char whitespace-chars)
1827 (modify-syntax-entry char "_" table))
1828 (dolist (char separator-chars)
1829 (modify-syntax-entry char " " table))
1830 (modify-syntax-entry ?\[ "(]" table)
1831 (modify-syntax-entry ?\{ "(}" table)
1832 (modify-syntax-entry ?\] ")[" table)
1833 (modify-syntax-entry ?\} "){" table)
1837 (defconst *c-def-regexp*
1838 ;; This stops on lines with possible definitions
1840 ;; This stops after the symbol to add.
1841 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
1842 ;; This stops before the symbol to add. {Test cases in parens. below}
1843 ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)"
1844 ;; this simple version picks up too much extraneous stuff
1845 ;; "\n\\(\\w\\|\\s_\\|#\\)\\B"
1846 "A regexp that searches for a definition form.")
1848 ;(defconst *c-cont-regexp*
1849 ; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)"
1850 ; "This regexp should be used in a looking-at to parse for lists of variables.")
1852 ;(defconst *c-struct-regexp*
1853 ; "\\(*\\|\\s \\)*\\b"
1854 ; "This regexp should be used to test whether a symbol follows a structure definition.")
1856 ;(defun test-c-def-regexp (regexp string)
1857 ; (and (eq 0 (string-match regexp string)) (match-end 0))
1861 ;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
1862 ;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
1863 ;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
1864 ;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
1865 ;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
1866 ;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
1867 ;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
1868 ;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
1869 ;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
1870 ;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
1871 ;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
1873 ;; Parses all the definition names from a C mode buffer and adds them to the
1874 ;; completion database.
1875 (defun add-completions-from-c-buffer ()
1877 ;; Sun 3/280-- 1250 lines/sec.
1879 (let (string next-point char)
1881 (goto-char (point-min))
1882 (catch 'finish-add-completions
1883 (with-syntax-table completion-c-def-syntax-table
1885 ;; we loop here only when scan-sexps fails
1886 ;; (i.e. unbalance exps.)
1889 (re-search-forward *c-def-regexp*)
1891 ((= (preceding-char) ?#)
1892 ;; preprocessor macro, see if it's one we handle
1893 (cond ((looking-at "\\(define\\|ifdef\\)\\>")
1894 ;; skip forward over definition symbol
1895 ;; and add it to database
1896 (and (forward-word 2)
1897 (setq string (symbol-before-point))
1899 (add-completion-to-tail-if-new string)))))
1902 (setq next-point (point))
1905 ;; scan to next separator char.
1906 (setq next-point (scan-sexps next-point 1)))
1907 ;; position the point on the word we want to add
1908 (goto-char next-point)
1909 (while (= (setq char (following-char)) ?*)
1910 ;; handle pointer ref
1911 ;; move to next separator char.
1913 (setq next-point (scan-sexps (point) 1))))
1916 (if (setq string (symbol-under-point))
1917 ;; (push string foo)
1918 (add-completion-to-tail-if-new string)
1919 ;; Local TMC hack (useful for parsing paris.h)
1920 (if (and (looking-at "_AP") ;; "ansi prototype"
1924 (symbol-under-point))))
1925 (add-completion-to-tail-if-new string)))
1927 (goto-char next-point)
1928 ;; (push (format "%c" (following-char)) foo)
1929 (if (= (char-syntax char) ?\()
1930 ;; if on an opening delimiter, go to end
1931 (while (= (char-syntax char) ?\()
1932 (setq next-point (scan-sexps next-point 1)
1933 char (char-after next-point)))
1935 ;; Current char is an end char.
1936 (setq next-point nil)))))))
1937 (search-failed ;;done
1938 (throw 'finish-add-completions t))
1940 ;; Check for failure in scan-sexps
1941 (if (member (nth 1 e)
1942 '("Containing expression ends prematurely"
1943 "Unbalanced parentheses"))
1944 ;; unbalanced paren., keep going
1947 (message "Error parsing C buffer for completions--please send bug report")
1948 (throw 'finish-add-completions t))))))))))
1951 ;;---------------------------------------------------------------------------
1953 ;;---------------------------------------------------------------------------
1955 ;; The version of save-completions-to-file called at kill-emacs time.
1956 (defun kill-emacs-save-completions ()
1957 (if (and save-completions-flag enable-completion cmpl-initialized-p)
1959 ((not cmpl-completions-accepted-p)
1960 (message "Completions database has not changed - not writing."))
1962 (save-completions-to-file))))
1963 (cmpl-statistics-block (record-cmpl-kill-emacs)))
1965 ;; There is no point bothering to change this again
1966 ;; unless the package changes so much that it matters
1967 ;; for people that have saved completions.
1968 (defconst completion-version "11")
1970 (defconst saved-cmpl-file-header
1971 ";;; Completion Initialization file.
1973 ;; Format is (<string> . <last-use-time>)
1974 ;; <string> is the completion
1975 ;; <last-use-time> is the time the completion was last used
1976 ;; If it is t, the completion will never be pruned from the file.
1977 ;; Otherwise it is in hours since origin.
1980 (defun completion-backup-filename (filename)
1981 (concat filename ".BAK"))
1983 (defun save-completions-to-file (&optional filename)
1984 "Save completions in init file FILENAME.
1985 If file name is not specified, use `save-completions-file-name'."
1987 (setq filename (expand-file-name (or filename save-completions-file-name)))
1988 (if (file-writable-p filename)
1990 (if (not cmpl-initialized-p)
1991 (completion-initialize)) ;; make sure everything's loaded
1992 (message "Saving completions to file %s" filename)
1994 (let* ((delete-old-versions t)
1995 (kept-old-versions 0)
1996 (kept-new-versions completions-file-versions-kept)
1998 (current-time (cmpl-hours-since-origin))
2002 (backup-filename (completion-backup-filename filename)))
2004 (with-current-buffer (get-buffer-create " *completion-save-buffer*")
2005 (setq buffer-file-name filename)
2007 (if (not (verify-visited-file-modtime (current-buffer)))
2009 ;; file has changed on disk. Bring us up-to-date
2010 (message "Completion file has changed. Merging. . .")
2011 (load-completions-from-file filename t)
2012 (message "Merging finished. Saving completions to file %s" filename)))
2014 ;; prepare the buffer to be modified
2015 (clear-visited-file-modtime)
2018 (insert (format saved-cmpl-file-header completion-version))
2019 (dolist (completion (list-all-completions))
2020 (setq total-in-db (1+ total-in-db))
2021 (setq last-use-time (completion-last-use-time completion))
2022 ;; Update num uses and maybe write completion to a file
2023 (cond ((or;; Write to file if
2025 (and (eq last-use-time t)
2026 (setq total-perm (1+ total-perm)))
2028 (if (> (completion-num-uses completion) 0)
2030 (setq last-use-time current-time)
2031 ;; or it was saved before and
2033 ;; save-completions-retention-time is nil
2034 (or (not save-completions-retention-time)
2035 ;; or time since last use is < ...retention-time*
2036 (< (- current-time last-use-time)
2037 save-completions-retention-time)))))
2039 (setq total-saved (1+ total-saved))
2040 (insert (prin1-to-string (cons (completion-string completion)
2041 last-use-time)) "\n"))))
2045 (let ((file-exists-p (file-exists-p filename)))
2048 ;; If file exists . . .
2049 ;; Save a backup(so GNU doesn't screw us when we're out of disk)
2050 ;; (GNU leaves a 0 length file if it gets a disk full error!)
2052 ;; If backup doesn't exit, Rename current to backup
2053 ;; {If backup exists the primary file is probably messed up}
2054 (or (file-exists-p backup-filename)
2055 (rename-file filename backup-filename))
2056 ;; Copy the backup back to the current name
2057 ;; (so versioning works)
2058 (copy-file backup-filename filename t)))
2062 ;; If successful, remove backup
2063 (delete-file backup-filename)))
2065 (set-buffer-modified-p nil)
2066 (message "Couldn't save completion file `%s'" filename)))
2067 ;; Reset accepted-p flag
2068 (setq cmpl-completions-accepted-p nil) )
2069 (cmpl-statistics-block
2070 (record-save-completions total-in-db total-perm total-saved))))))
2072 ;;(defun auto-save-completions ()
2073 ;; (if (and save-completions-flag enable-completion cmpl-initialized-p
2074 ;; *completion-auto-save-period*
2075 ;; (> cmpl-emacs-idle-time *completion-auto-save-period*)
2076 ;; cmpl-completions-accepted-p)
2077 ;; (save-completions-to-file)))
2079 ;;(add-hook 'cmpl-emacs-idle-time-hooks 'auto-save-completions)
2081 (defun load-completions-from-file (&optional filename no-message-p)
2082 "Load a completion init file FILENAME.
2083 If file is not specified, then use `save-completions-file-name'."
2085 (setq filename (expand-file-name (or filename save-completions-file-name)))
2086 (let* ((backup-filename (completion-backup-filename filename))
2087 (backup-readable-p (file-readable-p backup-filename)))
2088 (if backup-readable-p (setq filename backup-filename))
2089 (if (file-readable-p filename)
2091 (if (not no-message-p)
2092 (message "Loading completions from %sfile %s . . ."
2093 (if backup-readable-p "backup " "") filename))
2094 (with-current-buffer (get-buffer-create " *completion-save-buffer*")
2095 (setq buffer-file-name filename)
2096 ;; prepare the buffer to be modified
2097 (clear-visited-file-modtime)
2100 (let ((insert-okay-p nil)
2101 (buffer (current-buffer))
2102 string entry last-use-time
2103 cmpl-entry cmpl-last-use-time
2104 (current-completion-source cmpl-source-init-file)
2106 (cmpl-statistics-block
2107 (aref completion-add-count-vector cmpl-source-file-parsing)))
2108 (total-in-file 0) (total-perm 0))
2109 ;; insert the file into a buffer
2111 (progn (insert-file-contents filename t)
2112 (setq insert-okay-p t))
2115 (message "File error trying to load completion file %s."
2120 (goto-char (point-min))
2124 (setq entry (read buffer))
2125 (setq total-in-file (1+ total-in-file))
2128 (stringp (setq string (car entry)))
2130 ((eq (setq last-use-time (cdr entry)) 'T)
2131 ;; handle case sensitivity
2132 (setq total-perm (1+ total-perm))
2133 (setq last-use-time t))
2134 ((eq last-use-time t)
2135 (setq total-perm (1+ total-perm)))
2136 ((integerp last-use-time))))
2139 (setq cmpl-last-use-time
2140 (completion-last-use-time
2142 (add-completion-to-tail-if-new string))))
2143 (if (or (eq last-use-time t)
2144 (and (> last-use-time 1000);;backcompatibility
2145 (not (eq cmpl-last-use-time t))
2146 (or (not cmpl-last-use-time)
2148 (> last-use-time cmpl-last-use-time))))
2149 ;; update last-use-time
2150 (set-completion-last-use-time cmpl-entry last-use-time)))
2153 (message "Error: invalid saved completion - %s"
2154 (prin1-to-string entry))
2155 ;; try to get back in sync
2156 (search-forward "\n("))))
2158 (message "End of file while reading completions."))
2160 (if (= (point) (point-max))
2161 (if (not no-message-p)
2162 (message "Loading completions from file %s . . . Done."
2164 (message "End of file while reading completions."))))))
2166 (cmpl-statistics-block
2167 (record-load-completions
2168 total-in-file total-perm
2169 (- (aref completion-add-count-vector cmpl-source-init-file)
2173 (defun completion-initialize ()
2174 "Load the default completions file.
2175 Also sets up so that exiting Emacs will automatically save the file."
2177 (unless cmpl-initialized-p
2178 (load-completions-from-file)
2179 (setq cmpl-initialized-p t)))
2181 ;;-----------------------------------------------
2182 ;; Kill region patch
2183 ;;-----------------------------------------------
2185 (defun completion-kill-region (&optional beg end)
2186 "Kill between point and mark.
2187 The text is deleted but saved in the kill ring.
2188 The command \\[yank] can retrieve it from there.
2189 /(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
2191 This is the primitive for programs to kill text (as opposed to deleting it).
2192 Supply two arguments, character positions indicating the stretch of text
2194 Any command that calls this function is a \"kill command\".
2195 If the previous command was also a kill command,
2196 the text killed this time appends to the text killed last time
2197 to make one entry in the kill ring.
2198 Patched to remove the most recent completion."
2200 (cond ((eq last-command 'complete)
2201 (delete-region (point) cmpl-last-insert-location)
2202 (insert cmpl-original-string)
2203 (setq completion-to-accept nil)
2204 (cmpl-statistics-block
2205 (record-complete-failed)))
2207 (kill-region beg end))))
2210 ;;-----------------------------------------------
2211 ;; Patches to self-insert-command.
2212 ;;-----------------------------------------------
2214 ;; Need 2 versions: generic separator chars. and space (to get auto fill
2217 ;; All common separators (eg. space "(" ")" """) characters go through a
2218 ;; function to add new words to the list of words to complete from:
2219 ;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
2220 ;; If the character before this was an alpha-numeric then this adds the
2221 ;; symbol before point to the completion list (using ADD-COMPLETION).
2223 (defun completion-separator-self-insert-command (arg)
2225 (if (command-remapping 'self-insert-command)
2226 (funcall (command-remapping 'self-insert-command) arg)
2227 (use-completion-before-separator)
2228 (self-insert-command arg)))
2230 (defun completion-separator-self-insert-autofilling (arg)
2232 (if (command-remapping 'self-insert-command)
2233 (funcall (command-remapping 'self-insert-command) arg)
2234 (use-completion-before-separator)
2235 (self-insert-command arg)
2236 (and auto-fill-function
2237 (funcall auto-fill-function))))
2239 ;;-----------------------------------------------
2241 ;;-----------------------------------------------
2243 ;; Note that because of the way byte compiling works, none of
2244 ;; the functions defined with this macro get byte compiled.
2246 (defun completion-def-wrapper (function-name type)
2247 "Add a call to update the completion database before function execution.
2248 TYPE is the type of the wrapper to be added. Can be :before or :under."
2249 (put function-name 'completion-function
2251 '((:separator . use-completion-before-separator)
2252 (:before . use-completion-before-point)
2253 (:backward-under . use-completion-backward-under)
2254 (:backward . use-completion-backward)
2255 (:under . use-completion-under-point)
2256 (:under-or-before . use-completion-under-or-before-point)
2257 (:minibuffer-separator
2258 . use-completion-minibuffer-separator))))))
2260 (defun use-completion-minibuffer-separator ()
2261 (let ((completion-syntax-table completion-standard-syntax-table))
2262 (use-completion-before-separator)))
2264 (defun use-completion-backward-under ()
2265 (use-completion-under-point)
2266 (if (eq last-command 'complete)
2267 ;; probably a failed completion if you have to back up
2268 (cmpl-statistics-block (record-complete-failed))))
2270 (defun use-completion-backward ()
2271 (if (eq last-command 'complete)
2272 ;; probably a failed completion if you have to back up
2273 (cmpl-statistics-block (record-complete-failed))))
2275 (defun completion-before-command ()
2276 (funcall (or (and (symbolp this-command)
2277 (get this-command 'completion-function))
2278 'use-completion-under-or-before-point)))
2282 (defconst completion-lisp-syntax-table
2283 (let ((table (copy-syntax-table completion-standard-syntax-table))
2284 (symbol-chars '(?! ?& ?? ?= ?^)))
2285 (dolist (char symbol-chars)
2286 (modify-syntax-entry char "_" table))
2289 (defun completion-lisp-mode-hook ()
2290 (setq completion-syntax-table completion-lisp-syntax-table)
2292 (local-set-key "!" 'self-insert-command)
2293 (local-set-key "&" 'self-insert-command)
2294 (local-set-key "%" 'self-insert-command)
2295 (local-set-key "?" 'self-insert-command)
2296 (local-set-key "=" 'self-insert-command)
2297 (local-set-key "^" 'self-insert-command))
2301 (defconst completion-c-syntax-table
2302 (let ((table (copy-syntax-table completion-standard-syntax-table))
2303 (separator-chars '(?+ ?* ?/ ?: ?%)))
2304 (dolist (char separator-chars)
2305 (modify-syntax-entry char " " table))
2308 (completion-def-wrapper 'electric-c-semi :separator)
2309 (defun completion-c-mode-hook ()
2310 (setq completion-syntax-table completion-c-syntax-table)
2311 (local-set-key "+" 'completion-separator-self-insert-command)
2312 (local-set-key "*" 'completion-separator-self-insert-command)
2313 (local-set-key "/" 'completion-separator-self-insert-command))
2315 ;; FORTRAN mode diffs. (these are defined when fortran is called)
2317 (defconst completion-fortran-syntax-table
2318 (let ((table (copy-syntax-table completion-standard-syntax-table))
2319 (separator-chars '(?+ ?- ?* ?/ ?:)))
2320 (dolist (char separator-chars)
2321 (modify-syntax-entry char " " table))
2324 (defun completion-setup-fortran-mode ()
2325 (setq completion-syntax-table completion-fortran-syntax-table)
2326 (local-set-key "+" 'completion-separator-self-insert-command)
2327 (local-set-key "-" 'completion-separator-self-insert-command)
2328 (local-set-key "*" 'completion-separator-self-insert-command)
2329 (local-set-key "/" 'completion-separator-self-insert-command))
2331 ;; Enable completion mode.
2333 (defvar fortran-mode-hook)
2335 (defvar completion-saved-bindings nil)
2338 (define-minor-mode dynamic-completion-mode
2339 "Enable dynamic word-completion."
2341 ;; This is always good, not specific to dynamic-completion-mode.
2342 (define-key function-key-map [C-return] [?\C-\r])
2344 (dolist (x '((find-file-hook . completion-find-file-hook)
2345 (pre-command-hook . completion-before-command)
2346 ;; Save completions when killing Emacs.
2347 (kill-emacs-hook . kill-emacs-save-completions)
2349 ;; Install the appropriate mode tables.
2350 (lisp-mode-hook . completion-lisp-mode-hook)
2351 (c-mode-hook . completion-c-mode-hook)
2352 (fortran-mode-hook . completion-setup-fortran-mode)))
2353 (if dynamic-completion-mode
2354 (add-hook (car x) (cdr x))
2355 (remove-hook (car x) (cdr x))))
2357 ;; "Complete" Key Keybindings. We don't want to use a minor-mode
2358 ;; map because these have too high a priority. We could/should
2359 ;; probably change the interpretation of minor-mode-map-alist such
2360 ;; that a map has lower precedence if the symbol is not buffer-local.
2361 (while completion-saved-bindings
2362 (let ((binding (pop completion-saved-bindings)))
2363 (global-set-key (car binding) (cdr binding))))
2364 (when dynamic-completion-mode
2366 '(("\M-\r" . complete)
2367 ([?\C-\r] . complete)
2370 ;; (add-completion "cumberland")
2371 ;; (add-completion "cumberbund")
2377 ;; Patches to standard keymaps insert completions
2378 ([remap kill-region] . completion-kill-region)
2381 ;; We've used the completion syntax table given as a guide.
2383 ;; Global separator chars.
2384 ;; We left out <tab> because there are too many special
2385 ;; cases for it. Also, in normal coding it's rarely typed
2387 (" " . completion-separator-self-insert-autofilling)
2388 ("!" . completion-separator-self-insert-command)
2389 ("%" . completion-separator-self-insert-command)
2390 ("^" . completion-separator-self-insert-command)
2391 ("&" . completion-separator-self-insert-command)
2392 ("(" . completion-separator-self-insert-command)
2393 (")" . completion-separator-self-insert-command)
2394 ("=" . completion-separator-self-insert-command)
2395 ("`" . completion-separator-self-insert-command)
2396 ("|" . completion-separator-self-insert-command)
2397 ("{" . completion-separator-self-insert-command)
2398 ("}" . completion-separator-self-insert-command)
2399 ("[" . completion-separator-self-insert-command)
2400 ("]" . completion-separator-self-insert-command)
2401 (";" . completion-separator-self-insert-command)
2402 ("\"". completion-separator-self-insert-command)
2403 ("'" . completion-separator-self-insert-command)
2404 ("#" . completion-separator-self-insert-command)
2405 ("," . completion-separator-self-insert-command)
2406 ("?" . completion-separator-self-insert-command)
2408 ;; We include period and colon even though they are symbol
2410 ;; - in text we want to pick up the last word in a sentence.
2411 ;; - in C pointer refs. we want to pick up the first symbol
2412 ;; - it won't make a difference for lisp mode (package names
2414 ("." . completion-separator-self-insert-command)
2415 (":" . completion-separator-self-insert-command)))
2416 (push (cons (car binding) (lookup-key global-map (car binding)))
2417 completion-saved-bindings)
2418 (global-set-key (car binding) (cdr binding)))
2426 (cmpl-statistics-block
2427 (record-completion-file-loaded))
2429 (completion-initialize)))
2431 ;;-----------------------------------------------
2432 ;; End of line chars.
2433 ;;-----------------------------------------------
2434 (completion-def-wrapper 'newline :separator)
2435 (completion-def-wrapper 'newline-and-indent :separator)
2436 (completion-def-wrapper 'comint-send-input :separator)
2437 (completion-def-wrapper 'exit-minibuffer :minibuffer-separator)
2438 (completion-def-wrapper 'eval-print-last-sexp :separator)
2439 (completion-def-wrapper 'eval-last-sexp :separator)
2440 ;;(completion-def-wrapper 'minibuffer-complete-and-exit :minibuffer)
2442 ;;-----------------------------------------------
2444 ;;-----------------------------------------------
2446 (completion-def-wrapper 'next-line :under-or-before)
2447 (completion-def-wrapper 'previous-line :under-or-before)
2448 (completion-def-wrapper 'beginning-of-buffer :under-or-before)
2449 (completion-def-wrapper 'end-of-buffer :under-or-before)
2450 (completion-def-wrapper 'beginning-of-line :under-or-before)
2451 (completion-def-wrapper 'end-of-line :under-or-before)
2452 (completion-def-wrapper 'forward-char :under-or-before)
2453 (completion-def-wrapper 'forward-word :under-or-before)
2454 (completion-def-wrapper 'forward-sexp :under-or-before)
2455 (completion-def-wrapper 'backward-char :backward-under)
2456 (completion-def-wrapper 'backward-word :backward-under)
2457 (completion-def-wrapper 'backward-sexp :backward-under)
2459 (completion-def-wrapper 'delete-backward-char :backward)
2460 (completion-def-wrapper 'delete-backward-char-untabify :backward)
2462 ;; Old names, non-namespace-clean.
2463 (defvaralias 'cmpl-syntax-table 'completion-syntax-table)
2464 (defalias 'initialize-completions 'completion-initialize)
2466 (dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
2467 "^The string \".*\" is too short to be saved as a completion\\.$"))
2468 (add-to-list 'debug-ignored-errors x))
2470 (provide 'completion)
2472 ;;; completion.el ends here