37 |
;; |
;; |
38 |
;; Introduction |
;; Introduction |
39 |
;;--------------- |
;;--------------- |
40 |
;; |
;; |
41 |
;; After you type a few characters, pressing the "complete" key inserts |
;; After you type a few characters, pressing the "complete" key inserts |
42 |
;; the rest of the word you are likely to type. |
;; the rest of the word you are likely to type. |
43 |
;; |
;; |
44 |
;; This watches all the words that you type and remembers them. When |
;; This watches all the words that you type and remembers them. When |
45 |
;; typing a new word, pressing "complete" (meta-return) "completes" the |
;; typing a new word, pressing "complete" (meta-return) "completes" the |
46 |
;; word by inserting the most recently used word that begins with the |
;; word by inserting the most recently used word that begins with the |
47 |
;; same characters. If you press meta-return repeatedly, it cycles |
;; same characters. If you press meta-return repeatedly, it cycles |
48 |
;; through all the words it knows about. |
;; through all the words it knows about. |
49 |
;; |
;; |
50 |
;; If you like the completion then just continue typing, it is as if you |
;; 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 |
;; 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. |
;; to go away, type control-w or delete. More options are described below. |
53 |
;; |
;; |
54 |
;; The guesses are made in the order of the most recently "used". Typing |
;; 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" |
;; 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, |
;; 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. |
;; it uses an extended version of the dabbrev style completion. |
58 |
;; |
;; |
59 |
;; You automatically save the completions you use to a file between |
;; You automatically save the completions you use to a file between |
60 |
;; sessions. |
;; sessions. |
61 |
;; |
;; |
62 |
;; Completion enables programmers to enter longer, more descriptive |
;; Completion enables programmers to enter longer, more descriptive |
63 |
;; variable names while typing fewer keystrokes than they normally would. |
;; variable names while typing fewer keystrokes than they normally would. |
64 |
;; |
;; |
65 |
;; |
;; |
66 |
;; Full documentation |
;; Full documentation |
67 |
;;--------------------- |
;;--------------------- |
68 |
;; |
;; |
69 |
;; A "word" is any string containing characters with either word or symbol |
;; A "word" is any string containing characters with either word or symbol |
70 |
;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.] |
;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.] |
71 |
;; Unless you change the constants, you must type at least three characters |
;; 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 |
;; for the word to be recognized. Only words longer than 6 characters are |
75 |
;; When you load this file, completion will be on. I suggest you use the |
;; When you load this file, completion will be on. I suggest you use the |
76 |
;; compiled version (because it is noticeably faster). |
;; compiled version (because it is noticeably faster). |
77 |
;; |
;; |
78 |
;; M-X completion-mode toggles whether or not new words are added to the |
;; M-x completion-mode toggles whether or not new words are added to the |
79 |
;; database by changing the value of enable-completion. |
;; database by changing the value of enable-completion. |
80 |
;; |
;; |
81 |
;; SAVING/LOADING COMPLETIONS |
;; SAVING/LOADING COMPLETIONS |
82 |
;; Completions are automatically saved from one session to another |
;; Completions are automatically saved from one session to another |
83 |
;; (unless save-completions-flag or enable-completion is nil). |
;; (unless save-completions-flag or enable-completion is nil). |
84 |
;; Loading this file (or calling initialize-completions) causes EMACS |
;; Loading this file (or calling initialize-completions) causes EMACS |
85 |
;; to load a completions database for a saved completions file |
;; to load a completions database for a saved completions file |
86 |
;; (default: ~/.completions). When you exit, EMACS saves a copy of the |
;; (default: ~/.completions). When you exit, EMACS saves a copy of the |
87 |
;; completions that you |
;; completions that you |
88 |
;; often use. When you next start, EMACS loads in the saved completion file. |
;; often use. When you next start, EMACS loads in the saved completion file. |
89 |
;; |
;; |
90 |
;; The number of completions saved depends loosely on |
;; The number of completions saved depends loosely on |
91 |
;; *saved-completions-decay-factor*. Completions that have never been |
;; *saved-completions-decay-factor*. Completions that have never been |
92 |
;; inserted via "complete" are not saved. You are encouraged to experiment |
;; inserted via "complete" are not saved. You are encouraged to experiment |
93 |
;; with different functions (see compute-completion-min-num-uses). |
;; with different functions (see compute-completion-min-num-uses). |
94 |
;; |
;; |
95 |
;; Some completions are permanent and are always saved out. These |
;; Some completions are permanent and are always saved out. These |
96 |
;; completions have their num-uses slot set to T. Use |
;; completions have their num-uses slot set to T. Use |
97 |
;; add-permanent-completion to do this |
;; add-permanent-completion to do this |
98 |
;; |
;; |
99 |
;; Completions are saved only if enable-completion is T. The number of old |
;; Completions are saved only if enable-completion is T. The number of old |
100 |
;; versions kept of the saved completions file is controlled by |
;; versions kept of the saved completions file is controlled by |
101 |
;; completions-file-versions-kept. |
;; completions-file-versions-kept. |
102 |
;; |
;; |
103 |
;; COMPLETE KEY OPTIONS |
;; COMPLETE KEY OPTIONS |
104 |
;; The complete function takes a numeric arguments. |
;; The complete function takes a numeric arguments. |
105 |
;; control-u :: leave the point at the beginning of the completion rather |
;; control-u :: leave the point at the beginning of the completion rather |
106 |
;; than the middle. |
;; than the middle. |
107 |
;; a number :: rotate through the possible completions by that amount |
;; a number :: rotate through the possible completions by that amount |
108 |
;; `-' :: same as -1 (insert previous completion) |
;; `-' :: same as -1 (insert previous completion) |
111 |
;; <write> |
;; <write> |
112 |
;; |
;; |
113 |
;; UPDATING THE DATABASE MANUALLY |
;; UPDATING THE DATABASE MANUALLY |
114 |
;; m-x kill-completion |
;; m-x kill-completion |
115 |
;; kills the completion at point. |
;; kills the completion at point. |
116 |
;; m-x add-completion |
;; m-x add-completion |
117 |
;; m-x add-permanent-completion |
;; m-x add-permanent-completion |
118 |
;; |
;; |
119 |
;; UPDATING THE DATABASE FROM A SOURCE CODE FILE |
;; UPDATING THE DATABASE FROM A SOURCE CODE FILE |
120 |
;; m-x add-completions-from-buffer |
;; m-x add-completions-from-buffer |
121 |
;; Parses all the definition names from a C or LISP mode buffer and |
;; Parses all the definition names from a C or LISP mode buffer and |
122 |
;; adds them to the completion database. |
;; adds them to the completion database. |
123 |
;; |
;; |
124 |
;; m-x add-completions-from-lisp-file |
;; m-x add-completions-from-lisp-file |
125 |
;; Parses all the definition names from a C or Lisp mode file and |
;; Parses all the definition names from a C or Lisp mode file and |
126 |
;; adds them to the completion database. |
;; adds them to the completion database. |
127 |
;; |
;; |
133 |
;; <write> |
;; <write> |
134 |
;; |
;; |
135 |
;; STRING CASING |
;; STRING CASING |
136 |
;; Completion is string case independent if case-fold-search has its |
;; 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 |
;; normal default of T. Also when the completion is inserted the case of the |
138 |
;; entry is coerced appropriately. |
;; entry is coerced appropriately. |
139 |
;; [E.G. APP --> APPROPRIATELY app --> appropriately |
;; [E.G. APP --> APPROPRIATELY app --> appropriately |
140 |
;; App --> Appropriately] |
;; App --> Appropriately] |
141 |
;; |
;; |
142 |
;; INITIALIZATION |
;; INITIALIZATION |
143 |
;; The form `(initialize-completions)' initializes the completion system by |
;; The form `(initialize-completions)' initializes the completion system by |
144 |
;; trying to load in the user's completions. After the first cal, further |
;; 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 |
;; calls have no effect so one should be careful not to put the form in a |
146 |
;; site's standard site-init file. |
;; site's standard site-init file. |
147 |
;; |
;; |
148 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
180 |
;; Inserts a completion at point |
;; Inserts a completion at point |
181 |
;; |
;; |
182 |
;; initialize-completions |
;; initialize-completions |
183 |
;; Loads the completions file and sets up so that exiting emacs will |
;; Loads the completions file and sets up so that exiting emacs will |
184 |
;; save them. |
;; save them. |
185 |
;; |
;; |
186 |
;; save-completions-to-file &optional filename |
;; save-completions-to-file &optional filename |
187 |
;; load-completions-from-file &optional filename |
;; load-completions-from-file &optional filename |
188 |
;; |
;; |
189 |
;;----------------------------------------------- |
;;----------------------------------------------- |
194 |
;; |
;; |
195 |
;; These things are for manipulating the structure |
;; These things are for manipulating the structure |
196 |
;; make-completion string num-uses |
;; make-completion string num-uses |
197 |
;; completion-num-uses completion |
;; completion-num-uses completion |
198 |
;; completion-string completion |
;; completion-string completion |
199 |
;; set-completion-num-uses completion num-uses |
;; set-completion-num-uses completion num-uses |
200 |
;; set-completion-string completion string |
;; set-completion-string completion string |
201 |
;; |
;; |
202 |
;; |
;; |
203 |
|
|
204 |
;;----------------------------------------------- |
;;----------------------------------------------- |
215 |
;;----------------------------------------------- |
;;----------------------------------------------- |
216 |
;;; Change Log: |
;;; Change Log: |
217 |
;;----------------------------------------------- |
;;----------------------------------------------- |
218 |
;; Sometime in '84 Brewster implemented a somewhat buggy version for |
;; Sometime in '84 Brewster implemented a somewhat buggy version for |
219 |
;; Symbolics LISPMs. |
;; Symbolics LISPMs. |
220 |
;; Jan. '85 Jim became enamored of the idea and implemented a faster, |
;; Jan. '85 Jim became enamored of the idea and implemented a faster, |
221 |
;; more robust version. |
;; more robust version. |
222 |
;; With input from many users at TMC, (rose, craig, and gls come to mind), |
;; With input from many users at TMC, (rose, craig, and gls come to mind), |
223 |
;; the current style of interface was developed. |
;; the current style of interface was developed. |
224 |
;; 9/87, Jim and Brewster took terminals home. Yuck. After |
;; 9/87, Jim and Brewster took terminals home. Yuck. After |
225 |
;; complaining for a while Brewster implemented a subset of the current |
;; complaining for a while Brewster implemented a subset of the current |
226 |
;; LISPM version for GNU Emacs. |
;; LISPM version for GNU Emacs. |
227 |
;; 8/88 After complaining for a while (and with sufficient |
;; 8/88 After complaining for a while (and with sufficient |
228 |
;; promised rewards), Jim reimplemented a version of GNU completion |
;; promised rewards), Jim reimplemented a version of GNU completion |
229 |
;; superior to that of the LISPM version. |
;; superior to that of the LISPM version. |
230 |
;; |
;; |
269 |
;; - minor fix to capitalization code |
;; - minor fix to capitalization code |
270 |
;; - added *completion-auto-save-period* to variables recorded. |
;; - added *completion-auto-save-period* to variables recorded. |
271 |
;; - added reenter protection to cmpl-record-statistics-filter |
;; - added reenter protection to cmpl-record-statistics-filter |
272 |
;; - added backup protection to save-completions-to-file (prevents |
;; - added backup protection to save-completions-to-file (prevents |
273 |
;; problems with disk full errors) |
;; problems with disk full errors) |
274 |
|
|
275 |
;;; Code: |
;;; Code: |
350 |
;; "*The period in seconds to wait for emacs to be idle before autosaving |
;; "*The period in seconds to wait for emacs to be idle before autosaving |
351 |
;;the completions. Default is a 1/2 hour.") |
;;the completions. Default is a 1/2 hour.") |
352 |
|
|
353 |
(defconst completion-min-length nil ;; defined below in eval-when |
(defvar completion-min-length 6 |
354 |
"*The minimum length of a stored completion. |
"*The minimum length of a stored completion. |
355 |
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") |
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") |
356 |
|
|
357 |
(defconst completion-max-length nil ;; defined below in eval-when |
(defvar completion-max-length 200 |
358 |
"*The maximum length of a stored completion. |
"*The maximum length of a stored completion. |
359 |
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") |
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") |
360 |
|
|
361 |
(defconst completion-prefix-min-length nil ;; defined below in eval-when |
(defvar completion-prefix-min-length 3 |
362 |
"The minimum length of a completion search string. |
"The minimum length of a completion search string. |
363 |
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") |
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") |
364 |
|
|
|
(defmacro eval-when-compile-load-eval (&rest body) |
|
|
;; eval everything before expanding |
|
|
(mapcar 'eval body) |
|
|
(cons 'progn body)) |
|
|
|
|
|
(defun completion-eval-when () |
|
|
(eval-when-compile-load-eval |
|
|
;; These vars. are defined at both compile and load time. |
|
|
(setq completion-min-length 6) |
|
|
(setq completion-max-length 200) |
|
|
(setq completion-prefix-min-length 3))) |
|
|
|
|
|
(completion-eval-when) |
|
|
|
|
365 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
366 |
;; Internal Variables |
;; Internal Variables |
367 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
383 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
384 |
|
|
385 |
;;----------------------------------------------- |
;;----------------------------------------------- |
|
;; Misc. |
|
|
;;----------------------------------------------- |
|
|
|
|
|
(defun minibuffer-window-selected-p () |
|
|
"True iff the current window is the minibuffer." |
|
|
(window-minibuffer-p (selected-window))) |
|
|
|
|
|
;; This used to be `(eval form)'. Eval FORM at run time now. |
|
|
(defmacro cmpl-read-time-eval (form) |
|
|
form) |
|
|
|
|
|
;;----------------------------------------------- |
|
386 |
;; String case coercion |
;; String case coercion |
387 |
;;----------------------------------------------- |
;;----------------------------------------------- |
388 |
|
|
450 |
;; of syntax in these "symbol" syntax tables :: |
;; of syntax in these "symbol" syntax tables :: |
451 |
;; |
;; |
452 |
;; syntax (?_) - "symbol" chars (e.g. alphanumerics) |
;; syntax (?_) - "symbol" chars (e.g. alphanumerics) |
453 |
;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). |
;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). |
454 |
;; syntax (? ) - everything else |
;; syntax (? ) - everything else |
455 |
;; |
;; |
456 |
;; Thus by judicious use of scan-sexps and forward-word, we can get |
;; Thus by judicious use of scan-sexps and forward-word, we can get |
457 |
;; the word we want relatively fast and without consing. |
;; the word we want relatively fast and without consing. |
458 |
;; |
;; |
459 |
;; Why do we need a separate category for "symbol chars to ignore at ends" ? |
;; Why do we need a separate category for "symbol chars to ignore at ends" ? |
460 |
;; For example, in LISP we want starting :'s trimmed |
;; For example, in LISP we want starting :'s trimmed |
461 |
;; so keyword argument specifiers also define the keyword completion. And, |
;; so keyword argument specifiers also define the keyword completion. And, |
462 |
;; for example, in C we want `.' appearing in a structure ref. to |
;; for example, in C we want `.' appearing in a structure ref. to |
463 |
;; be kept intact in order to store the whole structure ref.; however, if |
;; be kept intact in order to store the whole structure ref.; however, if |
464 |
;; it appears at the end of a symbol it should be discarded because it is |
;; it appears at the end of a symbol it should be discarded because it is |
465 |
;; probably used as a period. |
;; probably used as a period. |
466 |
|
|
477 |
;; C diffs -> |
;; C diffs -> |
478 |
;; Separator chars :: + * / : % |
;; Separator chars :: + * / : % |
479 |
;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator |
;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator |
480 |
;; char., however, we wanted to have completion symbols include pointer |
;; char., however, we wanted to have completion symbols include pointer |
481 |
;; references. For example, "foo->bar" is a symbol as far as completion is |
;; references. For example, "foo->bar" is a symbol as far as completion is |
482 |
;; concerned. |
;; concerned. |
483 |
;; |
;; |
530 |
(dolist (char symbol-chars) |
(dolist (char symbol-chars) |
531 |
(modify-syntax-entry char "_" table)) |
(modify-syntax-entry char "_" table)) |
532 |
table)) |
table)) |
533 |
|
|
534 |
(defun cmpl-make-c-completion-syntax-table () |
(defun cmpl-make-c-completion-syntax-table () |
535 |
(let ((table (copy-syntax-table cmpl-standard-syntax-table)) |
(let ((table (copy-syntax-table cmpl-standard-syntax-table)) |
536 |
(separator-chars '(?+ ?* ?/ ?: ?%))) |
(separator-chars '(?+ ?* ?/ ?: ?%))) |
566 |
(defvar cmpl-saved-point nil) |
(defvar cmpl-saved-point nil) |
567 |
|
|
568 |
(defun symbol-under-point () |
(defun symbol-under-point () |
569 |
"Returns the symbol that the point is currently on. |
"Return the symbol that the point is currently on. |
570 |
But only if it is longer than `completion-min-length'." |
But only if it is longer than `completion-min-length'." |
571 |
(setq cmpl-saved-syntax (syntax-table)) |
(setq cmpl-saved-syntax (syntax-table)) |
572 |
(unwind-protect |
(unwind-protect |
573 |
(progn |
(progn |
574 |
(set-syntax-table cmpl-syntax-table) |
(set-syntax-table cmpl-syntax-table) |
575 |
(cond |
(cond |
576 |
;; Cursor is on following-char and after preceding-char |
;; Cursor is on following-char and after preceding-char |
577 |
((memq (char-syntax (following-char)) '(?w ?_)) |
((memq (char-syntax (following-char)) '(?w ?_)) |
578 |
(setq cmpl-saved-point (point) |
(setq cmpl-saved-point (point) |
579 |
cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) |
cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) |
580 |
cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) |
cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) |
591 |
(setq cmpl-symbol-end (point)) |
(setq cmpl-symbol-end (point)) |
592 |
(goto-char cmpl-saved-point))) |
(goto-char cmpl-saved-point))) |
593 |
;; Return completion if the length is reasonable. |
;; Return completion if the length is reasonable. |
594 |
(if (and (<= (cmpl-read-time-eval completion-min-length) |
(if (and (<= completion-min-length |
595 |
(- cmpl-symbol-end cmpl-symbol-start)) |
(- cmpl-symbol-end cmpl-symbol-start)) |
596 |
(<= (- cmpl-symbol-end cmpl-symbol-start) |
(<= (- cmpl-symbol-end cmpl-symbol-start) |
597 |
(cmpl-read-time-eval completion-max-length))) |
completion-max-length)) |
598 |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))))) |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))))) |
599 |
(set-syntax-table cmpl-saved-syntax))) |
(set-syntax-table cmpl-saved-syntax))) |
600 |
|
|
611 |
;; |
;; |
612 |
|
|
613 |
(defun symbol-before-point () |
(defun symbol-before-point () |
614 |
"Returns a string of the symbol immediately before point. |
"Return a string of the symbol immediately before point. |
615 |
Returns nil if there isn't one longer than `completion-min-length'." |
Returns nil if there isn't one longer than `completion-min-length'." |
616 |
;; This is called when a word separator is typed so it must be FAST ! |
;; This is called when a word separator is typed so it must be FAST ! |
617 |
(setq cmpl-saved-syntax (syntax-table)) |
(setq cmpl-saved-syntax (syntax-table)) |
618 |
(unwind-protect |
(unwind-protect |
631 |
(goto-char cmpl-symbol-end))) |
(goto-char cmpl-symbol-end))) |
632 |
;; Return value if long enough. |
;; Return value if long enough. |
633 |
(if (>= cmpl-symbol-end |
(if (>= cmpl-symbol-end |
634 |
(+ cmpl-symbol-start |
(+ cmpl-symbol-start completion-min-length)) |
|
(cmpl-read-time-eval completion-min-length))) |
|
635 |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))) |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))) |
636 |
((= cmpl-preceding-syntax ?w) |
((= cmpl-preceding-syntax ?w) |
637 |
;; chars to ignore at end |
;; chars to ignore at end |
648 |
;; Restore state. |
;; Restore state. |
649 |
(goto-char cmpl-saved-point) |
(goto-char cmpl-saved-point) |
650 |
;; Return completion if the length is reasonable |
;; Return completion if the length is reasonable |
651 |
(if (and (<= (cmpl-read-time-eval completion-min-length) |
(if (and (<= completion-min-length |
652 |
(- cmpl-symbol-end cmpl-symbol-start)) |
(- cmpl-symbol-end cmpl-symbol-start)) |
653 |
(<= (- cmpl-symbol-end cmpl-symbol-start) |
(<= (- cmpl-symbol-end cmpl-symbol-start) |
654 |
(cmpl-read-time-eval completion-max-length))) |
completion-max-length)) |
655 |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))))) |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))))) |
656 |
(set-syntax-table cmpl-saved-syntax))) |
(set-syntax-table cmpl-saved-syntax))) |
657 |
|
|
707 |
(setq cmpl-symbol-start (point)) |
(setq cmpl-symbol-start (point)) |
708 |
(goto-char cmpl-symbol-end))) |
(goto-char cmpl-symbol-end))) |
709 |
;; Return completion if the length is reasonable. |
;; Return completion if the length is reasonable. |
710 |
(if (and (<= (cmpl-read-time-eval |
(if (and (<= completion-prefix-min-length |
|
completion-prefix-min-length) |
|
711 |
(- cmpl-symbol-end cmpl-symbol-start)) |
(- cmpl-symbol-end cmpl-symbol-start)) |
712 |
(<= (- cmpl-symbol-end cmpl-symbol-start) |
(<= (- cmpl-symbol-end cmpl-symbol-start) |
713 |
(cmpl-read-time-eval completion-max-length))) |
completion-max-length)) |
714 |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))))) |
(buffer-substring cmpl-symbol-start cmpl-symbol-end))))) |
715 |
;; Restore syntax table. |
;; Restore syntax table. |
716 |
(set-syntax-table cmpl-saved-syntax))) |
(set-syntax-table cmpl-saved-syntax))) |
746 |
;; "Only executes body if we are recording statistics." |
;; "Only executes body if we are recording statistics." |
747 |
;; (list 'cond |
;; (list 'cond |
748 |
;; (list* '*record-cmpl-statistics-p* body) |
;; (list* '*record-cmpl-statistics-p* body) |
749 |
;; )) |
;; )) |
750 |
|
|
751 |
;;----------------------------------------------- |
;;----------------------------------------------- |
752 |
;; Completion Sources |
;; Completion Sources |
769 |
;; Completion Method #2: dabbrev-expand style |
;; Completion Method #2: dabbrev-expand style |
770 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
771 |
;; |
;; |
772 |
;; This method is used if there are no useful stored completions. It is |
;; This method is used if there are no useful stored completions. It is |
773 |
;; based on dabbrev-expand with these differences : |
;; based on dabbrev-expand with these differences : |
774 |
;; 1) Faster (we don't use regexps) |
;; 1) Faster (we don't use regexps) |
775 |
;; 2) case coercion handled correctly |
;; 2) case coercion handled correctly |
805 |
|
|
806 |
|
|
807 |
(defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) |
(defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) |
808 |
"Resets the cdabbrev search to search for abbrev-string. |
"Reset the cdabbrev search to search for ABBREV-STRING. |
809 |
INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore |
INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore |
810 |
during the search." |
during the search." |
811 |
(setq cdabbrev-abbrev-string abbrev-string |
(setq cdabbrev-abbrev-string abbrev-string |
821 |
|
|
822 |
|
|
823 |
(defun reset-cdabbrev-window (&optional initializep) |
(defun reset-cdabbrev-window (&optional initializep) |
824 |
"Resets the cdabbrev search to search for abbrev-string." |
"Reset the cdabbrev search to search for abbrev-string." |
825 |
;; Set the window |
;; Set the window |
826 |
(cond (initializep |
(cond (initializep |
827 |
(setq cdabbrev-current-window (selected-window))) |
(setq cdabbrev-current-window (selected-window))) |
852 |
;; note that case-fold-search affects the behavior of this function |
;; note that case-fold-search affects the behavior of this function |
853 |
;; Bug: won't pick up an expansion that starts at the top of buffer |
;; Bug: won't pick up an expansion that starts at the top of buffer |
854 |
(if cdabbrev-current-window |
(if cdabbrev-current-window |
855 |
(let (saved-point |
(let (saved-point |
856 |
saved-syntax |
saved-syntax |
857 |
(expansion nil) |
(expansion nil) |
858 |
downcase-expansion tried-list syntax saved-point-2) |
downcase-expansion tried-list syntax saved-point-2) |
976 |
;; last-use-time is t if the string should be kept permanently |
;; last-use-time is t if the string should be kept permanently |
977 |
;; num-uses is incremented every time the completion is used. |
;; num-uses is incremented every time the completion is used. |
978 |
|
|
979 |
;; We chose lists because (car foo) is faster than (aref foo 0) and the |
;; We chose lists because (car foo) is faster than (aref foo 0) and the |
980 |
;; creation time is about the same. |
;; creation time is about the same. |
981 |
|
|
982 |
;; READER MACROS |
;; READER MACROS |
985 |
(list 'car completion-entry)) |
(list 'car completion-entry)) |
986 |
|
|
987 |
(defmacro completion-num-uses (completion-entry) |
(defmacro completion-num-uses (completion-entry) |
988 |
;; "The number of times it has used. Used to decide whether to save |
;; "The number of times it has used. Used to decide whether to save |
989 |
;; it." |
;; it." |
990 |
(list 'car (list 'cdr completion-entry))) |
(list 'car (list 'cdr completion-entry))) |
991 |
|
|
1009 |
|
|
1010 |
;; CONSTRUCTOR |
;; CONSTRUCTOR |
1011 |
(defun make-completion (string) |
(defun make-completion (string) |
1012 |
"Returns a list of a completion entry." |
"Return a list of a completion entry." |
1013 |
(list (list string 0 nil current-completion-source))) |
(list (list string 0 nil current-completion-source))) |
1014 |
|
|
1015 |
;; Obsolete |
;; Obsolete |
1042 |
;; Constructor |
;; Constructor |
1043 |
|
|
1044 |
(defun make-cmpl-prefix-entry (completion-entry-list) |
(defun make-cmpl-prefix-entry (completion-entry-list) |
1045 |
"Makes a new prefix entry containing only completion-entry." |
"Make a new prefix entry containing only completion-entry." |
1046 |
(cons completion-entry-list completion-entry-list)) |
(cons completion-entry-list completion-entry-list)) |
1047 |
|
|
1048 |
;;----------------------------------------------- |
;;----------------------------------------------- |
1193 |
;; setup the prefix |
;; setup the prefix |
1194 |
(prefix-entry (find-cmpl-prefix-entry |
(prefix-entry (find-cmpl-prefix-entry |
1195 |
(substring cmpl-db-downcase-string 0 |
(substring cmpl-db-downcase-string 0 |
1196 |
(cmpl-read-time-eval |
completion-prefix-min-length)))) |
|
completion-prefix-min-length))))) |
|
1197 |
;; The next two forms should happen as a unit (atomically) but |
;; The next two forms should happen as a unit (atomically) but |
1198 |
;; no fatal errors should result if that is not the case. |
;; no fatal errors should result if that is not the case. |
1199 |
(cond (prefix-entry |
(cond (prefix-entry |
1224 |
;; found |
;; found |
1225 |
(let* ((prefix-entry (find-cmpl-prefix-entry |
(let* ((prefix-entry (find-cmpl-prefix-entry |
1226 |
(substring cmpl-db-downcase-string 0 |
(substring cmpl-db-downcase-string 0 |
1227 |
(cmpl-read-time-eval |
completion-prefix-min-length))) |
|
completion-prefix-min-length)))) |
|
1228 |
(splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) |
(splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) |
1229 |
(cmpl-ptr (cdr splice-ptr))) |
(cmpl-ptr (cdr splice-ptr))) |
1230 |
;; update entry |
;; update entry |
1247 |
;; setup the prefix |
;; setup the prefix |
1248 |
(prefix-entry (find-cmpl-prefix-entry |
(prefix-entry (find-cmpl-prefix-entry |
1249 |
(substring cmpl-db-downcase-string 0 |
(substring cmpl-db-downcase-string 0 |
1250 |
(cmpl-read-time-eval |
completion-prefix-min-length)))) |
|
completion-prefix-min-length))))) |
|
1251 |
(cond (prefix-entry |
(cond (prefix-entry |
1252 |
;; Splice in at head |
;; Splice in at head |
1253 |
(setcdr entry (cmpl-prefix-entry-head prefix-entry)) |
(setcdr entry (cmpl-prefix-entry-head prefix-entry)) |
1260 |
(note-added-completion)) |
(note-added-completion)) |
1261 |
;; Add it to the symbol |
;; Add it to the symbol |
1262 |
(set cmpl-db-symbol (car entry))))) |
(set cmpl-db-symbol (car entry))))) |
1263 |
|
|
1264 |
(defun delete-completion (completion-string) |
(defun delete-completion (completion-string) |
1265 |
"Delete the completion from the database. |
"Delete the completion from the database. |
1266 |
String must be longer than `completion-prefix-min-length'." |
String must be longer than `completion-prefix-min-length'." |
1268 |
(if completion-to-accept (accept-completion)) |
(if completion-to-accept (accept-completion)) |
1269 |
(if (setq cmpl-db-entry (find-exact-completion completion-string)) |
(if (setq cmpl-db-entry (find-exact-completion completion-string)) |
1270 |
;; found |
;; found |
1271 |
(let* ((prefix-entry (find-cmpl-prefix-entry |
(let* ((prefix-entry (find-cmpl-prefix-entry |
1272 |
(substring cmpl-db-downcase-string 0 |
(substring cmpl-db-downcase-string 0 |
1273 |
(cmpl-read-time-eval |
completion-prefix-min-length))) |
|
completion-prefix-min-length)))) |
|
1274 |
(splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))) |
(splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))) |
1275 |
;; delete symbol reference |
;; delete symbol reference |
1276 |
(set cmpl-db-symbol nil) |
(set cmpl-db-symbol nil) |
1307 |
;; |
;; |
1308 |
;; - Deleting - |
;; - Deleting - |
1309 |
;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) |
;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) |
1310 |
;; (delete-completion "banner") |
;; (delete-completion "banner") |
1311 |
;; (find-exact-completion "banner") --> nil |
;; (find-exact-completion "banner") --> nil |
1312 |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) |
1313 |
;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) |
;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) |
1314 |
;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) |
;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) |
1315 |
;; (delete-completion "banana") |
;; (delete-completion "banana") |
1316 |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) |
1317 |
;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) |
;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) |
1318 |
;; (delete-completion "banner") |
;; (delete-completion "banner") |
1319 |
;; (delete-completion "banish") |
;; (delete-completion "banish") |
1320 |
;; (find-cmpl-prefix-entry "ban") --> nil |
;; (find-cmpl-prefix-entry "ban") --> nil |
1321 |
;; (delete-completion "banner") --> error |
;; (delete-completion "banner") --> error |
1322 |
;; |
;; |
1333 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
1334 |
;; Database Update :: Interface level routines |
;; Database Update :: Interface level routines |
1335 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
1336 |
;; |
;; |
1337 |
;; These lie on top of the database ref. functions but below the standard |
;; These lie on top of the database ref. functions but below the standard |
1338 |
;; user interface level |
;; user interface level |
1339 |
|
|
1356 |
|
|
1357 |
(defun add-completion (string &optional num-uses last-use-time) |
(defun add-completion (string &optional num-uses last-use-time) |
1358 |
"Add STRING to completion list, or move it to head of list. |
"Add STRING to completion list, or move it to head of list. |
1359 |
The completion is altered appropriately if num-uses and/or last-use-time is |
The completion is altered appropriately if num-uses and/or last-use-time is |
1360 |
specified." |
specified." |
1361 |
(interactive (interactive-completion-string-reader "Completion to add")) |
(interactive (interactive-completion-string-reader "Completion to add")) |
1362 |
(check-completion-length string) |
(check-completion-length string) |
1364 |
cmpl-source-interactive |
cmpl-source-interactive |
1365 |
current-completion-source)) |
current-completion-source)) |
1366 |
(entry (add-completion-to-head string))) |
(entry (add-completion-to-head string))) |
1367 |
|
|
1368 |
(if num-uses (set-completion-num-uses entry num-uses)) |
(if num-uses (set-completion-num-uses entry num-uses)) |
1369 |
(if last-use-time |
(if last-use-time |
1370 |
(set-completion-last-use-time entry last-use-time)))) |
(set-completion-last-use-time entry last-use-time)))) |
1385 |
|
|
1386 |
(defun accept-completion () |
(defun accept-completion () |
1387 |
"Accepts the pending completion in `completion-to-accept'. |
"Accepts the pending completion in `completion-to-accept'. |
1388 |
This bumps num-uses. Called by `add-completion-to-head' and |
This bumps num-uses. Called by `add-completion-to-head' and |
1389 |
`completion-search-reset'." |
`completion-search-reset'." |
1390 |
(let ((string completion-to-accept) |
(let ((string completion-to-accept) |
1391 |
;; if this is added afresh here, then it must be a cdabbrev |
;; if this is added afresh here, then it must be a cdabbrev |
1401 |
(let ((string (and enable-completion (symbol-under-point))) |
(let ((string (and enable-completion (symbol-under-point))) |
1402 |
(current-completion-source cmpl-source-cursor-moves)) |
(current-completion-source cmpl-source-cursor-moves)) |
1403 |
(if string (add-completion-to-head string)))) |
(if string (add-completion-to-head string)))) |
1404 |
|
|
1405 |
(defun use-completion-before-point () |
(defun use-completion-before-point () |
1406 |
"Add the completion symbol before point into the completion buffer." |
"Add the completion symbol before point into the completion buffer." |
1407 |
(let ((string (and enable-completion (symbol-before-point))) |
(let ((string (and enable-completion (symbol-before-point))) |
1433 |
|
|
1434 |
;; Tests -- |
;; Tests -- |
1435 |
;; - Add and Find - |
;; - Add and Find - |
1436 |
;; (add-completion "banana" 5 10) |
;; (add-completion "banana" 5 10) |
1437 |
;; (find-exact-completion "banana") --> ("banana" 5 10 0) |
;; (find-exact-completion "banana") --> ("banana" 5 10 0) |
1438 |
;; (add-completion "banana" 6) |
;; (add-completion "banana" 6) |
1439 |
;; (find-exact-completion "banana") --> ("banana" 6 10 0) |
;; (find-exact-completion "banana") --> ("banana" 6 10 0) |
1440 |
;; (add-completion "banish") |
;; (add-completion "banish") |
1441 |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) |
1442 |
;; |
;; |
1443 |
;; - Accepting - |
;; - Accepting - |
1444 |
;; (setq completion-to-accept "banana") |
;; (setq completion-to-accept "banana") |
1445 |
;; (accept-completion) |
;; (accept-completion) |
1446 |
;; (find-exact-completion "banana") --> ("banana" 7 10) |
;; (find-exact-completion "banana") --> ("banana" 7 10) |
1447 |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) |
1448 |
;; (setq completion-to-accept "banish") |
;; (setq completion-to-accept "banish") |
1449 |
;; (add-completion "banner") |
;; (add-completion "banner") |
1450 |
;; (car (find-cmpl-prefix-entry "ban")) |
;; (car (find-cmpl-prefix-entry "ban")) |
1451 |
;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) |
;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) |
1452 |
;; |
;; |
1453 |
;; - Deleting - |
;; - Deleting - |
1454 |
;; (kill-completion "banish") |
;; (kill-completion "banish") |
1455 |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) |
;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) |
1456 |
|
|
1457 |
|
|
1467 |
(defvar cmpl-test-string "") |
(defvar cmpl-test-string "") |
1468 |
;; "The current string used by completion-search-next." |
;; "The current string used by completion-search-next." |
1469 |
(defvar cmpl-test-regexp "") |
(defvar cmpl-test-regexp "") |
1470 |
;; "The current regexp used by completion-search-next. |
;; "The current regexp used by completion-search-next. |
1471 |
;; (derived from cmpl-test-string)" |
;; (derived from cmpl-test-string)" |
1472 |
(defvar cmpl-last-index 0) |
(defvar cmpl-last-index 0) |
1473 |
;; "The last index that completion-search-next was called with." |
;; "The last index that completion-search-next was called with." |
1522 |
(cond ((not cmpl-next-possibilities)) |
(cond ((not cmpl-next-possibilities)) |
1523 |
;; If no more possibilities, leave it that way |
;; If no more possibilities, leave it that way |
1524 |
((= -1 cmpl-last-index) |
((= -1 cmpl-last-index) |
1525 |
;; next completion is at index 0. reset next-possibility list |
;; next completion is at index 0. reset next-possibility list |
1526 |
;; to start at beginning |
;; to start at beginning |
1527 |
(setq cmpl-next-possibilities cmpl-starting-possibilities)) |
(setq cmpl-next-possibilities cmpl-starting-possibilities)) |
1528 |
(t |
(t |
1542 |
(prog1 |
(prog1 |
1543 |
cmpl-next-possibility |
cmpl-next-possibility |
1544 |
(setq cmpl-next-possibility nil))) |
(setq cmpl-next-possibility nil))) |
1545 |
|
|
1546 |
|
|
1547 |
(defun completion-search-peek (use-cdabbrev) |
(defun completion-search-peek (use-cdabbrev) |
1548 |
"Returns the next completion entry without actually moving the pointers. |
"Return the next completion entry without actually moving the pointers. |
1549 |
Calling this again or calling `completion-search-next' results in the same |
Calling this again or calling `completion-search-next' results in the same |
1550 |
string being returned. Depends on `case-fold-search'. |
string being returned. Depends on `case-fold-search'. |
1551 |
If there are no more entries, try cdabbrev and then return only a string." |
If there are no more entries, try cdabbrev and then return only a string." |
1552 |
(cond |
(cond |
1577 |
|
|
1578 |
;; Tests -- |
;; Tests -- |
1579 |
;; - Add and Find - |
;; - Add and Find - |
1580 |
;; (add-completion "banana") |
;; (add-completion "banana") |
1581 |
;; (completion-search-reset "ban") |
;; (completion-search-reset "ban") |
1582 |
;; (completion-search-next 0) --> "banana" |
;; (completion-search-next 0) --> "banana" |
1583 |
;; |
;; |
1584 |
;; - Discrimination - |
;; - Discrimination - |
1585 |
;; (add-completion "cumberland") |
;; (add-completion "cumberland") |
1586 |
;; (add-completion "cumberbund") |
;; (add-completion "cumberbund") |
1587 |
;; cumbering |
;; cumbering |
1588 |
;; (completion-search-reset "cumb") |
;; (completion-search-reset "cumb") |
1589 |
;; (completion-search-peek t) --> "cumberbund" |
;; (completion-search-peek t) --> "cumberbund" |
1590 |
;; (completion-search-next 0) --> "cumberbund" |
;; (completion-search-next 0) --> "cumberbund" |
1605 |
;; |
;; |
1606 |
;; - Deleting - |
;; - Deleting - |
1607 |
;; (kill-completion "cumberland") |
;; (kill-completion "cumberland") |
1608 |
;; cummings |
;; cummings |
1609 |
;; (completion-search-reset "cum") |
;; (completion-search-reset "cum") |
1610 |
;; (completion-search-next 0) --> "cumberbund" |
;; (completion-search-next 0) --> "cumberbund" |
1611 |
;; (completion-search-next 1) --> "cummings" |
;; (completion-search-next 1) --> "cummings" |
1625 |
(interactive) |
(interactive) |
1626 |
(setq enable-completion (not enable-completion)) |
(setq enable-completion (not enable-completion)) |
1627 |
(message "Completion mode is now %s." (if enable-completion "ON" "OFF"))) |
(message "Completion mode is now %s." (if enable-completion "ON" "OFF"))) |
1628 |
|
|
1629 |
(defvar cmpl-current-index 0) |
(defvar cmpl-current-index 0) |
1630 |
(defvar cmpl-original-string nil) |
(defvar cmpl-original-string nil) |
1631 |
(defvar cmpl-last-insert-location -1) |
(defvar cmpl-last-insert-location -1) |
1632 |
(defvar cmpl-leave-point-at-start nil) |
(defvar cmpl-leave-point-at-start nil) |
1633 |
|
|
1634 |
(defun complete (&optional arg) |
(defun complete (&optional arg) |
1635 |
"Fill out a completion of the word before point. |
"Fill out a completion of the word before point. |
1636 |
Point is left at end. Consecutive calls rotate through all possibilities. |
Point is left at end. Consecutive calls rotate through all possibilities. |
1637 |
Prefix args :: |
Prefix args :: |
1638 |
control-u :: leave the point at the beginning of the completion rather |
control-u :: leave the point at the beginning of the completion rather |
1639 |
than at the end. |
than at the end. |
1640 |
a number :: rotate through the possible completions by that amount |
a number :: rotate through the possible completions by that amount |
1641 |
`-' :: same as -1 (insert previous completion) |
`-' :: same as -1 (insert previous completion) |
1661 |
(setq this-command 'failed-complete) |
(setq this-command 'failed-complete) |
1662 |
(error "To complete, point must be after a symbol at least %d character long" |
(error "To complete, point must be after a symbol at least %d character long" |
1663 |
completion-prefix-min-length))) |
completion-prefix-min-length))) |
1664 |
;; get index |
;; get index |
1665 |
(setq cmpl-current-index (if current-prefix-arg arg 0)) |
(setq cmpl-current-index (if current-prefix-arg arg 0)) |
1666 |
;; statistics |
;; statistics |
1667 |
(cmpl-statistics-block |
(cmpl-statistics-block |
1675 |
;; Get the next completion |
;; Get the next completion |
1676 |
(let* ((print-status-p |
(let* ((print-status-p |
1677 |
(and (>= baud-rate completion-prompt-speed-threshold) |
(and (>= baud-rate completion-prompt-speed-threshold) |
1678 |
(not (minibuffer-window-selected-p)))) |
(not (window-minibuffer-p (selected-window))))) |
1679 |
(insert-point (point)) |
(insert-point (point)) |
1680 |
(entry (completion-search-next cmpl-current-index)) |
(entry (completion-search-next cmpl-current-index)) |
1681 |
string) |
string) |
1716 |
(setq string (cmpl-merge-string-cases |
(setq string (cmpl-merge-string-cases |
1717 |
string cmpl-original-string)) |
string cmpl-original-string)) |
1718 |
(message "Next completion: %s" string)))) |
(message "Next completion: %s" string)))) |
1719 |
(t;; none found, insert old |
(t;; none found, insert old |
1720 |
(insert cmpl-original-string) |
(insert cmpl-original-string) |
1721 |
;; Don't accept completions |
;; Don't accept completions |
1722 |
(setq completion-to-accept nil) |
(setq completion-to-accept nil) |
1830 |
;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 |
;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 |
1831 |
;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 |
;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 |
1832 |
|
|
1833 |
;; Parses all the definition names from a Lisp mode buffer and adds them to |
;; Parses all the definition names from a Lisp mode buffer and adds them to |
1834 |
;; the completion database. |
;; the completion database. |
1835 |
(defun add-completions-from-lisp-buffer () |
(defun add-completions-from-lisp-buffer () |
1836 |
;;; Benchmarks |
;;; Benchmarks |
1923 |
;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 |
;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 |
1924 |
;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil |
;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil |
1925 |
|
|
1926 |
;; Parses all the definition names from a C mode buffer and adds them to the |
;; Parses all the definition names from a C mode buffer and adds them to the |
1927 |
;; completion database. |
;; completion database. |
1928 |
(defun add-completions-from-c-buffer () |
(defun add-completions-from-c-buffer () |
1929 |
;; Benchmark -- |
;; Benchmark -- |
2057 |
(total-perm 0) |
(total-perm 0) |
2058 |
(total-saved 0) |
(total-saved 0) |
2059 |
(backup-filename (completion-backup-filename filename))) |
(backup-filename (completion-backup-filename filename))) |
2060 |
|
|
2061 |
(save-excursion |
(save-excursion |
2062 |
(get-buffer-create " *completion-save-buffer*") |
(get-buffer-create " *completion-save-buffer*") |
2063 |
(set-buffer " *completion-save-buffer*") |
(set-buffer " *completion-save-buffer*") |
2098 |
(setq total-saved (1+ total-saved)) |
(setq total-saved (1+ total-saved)) |
2099 |
(insert (prin1-to-string (cons (completion-string completion) |
(insert (prin1-to-string (cons (completion-string completion) |
2100 |
last-use-time)) "\n")))) |
last-use-time)) "\n")))) |
2101 |
|
|
2102 |
;; write the buffer |
;; write the buffer |
2103 |
(condition-case e |
(condition-case e |
2104 |
(let ((file-exists-p (file-exists-p filename))) |
(let ((file-exists-p (file-exists-p filename))) |
2107 |
;; If file exists . . . |
;; If file exists . . . |
2108 |
;; Save a backup(so GNU doesn't screw us when we're out of disk) |
;; Save a backup(so GNU doesn't screw us when we're out of disk) |
2109 |
;; (GNU leaves a 0 length file if it gets a disk full error!) |
;; (GNU leaves a 0 length file if it gets a disk full error!) |
2110 |
|
|
2111 |
;; If backup doesn't exit, Rename current to backup |
;; If backup doesn't exit, Rename current to backup |
2112 |
;; {If backup exists the primary file is probably messed up} |
;; {If backup exists the primary file is probably messed up} |
2113 |
(or (file-exists-p backup-filename) |
(or (file-exists-p backup-filename) |
2157 |
;; prepare the buffer to be modified |
;; prepare the buffer to be modified |
2158 |
(clear-visited-file-modtime) |
(clear-visited-file-modtime) |
2159 |
(erase-buffer) |
(erase-buffer) |
2160 |
|
|
2161 |
(let ((insert-okay-p nil) |
(let ((insert-okay-p nil) |
2162 |
(buffer (current-buffer)) |
(buffer (current-buffer)) |
2163 |
(current-time (cmpl-hours-since-origin)) |
(current-time (cmpl-hours-since-origin)) |
2173 |
(progn (insert-file-contents filename t) |
(progn (insert-file-contents filename t) |
2174 |
(setq insert-okay-p t)) |
(setq insert-okay-p t)) |
2175 |
|
|
2176 |
(file-error |
(file-error |
2177 |
(message "File error trying to load completion file %s." |
(message "File error trying to load completion file %s." |
2178 |
filename))) |
filename))) |
2179 |
;; parse it |
;; parse it |
2180 |
(if insert-okay-p |
(if insert-okay-p |
2181 |
(progn |
(progn |
2182 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2202 |
(completion-last-use-time |
(completion-last-use-time |
2203 |
(setq cmpl-entry |
(setq cmpl-entry |
2204 |
(add-completion-to-tail-if-new string)))) |
(add-completion-to-tail-if-new string)))) |
2205 |
(if (or (eq last-use-time t) |
(if (or (eq last-use-time t) |
2206 |
(and (> last-use-time 1000);;backcompatibility |
(and (> last-use-time 1000);;backcompatibility |
2207 |
(not (eq cmpl-last-use-time t)) |
(not (eq cmpl-last-use-time t)) |
2208 |
(or (not cmpl-last-use-time) |
(or (not cmpl-last-use-time) |
2234 |
|
|
2235 |
(defun initialize-completions () |
(defun initialize-completions () |
2236 |
"Load the default completions file. |
"Load the default completions file. |
2237 |
Also sets up so that exiting emacs will automatically save the file." |
Also sets up so that exiting Emacs will automatically save the file." |
2238 |
(interactive) |
(interactive) |
2239 |
(cond ((not cmpl-initialized-p) |
(cond ((not cmpl-initialized-p) |
2240 |
(load-completions-from-file))) |
(load-completions-from-file))) |
2258 |
the text killed this time appends to the text killed last time |
the text killed this time appends to the text killed last time |
2259 |
to make one entry in the kill ring. |
to make one entry in the kill ring. |
2260 |
Patched to remove the most recent completion." |
Patched to remove the most recent completion." |
2261 |
(interactive "r") |
(interactive "r") |
2262 |
(cond ((eq last-command 'complete) |
(cond ((eq last-command 'complete) |
2263 |
(delete-region (point) cmpl-last-insert-location) |
(delete-region (point) cmpl-last-insert-location) |
2264 |
(insert cmpl-original-string) |
(insert cmpl-original-string) |
2279 |
;; All common separators (eg. space "(" ")" """) characters go through a |
;; All common separators (eg. space "(" ")" """) characters go through a |
2280 |
;; function to add new words to the list of words to complete from: |
;; function to add new words to the list of words to complete from: |
2281 |
;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). |
;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). |
2282 |
;; If the character before this was an alpha-numeric then this adds the |
;; If the character before this was an alpha-numeric then this adds the |
2283 |
;; symbol before point to the completion list (using ADD-COMPLETION). |
;; symbol before point to the completion list (using ADD-COMPLETION). |
2284 |
|
|
2285 |
(defun completion-separator-self-insert-command (arg) |
(defun completion-separator-self-insert-command (arg) |
2298 |
;; Wrapping Macro |
;; Wrapping Macro |
2299 |
;;----------------------------------------------- |
;;----------------------------------------------- |
2300 |
|
|
2301 |
;; Note that because of the way byte compiling works, none of |
;; Note that because of the way byte compiling works, none of |
2302 |
;; the functions defined with this macro get byte compiled. |
;; the functions defined with this macro get byte compiled. |
2303 |
|
|
2304 |
(defmacro def-completion-wrapper (function-name type &optional new-name) |
(defmacro def-completion-wrapper (function-name type &optional new-name) |
2365 |
(define-key fortran-mode-map "/" 'completion-separator-self-insert-command)) |
(define-key fortran-mode-map "/" 'completion-separator-self-insert-command)) |
2366 |
|
|
2367 |
;;; Enable completion mode. |
;;; Enable completion mode. |
2368 |
|
|
2369 |
;;;###autoload |
;;;###autoload |
2370 |
(defun dynamic-completion-mode () |
(defun dynamic-completion-mode () |
2371 |
"Enable dynamic word-completion." |
"Enable dynamic word-completion." |
2372 |
(interactive) |
(interactive) |
2373 |
(add-hook 'find-file-hooks 'cmpl-find-file-hook) |
(add-hook 'find-file-hook 'cmpl-find-file-hook) |
2374 |
(add-hook 'pre-command-hook 'completion-before-command) |
(add-hook 'pre-command-hook 'completion-before-command) |
2375 |
|
|
2376 |
;; Install the appropriate mode tables. |
;; Install the appropriate mode tables. |
2490 |
|
|
2491 |
;; Tests -- |
;; Tests -- |
2492 |
;; foobarbiz |
;; foobarbiz |
2493 |
;; foobar |
;; foobar |
2494 |
;; fooquux |
;; fooquux |
2495 |
;; fooper |
;; fooper |
2496 |
|
|
2497 |
(cmpl-statistics-block |
(cmpl-statistics-block |
2499 |
|
|
2500 |
(initialize-completions)) |
(initialize-completions)) |
2501 |
|
|
2502 |
(mapc (lambda (x) |
(mapc (lambda (x) (add-to-list 'debug-ignored-errors x)) |
|
(add-to-list 'debug-ignored-errors x)) |
|
2503 |
'("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" |
'("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" |
2504 |
"^The string \".*\" is too short to be saved as a completion\\.$")) |
"^The string \".*\" is too short to be saved as a completion\\.$")) |
2505 |
|
|