* xscheme.el (scheme-interaction-mode): Doc fix.
[emacs.git] / lisp / completion.el
blob4bc34cc4ba20574b4528a61344ba5d73debd3c69
1 ;;; completion.el --- dynamic word-completion code
3 ;; Copyright (C) 1990, 1993, 1995, 1997 Free Software Foundation, Inc.
5 ;; Maintainer: FSF
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 2, or (at your option)
15 ;; 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; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
27 ;;; Commentary:
29 ;; What to put in .emacs
30 ;;-----------------------
31 ;; (dynamic-completion-mode)
33 ;;---------------------------------------------------------------------------
34 ;; Documentation [Slightly out of date]
35 ;;---------------------------------------------------------------------------
36 ;; (also check the documentation string of the functions)
38 ;; Introduction
39 ;;---------------
40 ;;
41 ;; After you type a few characters, pressing the "complete" key inserts
42 ;; the rest of the word you are likely to type.
44 ;; This watches all the words that you type and remembers them. When
45 ;; typing a new word, pressing "complete" (meta-return) "completes" the
46 ;; word by inserting the most recently used word that begins with the
47 ;; same characters. If you press meta-return repeatedly, it cycles
48 ;; through all the words it knows about.
50 ;; If you like the completion then just continue typing, it is as if you
51 ;; entered the text by hand. If you want the inserted extra characters
52 ;; to go away, type control-w or delete. More options are described below.
54 ;; The guesses are made in the order of the most recently "used". Typing
55 ;; in a word and then typing a separator character (such as a space) "uses"
56 ;; the word. So does moving a cursor over the word. If no words are found,
57 ;; it uses an extended version of the dabbrev style completion.
59 ;; You automatically save the completions you use to a file between
60 ;; sessions.
62 ;; Completion enables programmers to enter longer, more descriptive
63 ;; variable names while typing fewer keystrokes than they normally would.
66 ;; Full documentation
67 ;;---------------------
69 ;; A "word" is any string containing characters with either word or symbol
70 ;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.]
71 ;; Unless you change the constants, you must type at least three characters
72 ;; for the word to be recognized. Only words longer than 6 characters are
73 ;; saved.
75 ;; When you load this file, completion will be on. I suggest you use the
76 ;; compiled version (because it is noticeably faster).
78 ;; M-X completion-mode toggles whether or not new words are added to the
79 ;; database by changing the value of enable-completion.
81 ;; SAVING/LOADING COMPLETIONS
82 ;; Completions are automatically saved from one session to another
83 ;; (unless save-completions-flag or enable-completion is nil).
84 ;; Loading this file (or calling initialize-completions) causes EMACS
85 ;; to load a completions database for a saved completions file
86 ;; (default: ~/.completions). When you exit, EMACS saves a copy of the
87 ;; completions that you
88 ;; often use. When you next start, EMACS loads in the saved completion file.
90 ;; The number of completions saved depends loosely on
91 ;; *saved-completions-decay-factor*. Completions that have never been
92 ;; inserted via "complete" are not saved. You are encouraged to experiment
93 ;; with different functions (see compute-completion-min-num-uses).
95 ;; Some completions are permanent and are always saved out. These
96 ;; completions have their num-uses slot set to T. Use
97 ;; add-permanent-completion to do this
99 ;; Completions are saved only if enable-completion is T. The number of old
100 ;; versions kept of the saved completions file is controlled by
101 ;; completions-file-versions-kept.
103 ;; COMPLETE KEY OPTIONS
104 ;; The complete function takes a numeric arguments.
105 ;; control-u :: leave the point at the beginning of the completion rather
106 ;; than the middle.
107 ;; a number :: rotate through the possible completions by that amount
108 ;; `-' :: same as -1 (insert previous completion)
110 ;; HOW THE DATABASE IS MAINTAINED
111 ;; <write>
113 ;; UPDATING THE DATABASE MANUALLY
114 ;; m-x kill-completion
115 ;; kills the completion at point.
116 ;; m-x add-completion
117 ;; m-x add-permanent-completion
119 ;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
120 ;; m-x add-completions-from-buffer
121 ;; Parses all the definition names from a C or LISP mode buffer and
122 ;; adds them to the completion database.
124 ;; m-x add-completions-from-lisp-file
125 ;; Parses all the definition names from a C or Lisp mode file and
126 ;; adds them to the completion database.
128 ;; UPDATING THE DATABASE FROM A TAGS TABLE
129 ;; m-x add-completions-from-tags-table
130 ;; Adds completions from the current tags-table-buffer.
132 ;; HOW A COMPLETION IS FOUND
133 ;; <write>
135 ;; STRING CASING
136 ;; Completion is string case independent if case-fold-search has its
137 ;; normal default of T. Also when the completion is inserted the case of the
138 ;; entry is coerced appropriately.
139 ;; [E.G. APP --> APPROPRIATELY app --> appropriately
140 ;; App --> Appropriately]
142 ;; INITIALIZATION
143 ;; The form `(initialize-completions)' initializes the completion system by
144 ;; trying to load in the user's completions. After the first cal, further
145 ;; calls have no effect so one should be careful not to put the form in a
146 ;; site's standard site-init file.
148 ;;---------------------------------------------------------------------------
152 ;;---------------------------------------------------------------------------
153 ;; Functions you might like to call
154 ;;---------------------------------------------------------------------------
156 ;; add-completion string &optional num-uses
157 ;; Adds a new string to the database
159 ;; add-permanent-completion string
160 ;; Adds a new string to the database with num-uses = T
163 ;; kill-completion string
164 ;; Kills the completion from the database.
166 ;; clear-all-completions
167 ;; Clears the database
169 ;; list-all-completions
170 ;; Returns a list of all completions.
173 ;; next-completion string &optional index
174 ;; Returns a completion entry that starts with string.
176 ;; find-exact-completion string
177 ;; Returns a completion entry that exactly matches string.
179 ;; complete
180 ;; Inserts a completion at point
182 ;; initialize-completions
183 ;; Loads the completions file and sets up so that exiting emacs will
184 ;; save them.
186 ;; save-completions-to-file &optional filename
187 ;; load-completions-from-file &optional filename
189 ;;-----------------------------------------------
190 ;; Other functions
191 ;;-----------------------------------------------
193 ;; get-completion-list string
195 ;; These things are for manipulating the structure
196 ;; make-completion string num-uses
197 ;; completion-num-uses completion
198 ;; completion-string completion
199 ;; set-completion-num-uses completion num-uses
200 ;; set-completion-string completion string
204 ;;-----------------------------------------------
205 ;; To Do :: (anybody ?)
206 ;;-----------------------------------------------
208 ;; Implement Lookup and keyboard interface in C
209 ;; Add package prefix smarts (for Common Lisp)
210 ;; Add autoprompting of possible completions after every keystroke (fast
211 ;; terminals only !)
212 ;; Add doc. to texinfo
215 ;;-----------------------------------------------
216 ;;; Change Log:
217 ;;-----------------------------------------------
218 ;; Sometime in '84 Brewster implemented a somewhat buggy version for
219 ;; Symbolics LISPMs.
220 ;; Jan. '85 Jim became enamored of the idea and implemented a faster,
221 ;; more robust version.
222 ;; With input from many users at TMC, (rose, craig, and gls come to mind),
223 ;; the current style of interface was developed.
224 ;; 9/87, Jim and Brewster took terminals home. Yuck. After
225 ;; complaining for a while Brewster implemented a subset of the current
226 ;; LISPM version for GNU Emacs.
227 ;; 8/88 After complaining for a while (and with sufficient
228 ;; promised rewards), Jim reimplemented a version of GNU completion
229 ;; superior to that of the LISPM version.
231 ;;-----------------------------------------------
232 ;; Acknowledgements
233 ;;-----------------------------------------------
234 ;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
235 ;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
237 ;;-----------------------------------------------
238 ;; Change Log
239 ;;-----------------------------------------------
240 ;; From version 9 to 10
241 ;; - Allowance for non-integral *completion-version* nos.
242 ;; - Fix cmpl-apply-as-top-level for keyboard macros
243 ;; - Fix broken completion merging (in save-completions-to-file)
244 ;; - More misc. fixes for version 19.0 of emacs
246 ;; From Version 8 to 9
247 ;; - Ported to version 19.0 of emacs (backcompatible with version 18)
248 ;; - Added add-completions-from-tags-table (with thanks to eero@media-lab)
250 ;; From Version 7 to 8
251 ;; - Misc. changes to comments
252 ;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e
253 ;; - cdabbrev now checks all the visible window buffers and the "other buffer"
254 ;; - `%' is now a symbol character rather than a separator (except in C mode)
256 ;; From Version 6 to 7
257 ;; - Fixed bug with saving out .completion file the first time
259 ;; From Version 5 to 6
260 ;; - removed statistics recording
261 ;; - reworked advise to handle autoloads
262 ;; - Fixed fortran mode support
263 ;; - Added new cursor motion triggers
265 ;; From Version 4 to 5
266 ;; - doesn't bother saving if nothing has changed
267 ;; - auto-save if haven't used for a 1/2 hour
268 ;; - save period extended to two weeks
269 ;; - minor fix to capitalization code
270 ;; - added *completion-auto-save-period* to variables recorded.
271 ;; - added reenter protection to cmpl-record-statistics-filter
272 ;; - added backup protection to save-completions-to-file (prevents
273 ;; problems with disk full errors)
275 ;;; Code:
277 ;;---------------------------------------------------------------------------
278 ;; User changeable parameters
279 ;;---------------------------------------------------------------------------
281 (defgroup completion nil
282 "Dynamic word-completion code."
283 :group 'matching
284 :group 'convenience)
287 (defcustom enable-completion t
288 "*Non-nil means enable recording and saving of completions.
289 If nil, no new words are added to the database or saved to the init file."
290 :type 'boolean
291 :group 'completion)
293 (defcustom save-completions-flag t
294 "*Non-nil means save most-used completions when exiting Emacs.
295 See also `save-completions-retention-time'."
296 :type 'boolean
297 :group 'completion)
299 (defcustom save-completions-file-name (convert-standard-filename "~/.completions")
300 "*The filename to save completions to."
301 :type 'file
302 :group 'completion)
304 (defcustom save-completions-retention-time 336
305 "*Discard a completion if unused for this many hours.
306 \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
307 will not be saved unless these are used. Default is two weeks."
308 :type 'integer
309 :group 'completion)
311 (defcustom completion-on-separator-character nil
312 "*Non-nil means separator characters mark previous word as used.
313 This means the word will be saved as a completion."
314 :type 'boolean
315 :group 'completion)
317 (defcustom completions-file-versions-kept kept-new-versions
318 "*Number of versions to keep for the saved completions file."
319 :type 'integer
320 :group 'completion)
322 (defcustom completion-prompt-speed-threshold 4800
323 "*Minimum output speed at which to display next potential completion."
324 :type 'integer
325 :group 'completion)
327 (defcustom completion-cdabbrev-prompt-flag nil
328 "*If non-nil, the next completion prompt does a cdabbrev search.
329 This can be time consuming."
330 :type 'boolean
331 :group 'completion)
333 (defcustom completion-search-distance 15000
334 "*How far to search in the buffer when looking for completions.
335 In number of characters. If nil, search the whole buffer."
336 :type 'integer
337 :group 'completion)
339 (defcustom completions-merging-modes '(lisp c)
340 "*List of modes {`c' or `lisp'} for automatic completions merging.
341 Definitions from visited files which have these modes
342 are automatically added to the completion database."
343 :type '(set (const lisp) (const c))
344 :group 'completion)
346 ;;(defvar *record-cmpl-statistics-p* nil
347 ;; "*If non-nil, record completion statistics.")
349 ;;(defvar *completion-auto-save-period* 1800
350 ;; "*The period in seconds to wait for emacs to be idle before autosaving
351 ;;the completions. Default is a 1/2 hour.")
353 (defconst completion-min-length nil ;; defined below in eval-when
354 "*The minimum length of a stored completion.
355 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
357 (defconst completion-max-length nil ;; defined below in eval-when
358 "*The maximum length of a stored completion.
359 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
361 (defconst completion-prefix-min-length nil ;; defined below in eval-when
362 "The minimum length of a completion search string.
363 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
365 (defmacro eval-when-compile-load-eval (&rest body)
366 ;; eval everything before expanding
367 (mapcar 'eval body)
368 (cons 'progn body))
370 (defun completion-eval-when ()
371 (eval-when-compile-load-eval
372 ;; These vars. are defined at both compile and load time.
373 (setq completion-min-length 6)
374 (setq completion-max-length 200)
375 (setq completion-prefix-min-length 3)))
377 (completion-eval-when)
379 ;;---------------------------------------------------------------------------
380 ;; Internal Variables
381 ;;---------------------------------------------------------------------------
383 (defvar cmpl-initialized-p nil
384 "Set to t when the completion system is initialized.
385 Indicates that the old completion file has been read in.")
387 (defvar cmpl-completions-accepted-p nil
388 "Set to t as soon as the first completion has been accepted.
389 Used to decide whether to save completions.")
391 (defvar cmpl-preceding-syntax)
393 (defvar completion-string)
395 ;;---------------------------------------------------------------------------
396 ;; Low level tools
397 ;;---------------------------------------------------------------------------
399 ;;-----------------------------------------------
400 ;; Misc.
401 ;;-----------------------------------------------
403 (defun minibuffer-window-selected-p ()
404 "True iff the current window is the minibuffer."
405 (window-minibuffer-p (selected-window)))
407 ;; This used to be `(eval form)'. Eval FORM at run time now.
408 (defmacro cmpl-read-time-eval (form)
409 form)
411 ;;-----------------------------------------------
412 ;; String case coercion
413 ;;-----------------------------------------------
415 (defun cmpl-string-case-type (string)
416 "Return :capitalized, :up, :down, :mixed, or :neither for case of STRING."
417 (let ((case-fold-search nil))
418 (cond ((string-match "[[:lower:]]" string)
419 (cond ((string-match "[[:upper:]]" string)
420 (cond ((and (> (length string) 1)
421 (null (string-match "[[:upper:]]" string 1)))
422 :capitalized)
424 :mixed)))
425 (t :down)))
427 (cond ((string-match "[[:upper:]]" string)
428 :up)
429 (t :neither))))))
431 ;; Tests -
432 ;; (cmpl-string-case-type "123ABCDEF456") --> :up
433 ;; (cmpl-string-case-type "123abcdef456") --> :down
434 ;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
435 ;; (cmpl-string-case-type "123456") --> :neither
436 ;; (cmpl-string-case-type "Abcde123") --> :capitalized
438 (defun cmpl-coerce-string-case (string case-type)
439 (cond ((eq case-type :down) (downcase string))
440 ((eq case-type :up) (upcase string))
441 ((eq case-type :capitalized)
442 (setq string (downcase string))
443 (aset string 0 (logand ?\337 (aref string 0)))
444 string)
445 (t string)))
447 (defun cmpl-merge-string-cases (string-to-coerce given-string)
448 (let ((string-case-type (cmpl-string-case-type string-to-coerce)))
449 (cond ((memq string-case-type '(:down :up :capitalized))
450 ;; Found string is in a standard case. Coerce to a type based on
451 ;; the given string
452 (cmpl-coerce-string-case string-to-coerce
453 (cmpl-string-case-type given-string)))
455 ;; If the found string is in some unusual case, just insert it
456 ;; as is
457 string-to-coerce))))
459 ;; Tests -
460 ;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
461 ;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
462 ;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
463 ;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
466 (defun cmpl-hours-since-origin ()
467 (let ((time (current-time)))
468 (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600)))
470 ;;---------------------------------------------------------------------------
471 ;; "Symbol" parsing functions
472 ;;---------------------------------------------------------------------------
473 ;; The functions symbol-before-point, symbol-under-point, etc. quickly return
474 ;; an appropriate symbol string. The strategy is to temporarily change
475 ;; the syntax table to enable fast symbol searching. There are three classes
476 ;; of syntax in these "symbol" syntax tables ::
478 ;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
479 ;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).
480 ;; syntax (? ) - everything else
482 ;; Thus by judicious use of scan-sexps and forward-word, we can get
483 ;; the word we want relatively fast and without consing.
485 ;; Why do we need a separate category for "symbol chars to ignore at ends" ?
486 ;; For example, in LISP we want starting :'s trimmed
487 ;; so keyword argument specifiers also define the keyword completion. And,
488 ;; for example, in C we want `.' appearing in a structure ref. to
489 ;; be kept intact in order to store the whole structure ref.; however, if
490 ;; it appears at the end of a symbol it should be discarded because it is
491 ;; probably used as a period.
493 ;; Here is the default completion syntax ::
494 ;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
495 ;; Symbol chars to ignore at ends :: _ : . -
496 ;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
497 ;; , ? <Everything else>
499 ;; Mode specific differences and notes ::
500 ;; LISP diffs ->
501 ;; Symbol chars :: ! & ? = ^
503 ;; C diffs ->
504 ;; Separator chars :: + * / : %
505 ;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator
506 ;; char., however, we wanted to have completion symbols include pointer
507 ;; references. For example, "foo->bar" is a symbol as far as completion is
508 ;; concerned.
510 ;; FORTRAN diffs ->
511 ;; Separator chars :: + - * / :
513 ;; Pathname diffs ->
514 ;; Symbol chars :: .
515 ;; Of course there is no pathname "mode" and in fact we have not implemented
516 ;; this table. However, if there was such a mode, this is what it would look
517 ;; like.
519 ;;-----------------------------------------------
520 ;; Table definitions
521 ;;-----------------------------------------------
523 (defun cmpl-make-standard-completion-syntax-table ()
524 (let ((table (make-syntax-table))
526 ;; Default syntax is whitespace.
527 (setq i 0)
528 (while (< i 256)
529 (modify-syntax-entry i " " table)
530 (setq i (1+ i)))
531 ;; alpha chars
532 (setq i 0)
533 (while (< i 26)
534 (modify-syntax-entry (+ ?a i) "_" table)
535 (modify-syntax-entry (+ ?A i) "_" table)
536 (setq i (1+ i)))
537 ;; digit chars.
538 (setq i 0)
539 (while (< i 10)
540 (modify-syntax-entry (+ ?0 i) "_" table)
541 (setq i (1+ i)))
542 ;; Other ones
543 (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%))
544 (symbol-chars-ignore '(?_ ?- ?: ?.)))
545 (dolist (char symbol-chars)
546 (modify-syntax-entry char "_" table))
547 (dolist (char symbol-chars-ignore)
548 (modify-syntax-entry char "w" table)))
549 table))
551 (defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table))
553 (defun cmpl-make-lisp-completion-syntax-table ()
554 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
555 (symbol-chars '(?! ?& ?? ?= ?^)))
556 (dolist (char symbol-chars)
557 (modify-syntax-entry char "_" table))
558 table))
560 (defun cmpl-make-c-completion-syntax-table ()
561 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
562 (separator-chars '(?+ ?* ?/ ?: ?%)))
563 (dolist (char separator-chars)
564 (modify-syntax-entry char " " table))
565 table))
567 (defun cmpl-make-fortran-completion-syntax-table ()
568 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
569 (separator-chars '(?+ ?- ?* ?/ ?:)))
570 (dolist (char separator-chars)
571 (modify-syntax-entry char " " table))
572 table))
574 (defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table))
575 (defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table))
576 (defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table))
578 (defvar cmpl-syntax-table cmpl-standard-syntax-table
579 "This variable holds the current completion syntax table.")
580 (make-variable-buffer-local 'cmpl-syntax-table)
582 ;;-----------------------------------------------
583 ;; Symbol functions
584 ;;-----------------------------------------------
585 (defvar cmpl-symbol-start nil
586 "Holds first character of symbol, after any completion symbol function.")
587 (defvar cmpl-symbol-end nil
588 "Holds last character of symbol, after any completion symbol function.")
589 ;; These are temp. vars. we use to avoid using let.
590 ;; Why ? Small speed improvement.
591 (defvar cmpl-saved-syntax nil)
592 (defvar cmpl-saved-point nil)
594 (defun symbol-under-point ()
595 "Returns the symbol that the point is currently on.
596 But only if it is longer than `completion-min-length'."
597 (setq cmpl-saved-syntax (syntax-table))
598 (unwind-protect
599 (progn
600 (set-syntax-table cmpl-syntax-table)
601 (cond
602 ;; Cursor is on following-char and after preceding-char
603 ((memq (char-syntax (following-char)) '(?w ?_))
604 (setq cmpl-saved-point (point)
605 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)
606 cmpl-symbol-end (scan-sexps cmpl-saved-point 1))
607 ;; Remove chars to ignore at the start.
608 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
609 (goto-char cmpl-symbol-start)
610 (forward-word 1)
611 (setq cmpl-symbol-start (point))
612 (goto-char cmpl-saved-point)))
613 ;; Remove chars to ignore at the end.
614 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
615 (goto-char cmpl-symbol-end)
616 (forward-word -1)
617 (setq cmpl-symbol-end (point))
618 (goto-char cmpl-saved-point)))
619 ;; Return completion if the length is reasonable.
620 (if (and (<= (cmpl-read-time-eval completion-min-length)
621 (- cmpl-symbol-end cmpl-symbol-start))
622 (<= (- cmpl-symbol-end cmpl-symbol-start)
623 (cmpl-read-time-eval completion-max-length)))
624 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
625 (set-syntax-table cmpl-saved-syntax)))
627 ;; tests for symbol-under-point
628 ;; `^' indicates cursor pos. where value is returned
629 ;; simple-word-test
630 ;; ^^^^^^^^^^^^^^^^ --> simple-word-test
631 ;; _harder_word_test_
632 ;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test
633 ;; .___.______.
634 ;; --> nil
635 ;; /foo/bar/quux.hello
636 ;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
639 (defun symbol-before-point ()
640 "Returns a string of the symbol immediately before point.
641 Returns nil if there isn't one longer than `completion-min-length'."
642 ;; This is called when a word separator is typed so it must be FAST !
643 (setq cmpl-saved-syntax (syntax-table))
644 (unwind-protect
645 (progn
646 (set-syntax-table cmpl-syntax-table)
647 ;; Cursor is on following-char and after preceding-char
648 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
649 ;; Number of chars to ignore at end.
650 (setq cmpl-symbol-end (point)
651 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
652 ;; Remove chars to ignore at the start.
653 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
654 (goto-char cmpl-symbol-start)
655 (forward-word 1)
656 (setq cmpl-symbol-start (point))
657 (goto-char cmpl-symbol-end)))
658 ;; Return value if long enough.
659 (if (>= cmpl-symbol-end
660 (+ cmpl-symbol-start
661 (cmpl-read-time-eval completion-min-length)))
662 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))
663 ((= cmpl-preceding-syntax ?w)
664 ;; chars to ignore at end
665 (setq cmpl-saved-point (point)
666 cmpl-symbol-start (scan-sexps cmpl-saved-point -1))
667 ;; take off chars. from end
668 (forward-word -1)
669 (setq cmpl-symbol-end (point))
670 ;; remove chars to ignore at the start
671 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
672 (goto-char cmpl-symbol-start)
673 (forward-word 1)
674 (setq cmpl-symbol-start (point))))
675 ;; Restore state.
676 (goto-char cmpl-saved-point)
677 ;; Return completion if the length is reasonable
678 (if (and (<= (cmpl-read-time-eval completion-min-length)
679 (- cmpl-symbol-end cmpl-symbol-start))
680 (<= (- cmpl-symbol-end cmpl-symbol-start)
681 (cmpl-read-time-eval completion-max-length)))
682 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
683 (set-syntax-table cmpl-saved-syntax)))
685 ;; tests for symbol-before-point
686 ;; `^' indicates cursor pos. where value is returned
687 ;; simple-word-test
688 ;; ^ --> nil
689 ;; ^ --> nil
690 ;; ^ --> simple-w
691 ;; ^ --> simple-word-test
692 ;; _harder_word_test_
693 ;; ^ --> harder_word_test
694 ;; ^ --> harder_word_test
695 ;; ^ --> harder
696 ;; .___....
697 ;; --> nil
699 (defun symbol-under-or-before-point ()
700 ;; This could be made slightly faster but it is better to avoid
701 ;; copying all the code.
702 ;; However, it is only used by the completion string prompter.
703 ;; If it comes into common use, it could be rewritten.
704 (cond ((memq (progn
705 (setq cmpl-saved-syntax (syntax-table))
706 (unwind-protect
707 (progn
708 (set-syntax-table cmpl-syntax-table)
709 (char-syntax (following-char)))
710 (set-syntax-table cmpl-saved-syntax)))
711 '(?w ?_))
712 (symbol-under-point))
714 (symbol-before-point))))
717 (defun symbol-before-point-for-complete ()
718 ;; "Returns a string of the symbol immediately before point
719 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the
720 ;; end chars."
721 ;; Cursor is on following-char and after preceding-char
722 (setq cmpl-saved-syntax (syntax-table))
723 (unwind-protect
724 (progn
725 (set-syntax-table cmpl-syntax-table)
726 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
727 '(?_ ?w))
728 (setq cmpl-symbol-end (point)
729 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
730 ;; Remove chars to ignore at the start.
731 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
732 (goto-char cmpl-symbol-start)
733 (forward-word 1)
734 (setq cmpl-symbol-start (point))
735 (goto-char cmpl-symbol-end)))
736 ;; Return completion if the length is reasonable.
737 (if (and (<= (cmpl-read-time-eval
738 completion-prefix-min-length)
739 (- cmpl-symbol-end cmpl-symbol-start))
740 (<= (- cmpl-symbol-end cmpl-symbol-start)
741 (cmpl-read-time-eval completion-max-length)))
742 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
743 ;; Restore syntax table.
744 (set-syntax-table cmpl-saved-syntax)))
746 ;; tests for symbol-before-point-for-complete
747 ;; `^' indicates cursor pos. where value is returned
748 ;; simple-word-test
749 ;; ^ --> nil
750 ;; ^ --> nil
751 ;; ^ --> simple-w
752 ;; ^ --> simple-word-test
753 ;; _harder_word_test_
754 ;; ^ --> harder_word_test
755 ;; ^ --> harder_word_test_
756 ;; ^ --> harder_
757 ;; .___....
758 ;; --> nil
762 ;;---------------------------------------------------------------------------
763 ;; Statistics Recording
764 ;;---------------------------------------------------------------------------
766 ;; Note that the guts of this has been turned off. The guts
767 ;; are in completion-stats.el.
769 ;;-----------------------------------------------
770 ;; Conditionalizing code on *record-cmpl-statistics-p*
771 ;;-----------------------------------------------
772 ;; All statistics code outside this block should use this
773 (defmacro cmpl-statistics-block (&rest body))
774 ;; "Only executes body if we are recording statistics."
775 ;; (list 'cond
776 ;; (list* '*record-cmpl-statistics-p* body)
777 ;; ))
779 ;;-----------------------------------------------
780 ;; Completion Sources
781 ;;-----------------------------------------------
783 ;; ID numbers
784 (defconst cmpl-source-unknown 0)
785 (defconst cmpl-source-init-file 1)
786 (defconst cmpl-source-file-parsing 2)
787 (defconst cmpl-source-separator 3)
788 (defconst cmpl-source-cursor-moves 4)
789 (defconst cmpl-source-interactive 5)
790 (defconst cmpl-source-cdabbrev 6)
791 (defconst num-cmpl-sources 7)
792 (defvar current-completion-source cmpl-source-unknown)
796 ;;---------------------------------------------------------------------------
797 ;; Completion Method #2: dabbrev-expand style
798 ;;---------------------------------------------------------------------------
800 ;; This method is used if there are no useful stored completions. It is
801 ;; based on dabbrev-expand with these differences :
802 ;; 1) Faster (we don't use regexps)
803 ;; 2) case coercion handled correctly
804 ;; This is called cdabbrev to differentiate it.
805 ;; We simply search backwards through the file looking for words which
806 ;; start with the same letters we are trying to complete.
809 (defvar cdabbrev-completions-tried nil)
810 ;; "A list of all the cdabbrev completions since the last reset.")
812 (defvar cdabbrev-current-point 0)
813 ;; "The current point position the cdabbrev search is at.")
815 (defvar cdabbrev-current-window nil)
816 ;; "The current window we are looking for cdabbrevs in.
817 ;; Return t if looking in (other-buffer), nil if no more cdabbrevs.")
819 (defvar cdabbrev-wrapped-p nil)
820 ;; "Return t if the cdabbrev search has wrapped around the file.")
822 (defvar cdabbrev-abbrev-string "")
823 (defvar cdabbrev-start-point 0)
824 (defvar cdabbrev-stop-point)
826 ;; Test strings for cdabbrev
827 ;; cdat-upcase ;;same namestring
828 ;; CDAT-UPCASE ;;ok
829 ;; cdat2 ;;too short
830 ;; cdat-1-2-3-4 ;;ok
831 ;; a-cdat-1 ;;doesn't start correctly
832 ;; cdat-simple ;;ok
835 (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried)
836 "Resets the cdabbrev search to search for abbrev-string.
837 INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore
838 during the search."
839 (setq cdabbrev-abbrev-string abbrev-string
840 cdabbrev-completions-tried
841 (cons (downcase abbrev-string) initial-completions-tried))
842 (reset-cdabbrev-window t))
844 (defun set-cdabbrev-buffer ()
845 ;; cdabbrev-current-window must not be nil
846 (set-buffer (if (eq cdabbrev-current-window t)
847 (other-buffer)
848 (window-buffer cdabbrev-current-window))))
851 (defun reset-cdabbrev-window (&optional initializep)
852 "Resets the cdabbrev search to search for abbrev-string."
853 ;; Set the window
854 (cond (initializep
855 (setq cdabbrev-current-window (selected-window)))
856 ((eq cdabbrev-current-window t)
857 ;; Everything has failed
858 (setq cdabbrev-current-window nil))
859 (cdabbrev-current-window
860 (setq cdabbrev-current-window (next-window cdabbrev-current-window))
861 (if (eq cdabbrev-current-window (selected-window))
862 ;; No more windows, try other buffer.
863 (setq cdabbrev-current-window t))))
864 (if cdabbrev-current-window
865 (save-excursion
866 (set-cdabbrev-buffer)
867 (setq cdabbrev-current-point (point)
868 cdabbrev-start-point cdabbrev-current-point
869 cdabbrev-stop-point
870 (if completion-search-distance
871 (max (point-min)
872 (- cdabbrev-start-point completion-search-distance))
873 (point-min))
874 cdabbrev-wrapped-p nil))))
876 (defun next-cdabbrev ()
877 "Return the next possible cdabbrev expansion or nil if there isn't one.
878 `reset-cdabbrev' must've been called already.
879 This is sensitive to `case-fold-search'."
880 ;; note that case-fold-search affects the behavior of this function
881 ;; Bug: won't pick up an expansion that starts at the top of buffer
882 (if cdabbrev-current-window
883 (let (saved-point
884 saved-syntax
885 (expansion nil)
886 downcase-expansion tried-list syntax saved-point-2)
887 (save-excursion
888 (unwind-protect
889 (progn
890 ;; Switch to current completion buffer
891 (set-cdabbrev-buffer)
892 ;; Save current buffer state
893 (setq saved-point (point)
894 saved-syntax (syntax-table))
895 ;; Restore completion state
896 (set-syntax-table cmpl-syntax-table)
897 (goto-char cdabbrev-current-point)
898 ;; Loop looking for completions
899 (while
900 ;; This code returns t if it should loop again
901 (cond
902 (;; search for the string
903 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t)
904 ;; return nil if the completion is valid
905 (not
906 (and
907 ;; does it start with a separator char ?
908 (or (= (setq syntax (char-syntax (preceding-char))) ? )
909 (and (= syntax ?w)
910 ;; symbol char to ignore at end. Are we at end ?
911 (progn
912 (setq saved-point-2 (point))
913 (forward-word -1)
914 (prog1
915 (= (char-syntax (preceding-char)) ? )
916 (goto-char saved-point-2)))))
917 ;; is the symbol long enough ?
918 (setq expansion (symbol-under-point))
919 ;; have we not tried this one before
920 (progn
921 ;; See if we've already used it
922 (setq tried-list cdabbrev-completions-tried
923 downcase-expansion (downcase expansion))
924 (while (and tried-list
925 (not (string-equal downcase-expansion
926 (car tried-list))))
927 ;; Already tried, don't choose this one
928 (setq tried-list (cdr tried-list)))
929 ;; at this point tried-list will be nil if this
930 ;; expansion has not yet been tried
931 (if tried-list
932 (setq expansion nil)
933 t)))))
934 ;; search failed
935 (cdabbrev-wrapped-p
936 ;; If already wrapped, then we've failed completely
937 nil)
939 ;; need to wrap
940 (goto-char (setq cdabbrev-current-point
941 (if completion-search-distance
942 (min (point-max) (+ cdabbrev-start-point completion-search-distance))
943 (point-max))))
945 (setq cdabbrev-wrapped-p t))))
946 ;; end of while loop
947 (cond (expansion
948 ;; successful
949 (setq cdabbrev-completions-tried
950 (cons downcase-expansion cdabbrev-completions-tried)
951 cdabbrev-current-point (point)))))
952 (set-syntax-table saved-syntax)
953 (goto-char saved-point)))
954 ;; If no expansion, go to next window
955 (cond (expansion)
956 (t (reset-cdabbrev-window)
957 (next-cdabbrev))))))
959 ;; The following must be eval'd in the minibuffer ::
960 ;; (reset-cdabbrev "cdat")
961 ;; (next-cdabbrev) --> "cdat-simple"
962 ;; (next-cdabbrev) --> "cdat-1-2-3-4"
963 ;; (next-cdabbrev) --> "CDAT-UPCASE"
964 ;; (next-cdabbrev) --> "cdat-wrapping"
965 ;; (next-cdabbrev) --> "cdat_start_sym"
966 ;; (next-cdabbrev) --> nil
967 ;; (next-cdabbrev) --> nil
968 ;; (next-cdabbrev) --> nil
970 ;; _cdat_start_sym
971 ;; cdat-wrapping
974 ;;---------------------------------------------------------------------------
975 ;; Completion Database
976 ;;---------------------------------------------------------------------------
978 ;; We use two storage modes for the two search types ::
979 ;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions
980 ;; Used by search-completion-next
981 ;; the value of the symbol is nil or a cons of head and tail pointers
982 ;; 2) Interning {cmpl-obarray} to see if it's in the database
983 ;; Used by find-exact-completion, completion-in-database-p
984 ;; The value of the symbol is the completion entry
986 ;; bad things may happen if this length is changed due to the way
987 ;; GNU implements obarrays
988 (defconst cmpl-obarray-length 511)
990 (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
991 "An obarray used to store the downcased completion prefixes.
992 Each symbol is bound to a list of completion entries.")
994 (defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
995 "An obarray used to store the downcased completions.
996 Each symbol is bound to a single completion entry.")
998 ;;-----------------------------------------------
999 ;; Completion Entry Structure Definition
1000 ;;-----------------------------------------------
1002 ;; A completion entry is a LIST of string, prefix-symbol num-uses, and
1003 ;; last-use-time (the time the completion was last used)
1004 ;; last-use-time is t if the string should be kept permanently
1005 ;; num-uses is incremented every time the completion is used.
1007 ;; We chose lists because (car foo) is faster than (aref foo 0) and the
1008 ;; creation time is about the same.
1010 ;; READER MACROS
1012 (defmacro completion-string (completion-entry)
1013 (list 'car completion-entry))
1015 (defmacro completion-num-uses (completion-entry)
1016 ;; "The number of times it has used. Used to decide whether to save
1017 ;; it."
1018 (list 'car (list 'cdr completion-entry)))
1020 (defmacro completion-last-use-time (completion-entry)
1021 ;; "The time it was last used. In hours since origin. Used to decide
1022 ;; whether to save it. t if one should always save it."
1023 (list 'nth 2 completion-entry))
1025 (defmacro completion-source (completion-entry)
1026 (list 'nth 3 completion-entry))
1028 ;; WRITER MACROS
1029 (defmacro set-completion-string (completion-entry string)
1030 (list 'setcar completion-entry string))
1032 (defmacro set-completion-num-uses (completion-entry num-uses)
1033 (list 'setcar (list 'cdr completion-entry) num-uses))
1035 (defmacro set-completion-last-use-time (completion-entry last-use-time)
1036 (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time))
1038 ;; CONSTRUCTOR
1039 (defun make-completion (string)
1040 "Returns a list of a completion entry."
1041 (list (list string 0 nil current-completion-source)))
1043 ;; Obsolete
1044 ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
1045 ;; (list 'car (list 'cdr completion-entry)))
1049 ;;-----------------------------------------------
1050 ;; Prefix symbol entry definition
1051 ;;-----------------------------------------------
1052 ;; A cons of (head . tail)
1054 ;; READER Macros
1056 (defmacro cmpl-prefix-entry-head (prefix-entry)
1057 (list 'car prefix-entry))
1059 (defmacro cmpl-prefix-entry-tail (prefix-entry)
1060 (list 'cdr prefix-entry))
1062 ;; WRITER Macros
1064 (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head)
1065 (list 'setcar prefix-entry new-head))
1067 (defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
1068 (list 'setcdr prefix-entry new-tail))
1070 ;; Constructor
1072 (defun make-cmpl-prefix-entry (completion-entry-list)
1073 "Makes a new prefix entry containing only completion-entry."
1074 (cons completion-entry-list completion-entry-list))
1076 ;;-----------------------------------------------
1077 ;; Completion Database - Utilities
1078 ;;-----------------------------------------------
1080 (defun clear-all-completions ()
1081 "Initialize the completion storage. All existing completions are lost."
1082 (interactive)
1083 (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
1084 (setq cmpl-obarray (make-vector cmpl-obarray-length 0))
1085 (cmpl-statistics-block
1086 (record-clear-all-completions)))
1088 (defvar completions-list-return-value)
1090 (defun list-all-completions ()
1091 "Return a list of all the known completion entries."
1092 (let ((completions-list-return-value nil))
1093 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
1094 completions-list-return-value))
1096 (defun list-all-completions-1 (prefix-symbol)
1097 (if (boundp prefix-symbol)
1098 (setq completions-list-return-value
1099 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
1100 completions-list-return-value))))
1102 (defun list-all-completions-by-hash-bucket ()
1103 "Return list of lists of known completion entries, organized by hash bucket."
1104 (let ((completions-list-return-value nil))
1105 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
1106 completions-list-return-value))
1108 (defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
1109 (if (boundp prefix-symbol)
1110 (setq completions-list-return-value
1111 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
1112 completions-list-return-value))))
1115 ;;-----------------------------------------------
1116 ;; Updating the database
1117 ;;-----------------------------------------------
1119 ;; These are the internal functions used to update the datebase
1122 (defvar completion-to-accept nil)
1123 ;;"Set to a string that is pending its acceptance."
1124 ;; this checked by the top level reading functions
1126 (defvar cmpl-db-downcase-string nil)
1127 ;; "Setup by find-exact-completion, etc. The given string, downcased."
1128 (defvar cmpl-db-symbol nil)
1129 ;; "The interned symbol corresponding to cmpl-db-downcase-string.
1130 ;; Set up by cmpl-db-symbol."
1131 (defvar cmpl-db-prefix-symbol nil)
1132 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."
1133 (defvar cmpl-db-entry nil)
1134 (defvar cmpl-db-debug-p nil
1135 "Set to t if you want to debug the database.")
1137 ;; READS
1138 (defun find-exact-completion (string)
1139 "Return the completion entry for STRING or nil.
1140 Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'."
1141 (and (boundp (setq cmpl-db-symbol
1142 (intern (setq cmpl-db-downcase-string (downcase string))
1143 cmpl-obarray)))
1144 (symbol-value cmpl-db-symbol)))
1146 (defun find-cmpl-prefix-entry (prefix-string)
1147 "Return the prefix entry for string.
1148 Sets `cmpl-db-prefix-symbol'.
1149 Prefix-string must be exactly `completion-prefix-min-length' long
1150 and downcased. Sets up `cmpl-db-prefix-symbol'."
1151 (and (boundp (setq cmpl-db-prefix-symbol
1152 (intern prefix-string cmpl-prefix-obarray)))
1153 (symbol-value cmpl-db-prefix-symbol)))
1155 (defvar inside-locate-completion-entry nil)
1156 ;; used to trap lossage in silent error correction
1158 (defun locate-completion-entry (completion-entry prefix-entry)
1159 "Locate the completion entry.
1160 Returns a pointer to the element before the completion entry or nil if
1161 the completion entry is at the head.
1162 Must be called after `find-exact-completion'."
1163 (let ((prefix-list (cmpl-prefix-entry-head prefix-entry))
1164 next-prefix-list)
1165 (cond
1166 ((not (eq (car prefix-list) completion-entry))
1167 ;; not already at head
1168 (while (and prefix-list
1169 (not (eq completion-entry
1170 (car (setq next-prefix-list (cdr prefix-list))))))
1171 (setq prefix-list next-prefix-list))
1172 (cond (;; found
1173 prefix-list)
1174 ;; Didn't find it. Database is messed up.
1175 (cmpl-db-debug-p
1176 ;; not found, error if debug mode
1177 (error "Completion entry exists but not on prefix list - %s"
1178 completion-string))
1179 (inside-locate-completion-entry
1180 ;; recursive error: really scrod
1181 (locate-completion-db-error))
1183 ;; Patch out
1184 (set cmpl-db-symbol nil)
1185 ;; Retry
1186 (locate-completion-entry-retry completion-entry)))))))
1188 (defun locate-completion-entry-retry (old-entry)
1189 (let ((inside-locate-completion-entry t))
1190 (add-completion (completion-string old-entry)
1191 (completion-num-uses old-entry)
1192 (completion-last-use-time old-entry))
1193 (let* ((cmpl-entry (find-exact-completion (completion-string old-entry)))
1194 (pref-entry
1195 (if cmpl-entry
1196 (find-cmpl-prefix-entry
1197 (substring cmpl-db-downcase-string
1198 0 completion-prefix-min-length)))))
1199 (if (and cmpl-entry pref-entry)
1200 ;; try again
1201 (locate-completion-entry cmpl-entry pref-entry)
1202 ;; still losing
1203 (locate-completion-db-error)))))
1205 (defun locate-completion-db-error ()
1206 ;; recursive error: really scrod
1207 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report"))
1209 ;; WRITES
1210 (defun add-completion-to-tail-if-new (string)
1211 "If STRING is not in the database add it to appropriate prefix list.
1212 STRING is added to the end of the appropriate prefix list with
1213 num-uses = 0. The database is unchanged if it is there. STRING must be
1214 longer than `completion-prefix-min-length'.
1215 This must be very fast.
1216 Returns the completion entry."
1217 (or (find-exact-completion string)
1218 ;; not there
1219 (let (;; create an entry
1220 (entry (make-completion string))
1221 ;; setup the prefix
1222 (prefix-entry (find-cmpl-prefix-entry
1223 (substring cmpl-db-downcase-string 0
1224 (cmpl-read-time-eval
1225 completion-prefix-min-length)))))
1226 ;; The next two forms should happen as a unit (atomically) but
1227 ;; no fatal errors should result if that is not the case.
1228 (cond (prefix-entry
1229 ;; These two should be atomic, but nothing fatal will happen
1230 ;; if they're not.
1231 (setcdr (cmpl-prefix-entry-tail prefix-entry) entry)
1232 (set-cmpl-prefix-entry-tail prefix-entry entry))
1234 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
1235 ;; statistics
1236 (cmpl-statistics-block
1237 (note-added-completion))
1238 ;; set symbol
1239 (set cmpl-db-symbol (car entry)))))
1241 (defun add-completion-to-head (completion-string)
1242 "If COMPLETION-STRING is not in the database, add it to prefix list.
1243 We add COMPLETION-STRING to the head of the appropriate prefix list,
1244 or it to the head of the list.
1245 COMPLETION-STRING must be longer than `completion-prefix-min-length'.
1246 Updates the saved string with the supplied string.
1247 This must be very fast.
1248 Returns the completion entry."
1249 ;; Handle pending acceptance
1250 (if completion-to-accept (accept-completion))
1251 ;; test if already in database
1252 (if (setq cmpl-db-entry (find-exact-completion completion-string))
1253 ;; found
1254 (let* ((prefix-entry (find-cmpl-prefix-entry
1255 (substring cmpl-db-downcase-string 0
1256 (cmpl-read-time-eval
1257 completion-prefix-min-length))))
1258 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
1259 (cmpl-ptr (cdr splice-ptr)))
1260 ;; update entry
1261 (set-completion-string cmpl-db-entry completion-string)
1262 ;; move to head (if necessary)
1263 (cond (splice-ptr
1264 ;; These should all execute atomically but it is not fatal if
1265 ;; they don't.
1266 ;; splice it out
1267 (or (setcdr splice-ptr (cdr cmpl-ptr))
1268 ;; fix up tail if necessary
1269 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
1270 ;; splice in at head
1271 (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
1272 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)))
1273 cmpl-db-entry)
1274 ;; not there
1275 (let (;; create an entry
1276 (entry (make-completion completion-string))
1277 ;; setup the prefix
1278 (prefix-entry (find-cmpl-prefix-entry
1279 (substring cmpl-db-downcase-string 0
1280 (cmpl-read-time-eval
1281 completion-prefix-min-length)))))
1282 (cond (prefix-entry
1283 ;; Splice in at head
1284 (setcdr entry (cmpl-prefix-entry-head prefix-entry))
1285 (set-cmpl-prefix-entry-head prefix-entry entry))
1287 ;; Start new prefix entry
1288 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
1289 ;; statistics
1290 (cmpl-statistics-block
1291 (note-added-completion))
1292 ;; Add it to the symbol
1293 (set cmpl-db-symbol (car entry)))))
1295 (defun delete-completion (completion-string)
1296 "Delete the completion from the database.
1297 String must be longer than `completion-prefix-min-length'."
1298 ;; Handle pending acceptance
1299 (if completion-to-accept (accept-completion))
1300 (if (setq cmpl-db-entry (find-exact-completion completion-string))
1301 ;; found
1302 (let* ((prefix-entry (find-cmpl-prefix-entry
1303 (substring cmpl-db-downcase-string 0
1304 (cmpl-read-time-eval
1305 completion-prefix-min-length))))
1306 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)))
1307 ;; delete symbol reference
1308 (set cmpl-db-symbol nil)
1309 ;; remove from prefix list
1310 (cond (splice-ptr
1311 ;; not at head
1312 (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
1313 ;; fix up tail if necessary
1314 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)))
1316 ;; at head
1317 (or (set-cmpl-prefix-entry-head
1318 prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
1319 ;; List is now empty
1320 (set cmpl-db-prefix-symbol nil))))
1321 (cmpl-statistics-block
1322 (note-completion-deleted)))
1323 (error "Unknown completion `%s'" completion-string)))
1325 ;; Tests --
1326 ;; - Add and Find -
1327 ;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1328 ;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
1329 ;; (find-exact-completion "bana") --> nil
1330 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1331 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1332 ;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
1333 ;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
1334 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1335 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1336 ;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1337 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1338 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1340 ;; - Deleting -
1341 ;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1342 ;; (delete-completion "banner")
1343 ;; (find-exact-completion "banner") --> nil
1344 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1345 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1346 ;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1347 ;; (delete-completion "banana")
1348 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
1349 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1350 ;; (delete-completion "banner")
1351 ;; (delete-completion "banish")
1352 ;; (find-cmpl-prefix-entry "ban") --> nil
1353 ;; (delete-completion "banner") --> error
1355 ;; - Tail -
1356 ;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
1357 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1358 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1359 ;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
1360 ;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
1361 ;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
1365 ;;---------------------------------------------------------------------------
1366 ;; Database Update :: Interface level routines
1367 ;;---------------------------------------------------------------------------
1369 ;; These lie on top of the database ref. functions but below the standard
1370 ;; user interface level
1373 (defun interactive-completion-string-reader (prompt)
1374 (let* ((default (symbol-under-or-before-point))
1375 (new-prompt
1376 (if default
1377 (format "%s: (default: %s) " prompt default)
1378 (format "%s: " prompt)))
1379 (read (completing-read new-prompt cmpl-obarray)))
1380 (if (zerop (length read)) (setq read (or default "")))
1381 (list read)))
1383 (defun check-completion-length (string)
1384 (if (< (length string) completion-min-length)
1385 (error "The string `%s' is too short to be saved as a completion"
1386 string)
1387 (list string)))
1389 (defun add-completion (string &optional num-uses last-use-time)
1390 "Add STRING to completion list, or move it to head of list.
1391 The completion is altered appropriately if num-uses and/or last-use-time is
1392 specified."
1393 (interactive (interactive-completion-string-reader "Completion to add"))
1394 (check-completion-length string)
1395 (let* ((current-completion-source (if (interactive-p)
1396 cmpl-source-interactive
1397 current-completion-source))
1398 (entry (add-completion-to-head string)))
1400 (if num-uses (set-completion-num-uses entry num-uses))
1401 (if last-use-time
1402 (set-completion-last-use-time entry last-use-time))))
1404 (defun add-permanent-completion (string)
1405 "Add STRING if it isn't already listed, and mark it permanent."
1406 (interactive
1407 (interactive-completion-string-reader "Completion to add permanently"))
1408 (let ((current-completion-source (if (interactive-p)
1409 cmpl-source-interactive
1410 current-completion-source)))
1411 (add-completion string nil t)))
1413 (defun kill-completion (string)
1414 (interactive (interactive-completion-string-reader "Completion to kill"))
1415 (check-completion-length string)
1416 (delete-completion string))
1418 (defun accept-completion ()
1419 "Accepts the pending completion in `completion-to-accept'.
1420 This bumps num-uses. Called by `add-completion-to-head' and
1421 `completion-search-reset'."
1422 (let ((string completion-to-accept)
1423 ;; if this is added afresh here, then it must be a cdabbrev
1424 (current-completion-source cmpl-source-cdabbrev)
1425 entry)
1426 (setq completion-to-accept nil)
1427 (setq entry (add-completion-to-head string))
1428 (set-completion-num-uses entry (1+ (completion-num-uses entry)))
1429 (setq cmpl-completions-accepted-p t)))
1431 (defun use-completion-under-point ()
1432 "Add the completion symbol underneath the point into the completion buffer."
1433 (let ((string (and enable-completion (symbol-under-point)))
1434 (current-completion-source cmpl-source-cursor-moves))
1435 (if string (add-completion-to-head string))))
1437 (defun use-completion-before-point ()
1438 "Add the completion symbol before point into the completion buffer."
1439 (let ((string (and enable-completion (symbol-before-point)))
1440 (current-completion-source cmpl-source-cursor-moves))
1441 (if string (add-completion-to-head string))))
1443 (defun use-completion-under-or-before-point ()
1444 "Add the completion symbol before point into the completion buffer."
1445 (let ((string (and enable-completion (symbol-under-or-before-point)))
1446 (current-completion-source cmpl-source-cursor-moves))
1447 (if string (add-completion-to-head string))))
1449 (defun use-completion-before-separator ()
1450 "Add the completion symbol before point into the completion buffer.
1451 Completions added this way will automatically be saved if
1452 `completion-on-separator-character' is non-nil."
1453 (let ((string (and enable-completion (symbol-before-point)))
1454 (current-completion-source cmpl-source-separator)
1455 entry)
1456 (cmpl-statistics-block
1457 (note-separator-character string))
1458 (cond (string
1459 (setq entry (add-completion-to-head string))
1460 (if (and completion-on-separator-character
1461 (zerop (completion-num-uses entry)))
1462 (progn
1463 (set-completion-num-uses entry 1)
1464 (setq cmpl-completions-accepted-p t)))))))
1466 ;; Tests --
1467 ;; - Add and Find -
1468 ;; (add-completion "banana" 5 10)
1469 ;; (find-exact-completion "banana") --> ("banana" 5 10 0)
1470 ;; (add-completion "banana" 6)
1471 ;; (find-exact-completion "banana") --> ("banana" 6 10 0)
1472 ;; (add-completion "banish")
1473 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1475 ;; - Accepting -
1476 ;; (setq completion-to-accept "banana")
1477 ;; (accept-completion)
1478 ;; (find-exact-completion "banana") --> ("banana" 7 10)
1479 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1480 ;; (setq completion-to-accept "banish")
1481 ;; (add-completion "banner")
1482 ;; (car (find-cmpl-prefix-entry "ban"))
1483 ;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
1485 ;; - Deleting -
1486 ;; (kill-completion "banish")
1487 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
1490 ;;---------------------------------------------------------------------------
1491 ;; Searching the database
1492 ;;---------------------------------------------------------------------------
1493 ;; Functions outside this block must call completion-search-reset followed
1494 ;; by calls to completion-search-next or completion-search-peek
1497 ;; Status variables
1498 ;; Commented out to improve loading speed
1499 (defvar cmpl-test-string "")
1500 ;; "The current string used by completion-search-next."
1501 (defvar cmpl-test-regexp "")
1502 ;; "The current regexp used by completion-search-next.
1503 ;; (derived from cmpl-test-string)"
1504 (defvar cmpl-last-index 0)
1505 ;; "The last index that completion-search-next was called with."
1506 (defvar cmpl-cdabbrev-reset-p nil)
1507 ;; "Set to t when cdabbrevs have been reset."
1508 (defvar cmpl-next-possibilities nil)
1509 ;; "A pointer to the element BEFORE the next set of possible completions.
1510 ;; cadr of this is the cmpl-next-possibility"
1511 (defvar cmpl-starting-possibilities nil)
1512 ;; "The initial list of starting possibilities."
1513 (defvar cmpl-next-possibility nil)
1514 ;; "The cached next possibility."
1515 (defvar cmpl-tried-list nil)
1516 ;; "A downcased list of all the completions we have tried."
1519 (defun completion-search-reset (string)
1520 "Set up the for completion searching for STRING.
1521 STRING must be longer than `completion-prefix-min-length'."
1522 (if completion-to-accept (accept-completion))
1523 (setq cmpl-starting-possibilities
1524 (cmpl-prefix-entry-head
1525 (find-cmpl-prefix-entry
1526 (downcase (substring string 0 completion-prefix-min-length))))
1527 cmpl-test-string string
1528 cmpl-test-regexp (concat (regexp-quote string) "."))
1529 (completion-search-reset-1))
1531 (defun completion-search-reset-1 ()
1532 (setq cmpl-next-possibilities cmpl-starting-possibilities
1533 cmpl-next-possibility nil
1534 cmpl-cdabbrev-reset-p nil
1535 cmpl-last-index -1
1536 cmpl-tried-list nil))
1538 (defun completion-search-next (index)
1539 "Return the next completion entry.
1540 If INDEX is out of sequence, reset and start from the top.
1541 If there are no more entries, try cdabbrev and returns only a string."
1542 (cond
1543 ((= index (setq cmpl-last-index (1+ cmpl-last-index)))
1544 (completion-search-peek t))
1545 ((< index 0)
1546 (completion-search-reset-1)
1547 (setq cmpl-last-index index)
1548 ;; reverse the possibilities list
1549 (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
1550 ;; do a "normal" search
1551 (while (and (completion-search-peek nil)
1552 (< (setq index (1+ index)) 0))
1553 (setq cmpl-next-possibility nil))
1554 (cond ((not cmpl-next-possibilities))
1555 ;; If no more possibilities, leave it that way
1556 ((= -1 cmpl-last-index)
1557 ;; next completion is at index 0. reset next-possibility list
1558 ;; to start at beginning
1559 (setq cmpl-next-possibilities cmpl-starting-possibilities))
1561 ;; otherwise point to one before current
1562 (setq cmpl-next-possibilities
1563 (nthcdr (- (length cmpl-starting-possibilities)
1564 (length cmpl-next-possibilities))
1565 cmpl-starting-possibilities)))))
1567 ;; non-negative index, reset and search
1568 ;;(prin1 'reset)
1569 (completion-search-reset-1)
1570 (setq cmpl-last-index index)
1571 (while (and (completion-search-peek t)
1572 (not (< (setq index (1- index)) 0)))
1573 (setq cmpl-next-possibility nil))))
1574 (prog1
1575 cmpl-next-possibility
1576 (setq cmpl-next-possibility nil)))
1579 (defun completion-search-peek (use-cdabbrev)
1580 "Returns the next completion entry without actually moving the pointers.
1581 Calling this again or calling `completion-search-next' results in the same
1582 string being returned. Depends on `case-fold-search'.
1583 If there are no more entries, try cdabbrev and then return only a string."
1584 (cond
1585 ;; return the cached value if we have it
1586 (cmpl-next-possibility)
1587 ((and cmpl-next-possibilities
1588 ;; still a few possibilities left
1589 (progn
1590 (while
1591 (and (not (eq 0 (string-match cmpl-test-regexp
1592 (completion-string (car cmpl-next-possibilities)))))
1593 (setq cmpl-next-possibilities (cdr cmpl-next-possibilities))))
1594 cmpl-next-possibilities))
1595 ;; successful match
1596 (setq cmpl-next-possibility (car cmpl-next-possibilities)
1597 cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility))
1598 cmpl-tried-list)
1599 cmpl-next-possibilities (cdr cmpl-next-possibilities))
1600 cmpl-next-possibility)
1601 (use-cdabbrev
1602 ;; unsuccessful, use cdabbrev
1603 (cond ((not cmpl-cdabbrev-reset-p)
1604 (reset-cdabbrev cmpl-test-string cmpl-tried-list)
1605 (setq cmpl-cdabbrev-reset-p t)))
1606 (setq cmpl-next-possibility (next-cdabbrev)))
1607 ;; Completely unsuccessful, return nil
1610 ;; Tests --
1611 ;; - Add and Find -
1612 ;; (add-completion "banana")
1613 ;; (completion-search-reset "ban")
1614 ;; (completion-search-next 0) --> "banana"
1616 ;; - Discrimination -
1617 ;; (add-completion "cumberland")
1618 ;; (add-completion "cumberbund")
1619 ;; cumbering
1620 ;; (completion-search-reset "cumb")
1621 ;; (completion-search-peek t) --> "cumberbund"
1622 ;; (completion-search-next 0) --> "cumberbund"
1623 ;; (completion-search-peek t) --> "cumberland"
1624 ;; (completion-search-next 1) --> "cumberland"
1625 ;; (completion-search-peek nil) --> nil
1626 ;; (completion-search-next 2) --> "cumbering" {cdabbrev}
1627 ;; (completion-search-next 3) --> nil or "cumming"{depends on context}
1628 ;; (completion-search-next 1) --> "cumberland"
1629 ;; (completion-search-peek t) --> "cumbering" {cdabbrev}
1631 ;; - Accepting -
1632 ;; (completion-search-next 1) --> "cumberland"
1633 ;; (setq completion-to-accept "cumberland")
1634 ;; (completion-search-reset "foo")
1635 ;; (completion-search-reset "cum")
1636 ;; (completion-search-next 0) --> "cumberland"
1638 ;; - Deleting -
1639 ;; (kill-completion "cumberland")
1640 ;; cummings
1641 ;; (completion-search-reset "cum")
1642 ;; (completion-search-next 0) --> "cumberbund"
1643 ;; (completion-search-next 1) --> "cummings"
1645 ;; - Ignoring Capitalization -
1646 ;; (completion-search-reset "CuMb")
1647 ;; (completion-search-next 0) --> "cumberbund"
1651 ;;-----------------------------------------------
1652 ;; COMPLETE
1653 ;;-----------------------------------------------
1655 (defun completion-mode ()
1656 "Toggle whether or not to add new words to the completion database."
1657 (interactive)
1658 (setq enable-completion (not enable-completion))
1659 (message "Completion mode is now %s." (if enable-completion "ON" "OFF")))
1661 (defvar cmpl-current-index 0)
1662 (defvar cmpl-original-string nil)
1663 (defvar cmpl-last-insert-location -1)
1664 (defvar cmpl-leave-point-at-start nil)
1666 (defun complete (&optional arg)
1667 "Fill out a completion of the word before point.
1668 Point is left at end. Consecutive calls rotate through all possibilities.
1669 Prefix args ::
1670 control-u :: leave the point at the beginning of the completion rather
1671 than at the end.
1672 a number :: rotate through the possible completions by that amount
1673 `-' :: same as -1 (insert previous completion)
1674 {See the comments at the top of `completion.el' for more info.}"
1675 (interactive "*p")
1676 ;;; Set up variables
1677 (cond ((eq last-command this-command)
1678 ;; Undo last one
1679 (delete-region cmpl-last-insert-location (point))
1680 ;; get next completion
1681 (setq cmpl-current-index (+ cmpl-current-index (or arg 1))))
1683 (if (not cmpl-initialized-p)
1684 (initialize-completions)) ;; make sure everything's loaded
1685 (cond ((consp current-prefix-arg) ;; control-u
1686 (setq arg 0)
1687 (setq cmpl-leave-point-at-start t))
1689 (setq cmpl-leave-point-at-start nil)))
1690 ;; get string
1691 (setq cmpl-original-string (symbol-before-point-for-complete))
1692 (cond ((not cmpl-original-string)
1693 (setq this-command 'failed-complete)
1694 (error "To complete, point must be after a symbol at least %d character long"
1695 completion-prefix-min-length)))
1696 ;; get index
1697 (setq cmpl-current-index (if current-prefix-arg arg 0))
1698 ;; statistics
1699 (cmpl-statistics-block
1700 (note-complete-entered-afresh cmpl-original-string))
1701 ;; reset database
1702 (completion-search-reset cmpl-original-string)
1703 ;; erase what we've got
1704 (delete-region cmpl-symbol-start cmpl-symbol-end)))
1706 ;; point is at the point to insert the new symbol
1707 ;; Get the next completion
1708 (let* ((print-status-p
1709 (and (>= baud-rate completion-prompt-speed-threshold)
1710 (not (minibuffer-window-selected-p))))
1711 (insert-point (point))
1712 (entry (completion-search-next cmpl-current-index))
1713 string)
1714 ;; entry is either a completion entry or a string (if cdabbrev)
1716 ;; If found, insert
1717 (cond (entry
1718 ;; Setup for proper case
1719 (setq string (if (stringp entry)
1720 entry (completion-string entry)))
1721 (setq string (cmpl-merge-string-cases
1722 string cmpl-original-string))
1723 ;; insert
1724 (insert string)
1725 ;; accept it
1726 (setq completion-to-accept string)
1727 ;; fixup and cache point
1728 (cond (cmpl-leave-point-at-start
1729 (setq cmpl-last-insert-location (point))
1730 (goto-char insert-point))
1731 (t;; point at end,
1732 (setq cmpl-last-insert-location insert-point)))
1733 ;; statistics
1734 (cmpl-statistics-block
1735 (note-complete-inserted entry cmpl-current-index))
1736 ;; Done ! cmpl-stat-complete-successful
1737 ;;display the next completion
1738 (cond
1739 ((and print-status-p
1740 ;; This updates the display and only prints if there
1741 ;; is no typeahead
1742 (sit-for 0)
1743 (setq entry
1744 (completion-search-peek
1745 completion-cdabbrev-prompt-flag)))
1746 (setq string (if (stringp entry)
1747 entry (completion-string entry)))
1748 (setq string (cmpl-merge-string-cases
1749 string cmpl-original-string))
1750 (message "Next completion: %s" string))))
1751 (t;; none found, insert old
1752 (insert cmpl-original-string)
1753 ;; Don't accept completions
1754 (setq completion-to-accept nil)
1755 ;; print message
1756 ;; This used to call cmpl19-sit-for, an undefined function.
1757 ;; I hope that sit-for does the right thing; I don't know -- rms.
1758 (if (and print-status-p (sit-for 0))
1759 (message "No %scompletions."
1760 (if (eq this-command last-command) "more " "")))
1761 ;; statistics
1762 (cmpl-statistics-block
1763 (record-complete-failed cmpl-current-index))
1764 ;; Pretend that we were never here
1765 (setq this-command 'failed-complete)))))
1767 ;;---------------------------------------------------------------------------
1768 ;; Parsing definitions from files into the database
1769 ;;---------------------------------------------------------------------------
1771 ;;-----------------------------------------------
1772 ;; Top Level functions ::
1773 ;;-----------------------------------------------
1775 ;; User interface
1776 (defun add-completions-from-file (file)
1777 "Parse possible completions from a FILE and add them to data base."
1778 (interactive "fFile: ")
1779 (setq file (expand-file-name file))
1780 (let* ((buffer (get-file-buffer file))
1781 (buffer-already-there-p buffer))
1782 (if (not buffer-already-there-p)
1783 (let ((completions-merging-modes nil))
1784 (setq buffer (find-file-noselect file))))
1785 (unwind-protect
1786 (save-excursion
1787 (set-buffer buffer)
1788 (add-completions-from-buffer))
1789 (if (not buffer-already-there-p)
1790 (kill-buffer buffer)))))
1792 (defun add-completions-from-buffer ()
1793 (interactive)
1794 (let ((current-completion-source cmpl-source-file-parsing)
1795 (start-num
1796 (cmpl-statistics-block
1797 (aref completion-add-count-vector cmpl-source-file-parsing)))
1798 mode)
1799 (cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
1800 (add-completions-from-lisp-buffer)
1801 (setq mode 'lisp))
1802 ((memq major-mode '(c-mode))
1803 (add-completions-from-c-buffer)
1804 (setq mode 'c))
1806 (error "Cannot parse completions in %s buffers"
1807 major-mode)))
1808 (cmpl-statistics-block
1809 (record-cmpl-parse-file
1810 mode (point-max)
1811 (- (aref completion-add-count-vector cmpl-source-file-parsing)
1812 start-num)))))
1814 ;; Find file hook
1815 (defun cmpl-find-file-hook ()
1816 (cond (enable-completion
1817 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
1818 (memq 'lisp completions-merging-modes))
1819 (add-completions-from-buffer))
1820 ((and (memq major-mode '(c-mode))
1821 (memq 'c completions-merging-modes))
1822 (add-completions-from-buffer))))))
1824 ;;-----------------------------------------------
1825 ;; Tags Table Completions
1826 ;;-----------------------------------------------
1828 (defun add-completions-from-tags-table ()
1829 ;; Inspired by eero@media-lab.media.mit.edu
1830 "Add completions from the current tags table."
1831 (interactive)
1832 (visit-tags-table-buffer) ;this will prompt if no tags-table
1833 (save-excursion
1834 (goto-char (point-min))
1835 (let (string)
1836 (condition-case e
1837 (while t
1838 (search-forward "\177")
1839 (backward-char 3)
1840 (and (setq string (symbol-under-point))
1841 (add-completion-to-tail-if-new string))
1842 (forward-char 3))
1843 (search-failed)))))
1846 ;;-----------------------------------------------
1847 ;; Lisp File completion parsing
1848 ;;-----------------------------------------------
1849 ;; This merely looks for phrases beginning with (def.... or
1850 ;; (package:def ... and takes the next word.
1852 ;; We tried using forward-lines and explicit searches but the regexp technique
1853 ;; was faster. (About 100K characters per second)
1855 (defconst *lisp-def-regexp*
1856 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
1857 "A regexp that searches for Lisp definition form.")
1859 ;; Tests -
1860 ;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
1861 ;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
1862 ;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
1863 ;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
1865 ;; Parses all the definition names from a Lisp mode buffer and adds them to
1866 ;; the completion database.
1867 (defun add-completions-from-lisp-buffer ()
1868 ;;; Benchmarks
1869 ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second
1870 (let (string)
1871 (save-excursion
1872 (goto-char (point-min))
1873 (condition-case e
1874 (while t
1875 (re-search-forward *lisp-def-regexp*)
1876 (and (setq string (symbol-under-point))
1877 (add-completion-to-tail-if-new string)))
1878 (search-failed)))))
1881 ;;-----------------------------------------------
1882 ;; C file completion parsing
1883 ;;-----------------------------------------------
1884 ;; C :
1885 ;; Looks for #define or [<storage class>] [<type>] <name>{,<name>}
1886 ;; or structure, array or pointer defs.
1887 ;; It gets most of the definition names.
1889 ;; As you might suspect by now, we use some symbol table hackery
1891 ;; Symbol separator chars (have whitespace syntax) --> , ; * = (
1892 ;; Opening char --> [ {
1893 ;; Closing char --> ] }
1894 ;; opening and closing must be skipped over
1895 ;; Whitespace chars (have symbol syntax)
1896 ;; Everything else has word syntax
1898 (defun cmpl-make-c-def-completion-syntax-table ()
1899 (let ((table (make-syntax-table))
1900 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r))
1901 ;; unfortunately the ?( causes the parens to appear unbalanced
1902 (separator-chars '(?, ?* ?= ?\( ?\;))
1904 ;; default syntax is whitespace
1905 (setq i 0)
1906 (while (< i 256)
1907 (modify-syntax-entry i "w" table)
1908 (setq i (1+ i)))
1909 (dolist (char whitespace-chars)
1910 (modify-syntax-entry char "_" table))
1911 (dolist (char separator-chars)
1912 (modify-syntax-entry char " " table))
1913 (modify-syntax-entry ?\[ "(]" table)
1914 (modify-syntax-entry ?\{ "(}" table)
1915 (modify-syntax-entry ?\] ")[" table)
1916 (modify-syntax-entry ?\} "){" table)
1917 table))
1919 (defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table))
1921 ;; Regexps
1922 (defconst *c-def-regexp*
1923 ;; This stops on lines with possible definitions
1924 "\n[_a-zA-Z#]"
1925 ;; This stops after the symbol to add.
1926 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
1927 ;; This stops before the symbol to add. {Test cases in parens. below}
1928 ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)"
1929 ;; this simple version picks up too much extraneous stuff
1930 ;; "\n\\(\\w\\|\\s_\\|#\\)\\B"
1931 "A regexp that searches for a definition form.")
1933 ;(defconst *c-cont-regexp*
1934 ; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)"
1935 ; "This regexp should be used in a looking-at to parse for lists of variables.")
1937 ;(defconst *c-struct-regexp*
1938 ; "\\(*\\|\\s \\)*\\b"
1939 ; "This regexp should be used to test whether a symbol follows a structure definition.")
1941 ;(defun test-c-def-regexp (regexp string)
1942 ; (and (eq 0 (string-match regexp string)) (match-end 0))
1945 ;; Tests -
1946 ;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
1947 ;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
1948 ;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
1949 ;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
1950 ;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
1951 ;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
1952 ;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
1953 ;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
1954 ;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
1955 ;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
1956 ;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
1958 ;; Parses all the definition names from a C mode buffer and adds them to the
1959 ;; completion database.
1960 (defun add-completions-from-c-buffer ()
1961 ;; Benchmark --
1962 ;; Sun 3/280-- 1250 lines/sec.
1964 (let (string next-point char
1965 (saved-syntax (syntax-table)))
1966 (save-excursion
1967 (goto-char (point-min))
1968 (catch 'finish-add-completions
1969 (unwind-protect
1970 (while t
1971 ;; we loop here only when scan-sexps fails
1972 ;; (i.e. unbalance exps.)
1973 (set-syntax-table cmpl-c-def-syntax-table)
1974 (condition-case e
1975 (while t
1976 (re-search-forward *c-def-regexp*)
1977 (cond
1978 ((= (preceding-char) ?#)
1979 ;; preprocessor macro, see if it's one we handle
1980 (setq string (buffer-substring (point) (+ (point) 6)))
1981 (cond ((or (string-equal string "define")
1982 (string-equal string "ifdef "))
1983 ;; skip forward over definition symbol
1984 ;; and add it to database
1985 (and (forward-word 2)
1986 (setq string (symbol-before-point))
1987 ;;(push string foo)
1988 (add-completion-to-tail-if-new string)))))
1990 ;; C definition
1991 (setq next-point (point))
1992 (while (and
1993 next-point
1994 ;; scan to next separator char.
1995 (setq next-point (scan-sexps next-point 1)))
1996 ;; position the point on the word we want to add
1997 (goto-char next-point)
1998 (while (= (setq char (following-char)) ?*)
1999 ;; handle pointer ref
2000 ;; move to next separator char.
2001 (goto-char
2002 (setq next-point (scan-sexps (point) 1))))
2003 (forward-word -1)
2004 ;; add to database
2005 (if (setq string (symbol-under-point))
2006 ;; (push string foo)
2007 (add-completion-to-tail-if-new string)
2008 ;; Local TMC hack (useful for parsing paris.h)
2009 (if (and (looking-at "_AP") ;; "ansi prototype"
2010 (progn
2011 (forward-word -1)
2012 (setq string
2013 (symbol-under-point))))
2014 (add-completion-to-tail-if-new string)))
2015 ;; go to next
2016 (goto-char next-point)
2017 ;; (push (format "%c" (following-char)) foo)
2018 (if (= (char-syntax char) ?\()
2019 ;; if on an opening delimiter, go to end
2020 (while (= (char-syntax char) ?\()
2021 (setq next-point (scan-sexps next-point 1)
2022 char (char-after next-point)))
2023 (or (= char ?,)
2024 ;; Current char is an end char.
2025 (setq next-point nil)))))))
2026 (search-failed ;;done
2027 (throw 'finish-add-completions t))
2028 (error
2029 ;; Check for failure in scan-sexps
2030 (if (or (string-equal (nth 1 e)
2031 "Containing expression ends prematurely")
2032 (string-equal (nth 1 e) "Unbalanced parentheses"))
2033 ;; unbalanced paren., keep going
2034 ;;(ding)
2035 (forward-line 1)
2036 (message "Error parsing C buffer for completions--please send bug report")
2037 (throw 'finish-add-completions t)))))
2038 (set-syntax-table saved-syntax))))))
2041 ;;---------------------------------------------------------------------------
2042 ;; Init files
2043 ;;---------------------------------------------------------------------------
2045 ;; The version of save-completions-to-file called at kill-emacs time.
2046 (defun kill-emacs-save-completions ()
2047 (if (and save-completions-flag enable-completion cmpl-initialized-p)
2048 (cond
2049 ((not cmpl-completions-accepted-p)
2050 (message "Completions database has not changed - not writing."))
2052 (save-completions-to-file)))))
2054 ;; There is no point bothering to change this again
2055 ;; unless the package changes so much that it matters
2056 ;; for people that have saved completions.
2057 (defconst completion-version "11")
2059 (defconst saved-cmpl-file-header
2060 ";;; Completion Initialization file.
2061 ;; Version = %s
2062 ;; Format is (<string> . <last-use-time>)
2063 ;; <string> is the completion
2064 ;; <last-use-time> is the time the completion was last used
2065 ;; If it is t, the completion will never be pruned from the file.
2066 ;; Otherwise it is in hours since origin.
2067 \n")
2069 (defun completion-backup-filename (filename)
2070 (concat filename ".BAK"))
2072 (defun save-completions-to-file (&optional filename)
2073 "Save completions in init file FILENAME.
2074 If file name is not specified, use `save-completions-file-name'."
2075 (interactive)
2076 (setq filename (expand-file-name (or filename save-completions-file-name)))
2077 (if (file-writable-p filename)
2078 (progn
2079 (if (not cmpl-initialized-p)
2080 (initialize-completions));; make sure everything's loaded
2081 (message "Saving completions to file %s" filename)
2083 (let* ((delete-old-versions t)
2084 (kept-old-versions 0)
2085 (kept-new-versions completions-file-versions-kept)
2086 last-use-time
2087 (current-time (cmpl-hours-since-origin))
2088 (total-in-db 0)
2089 (total-perm 0)
2090 (total-saved 0)
2091 (backup-filename (completion-backup-filename filename)))
2093 (save-excursion
2094 (get-buffer-create " *completion-save-buffer*")
2095 (set-buffer " *completion-save-buffer*")
2096 (setq buffer-file-name filename)
2098 (if (not (verify-visited-file-modtime (current-buffer)))
2099 (progn
2100 ;; file has changed on disk. Bring us up-to-date
2101 (message "Completion file has changed. Merging. . .")
2102 (load-completions-from-file filename t)
2103 (message "Merging finished. Saving completions to file %s" filename)))
2105 ;; prepare the buffer to be modified
2106 (clear-visited-file-modtime)
2107 (erase-buffer)
2108 ;; (/ 1 0)
2109 (insert (format saved-cmpl-file-header completion-version))
2110 (dolist (completion (list-all-completions))
2111 (setq total-in-db (1+ total-in-db))
2112 (setq last-use-time (completion-last-use-time completion))
2113 ;; Update num uses and maybe write completion to a file
2114 (cond ((or;; Write to file if
2115 ;; permanent
2116 (and (eq last-use-time t)
2117 (setq total-perm (1+ total-perm)))
2118 ;; or if
2119 (if (> (completion-num-uses completion) 0)
2120 ;; it's been used
2121 (setq last-use-time current-time)
2122 ;; or it was saved before and
2123 (and last-use-time
2124 ;; save-completions-retention-time is nil
2125 (or (not save-completions-retention-time)
2126 ;; or time since last use is < ...retention-time*
2127 (< (- current-time last-use-time)
2128 save-completions-retention-time)))))
2129 ;; write to file
2130 (setq total-saved (1+ total-saved))
2131 (insert (prin1-to-string (cons (completion-string completion)
2132 last-use-time)) "\n"))))
2134 ;; write the buffer
2135 (condition-case e
2136 (let ((file-exists-p (file-exists-p filename)))
2137 (if file-exists-p
2138 (progn
2139 ;; If file exists . . .
2140 ;; Save a backup(so GNU doesn't screw us when we're out of disk)
2141 ;; (GNU leaves a 0 length file if it gets a disk full error!)
2143 ;; If backup doesn't exit, Rename current to backup
2144 ;; {If backup exists the primary file is probably messed up}
2145 (or (file-exists-p backup-filename)
2146 (rename-file filename backup-filename))
2147 ;; Copy the backup back to the current name
2148 ;; (so versioning works)
2149 (copy-file backup-filename filename t)))
2150 ;; Save it
2151 (save-buffer)
2152 (if file-exists-p
2153 ;; If successful, remove backup
2154 (delete-file backup-filename)))
2155 (error
2156 (set-buffer-modified-p nil)
2157 (message "Couldn't save completion file `%s'" filename)))
2158 ;; Reset accepted-p flag
2159 (setq cmpl-completions-accepted-p nil) )
2160 (cmpl-statistics-block
2161 (record-save-completions total-in-db total-perm total-saved))))))
2163 ;;(defun auto-save-completions ()
2164 ;; (if (and save-completions-flag enable-completion cmpl-initialized-p
2165 ;; *completion-auto-save-period*
2166 ;; (> cmpl-emacs-idle-time *completion-auto-save-period*)
2167 ;; cmpl-completions-accepted-p)
2168 ;; (save-completions-to-file)))
2170 ;;(add-hook 'cmpl-emacs-idle-time-hooks 'auto-save-completions)
2172 (defun load-completions-from-file (&optional filename no-message-p)
2173 "Load a completion init file FILENAME.
2174 If file is not specified, then use `save-completions-file-name'."
2175 (interactive)
2176 (setq filename (expand-file-name (or filename save-completions-file-name)))
2177 (let* ((backup-filename (completion-backup-filename filename))
2178 (backup-readable-p (file-readable-p backup-filename)))
2179 (if backup-readable-p (setq filename backup-filename))
2180 (if (file-readable-p filename)
2181 (progn
2182 (if (not no-message-p)
2183 (message "Loading completions from %sfile %s . . ."
2184 (if backup-readable-p "backup " "") filename))
2185 (save-excursion
2186 (get-buffer-create " *completion-save-buffer*")
2187 (set-buffer " *completion-save-buffer*")
2188 (setq buffer-file-name filename)
2189 ;; prepare the buffer to be modified
2190 (clear-visited-file-modtime)
2191 (erase-buffer)
2193 (let ((insert-okay-p nil)
2194 (buffer (current-buffer))
2195 (current-time (cmpl-hours-since-origin))
2196 string num-uses entry last-use-time
2197 cmpl-entry cmpl-last-use-time
2198 (current-completion-source cmpl-source-init-file)
2199 (start-num
2200 (cmpl-statistics-block
2201 (aref completion-add-count-vector cmpl-source-file-parsing)))
2202 (total-in-file 0) (total-perm 0))
2203 ;; insert the file into a buffer
2204 (condition-case e
2205 (progn (insert-file-contents filename t)
2206 (setq insert-okay-p t))
2208 (file-error
2209 (message "File error trying to load completion file %s."
2210 filename)))
2211 ;; parse it
2212 (if insert-okay-p
2213 (progn
2214 (goto-char (point-min))
2216 (condition-case e
2217 (while t
2218 (setq entry (read buffer))
2219 (setq total-in-file (1+ total-in-file))
2220 (cond
2221 ((and (consp entry)
2222 (stringp (setq string (car entry)))
2223 (cond
2224 ((eq (setq last-use-time (cdr entry)) 'T)
2225 ;; handle case sensitivity
2226 (setq total-perm (1+ total-perm))
2227 (setq last-use-time t))
2228 ((eq last-use-time t)
2229 (setq total-perm (1+ total-perm)))
2230 ((integerp last-use-time))))
2231 ;; Valid entry
2232 ;; add it in
2233 (setq cmpl-last-use-time
2234 (completion-last-use-time
2235 (setq cmpl-entry
2236 (add-completion-to-tail-if-new string))))
2237 (if (or (eq last-use-time t)
2238 (and (> last-use-time 1000);;backcompatibility
2239 (not (eq cmpl-last-use-time t))
2240 (or (not cmpl-last-use-time)
2241 ;; more recent
2242 (> last-use-time cmpl-last-use-time))))
2243 ;; update last-use-time
2244 (set-completion-last-use-time cmpl-entry last-use-time)))
2246 ;; Bad format
2247 (message "Error: invalid saved completion - %s"
2248 (prin1-to-string entry))
2249 ;; try to get back in sync
2250 (search-forward "\n("))))
2251 (search-failed
2252 (message "End of file while reading completions."))
2253 (end-of-file
2254 (if (= (point) (point-max))
2255 (if (not no-message-p)
2256 (message "Loading completions from file %s . . . Done."
2257 filename))
2258 (message "End of file while reading completions."))))))
2260 (cmpl-statistics-block
2261 (record-load-completions
2262 total-in-file total-perm
2263 (- (aref completion-add-count-vector cmpl-source-init-file)
2264 start-num)))
2265 ))))))
2267 (defun initialize-completions ()
2268 "Load the default completions file.
2269 Also sets up so that exiting emacs will automatically save the file."
2270 (interactive)
2271 (cond ((not cmpl-initialized-p)
2272 (load-completions-from-file)))
2273 (setq cmpl-initialized-p t))
2275 ;;-----------------------------------------------
2276 ;; Kill region patch
2277 ;;-----------------------------------------------
2279 (defun completion-kill-region (&optional beg end)
2280 "Kill between point and mark.
2281 The text is deleted but saved in the kill ring.
2282 The command \\[yank] can retrieve it from there.
2283 /(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
2285 This is the primitive for programs to kill text (as opposed to deleting it).
2286 Supply two arguments, character numbers indicating the stretch of text
2287 to be killed.
2288 Any command that calls this function is a \"kill command\".
2289 If the previous command was also a kill command,
2290 the text killed this time appends to the text killed last time
2291 to make one entry in the kill ring.
2292 Patched to remove the most recent completion."
2293 (interactive "r")
2294 (cond ((eq last-command 'complete)
2295 (delete-region (point) cmpl-last-insert-location)
2296 (insert cmpl-original-string)
2297 (setq completion-to-accept nil)
2298 (cmpl-statistics-block
2299 (record-complete-failed)))
2301 (kill-region beg end))))
2304 ;;-----------------------------------------------
2305 ;; Patches to self-insert-command.
2306 ;;-----------------------------------------------
2308 ;; Need 2 versions: generic separator chars. and space (to get auto fill
2309 ;; to work)
2311 ;; All common separators (eg. space "(" ")" """) characters go through a
2312 ;; function to add new words to the list of words to complete from:
2313 ;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
2314 ;; If the character before this was an alpha-numeric then this adds the
2315 ;; symbol before point to the completion list (using ADD-COMPLETION).
2317 (defun completion-separator-self-insert-command (arg)
2318 (interactive "p")
2319 (use-completion-before-separator)
2320 (self-insert-command arg))
2322 (defun completion-separator-self-insert-autofilling (arg)
2323 (interactive "p")
2324 (use-completion-before-separator)
2325 (self-insert-command arg)
2326 (and auto-fill-function
2327 (funcall auto-fill-function)))
2329 ;;-----------------------------------------------
2330 ;; Wrapping Macro
2331 ;;-----------------------------------------------
2333 ;; Note that because of the way byte compiling works, none of
2334 ;; the functions defined with this macro get byte compiled.
2336 (defmacro def-completion-wrapper (function-name type &optional new-name)
2337 "Add a call to update the completion database before function execution.
2338 TYPE is the type of the wrapper to be added. Can be :before or :under."
2339 (cond ((eq type :separator)
2340 (list 'put (list 'quote function-name) ''completion-function
2341 ''use-completion-before-separator))
2342 ((eq type :before)
2343 (list 'put (list 'quote function-name) ''completion-function
2344 ''use-completion-before-point))
2345 ((eq type :backward-under)
2346 (list 'put (list 'quote function-name) ''completion-function
2347 ''use-completion-backward-under))
2348 ((eq type :backward)
2349 (list 'put (list 'quote function-name) ''completion-function
2350 ''use-completion-backward))
2351 ((eq type :under)
2352 (list 'put (list 'quote function-name) ''completion-function
2353 ''use-completion-under-point))
2354 ((eq type :under-or-before)
2355 (list 'put (list 'quote function-name) ''completion-function
2356 ''use-completion-under-or-before-point))
2357 ((eq type :minibuffer-separator)
2358 (list 'put (list 'quote function-name) ''completion-function
2359 ''use-completion-minibuffer-separator))))
2361 (defun use-completion-minibuffer-separator ()
2362 (let ((cmpl-syntax-table cmpl-standard-syntax-table))
2363 (use-completion-before-separator)))
2365 (defun use-completion-backward-under ()
2366 (use-completion-under-point)
2367 (if (eq last-command 'complete)
2368 ;; probably a failed completion if you have to back up
2369 (cmpl-statistics-block (record-complete-failed))))
2371 (defun use-completion-backward ()
2372 (if (eq last-command 'complete)
2373 ;; probably a failed completion if you have to back up
2374 (cmpl-statistics-block (record-complete-failed))))
2376 (defun completion-before-command ()
2377 (funcall (or (and (symbolp this-command)
2378 (get this-command 'completion-function))
2379 'use-completion-under-or-before-point)))
2381 ;; C mode diffs.
2382 (defun completion-c-mode-hook ()
2383 (def-completion-wrapper electric-c-semi :separator)
2384 (define-key c-mode-map "+" 'completion-separator-self-insert-command)
2385 (define-key c-mode-map "*" 'completion-separator-self-insert-command)
2386 (define-key c-mode-map "/" 'completion-separator-self-insert-command))
2387 ;; Do this either now or whenever C mode is loaded.
2388 (if (featurep 'cc-mode)
2389 (completion-c-mode-hook)
2390 (add-hook 'c-mode-hook 'completion-c-mode-hook))
2392 ;; FORTRAN mode diffs. (these are defined when fortran is called)
2393 (defun completion-setup-fortran-mode ()
2394 (define-key fortran-mode-map "+" 'completion-separator-self-insert-command)
2395 (define-key fortran-mode-map "-" 'completion-separator-self-insert-command)
2396 (define-key fortran-mode-map "*" 'completion-separator-self-insert-command)
2397 (define-key fortran-mode-map "/" 'completion-separator-self-insert-command))
2399 ;;; Enable completion mode.
2401 ;;;###autoload
2402 (defun dynamic-completion-mode ()
2403 "Enable dynamic word-completion."
2404 (interactive)
2405 (add-hook 'find-file-hook 'cmpl-find-file-hook)
2406 (add-hook 'pre-command-hook 'completion-before-command)
2408 ;; Install the appropriate mode tables.
2409 (add-hook 'lisp-mode-hook
2410 (lambda ()
2411 (setq cmpl-syntax-table cmpl-lisp-syntax-table)))
2412 (add-hook 'c-mode-hook
2413 (lambda ()
2414 (setq cmpl-syntax-table cmpl-c-syntax-table)))
2415 (add-hook 'fortran-mode-hook
2416 (lambda ()
2417 (setq cmpl-syntax-table cmpl-fortran-syntax-table)
2418 (completion-setup-fortran-mode)))
2420 ;; "Complete" Key Keybindings.
2422 (global-set-key "\M-\r" 'complete)
2423 (global-set-key [?\C-\r] 'complete)
2424 (define-key function-key-map [C-return] [?\C-\r])
2426 ;; Tests -
2427 ;; (add-completion "cumberland")
2428 ;; (add-completion "cumberbund")
2429 ;; cum
2430 ;; Cumber
2431 ;; cumbering
2432 ;; cumb
2434 ;; Save completions when killing Emacs.
2436 (add-hook 'kill-emacs-hook
2437 (lambda ()
2438 (kill-emacs-save-completions)
2439 (cmpl-statistics-block
2440 (record-cmpl-kill-emacs))))
2442 ;; Patches to standard keymaps insert completions
2443 (substitute-key-definition 'kill-region 'completion-kill-region
2444 global-map)
2446 ;; Separators
2447 ;; We've used the completion syntax table given as a guide.
2449 ;; Global separator chars.
2450 ;; We left out <tab> because there are too many special cases for it. Also,
2451 ;; in normal coding it's rarely typed after a word.
2452 (global-set-key " " 'completion-separator-self-insert-autofilling)
2453 (global-set-key "!" 'completion-separator-self-insert-command)
2454 (global-set-key "%" 'completion-separator-self-insert-command)
2455 (global-set-key "^" 'completion-separator-self-insert-command)
2456 (global-set-key "&" 'completion-separator-self-insert-command)
2457 (global-set-key "(" 'completion-separator-self-insert-command)
2458 (global-set-key ")" 'completion-separator-self-insert-command)
2459 (global-set-key "=" 'completion-separator-self-insert-command)
2460 (global-set-key "`" 'completion-separator-self-insert-command)
2461 (global-set-key "|" 'completion-separator-self-insert-command)
2462 (global-set-key "{" 'completion-separator-self-insert-command)
2463 (global-set-key "}" 'completion-separator-self-insert-command)
2464 (global-set-key "[" 'completion-separator-self-insert-command)
2465 (global-set-key "]" 'completion-separator-self-insert-command)
2466 (global-set-key ";" 'completion-separator-self-insert-command)
2467 (global-set-key "\"" 'completion-separator-self-insert-command)
2468 (global-set-key "'" 'completion-separator-self-insert-command)
2469 (global-set-key "#" 'completion-separator-self-insert-command)
2470 (global-set-key "," 'completion-separator-self-insert-command)
2471 (global-set-key "?" 'completion-separator-self-insert-command)
2473 ;; We include period and colon even though they are symbol chars because :
2474 ;; - in text we want to pick up the last word in a sentence.
2475 ;; - in C pointer refs. we want to pick up the first symbol
2476 ;; - it won't make a difference for lisp mode (package names are short)
2477 (global-set-key "." 'completion-separator-self-insert-command)
2478 (global-set-key ":" 'completion-separator-self-insert-command)
2480 ;; Lisp Mode diffs
2481 (define-key lisp-mode-map "!" 'self-insert-command)
2482 (define-key lisp-mode-map "&" 'self-insert-command)
2483 (define-key lisp-mode-map "%" 'self-insert-command)
2484 (define-key lisp-mode-map "?" 'self-insert-command)
2485 (define-key lisp-mode-map "=" 'self-insert-command)
2486 (define-key lisp-mode-map "^" 'self-insert-command)
2488 ;; Avoid warnings.
2489 (defvar c-mode-map)
2490 (defvar fortran-mode-map)
2492 ;;-----------------------------------------------
2493 ;; End of line chars.
2494 ;;-----------------------------------------------
2495 (def-completion-wrapper newline :separator)
2496 (def-completion-wrapper newline-and-indent :separator)
2497 (def-completion-wrapper comint-send-input :separator)
2498 (def-completion-wrapper exit-minibuffer :minibuffer-separator)
2499 (def-completion-wrapper eval-print-last-sexp :separator)
2500 (def-completion-wrapper eval-last-sexp :separator)
2501 ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
2503 ;;-----------------------------------------------
2504 ;; Cursor movement
2505 ;;-----------------------------------------------
2507 (def-completion-wrapper next-line :under-or-before)
2508 (def-completion-wrapper previous-line :under-or-before)
2509 (def-completion-wrapper beginning-of-buffer :under-or-before)
2510 (def-completion-wrapper end-of-buffer :under-or-before)
2511 (def-completion-wrapper beginning-of-line :under-or-before)
2512 (def-completion-wrapper end-of-line :under-or-before)
2513 (def-completion-wrapper forward-char :under-or-before)
2514 (def-completion-wrapper forward-word :under-or-before)
2515 (def-completion-wrapper forward-sexp :under-or-before)
2516 (def-completion-wrapper backward-char :backward-under)
2517 (def-completion-wrapper backward-word :backward-under)
2518 (def-completion-wrapper backward-sexp :backward-under)
2520 (def-completion-wrapper delete-backward-char :backward)
2521 (def-completion-wrapper delete-backward-char-untabify :backward)
2523 ;; Tests --
2524 ;; foobarbiz
2525 ;; foobar
2526 ;; fooquux
2527 ;; fooper
2529 (cmpl-statistics-block
2530 (record-completion-file-loaded))
2532 (initialize-completions))
2534 (mapc (lambda (x)
2535 (add-to-list 'debug-ignored-errors x))
2536 '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
2537 "^The string \".*\" is too short to be saved as a completion\\.$"))
2539 (provide 'completion)
2541 ;;; completion.el ends here