56
|
1 ;;; This is a Completion system for GNU Emacs
|
|
2 ;;;
|
|
3 ;;; E-Mail:
|
|
4 ;;; Internet: completion@think.com, bug-completion@think.com
|
|
5 ;;; UUCP: {rutgers,harvard,mit-eddie}!think!completion
|
|
6 ;;;
|
|
7 ;;; If you are a new user, we'd appreciate knowing your site name and
|
|
8 ;;; any comments you have.
|
|
9 ;;;
|
|
10 ;;;
|
|
11 ;;; NO WARRANTY
|
|
12 ;;;
|
|
13 ;;; This software is distributed free of charge and is in the public domain.
|
|
14 ;;; Anyone may use, duplicate or modify this program. Thinking Machines
|
|
15 ;;; Corporation does not restrict in any way the use of this software by
|
|
16 ;;; anyone.
|
|
17 ;;;
|
|
18 ;;; Thinking Machines Corporation provides absolutely no warranty of any kind.
|
|
19 ;;; The entire risk as to the quality and performance of this program is with
|
|
20 ;;; you. In no event will Thinking Machines Corporation be liable to you for
|
|
21 ;;; damages, including any lost profits, lost monies, or other special,
|
|
22 ;;; incidental or consequential damages arising out of the use of this program.
|
|
23 ;;;
|
|
24 ;;; You must not restrict the distribution of this software.
|
|
25 ;;;
|
|
26 ;;; Please keep this notice and author information in any copies you make.
|
|
27 ;;;
|
|
28 ;;; 4/90
|
|
29 ;;;
|
|
30 ;;;
|
|
31 ;;; Advertisement
|
|
32 ;;;---------------
|
|
33 ;;; Try using this. If you are like most you will be happy you did.
|
|
34 ;;;
|
|
35 ;;; What to put in .emacs
|
|
36 ;;;-----------------------
|
|
37 ;;; (load "completion") ;; If it's not part of the standard band.
|
|
38 ;;; (initialize-completions)
|
|
39 ;;;
|
|
40 ;;; For best results, be sure to byte-compile the file first.
|
|
41 ;;;
|
|
42
|
|
43 ;;; Authors
|
|
44 ;;;---------
|
|
45 ;;; Jim Salem {salem@think.com}
|
|
46 ;;; Brewster Kahle {brewster@think.com}
|
|
47 ;;; Thinking Machines Corporation
|
|
48 ;;; 245 First St., Cambridge MA 02142 (617) 876-1111
|
|
49 ;;;
|
|
50 ;;; Mailing Lists
|
|
51 ;;;---------------
|
|
52 ;;;
|
|
53 ;;; Bugs to bug-completion@think.com
|
|
54 ;;; Comments to completion@think.com
|
|
55 ;;; Requests to be added completion-request@think.com
|
|
56 ;;;
|
|
57 ;;; Availability
|
|
58 ;;;--------------
|
|
59 ;;; Anonymous FTP from think.com
|
|
60 ;;;
|
|
61
|
|
62 ;;;---------------------------------------------------------------------------
|
|
63 ;;; Documentation [Slightly out of date]
|
|
64 ;;;---------------------------------------------------------------------------
|
|
65 ;;; (also check the documentation string of the functions)
|
|
66 ;;;
|
|
67 ;;; Introduction
|
|
68 ;;;---------------
|
|
69 ;;;
|
|
70 ;;; After you type a few characters, pressing the "complete" key inserts
|
|
71 ;;; the rest of the word you are likely to type.
|
|
72 ;;;
|
|
73 ;;; This watches all the words that you type and remembers them. When
|
|
74 ;;; typing a new word, pressing "complete" (meta-return) "completes" the
|
|
75 ;;; word by inserting the most recently used word that begins with the
|
|
76 ;;; same characters. If you press meta-return repeatedly, it cycles
|
|
77 ;;; through all the words it knows about.
|
|
78 ;;;
|
|
79 ;;; If you like the completion then just continue typing, it is as if you
|
|
80 ;;; entered the text by hand. If you want the inserted extra characters
|
|
81 ;;; to go away, type control-w or delete. More options are described below.
|
|
82 ;;;
|
|
83 ;;; The guesses are made in the order of the most recently "used". Typing
|
|
84 ;;; in a word and then typing a separator character (such as a space) "uses"
|
|
85 ;;; the word. So does moving a cursor over the word. If no words are found,
|
|
86 ;;; it uses an extended version of the dabbrev style completion.
|
|
87 ;;;
|
|
88 ;;; You automatically save the completions you use to a file between
|
|
89 ;;; sessions.
|
|
90 ;;;
|
|
91 ;;; Completion enables programmers to enter longer, more descriptive
|
|
92 ;;; variable names while typing fewer keystrokes than they normally would.
|
|
93 ;;;
|
|
94 ;;;
|
|
95 ;;; Full documentation
|
|
96 ;;;---------------------
|
|
97 ;;;
|
|
98 ;;; A "word" is any string containing characters with either word or symbol
|
|
99 ;;; syntax. [E.G. Any alphanumeric string with hypens, underscores, etc.]
|
|
100 ;;; Unless you change the constants, you must type at least three characters
|
|
101 ;;; for the word to be recognized. Only words longer than 6 characters are
|
|
102 ;;; saved.
|
|
103 ;;;
|
|
104 ;;; When you load this file, completion will be on. I suggest you use the
|
|
105 ;;; compiled version (because it is noticibly faster).
|
|
106 ;;;
|
|
107 ;;; M-X completion-mode toggles whether or not new words are added to the
|
|
108 ;;; database by changing the value of *completep*.
|
|
109 ;;;
|
|
110 ;;; SAVING/LOADING COMPLETIONS
|
|
111 ;;; Completions are automatically saved from one session to another
|
|
112 ;;; (unless *save-completions-p* or *completep* is nil).
|
|
113 ;;; Loading this file (or calling initialize-completions) causes EMACS
|
|
114 ;;; to load a completions database for a saved completions file
|
|
115 ;;; (default: ~/.completions). When you exit, EMACS saves a copy of the
|
|
116 ;;; completions that you
|
|
117 ;;; often use. When you next start, EMACS loads in the saved completion file.
|
|
118 ;;;
|
|
119 ;;; The number of completions saved depends loosely on
|
|
120 ;;; *saved-completions-decay-factor*. Completions that have never been
|
|
121 ;;; inserted via "complete" are not saved. You are encouraged to experiment
|
|
122 ;;; with different functions (see compute-completion-min-num-uses).
|
|
123 ;;;
|
|
124 ;;; Some completions are permanent and are always saved out. These
|
|
125 ;;; completions have their num-uses slot set to T. Use
|
|
126 ;;; add-permanent-completion to do this
|
|
127 ;;;
|
|
128 ;;; Completions are saved only if *completep* is T. The number of old
|
|
129 ;;; versions kept of the saved completions file is controlled by
|
|
130 ;;; *completion-file-versions-kept*.
|
|
131 ;;;
|
|
132 ;;; COMPLETE KEY OPTIONS
|
|
133 ;;; The complete function takes a numeric arguments.
|
|
134 ;;; control-u :: leave the point at the beginning of the completion rather
|
|
135 ;;; than the middle.
|
|
136 ;;; a number :: rotate through the possible completions by that amount
|
|
137 ;;; `-' :: same as -1 (insert previous completion)
|
|
138 ;;;
|
|
139 ;;; HOW THE DATABASE IS MAINTAINED
|
|
140 ;;; <write>
|
|
141 ;;;
|
|
142 ;;; UPDATING THE DATABASE MANUALLY
|
|
143 ;;; m-x kill-completion
|
|
144 ;;; kills the completion at point.
|
|
145 ;;; m-x add-completion
|
|
146 ;;; m-x add-permanent-completion
|
|
147 ;;;
|
|
148 ;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
|
|
149 ;;; m-x add-completions-from-buffer
|
|
150 ;;; Parses all the definition names from a C or LISP mode buffer and
|
|
151 ;;; adds them to the completion database.
|
|
152 ;;;
|
|
153 ;;; m-x add-completions-from-lisp-file
|
|
154 ;;; Parses all the definition names from a C or Lisp mode file and
|
|
155 ;;; adds them to the completion database.
|
|
156 ;;;
|
|
157 ;;; UPDATING THE DATABASE FROM A TAGS TABLE
|
|
158 ;;; m-x add-completions-from-tags-table
|
|
159 ;;; Adds completions from the current tags-table-buffer.
|
|
160 ;;;
|
|
161 ;;; HOW A COMPLETION IS FOUND
|
|
162 ;;; <write>
|
|
163 ;;;
|
|
164 ;;; STRING CASING
|
|
165 ;;; Completion is string case independent if case-fold-search has its
|
|
166 ;;; normal default of T. Also when the completion is inserted the case of the
|
|
167 ;;; entry is coerced appropriately.
|
|
168 ;;; [E.G. APP --> APPROPRIATELY app --> appropriately
|
|
169 ;;; App --> Appropriately]
|
|
170 ;;;
|
|
171 ;;; INITIALIZATION
|
|
172 ;;; The form `(initialize-completions)' initializes the completion system by
|
|
173 ;;; trying to load in the user's completions. After the first cal, further
|
|
174 ;;; calls have no effect so one should be careful not to put the form in a
|
|
175 ;;; site's standard site-init file.
|
|
176 ;;;
|
|
177 ;;;---------------------------------------------------------------------------
|
|
178 ;;;
|
|
179 ;;;
|
|
180
|
|
181 ;;;-----------------------------------------------
|
|
182 ;;; Porting Notes
|
|
183 ;;;-----------------------------------------------
|
|
184 ;;;
|
|
185 ;;; Should run on 18.49, 18.52, and 19.0
|
|
186 ;;; Tested on vanilla version.
|
|
187 ;;; This requires the standard cl.el file. It could easily rewritten to not
|
|
188 ;;; require it. It defines remove which is not in cl.el.
|
|
189 ;;;
|
|
190 ;;; FUNCTIONS BASHED
|
|
191 ;;; The following functions are bashed but it is done carefully and should not
|
|
192 ;;; cause problems ::
|
|
193 ;;; kill-region, next-line, previous-line, newline, newline-and-indent,
|
|
194 ;;; kill-emacs
|
|
195 ;;;
|
|
196 ;;;
|
|
197 ;;;---------------------------------------------------------------------------
|
|
198 ;;; Functions you might like to call
|
|
199 ;;;---------------------------------------------------------------------------
|
|
200 ;;;
|
|
201 ;;; add-completion string &optional num-uses
|
|
202 ;;; Adds a new string to the database
|
|
203 ;;;
|
|
204 ;;; add-permanent-completion string
|
|
205 ;;; Adds a new string to the database with num-uses = T
|
|
206 ;;;
|
|
207
|
|
208 ;;; kill-completion string
|
|
209 ;;; Kills the completion from the database.
|
|
210 ;;;
|
|
211 ;;; clear-all-completions
|
|
212 ;;; Clears the database
|
|
213 ;;;
|
|
214 ;;; list-all-completions
|
|
215 ;;; Returns a list of all completions.
|
|
216 ;;;
|
|
217 ;;;
|
|
218 ;;; next-completion string &optional index
|
|
219 ;;; Returns a completion entry that starts with string.
|
|
220 ;;;
|
|
221 ;;; find-exact-completion string
|
|
222 ;;; Returns a completion entry that exactly matches string.
|
|
223 ;;;
|
|
224 ;;; complete
|
|
225 ;;; Inserts a completion at point
|
|
226 ;;;
|
|
227 ;;; initialize-completions
|
|
228 ;;; Loads the completions file and sets up so that exiting emacs will
|
|
229 ;;; save them.
|
|
230 ;;;
|
|
231 ;;; save-completions-to-file &optional filename
|
|
232 ;;; load-completions-from-file &optional filename
|
|
233 ;;;
|
|
234 ;;;-----------------------------------------------
|
|
235 ;;; Other functions
|
|
236 ;;;-----------------------------------------------
|
|
237 ;;;
|
|
238 ;;; get-completion-list string
|
|
239 ;;;
|
|
240 ;;; These things are for manipulating the structure
|
|
241 ;;; make-completion string num-uses
|
|
242 ;;; completion-num-uses completion
|
|
243 ;;; completion-string completion
|
|
244 ;;; set-completion-num-uses completion num-uses
|
|
245 ;;; set-completion-string completion string
|
|
246 ;;;
|
|
247 ;;;
|
|
248
|
|
249 ;;;-----------------------------------------------
|
|
250 ;;; To Do :: (anybody ?)
|
|
251 ;;;-----------------------------------------------
|
|
252 ;;;
|
|
253 ;;; Implement Lookup and keyboard interface in C
|
|
254 ;;; Add package prefix smarts (for Common Lisp)
|
|
255 ;;; Add autoprompting of possible completions after every keystroke (fast
|
|
256 ;;; terminals only !)
|
|
257 ;;; Add doc. to texinfo
|
|
258 ;;;
|
|
259 ;;;
|
|
260 ;;;-----------------------------------------------
|
|
261 ;;; History ::
|
|
262 ;;;-----------------------------------------------
|
|
263 ;;; Sometime in '84 Brewster implemented a somewhat buggy version for
|
|
264 ;;; Symbolics LISPMs.
|
|
265 ;;; Jan. '85 Jim became enamored of the idea and implemented a faster,
|
|
266 ;;; more robust version.
|
|
267 ;;; With input from many users at TMC, (rose, craig, and gls come to mind),
|
|
268 ;;; the current style of interface was developed.
|
|
269 ;;; 9/87, Jim and Brewster took terminals home. Yuck. After
|
|
270 ;;; complaining for a while Brewester implemented a subset of the current
|
|
271 ;;; LISPM version for GNU Emacs.
|
|
272 ;;; 8/88 After complaining for a while (and with sufficient
|
|
273 ;;; promised rewards), Jim reimplemented a version of GNU completion
|
|
274 ;;; superior to that of the LISPM version.
|
|
275 ;;;
|
|
276 ;;;-----------------------------------------------
|
|
277 ;;; Acknowlegements
|
|
278 ;;;-----------------------------------------------
|
|
279 ;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
|
|
280 ;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
|
|
281 ;;;
|
|
282 ;;;-----------------------------------------------
|
|
283 ;;; Change Log
|
|
284 ;;;-----------------------------------------------
|
|
285 ;;; From version 9 to 10
|
|
286 ;;; - Allowance for non-integral *completion-version* nos.
|
|
287 ;;; - Fix cmpl-apply-as-top-level for keyboard macros
|
|
288 ;;; - Fix broken completion merging (in save-completions-to-file)
|
|
289 ;;; - More misc. fixes for version 19.0 of emacs
|
|
290 ;;;
|
|
291 ;;; From Version 8 to 9
|
|
292 ;;; - Ported to version 19.0 of emacs (backcompatible with version 18)
|
|
293 ;;; - Added add-completions-from-tags-table (with thanks to eero@media-lab)
|
|
294 ;;;
|
|
295 ;;; From Version 7 to 8
|
|
296 ;;; - Misc. changes to comments
|
|
297 ;;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e
|
|
298 ;;; - cdabbrev now checks all the visible window buffers and the "other buffer"
|
|
299 ;;; - `%' is now a symbol character rather than a separator (except in C mode)
|
|
300 ;;;
|
|
301 ;;; From Version 6 to 7
|
|
302 ;;; - Fixed bug with saving out .completion file the first time
|
|
303 ;;;
|
|
304 ;;; From Version 5 to 6
|
|
305 ;;; - removed statistics recording
|
|
306 ;;; - reworked advise to handle autoloads
|
|
307 ;;; - Fixed fortran mode support
|
|
308 ;;; - Added new cursor motion triggers
|
|
309 ;;;
|
|
310 ;;; From Version 4 to 5
|
|
311 ;;; - doesn't bother saving if nothing has changed
|
|
312 ;;; - auto-save if haven't used for a 1/2 hour
|
|
313 ;;; - save period extended to two weeks
|
|
314 ;;; - minor fix to capitalization code
|
|
315 ;;; - added *completion-auto-save-period* to variables recorded.
|
|
316 ;;; - added reenter protection to cmpl-record-statistics-filter
|
|
317 ;;; - added backup protection to save-completions-to-file (prevents
|
|
318 ;;; problems with disk full errors)
|
|
319
|
|
320 ;;;-----------------------------------------------
|
|
321 ;;; Requires
|
|
322 ;;; Version
|
|
323 ;;;-----------------------------------------------
|
|
324
|
|
325 ;;(require 'cl) ;; DOTIMES, etc. {actually done after variable defs.}
|
|
326
|
|
327 (defconst *completion-version* 10
|
|
328 "Tested for EMACS versions 18.49, 18.52, 18.55 and beyond and 19.0.")
|
|
329
|
|
330 ;;;---------------------------------------------------------------------------
|
|
331 ;;; User changeable parameters
|
|
332 ;;;---------------------------------------------------------------------------
|
|
333
|
|
334 (defvar *completep* t
|
|
335 "*Set to nil to turn off the completion hooks.
|
|
336 (No new words added to the database or saved to the init file)."
|
|
337 )
|
|
338
|
|
339 (defvar *save-completions-p* t
|
|
340 "*If non-nil, the most useful completions are saved to disk when
|
|
341 exiting EMACS. See *saved-completions-decay-factor*.")
|
|
342
|
|
343 (defvar *saved-completions-filename* "~/.completions"
|
|
344 "*The filename to save completions to.")
|
|
345
|
|
346 (defvar *saved-completion-retention-time* 336
|
|
347 "*The maximum amout of time to save a completion for if it has not been used.
|
|
348 In hours. (1 day = 24, 1 week = 168). If this is 0, non-permanent completions
|
|
349 will not be saved unless these are used. Default is two weeks."
|
|
350 )
|
|
351
|
|
352 (defvar *separator-character-uses-completion-p* nil
|
|
353 "*If non-nil, typing a separator character after a completion symbol that
|
|
354 is not part of the database marks it as used (so it will be saved).")
|
|
355
|
|
356 (defvar *completion-file-versions-kept* kept-new-versions
|
|
357 "*Set this to the number of versions you want save-completions-to-file
|
|
358 to keep.")
|
|
359
|
|
360 (defvar *print-next-completion-speed-threshold* 4800
|
|
361 "*The baud rate at or above which to print the next potential completion
|
|
362 after inserting the current one."
|
|
363 )
|
|
364
|
|
365 (defvar *print-next-completion-does-cdabbrev-search-p* nil
|
|
366 "*If non-NIL, the next completion prompt will also do a cdabbrev search.
|
|
367 This can be time consuming.")
|
|
368
|
|
369 (defvar *cdabbrev-radius* 15000
|
|
370 "*How far to search for cdabbrevs. In number of characters. If nil, the
|
|
371 whole buffer is searched.")
|
|
372
|
|
373 (defvar *modes-for-completion-find-file-hook* '(lisp c)
|
|
374 "*A list of modes {either c or lisp}. Definitions from visited files
|
|
375 of those types are automatically added to the completion database.")
|
|
376
|
|
377 (defvar *record-cmpl-statistics-p* nil
|
|
378 "*If non-nil, statistics are automatically recorded.")
|
|
379
|
|
380 (defvar *completion-auto-save-period* 1800
|
|
381 "*The period in seconds to wait for emacs to be idle before autosaving
|
|
382 the completions. Default is a 1/2 hour.")
|
|
383
|
|
384 (defconst *completion-min-length* nil ;; defined below in eval-when
|
|
385 "*The minimum length of a stored completion.
|
|
386 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
|
|
387
|
|
388 (defconst *completion-max-length* nil ;; defined below in eval-when
|
|
389 "*The maximum length of a stored completion.
|
|
390 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
|
|
391
|
|
392 (defconst *completion-prefix-min-length* nil ;; defined below in eval-when
|
|
393 "The minimum length of a completion search string.
|
|
394 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
|
|
395
|
|
396 (defmacro eval-when-compile-load-eval (&rest body)
|
|
397 ;; eval everything before expanding
|
|
398 (mapcar 'eval body)
|
|
399 (cons 'progn body)
|
|
400 )
|
|
401
|
|
402 (defun completion-eval-when ()
|
|
403 (eval-when-compile-load-eval
|
|
404 ;; These vars. are defined at both compile and load time.
|
|
405 (setq *completion-min-length* 6)
|
|
406 (setq *completion-max-length* 200)
|
|
407 (setq *completion-prefix-min-length* 3)
|
|
408 ;; Need this file around too
|
|
409 (require 'cl)
|
|
410 )) ;; eval-when
|
|
411
|
|
412 (completion-eval-when)
|
|
413
|
|
414 ;;;---------------------------------------------------------------------------
|
|
415 ;;; Internal Variables
|
|
416 ;;;---------------------------------------------------------------------------
|
|
417
|
|
418 (defvar cmpl-initialized-p nil
|
|
419 "Set to t when the completion system is initialized. Indicates that the old
|
|
420 completion file has been read in.")
|
|
421
|
|
422 (defvar cmpl-completions-accepted-p nil
|
|
423 "Set to T as soon as the first completion has been accepted. Used to
|
|
424 decide whether to save completions.")
|
|
425
|
|
426
|
|
427 ;;;---------------------------------------------------------------------------
|
|
428 ;;; Low level tools
|
|
429 ;;;---------------------------------------------------------------------------
|
|
430
|
|
431 ;;;-----------------------------------------------
|
|
432 ;;; Misc.
|
|
433 ;;;-----------------------------------------------
|
|
434
|
|
435 (defun remove (item list)
|
|
436 (setq list (copy-sequence list))
|
|
437 (delq item list)
|
|
438 )
|
|
439
|
|
440 (defun minibuffer-window-selected-p ()
|
|
441 "True iff the current window is the minibuffer."
|
|
442 (eq (minibuffer-window) (selected-window)))
|
|
443
|
|
444 (eval-when-compile-load-eval
|
|
445 (defun function-needs-autoloading-p (symbol)
|
|
446 ;; True iff symbol is represents an autoloaded function and has not yet been
|
|
447 ;; autoloaded.
|
|
448 (and (listp (symbol-function symbol))
|
|
449 (eq 'autoload (car (symbol-function symbol)))
|
|
450 ))
|
|
451 ) ;; eval-when
|
|
452
|
|
453 (defun function-defined-and-loaded (symbol)
|
|
454 ;; True iff symbol is bound to a loaded function.
|
|
455 (and (fboundp symbol) (not (function-needs-autoloading-p symbol)))
|
|
456 )
|
|
457
|
|
458 (defmacro read-time-eval (form)
|
|
459 ;; Like the #. reader macro
|
|
460 (eval form)
|
|
461 )
|
|
462
|
|
463 ;;;-----------------------------------------------
|
|
464 ;;; Emacs Version 19 compatibility
|
|
465 ;;;-----------------------------------------------
|
|
466
|
|
467 (defconst emacs-is-version-19 (string= (substring emacs-version 0 2) "19"))
|
|
468
|
|
469 (defun cmpl19-baud-rate ()
|
|
470 (if emacs-is-version-19
|
|
471 baud-rate
|
|
472 (baud-rate)))
|
|
473
|
|
474 (defun cmpl19-sit-for (amount)
|
|
475 (if (and emacs-is-version-19 (= amount 0))
|
|
476 (sit-for 1 t)
|
|
477 (sit-for amount)))
|
|
478
|
|
479 ;;;-----------------------------------------------
|
|
480 ;;; Advise
|
|
481 ;;;-----------------------------------------------
|
|
482
|
|
483 (defmacro completion-advise (function-name where &rest body)
|
|
484 "Adds the body code before calling function. This advise is not compiled.
|
|
485 WHERE is either :BEFORE or :AFTER."
|
|
486 (completion-advise-1 function-name where body)
|
|
487 )
|
|
488
|
|
489 (defmacro cmpl-apply-as-top-level (function arglist)
|
|
490 "Calls function-name interactively if inside a call-interactively."
|
|
491 (list 'cmpl-apply-as-top-level-1 function arglist
|
|
492 '(let ((executing-macro nil)) (interactive-p)))
|
|
493 )
|
|
494
|
|
495 (defun cmpl-apply-as-top-level-1 (function arglist interactive-p)
|
|
496 (if (and interactive-p (commandp function))
|
|
497 (call-interactively function)
|
|
498 (apply function arglist)
|
|
499 ))
|
|
500
|
|
501 (eval-when-compile-load-eval
|
|
502
|
|
503 (defun cmpl-defun-preamble (function-name)
|
|
504 (let ((doc-string
|
|
505 (condition-case e
|
|
506 ;; This condition-case is here to stave
|
|
507 ;; off bizarre load time errors 18.52 gets
|
|
508 ;; on the function c-mode
|
|
509 (documentation function-name)
|
|
510 (error nil)))
|
|
511 (interactivep (commandp function-name))
|
|
512 )
|
|
513 (append
|
|
514 (if doc-string (list doc-string))
|
|
515 (if interactivep '((interactive)))
|
|
516 )))
|
|
517
|
|
518 (defun completion-advise-1 (function-name where body &optional new-name)
|
|
519 (unless new-name (setq new-name function-name))
|
|
520 (let ((quoted-name (list 'quote function-name))
|
|
521 (quoted-new-name (list 'quote new-name))
|
|
522 )
|
|
523
|
|
524 (cond ((function-needs-autoloading-p function-name)
|
|
525 (list* 'defun function-name '(&rest arglist)
|
|
526 (append
|
|
527 (cmpl-defun-preamble function-name)
|
|
528 (list (list 'load (second (symbol-function function-name)))
|
|
529 (list 'eval
|
|
530 (list 'completion-advise-1 quoted-name
|
|
531 (list 'quote where) (list 'quote body)
|
|
532 quoted-new-name))
|
|
533 (list 'cmpl-apply-as-top-level quoted-new-name 'arglist)
|
|
534 )))
|
|
535 )
|
|
536 (t
|
|
537 (let ((old-def-name
|
|
538 (intern (concat "$$$cmpl-" (symbol-name function-name))))
|
|
539 )
|
|
540
|
|
541 (list 'progn
|
|
542 (list 'defvar old-def-name
|
|
543 (list 'symbol-function quoted-name))
|
|
544 (list* 'defun new-name '(&rest arglist)
|
|
545 (append
|
|
546 (cmpl-defun-preamble function-name)
|
|
547 (ecase where
|
|
548 (:before
|
|
549 (list (cons 'progn body)
|
|
550 (list 'cmpl-apply-as-top-level
|
|
551 old-def-name 'arglist)))
|
|
552 (:after
|
|
553 (list* (list 'cmpl-apply-as-top-level
|
|
554 old-def-name 'arglist)
|
|
555 body)
|
|
556 )))
|
|
557 )))
|
|
558 ))))
|
|
559 ) ;; eval-when
|
|
560
|
|
561
|
|
562 ;;;-----------------------------------------------
|
|
563 ;;; String case coercion
|
|
564 ;;;-----------------------------------------------
|
|
565
|
|
566 (defun cmpl-string-case-type (string)
|
|
567 "Returns :capitalized, :up, :down, :mixed, or :neither."
|
|
568 (let ((case-fold-search nil))
|
|
569 (cond ((string-match "[a-z]" string)
|
|
570 (cond ((string-match "[A-Z]" string)
|
|
571 (cond ((and (> (length string) 1)
|
|
572 (null (string-match "[A-Z]" string 1)))
|
|
573 ':capitalized)
|
|
574 (t
|
|
575 ':mixed)))
|
|
576 (t ':down)))
|
|
577 (t
|
|
578 (cond ((string-match "[A-Z]" string)
|
|
579 ':up)
|
|
580 (t ':neither))))
|
|
581 ))
|
|
582
|
|
583 ;;; Tests -
|
|
584 ;;; (cmpl-string-case-type "123ABCDEF456") --> :up
|
|
585 ;;; (cmpl-string-case-type "123abcdef456") --> :down
|
|
586 ;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
|
|
587 ;;; (cmpl-string-case-type "123456") --> :neither
|
|
588 ;;; (cmpl-string-case-type "Abcde123") --> :capitalized
|
|
589
|
|
590 (defun cmpl-coerce-string-case (string case-type)
|
|
591 (cond ((eq case-type ':down) (downcase string))
|
|
592 ((eq case-type ':up) (upcase string))
|
|
593 ((eq case-type ':capitalized)
|
|
594 (setq string (downcase string))
|
|
595 (aset string 0 (logand ?\337 (aref string 0)))
|
|
596 string)
|
|
597 (t string)
|
|
598 ))
|
|
599
|
|
600 (defun cmpl-merge-string-cases (string-to-coerce given-string)
|
|
601 (let ((string-case-type (cmpl-string-case-type string-to-coerce))
|
|
602 )
|
|
603 (cond ((memq string-case-type '(:down :up :capitalized))
|
|
604 ;; Found string is in a standard case. Coerce to a type based on
|
|
605 ;; the given string
|
|
606 (cmpl-coerce-string-case string-to-coerce
|
|
607 (cmpl-string-case-type given-string))
|
|
608 )
|
|
609 (t
|
|
610 ;; If the found string is in some unusual case, just insert it
|
|
611 ;; as is
|
|
612 string-to-coerce)
|
|
613 )))
|
|
614
|
|
615 ;;; Tests -
|
|
616 ;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
|
|
617 ;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
|
|
618 ;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
|
|
619 ;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
|
|
620
|
|
621
|
|
622 ;;;-----------------------------------------------
|
|
623 ;;; Emacs Idle Time hooks
|
|
624 ;;;-----------------------------------------------
|
|
625
|
|
626 (defvar cmpl-emacs-idle-process nil)
|
|
627
|
|
628 (defvar cmpl-emacs-idle-interval 150
|
|
629 "Seconds between running the emacs idle process.")
|
|
630
|
|
631 (defun init-cmpl-emacs-idle-process ()
|
|
632 "Initialize the emacs idle process."
|
|
633 (let ((live (and cmpl-emacs-idle-process
|
|
634 (eq (process-status cmpl-emacs-idle-process) 'run)))
|
|
635 ;; do not allocate a pty
|
|
636 (process-connection-type nil))
|
|
637 (if live
|
|
638 (kill-process cmpl-emacs-idle-process))
|
|
639 (if cmpl-emacs-idle-process
|
|
640 (delete-process cmpl-emacs-idle-process))
|
|
641 (setq cmpl-emacs-idle-process
|
|
642 (start-process "cmpl-emacs-idle" nil
|
|
643 "loadst"
|
|
644 "-n" (int-to-string cmpl-emacs-idle-interval)))
|
|
645 (process-kill-without-query cmpl-emacs-idle-process)
|
|
646 (set-process-filter cmpl-emacs-idle-process 'cmpl-emacs-idle-filter)
|
|
647 ))
|
|
648
|
|
649 (defvar cmpl-emacs-buffer nil)
|
|
650 (defvar cmpl-emacs-point 0)
|
|
651 (defvar cmpl-emacs-last-command nil)
|
|
652 (defvar cmpl-emacs-last-command-char nil)
|
|
653 (defun cmpl-emacs-idle-p ()
|
|
654 ;; returns T if emacs has been idle
|
|
655 (if (and (eq cmpl-emacs-buffer (current-buffer))
|
|
656 (= cmpl-emacs-point (point))
|
|
657 (eq cmpl-emacs-last-command last-command)
|
|
658 (eq last-command-char last-command-char)
|
|
659 )
|
|
660 t ;; idle
|
|
661 ;; otherwise, update count
|
|
662 (setq cmpl-emacs-buffer (current-buffer))
|
|
663 (setq cmpl-emacs-point (point))
|
|
664 (setq cmpl-emacs-last-command last-command)
|
|
665 (setq last-command-char last-command-char)
|
|
666 nil
|
|
667 ))
|
|
668
|
|
669 (defvar cmpl-emacs-idle-time 0
|
|
670 "The idle time of emacs in seconds.")
|
|
671
|
|
672 (defvar inside-cmpl-emacs-idle-filter nil)
|
|
673 (defvar cmpl-emacs-idle-time-hooks nil)
|
|
674
|
|
675 (defun cmpl-emacs-idle-filter (proc string)
|
|
676 ;; This gets called every cmpl-emacs-idle-interval seconds
|
|
677 ;; Update idle time clock
|
|
678 (if (cmpl-emacs-idle-p)
|
|
679 (incf cmpl-emacs-idle-time cmpl-emacs-idle-interval)
|
|
680 (setq cmpl-emacs-idle-time 0))
|
|
681
|
|
682 (unless inside-cmpl-emacs-idle-filter
|
|
683 ;; Don't reenter if we are hung
|
|
684
|
|
685 (setq inside-cmpl-emacs-idle-filter t)
|
|
686
|
|
687 (dolist (function cmpl-emacs-idle-time-hooks)
|
|
688 (condition-case e
|
|
689 (funcall function)
|
|
690 (error nil)
|
|
691 ))
|
|
692 (setq inside-cmpl-emacs-idle-filter nil)
|
|
693 ))
|
|
694
|
|
695
|
|
696 ;;;-----------------------------------------------
|
|
697 ;;; Time
|
|
698 ;;;-----------------------------------------------
|
|
699 ;;; What a backwards way to get the time ! Unfortunately, GNU Emacs
|
|
700 ;;; doesn't have an accessible time function.
|
|
701
|
|
702 (defconst cmpl-hours-per-day 24)
|
|
703 (defconst cmpl-hours-per-year (* 365 cmpl-hours-per-day))
|
|
704 (defconst cmpl-hours-per-4-years (+ (* 4 cmpl-hours-per-year)
|
|
705 cmpl-hours-per-day))
|
|
706 (defconst cmpl-days-since-start-of-year
|
|
707 '(0 31 59 90 120 151 181 212 243 273 304 334))
|
|
708 (defconst cmpl-days-since-start-of-leap-year
|
|
709 '(0 31 60 91 121 152 182 213 244 274 305 335))
|
|
710 (defconst cmpl-months
|
|
711 '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
|
|
712 )
|
|
713
|
|
714 (defun cmpl-hours-since-1900-internal (month day year hours)
|
|
715 "Month is an integer from 1 to 12. Year is a two digit integer (19XX)"
|
|
716 (+ ;; Year
|
|
717 (* (/ (1- year) 4) cmpl-hours-per-4-years)
|
|
718 (* (1+ (mod (1- year) 4)) cmpl-hours-per-year)
|
|
719 ;; minus two to account for 1968 rather than 1900
|
|
720 ;; month
|
|
721 (* cmpl-hours-per-day
|
|
722 (nth (1- month) (if (zerop (mod year 4))
|
|
723 cmpl-days-since-start-of-leap-year
|
|
724 cmpl-days-since-start-of-year)))
|
|
725 (* (1- day) cmpl-hours-per-day)
|
|
726 hours
|
|
727 ))
|
|
728
|
|
729 (defun cmpl-month-from-string (month-string)
|
|
730 "Month string is a three char. month string"
|
|
731 (let ((count 1))
|
|
732 (do ((list cmpl-months (cdr list))
|
|
733 )
|
|
734 ((or (null list) (string-equal month-string (car list))))
|
|
735 (setq count (1+ count)))
|
|
736 (if (> count 12)
|
|
737 (error "Unknown month - %s" month-string))
|
|
738 count))
|
|
739
|
|
740 (defun cmpl-hours-since-1900 (&optional time-string)
|
|
741 "String is a string in the format of current-time-string (the default)."
|
|
742 (let* ((string (or time-string (current-time-string)))
|
|
743 (month (cmpl-month-from-string (substring string 4 7)))
|
|
744 (day (string-to-int (substring string 8 10)))
|
|
745 (year (string-to-int (substring string 22 24)))
|
|
746 (hour (string-to-int (substring string 11 13)))
|
|
747 )
|
|
748 (cmpl-hours-since-1900-internal month day year hour)
|
|
749 ))
|
|
750
|
|
751 ;;; Tests -
|
|
752 ;;;(cmpl-hours-since-1900 "Wed Jan 1 00:00:28 1900") --> 35040
|
|
753 ;;;(cmpl-hours-since-1900 "Wed Nov 2 23:00:28 1988") --> 778751
|
|
754 ;;;(cmpl-hours-since-1900 "Wed Jan 23 14:34:28 1988") --> 771926
|
|
755 ;;;(cmpl-hours-since-1900 "Wed Feb 23 14:34:28 1988") --> 772670
|
|
756 ;;;(cmpl-hours-since-1900 "Wed Mar 23 14:34:28 1988") --> 773366
|
|
757 ;;;(cmpl-hours-since-1900 "Wed Apr 23 14:34:28 1988") --> 774110
|
|
758 ;;;(cmpl-hours-since-1900 "Wed May 23 14:34:28 1988") --> 774830
|
|
759 ;;;(cmpl-hours-since-1900 "Wed Jun 23 14:34:28 1988") --> 775574
|
|
760 ;;;(cmpl-hours-since-1900 "Wed Jul 23 14:34:28 1988") --> 776294
|
|
761 ;;;(cmpl-hours-since-1900 "Wed Aug 23 14:34:28 1988") --> 777038
|
|
762 ;;;(cmpl-hours-since-1900 "Wed Sep 23 14:34:28 1988") --> 777782
|
|
763 ;;;(cmpl-hours-since-1900 "Wed Oct 23 14:34:28 1988") --> 778502
|
|
764 ;;;(cmpl-hours-since-1900 "Wed Nov 23 14:34:28 1988") --> 779246
|
|
765 ;;;(cmpl-hours-since-1900 "Wed Dec 23 14:34:28 1988") --> 779966
|
|
766 ;;;(cmpl-hours-since-1900 "Wed Jan 23 14:34:28 1957") --> 500198
|
|
767 ;;;(cmpl-hours-since-1900 "Wed Feb 23 14:34:28 1957") --> 500942
|
|
768 ;;;(cmpl-hours-since-1900 "Wed Mar 23 14:34:28 1957") --> 501614
|
|
769 ;;;(cmpl-hours-since-1900 "Wed Apr 23 14:34:28 1957") --> 502358
|
|
770 ;;;(cmpl-hours-since-1900 "Wed May 23 14:34:28 1957") --> 503078
|
|
771 ;;;(cmpl-hours-since-1900 "Wed Jun 23 14:34:28 1957") --> 503822
|
|
772 ;;;(cmpl-hours-since-1900 "Wed Jul 23 14:34:28 1957") --> 504542
|
|
773 ;;;(cmpl-hours-since-1900 "Wed Aug 23 14:34:28 1957") --> 505286
|
|
774 ;;;(cmpl-hours-since-1900 "Wed Sep 23 14:34:28 1957") --> 506030
|
|
775 ;;;(cmpl-hours-since-1900 "Wed Oct 23 14:34:28 1957") --> 506750
|
|
776 ;;;(cmpl-hours-since-1900 "Wed Nov 23 14:34:28 1957") --> 507494
|
|
777 ;;;(cmpl-hours-since-1900 "Wed Dec 23 14:34:28 1957") --> 508214
|
|
778
|
|
779
|
|
780 ;;;---------------------------------------------------------------------------
|
|
781 ;;; "Symbol" parsing functions
|
|
782 ;;;---------------------------------------------------------------------------
|
|
783 ;;; The functions symbol-before-point, symbol-under-point, etc. quickly return
|
|
784 ;;; an appropriate symbol string. The strategy is to temporarily change
|
|
785 ;;; the syntax table to enable fast symbol searching. There are three classes
|
|
786 ;;; of syntax in these "symbol" syntax tables ::
|
|
787 ;;;
|
|
788 ;;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
|
|
789 ;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).
|
|
790 ;;; syntax (? ) - everything else
|
|
791 ;;;
|
|
792 ;;; Thus by judicious use of scan-sexps and forward-word, we can get
|
|
793 ;;; the word we want relatively fast and without consing.
|
|
794 ;;;
|
|
795 ;;; Why do we need a separate category for "symbol chars to ignore at ends" ?
|
|
796 ;;; For example, in LISP we want starting :'s trimmed
|
|
797 ;;; so keyword argument specifiers also define the keyword completion. And,
|
|
798 ;;; for example, in C we want `.' appearing in a structure ref. to
|
|
799 ;;; be kept intact in order to store the whole structure ref.; however, if
|
|
800 ;;; it appears at the end of a symbol it should be discarded because it is
|
|
801 ;;; probably used as a period.
|
|
802
|
|
803 ;;; Here is the default completion syntax ::
|
|
804 ;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
|
|
805 ;;; Symbol chars to ignore at ends :: _ : . -
|
|
806 ;;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
|
|
807 ;;; , ? <Everything else>
|
|
808
|
|
809 ;;; Mode specific differences and notes ::
|
|
810 ;;; LISP diffs ->
|
|
811 ;;; Symbol chars :: ! & ? = ^
|
|
812 ;;;
|
|
813 ;;; C diffs ->
|
|
814 ;;; Separator chars :: + * / : %
|
|
815 ;;; A note on the hypen (`-'). Perhaps, the hypen should also be a separator
|
|
816 ;;; char., however, we wanted to have completion symbols include pointer
|
|
817 ;;; references. For example, "foo->bar" is a symbol as far as completion is
|
|
818 ;;; concerned.
|
|
819 ;;;
|
|
820 ;;; FORTRAN diffs ->
|
|
821 ;;; Separator chars :: + - * / :
|
|
822 ;;;
|
|
823 ;;; Pathname diffs ->
|
|
824 ;;; Symbol chars :: .
|
|
825 ;;; Of course there is no pathname "mode" and in fact we have not implemented
|
|
826 ;;; this table. However, if there was such a mode, this is what it would look
|
|
827 ;;; like.
|
|
828
|
|
829 ;;;-----------------------------------------------
|
|
830 ;;; Table definitions
|
|
831 ;;;-----------------------------------------------
|
|
832
|
|
833 (defun make-standard-completion-syntax-table ()
|
|
834 (let ((table (make-vector 256 0)) ;; default syntax is whitespace
|
|
835 )
|
|
836 ;; alpha chars
|
|
837 (dotimes (i 26)
|
|
838 (modify-syntax-entry (+ ?a i) "_" table)
|
|
839 (modify-syntax-entry (+ ?A i) "_" table))
|
|
840 ;; digit chars.
|
|
841 (dotimes (i 10)
|
|
842 (modify-syntax-entry (+ ?0 i) "_" table))
|
|
843 ;; Other ones
|
|
844 (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%))
|
|
845 (symbol-chars-ignore '(?_ ?- ?: ?.))
|
|
846 )
|
|
847 (dolist (char symbol-chars)
|
|
848 (modify-syntax-entry char "_" table))
|
|
849 (dolist (char symbol-chars-ignore)
|
|
850 (modify-syntax-entry char "w" table)
|
|
851 )
|
|
852 )
|
|
853 table))
|
|
854
|
|
855 (defconst cmpl-standard-syntax-table (make-standard-completion-syntax-table))
|
|
856
|
|
857 (defun make-lisp-completion-syntax-table ()
|
|
858 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
|
|
859 (symbol-chars '(?! ?& ?? ?= ?^))
|
|
860 )
|
|
861 (dolist (char symbol-chars)
|
|
862 (modify-syntax-entry char "_" table))
|
|
863 table))
|
|
864
|
|
865 (defun make-c-completion-syntax-table ()
|
|
866 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
|
|
867 (separator-chars '(?+ ?* ?/ ?: ?%))
|
|
868 )
|
|
869 (dolist (char separator-chars)
|
|
870 (modify-syntax-entry char " " table))
|
|
871 table))
|
|
872
|
|
873 (defun make-fortran-completion-syntax-table ()
|
|
874 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
|
|
875 (separator-chars '(?+ ?- ?* ?/ ?:))
|
|
876 )
|
|
877 (dolist (char separator-chars)
|
|
878 (modify-syntax-entry char " " table))
|
|
879 table))
|
|
880
|
|
881 (defconst cmpl-lisp-syntax-table (make-lisp-completion-syntax-table))
|
|
882 (defconst cmpl-c-syntax-table (make-c-completion-syntax-table))
|
|
883 (defconst cmpl-fortran-syntax-table (make-fortran-completion-syntax-table))
|
|
884
|
|
885 (defvar cmpl-syntax-table cmpl-standard-syntax-table
|
|
886 "This variable holds the current completion syntax table.")
|
|
887 (make-variable-buffer-local 'cmpl-syntax-table)
|
|
888
|
|
889 ;;;-----------------------------------------------
|
|
890 ;;; Installing the appropriate mode tables
|
|
891 ;;;-----------------------------------------------
|
|
892
|
|
893 (completion-advise lisp-mode-variables :after
|
|
894 (setq cmpl-syntax-table cmpl-lisp-syntax-table)
|
|
895 )
|
|
896
|
|
897 (completion-advise c-mode :after
|
|
898 (setq cmpl-syntax-table cmpl-c-syntax-table)
|
|
899 )
|
|
900
|
|
901 (completion-advise fortran-mode :after
|
|
902 (setq cmpl-syntax-table cmpl-fortran-syntax-table)
|
|
903 (completion-setup-fortran-mode)
|
|
904 )
|
|
905
|
|
906 ;;;-----------------------------------------------
|
|
907 ;;; Symbol functions
|
|
908 ;;;-----------------------------------------------
|
|
909 (defvar cmpl-symbol-start nil
|
|
910 "Set to the first character of the symbol after one of the completion
|
|
911 symbol functions is called.")
|
|
912 (defvar cmpl-symbol-end nil
|
|
913 "Set to the last character of the symbol after one of the completion
|
|
914 symbol functions is called.")
|
|
915 ;;; These are temp. vars. we use to avoid using let.
|
|
916 ;;; Why ? Small speed improvement.
|
|
917 (defvar cmpl-saved-syntax nil)
|
|
918 (defvar cmpl-saved-point nil)
|
|
919
|
|
920 (defun symbol-under-point ()
|
|
921 "Returns the symbol that the point is currently on if it is longer
|
|
922 than *completion-min-length*."
|
|
923 (setq cmpl-saved-syntax (syntax-table))
|
|
924 (set-syntax-table cmpl-syntax-table)
|
|
925 (cond
|
|
926 ;; Cursor is on following-char and after preceding-char
|
|
927 ((memq (char-syntax (following-char)) '(?w ?_))
|
|
928 (setq cmpl-saved-point (point)
|
|
929 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)
|
|
930 cmpl-symbol-end (scan-sexps cmpl-saved-point 1))
|
|
931 ;; remove chars to ignore at the start
|
|
932 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
|
|
933 (goto-char cmpl-symbol-start)
|
|
934 (forward-word 1)
|
|
935 (setq cmpl-symbol-start (point))
|
|
936 (goto-char cmpl-saved-point)
|
|
937 ))
|
|
938 ;; remove chars to ignore at the end
|
|
939 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
|
|
940 (goto-char cmpl-symbol-end)
|
|
941 (forward-word -1)
|
|
942 (setq cmpl-symbol-end (point))
|
|
943 (goto-char cmpl-saved-point)
|
|
944 ))
|
|
945 ;; restore state
|
|
946 (set-syntax-table cmpl-saved-syntax)
|
|
947 ;; Return completion if the length is reasonable
|
|
948 (if (and (<= (read-time-eval *completion-min-length*)
|
|
949 (- cmpl-symbol-end cmpl-symbol-start))
|
|
950 (<= (- cmpl-symbol-end cmpl-symbol-start)
|
|
951 (read-time-eval *completion-max-length*)))
|
|
952 (buffer-substring cmpl-symbol-start cmpl-symbol-end))
|
|
953 )
|
|
954 (t
|
|
955 ;; restore table if no symbol
|
|
956 (set-syntax-table cmpl-saved-syntax)
|
|
957 nil)
|
|
958 ))
|
|
959
|
|
960 ;;; tests for symbol-under-point
|
|
961 ;;; `^' indicates cursor pos. where value is returned
|
|
962 ;;; simple-word-test
|
|
963 ;;; ^^^^^^^^^^^^^^^^ --> simple-word-test
|
|
964 ;;; _harder_word_test_
|
|
965 ;;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test
|
|
966 ;;; .___.______.
|
|
967 ;;; --> nil
|
|
968 ;;; /foo/bar/quux.hello
|
|
969 ;;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
|
|
970 ;;;
|
|
971
|
|
972 (defun symbol-before-point ()
|
|
973 "Returns a string of the symbol immediately before point
|
|
974 or nil if there isn't one longer than *completion-min-length*."
|
|
975 ;; This is called when a word separator is typed so it must be FAST !
|
|
976 (setq cmpl-saved-syntax (syntax-table))
|
|
977 (set-syntax-table cmpl-syntax-table)
|
|
978 ;; Cursor is on following-char and after preceding-char
|
|
979 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
|
|
980 ;; No chars. to ignore at end
|
|
981 (setq cmpl-symbol-end (point)
|
|
982 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1)
|
|
983 )
|
|
984 ;; remove chars to ignore at the start
|
|
985 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
|
|
986 (goto-char cmpl-symbol-start)
|
|
987 (forward-word 1)
|
|
988 (setq cmpl-symbol-start (point))
|
|
989 (goto-char cmpl-symbol-end)
|
|
990 ))
|
|
991 ;; restore state
|
|
992 (set-syntax-table cmpl-saved-syntax)
|
|
993 ;; return value if long enough
|
|
994 (if (>= cmpl-symbol-end
|
|
995 (+ cmpl-symbol-start
|
|
996 (read-time-eval *completion-min-length*)))
|
|
997 (buffer-substring cmpl-symbol-start cmpl-symbol-end))
|
|
998 )
|
|
999 ((= cmpl-preceding-syntax ?w)
|
|
1000 ;; chars to ignore at end
|
|
1001 (setq cmpl-saved-point (point)
|
|
1002 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1))
|
|
1003 ;; take off chars. from end
|
|
1004 (forward-word -1)
|
|
1005 (setq cmpl-symbol-end (point))
|
|
1006 ;; remove chars to ignore at the start
|
|
1007 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
|
|
1008 (goto-char cmpl-symbol-start)
|
|
1009 (forward-word 1)
|
|
1010 (setq cmpl-symbol-start (point))
|
|
1011 ))
|
|
1012 ;; restore state
|
|
1013 (goto-char cmpl-saved-point)
|
|
1014 (set-syntax-table cmpl-saved-syntax)
|
|
1015 ;; Return completion if the length is reasonable
|
|
1016 (if (and (<= (read-time-eval *completion-min-length*)
|
|
1017 (- cmpl-symbol-end cmpl-symbol-start))
|
|
1018 (<= (- cmpl-symbol-end cmpl-symbol-start)
|
|
1019 (read-time-eval *completion-max-length*)))
|
|
1020 (buffer-substring cmpl-symbol-start cmpl-symbol-end))
|
|
1021 )
|
|
1022 (t
|
|
1023 ;; restore table if no symbol
|
|
1024 (set-syntax-table cmpl-saved-syntax)
|
|
1025 nil)
|
|
1026 ))
|
|
1027
|
|
1028 ;;; tests for symbol-before-point
|
|
1029 ;;; `^' indicates cursor pos. where value is returned
|
|
1030 ;;; simple-word-test
|
|
1031 ;;; ^ --> nil
|
|
1032 ;;; ^ --> nil
|
|
1033 ;;; ^ --> simple-w
|
|
1034 ;;; ^ --> simple-word-test
|
|
1035 ;;; _harder_word_test_
|
|
1036 ;;; ^ --> harder_word_test
|
|
1037 ;;; ^ --> harder_word_test
|
|
1038 ;;; ^ --> harder
|
|
1039 ;;; .___....
|
|
1040 ;;; --> nil
|
|
1041
|
|
1042 (defun symbol-under-or-before-point ()
|
|
1043 ;;; This could be made slightly faster but it is better to avoid
|
|
1044 ;;; copying all the code.
|
|
1045 ;;; However, it is only used by the completion string prompter.
|
|
1046 ;;; If it comes into common use, it could be rewritten.
|
|
1047 (setq cmpl-saved-syntax (syntax-table))
|
|
1048 (set-syntax-table cmpl-syntax-table)
|
|
1049 (cond ((memq (char-syntax (following-char)) '(?w ?_))
|
|
1050 (set-syntax-table cmpl-saved-syntax)
|
|
1051 (symbol-under-point))
|
|
1052 (t
|
|
1053 (set-syntax-table cmpl-saved-syntax)
|
|
1054 (symbol-before-point))
|
|
1055 ))
|
|
1056
|
|
1057
|
|
1058 (defun symbol-before-point-for-complete ()
|
|
1059 ;; "Returns a string of the symbol immediately before point
|
|
1060 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the
|
|
1061 ;; end chars."
|
|
1062 ;; Cursor is on following-char and after preceding-char
|
|
1063 (setq cmpl-saved-syntax (syntax-table))
|
|
1064 (set-syntax-table cmpl-syntax-table)
|
|
1065 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
|
|
1066 '(?_ ?w))
|
|
1067 (setq cmpl-symbol-end (point)
|
|
1068 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1)
|
|
1069 )
|
|
1070 ;; remove chars to ignore at the start
|
|
1071 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
|
|
1072 (goto-char cmpl-symbol-start)
|
|
1073 (forward-word 1)
|
|
1074 (setq cmpl-symbol-start (point))
|
|
1075 (goto-char cmpl-symbol-end)
|
|
1076 ))
|
|
1077 ;; restore state
|
|
1078 (set-syntax-table cmpl-saved-syntax)
|
|
1079 ;; Return completion if the length is reasonable
|
|
1080 (if (and (<= (read-time-eval
|
|
1081 *completion-prefix-min-length*)
|
|
1082 (- cmpl-symbol-end cmpl-symbol-start))
|
|
1083 (<= (- cmpl-symbol-end cmpl-symbol-start)
|
|
1084 (read-time-eval *completion-max-length*)))
|
|
1085 (buffer-substring cmpl-symbol-start cmpl-symbol-end))
|
|
1086 )
|
|
1087 (t
|
|
1088 ;; restore table if no symbol
|
|
1089 (set-syntax-table cmpl-saved-syntax)
|
|
1090 nil)
|
|
1091 ))
|
|
1092
|
|
1093 ;;; tests for symbol-before-point-for-complete
|
|
1094 ;;; `^' indicates cursor pos. where value is returned
|
|
1095 ;;; simple-word-test
|
|
1096 ;;; ^ --> nil
|
|
1097 ;;; ^ --> nil
|
|
1098 ;;; ^ --> simple-w
|
|
1099 ;;; ^ --> simple-word-test
|
|
1100 ;;; _harder_word_test_
|
|
1101 ;;; ^ --> harder_word_test
|
|
1102 ;;; ^ --> harder_word_test_
|
|
1103 ;;; ^ --> harder_
|
|
1104 ;;; .___....
|
|
1105 ;;; --> nil
|
|
1106
|
|
1107
|
|
1108
|
|
1109 ;;;---------------------------------------------------------------------------
|
|
1110 ;;; Statistics Recording
|
|
1111 ;;;---------------------------------------------------------------------------
|
|
1112
|
|
1113 ;;; Note that the guts of this has been turned off. The guts
|
|
1114 ;;; are in completion-stats.el.
|
|
1115
|
|
1116 ;;;-----------------------------------------------
|
|
1117 ;;; Conditionalizing code on *record-cmpl-statistics-p*
|
|
1118 ;;;-----------------------------------------------
|
|
1119 ;;; All statistics code outside this block should use this
|
|
1120 (defmacro cmpl-statistics-block (&rest body)
|
|
1121 "Only executes body if we are recording statistics."
|
|
1122 (list 'cond
|
|
1123 (list* '*record-cmpl-statistics-p* body)
|
|
1124 ))
|
|
1125
|
|
1126 ;;;-----------------------------------------------
|
|
1127 ;;; Completion Sources
|
|
1128 ;;;-----------------------------------------------
|
|
1129
|
|
1130 ;; ID numbers
|
|
1131 (defconst cmpl-source-unknown 0)
|
|
1132 (defconst cmpl-source-init-file 1)
|
|
1133 (defconst cmpl-source-file-parsing 2)
|
|
1134 (defconst cmpl-source-separator 3)
|
|
1135 (defconst cmpl-source-cursor-moves 4)
|
|
1136 (defconst cmpl-source-interactive 5)
|
|
1137 (defconst cmpl-source-cdabbrev 6)
|
|
1138 (defconst num-cmpl-sources 7)
|
|
1139 (defvar current-completion-source cmpl-source-unknown)
|
|
1140
|
|
1141
|
|
1142
|
|
1143 ;;;---------------------------------------------------------------------------
|
|
1144 ;;; Completion Method #2: dabbrev-expand style
|
|
1145 ;;;---------------------------------------------------------------------------
|
|
1146 ;;;
|
|
1147 ;;; This method is used if there are no useful stored completions. It is
|
|
1148 ;;; based on dabbrev-expand with these differences :
|
|
1149 ;;; 1) Faster (we don't use regexps)
|
|
1150 ;;; 2) case coercion handled correctly
|
|
1151 ;;; This is called cdabbrev to differentiate it.
|
|
1152 ;;; We simply search backwards through the file looking for words which
|
|
1153 ;;; start with the same letters we are trying to complete.
|
|
1154 ;;;
|
|
1155
|
|
1156 (defvar cdabbrev-completions-tried nil)
|
|
1157 ;;; "A list of all the cdabbrev completions since the last reset.")
|
|
1158
|
|
1159 (defvar cdabbrev-current-point 0)
|
|
1160 ;;; "The current point position the cdabbrev search is at.")
|
|
1161
|
|
1162 (defvar cdabbrev-current-window nil)
|
|
1163 ;;; "The current window we are looking for cdabbrevs in. T if looking in
|
|
1164 ;;; (other-buffer), NIL if no more cdabbrevs.")
|
|
1165
|
|
1166 (defvar cdabbrev-wrapped-p nil)
|
|
1167 ;;; "T if the cdabbrev search has wrapped around the file.")
|
|
1168
|
|
1169 (defvar cdabbrev-abbrev-string "")
|
|
1170 (defvar cdabbrev-start-point 0)
|
|
1171
|
|
1172 ;;; Test strings for cdabbrev
|
|
1173 ;;; cdat-upcase ;;same namestring
|
|
1174 ;;; CDAT-UPCASE ;;ok
|
|
1175 ;;; cdat2 ;;too short
|
|
1176 ;;; cdat-1-2-3-4 ;;ok
|
|
1177 ;;; a-cdat-1 ;;doesn't start correctly
|
|
1178 ;;; cdat-simple ;;ok
|
|
1179
|
|
1180
|
|
1181 (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried)
|
|
1182 "Resets the cdabbrev search to search for abbrev-string.
|
|
1183 initial-completions-tried is a list of downcased strings to ignore
|
|
1184 during the search."
|
|
1185 (setq cdabbrev-abbrev-string abbrev-string
|
|
1186 cdabbrev-completions-tried
|
|
1187 (cons (downcase abbrev-string) initial-completions-tried)
|
|
1188 )
|
|
1189 (reset-cdabbrev-window t)
|
|
1190 )
|
|
1191
|
|
1192 (defun set-cdabbrev-buffer ()
|
|
1193 ;; cdabbrev-current-window must not be NIL
|
|
1194 (set-buffer (if (eq cdabbrev-current-window t)
|
|
1195 (other-buffer)
|
|
1196 (window-buffer cdabbrev-current-window)))
|
|
1197 )
|
|
1198
|
|
1199
|
|
1200 (defun reset-cdabbrev-window (&optional initializep)
|
|
1201 "Resets the cdabbrev search to search for abbrev-string.
|
|
1202 initial-completions-tried is a list of downcased strings to ignore
|
|
1203 during the search."
|
|
1204 ;; Set the window
|
|
1205 (cond (initializep
|
|
1206 (setq cdabbrev-current-window (selected-window))
|
|
1207 )
|
|
1208 ((eq cdabbrev-current-window t)
|
|
1209 ;; Everything has failed
|
|
1210 (setq cdabbrev-current-window nil))
|
|
1211 (cdabbrev-current-window
|
|
1212 (setq cdabbrev-current-window (next-window cdabbrev-current-window))
|
|
1213 (if (eq cdabbrev-current-window (selected-window))
|
|
1214 ;; No more windows, try other buffer.
|
|
1215 (setq cdabbrev-current-window t)))
|
|
1216 )
|
|
1217 (when cdabbrev-current-window
|
|
1218 (save-excursion
|
|
1219 (set-cdabbrev-buffer)
|
|
1220 (setq cdabbrev-current-point (point)
|
|
1221 cdabbrev-start-point cdabbrev-current-point
|
|
1222 cdabbrev-stop-point
|
|
1223 (if *cdabbrev-radius*
|
|
1224 (max (point-min)
|
|
1225 (- cdabbrev-start-point *cdabbrev-radius*))
|
|
1226 (point-min))
|
|
1227 cdabbrev-wrapped-p nil)
|
|
1228 )))
|
|
1229
|
|
1230 (defun next-cdabbrev ()
|
|
1231 "Return the next possible cdabbrev expansion or nil if there isn't one.
|
|
1232 reset-cdabbrev must've been called. This is sensitive to case-fold-search."
|
|
1233 ;; note that case-fold-search affects the behavior of this function
|
|
1234 ;; Bug: won't pick up an expansion that starts at the top of buffer
|
|
1235 (when cdabbrev-current-window
|
|
1236 (let (saved-point
|
|
1237 saved-syntax
|
|
1238 (expansion nil)
|
|
1239 downcase-expansion tried-list syntax saved-point-2)
|
|
1240 (save-excursion
|
|
1241 (unwind-protect
|
|
1242 (progn
|
|
1243 ;; Switch to current completion buffer
|
|
1244 (set-cdabbrev-buffer)
|
|
1245 ;; Save current buffer state
|
|
1246 (setq saved-point (point)
|
|
1247 saved-syntax (syntax-table))
|
|
1248 ;; Restore completion state
|
|
1249 (set-syntax-table cmpl-syntax-table)
|
|
1250 (goto-char cdabbrev-current-point)
|
|
1251 ;; Loop looking for completions
|
|
1252 (while
|
|
1253 ;; This code returns t if it should loop again
|
|
1254 (cond
|
|
1255 (;; search for the string
|
|
1256 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t)
|
|
1257 ;; return nil if the completion is valid
|
|
1258 (not
|
|
1259 (and
|
|
1260 ;; does it start with a separator char ?
|
|
1261 (or (= (setq syntax (char-syntax (preceding-char))) ? )
|
|
1262 (and (= syntax ?w)
|
|
1263 ;; symbol char to ignore at end. Are we at end ?
|
|
1264 (progn
|
|
1265 (setq saved-point-2 (point))
|
|
1266 (forward-word -1)
|
|
1267 (prog1
|
|
1268 (= (char-syntax (preceding-char)) ? )
|
|
1269 (goto-char saved-point-2)
|
|
1270 ))))
|
|
1271 ;; is the symbol long enough ?
|
|
1272 (setq expansion (symbol-under-point))
|
|
1273 ;; have we not tried this one before
|
|
1274 (progn
|
|
1275 ;; See if we've already used it
|
|
1276 (setq tried-list cdabbrev-completions-tried
|
|
1277 downcase-expansion (downcase expansion))
|
|
1278 (while (and tried-list
|
|
1279 (not (string-equal downcase-expansion
|
|
1280 (car tried-list))))
|
|
1281 ;; Already tried, don't choose this one
|
|
1282 (setq tried-list (cdr tried-list))
|
|
1283 )
|
|
1284 ;; at this point tried-list will be nil if this
|
|
1285 ;; expansion has not yet been tried
|
|
1286 (if tried-list
|
|
1287 (setq expansion nil)
|
|
1288 t)
|
|
1289 ))))
|
|
1290 ;; search failed
|
|
1291 (cdabbrev-wrapped-p
|
|
1292 ;; If already wrapped, then we've failed completely
|
|
1293 nil)
|
|
1294 (t
|
|
1295 ;; need to wrap
|
|
1296 (goto-char (setq cdabbrev-current-point
|
|
1297 (if *cdabbrev-radius*
|
|
1298 (min (point-max) (+ cdabbrev-start-point *cdabbrev-radius*))
|
|
1299 (point-max))))
|
|
1300
|
|
1301 (setq cdabbrev-wrapped-p t))
|
|
1302 ))
|
|
1303 ;; end of while loop
|
|
1304 (cond (expansion
|
|
1305 ;; successful
|
|
1306 (setq cdabbrev-completions-tried
|
|
1307 (cons downcase-expansion cdabbrev-completions-tried)
|
|
1308 cdabbrev-current-point (point))))
|
|
1309 )
|
|
1310 (set-syntax-table saved-syntax)
|
|
1311 (goto-char saved-point)
|
|
1312 ))
|
|
1313 ;; If no expansion, go to next window
|
|
1314 (cond (expansion)
|
|
1315 (t (reset-cdabbrev-window)
|
|
1316 (next-cdabbrev)))
|
|
1317 )))
|
|
1318
|
|
1319 ;;; The following must be eval'd in the minibuffer ::
|
|
1320 ;;; (reset-cdabbrev "cdat")
|
|
1321 ;;; (next-cdabbrev) --> "cdat-simple"
|
|
1322 ;;; (next-cdabbrev) --> "cdat-1-2-3-4"
|
|
1323 ;;; (next-cdabbrev) --> "CDAT-UPCASE"
|
|
1324 ;;; (next-cdabbrev) --> "cdat-wrapping"
|
|
1325 ;;; (next-cdabbrev) --> "cdat_start_sym"
|
|
1326 ;;; (next-cdabbrev) --> nil
|
|
1327 ;;; (next-cdabbrev) --> nil
|
|
1328 ;;; (next-cdabbrev) --> nil
|
|
1329
|
|
1330 ;;; _cdat_start_sym
|
|
1331 ;;; cdat-wrapping
|
|
1332
|
|
1333
|
|
1334 ;;;---------------------------------------------------------------------------
|
|
1335 ;;; Completion Database
|
|
1336 ;;;---------------------------------------------------------------------------
|
|
1337
|
|
1338 ;;; We use two storage modes for the two search types ::
|
|
1339 ;;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions
|
|
1340 ;;; Used by search-completion-next
|
|
1341 ;;; the value of the symbol is nil or a cons of head and tail pointers
|
|
1342 ;;; 2) Interning {cmpl-obarray} to see if it's in the database
|
|
1343 ;;; Used by find-exact-completion, completion-in-database-p
|
|
1344 ;;; The value of the symbol is the completion entry
|
|
1345
|
|
1346 ;;; bad things may happen if this length is changed due to the way
|
|
1347 ;;; GNU implements obarrays
|
|
1348 (defconst cmpl-obarray-length 511)
|
|
1349
|
|
1350 (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
|
|
1351 "An obarray used to store the downcased completion prefices.
|
|
1352 Each symbol is bound to a list of completion entries.")
|
|
1353
|
|
1354 (defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
|
|
1355 "An obarray used to store the downcased completions.
|
|
1356 Each symbol is bound to a single completion entry.")
|
|
1357
|
|
1358 ;;;-----------------------------------------------
|
|
1359 ;;; Completion Entry Structure Definition
|
|
1360 ;;;-----------------------------------------------
|
|
1361
|
|
1362 ;;; A completion entry is a LIST of string, prefix-symbol num-uses, and
|
|
1363 ;;; last-use-time (the time the completion was last used)
|
|
1364 ;;; last-use-time is T if the string should be kept permanently
|
|
1365 ;;; num-uses is incremented everytime the completion is used.
|
|
1366
|
|
1367 ;;; We chose lists because (car foo) is faster than (aref foo 0) and the
|
|
1368 ;;; creation time is about the same.
|
|
1369
|
|
1370 ;;; READER MACROS
|
|
1371
|
|
1372 (defmacro completion-string (completion-entry)
|
|
1373 (list 'car completion-entry))
|
|
1374
|
|
1375 (defmacro completion-num-uses (completion-entry)
|
|
1376 ;; "The number of times it has used. Used to decide whether to save
|
|
1377 ;; it."
|
|
1378 (list 'car (list 'cdr completion-entry)))
|
|
1379
|
|
1380 (defmacro completion-last-use-time (completion-entry)
|
|
1381 ;; "The time it was last used. In hours since 1900. Used to decide
|
|
1382 ;; whether to save it. T if one should always save it."
|
|
1383 (list 'nth 2 completion-entry))
|
|
1384
|
|
1385 (defmacro completion-source (completion-entry)
|
|
1386 (list 'nth 3 completion-entry))
|
|
1387
|
|
1388 ;;; WRITER MACROS
|
|
1389 (defmacro set-completion-string (completion-entry string)
|
|
1390 (list 'setcar completion-entry string))
|
|
1391
|
|
1392 (defmacro set-completion-num-uses (completion-entry num-uses)
|
|
1393 (list 'setcar (list 'cdr completion-entry) num-uses))
|
|
1394
|
|
1395 (defmacro set-completion-last-use-time (completion-entry last-use-time)
|
|
1396 (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time))
|
|
1397
|
|
1398 ;;; CONSTRUCTOR
|
|
1399 (defun make-completion (string)
|
|
1400 "Returns a list of a completion entry."
|
|
1401 (list (list string 0 nil current-completion-source)))
|
|
1402
|
|
1403 ;; Obsolete
|
|
1404 ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
|
|
1405 ;; (list 'car (list 'cdr completion-entry)))
|
|
1406
|
|
1407
|
|
1408
|
|
1409 ;;;-----------------------------------------------
|
|
1410 ;;; Prefix symbol entry definition
|
|
1411 ;;;-----------------------------------------------
|
|
1412 ;;; A cons of (head . tail)
|
|
1413
|
|
1414 ;;; READER Macros
|
|
1415
|
|
1416 (defmacro cmpl-prefix-entry-head (prefix-entry)
|
|
1417 (list 'car prefix-entry))
|
|
1418
|
|
1419 (defmacro cmpl-prefix-entry-tail (prefix-entry)
|
|
1420 (list 'cdr prefix-entry))
|
|
1421
|
|
1422 ;;; WRITER Macros
|
|
1423
|
|
1424 (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head)
|
|
1425 (list 'setcar prefix-entry new-head))
|
|
1426
|
|
1427 (defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
|
|
1428 (list 'setcdr prefix-entry new-tail))
|
|
1429
|
|
1430 ;;; Contructor
|
|
1431
|
|
1432 (defun make-cmpl-prefix-entry (completion-entry-list)
|
|
1433 "Makes a new prefix entry containing only completion-entry."
|
|
1434 (cons completion-entry-list completion-entry-list))
|
|
1435
|
|
1436 ;;;-----------------------------------------------
|
|
1437 ;;; Completion Database - Utilities
|
|
1438 ;;;-----------------------------------------------
|
|
1439
|
|
1440 (defun clear-all-completions ()
|
|
1441 "Initializes the completion storage. All existing completions are lost."
|
|
1442 (interactive)
|
|
1443 (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
|
|
1444 (setq cmpl-obarray (make-vector cmpl-obarray-length 0))
|
|
1445 (cmpl-statistics-block
|
|
1446 (record-clear-all-completions))
|
|
1447 )
|
|
1448
|
|
1449 (defun list-all-completions ()
|
|
1450 "Returns a list of all the known completion entries."
|
|
1451 (let ((return-completions nil))
|
|
1452 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
|
|
1453 return-completions))
|
|
1454
|
|
1455 (defun list-all-completions-1 (prefix-symbol)
|
|
1456 (if (boundp prefix-symbol)
|
|
1457 (setq return-completions
|
|
1458 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
|
|
1459 return-completions))))
|
|
1460
|
|
1461 (defun list-all-completions-by-hash-bucket ()
|
|
1462 "Returns a list of lists of all the known completion entries organized by
|
|
1463 hash bucket."
|
|
1464 (let ((return-completions nil))
|
|
1465 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
|
|
1466 return-completions))
|
|
1467
|
|
1468 (defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
|
|
1469 (if (boundp prefix-symbol)
|
|
1470 (setq return-completions
|
|
1471 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
|
|
1472 return-completions))))
|
|
1473
|
|
1474
|
|
1475 ;;;-----------------------------------------------
|
|
1476 ;;; Updating the database
|
|
1477 ;;;-----------------------------------------------
|
|
1478 ;;;
|
|
1479 ;;; These are the internal functions used to update the datebase
|
|
1480 ;;;
|
|
1481 ;;;
|
|
1482 (defvar completion-to-accept nil)
|
|
1483 ;;"Set to a string that is pending its acceptance."
|
|
1484 ;; this checked by the top level reading functions
|
|
1485
|
|
1486 (defvar cmpl-db-downcase-string nil)
|
|
1487 ;; "Setup by find-exact-completion, etc. The given string, downcased."
|
|
1488 (defvar cmpl-db-symbol nil)
|
|
1489 ;; "The interned symbol corresponding to cmpl-db-downcase-string.
|
|
1490 ;; Set up by cmpl-db-symbol."
|
|
1491 (defvar cmpl-db-prefix-symbol nil)
|
|
1492 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."
|
|
1493 (defvar cmpl-db-entry nil)
|
|
1494 (defvar cmpl-db-debug-p nil
|
|
1495 "Set to T if you want to debug the database.")
|
|
1496
|
|
1497 ;;; READS
|
|
1498 (defun find-exact-completion (string)
|
|
1499 "Returns the completion entry for string or nil.
|
|
1500 Sets up cmpl-db-downcase-string and cmpl-db-symbol."
|
|
1501 (and (boundp (setq cmpl-db-symbol
|
|
1502 (intern (setq cmpl-db-downcase-string (downcase string))
|
|
1503 cmpl-obarray)))
|
|
1504 (symbol-value cmpl-db-symbol)
|
|
1505 ))
|
|
1506
|
|
1507 (defun find-cmpl-prefix-entry (prefix-string)
|
|
1508 "Returns the prefix entry for string. Sets cmpl-db-prefix-symbol.
|
|
1509 Prefix-string must be exactly *completion-prefix-min-length* long
|
|
1510 and downcased. Sets up cmpl-db-prefix-symbol."
|
|
1511 (and (boundp (setq cmpl-db-prefix-symbol
|
|
1512 (intern prefix-string cmpl-prefix-obarray)))
|
|
1513 (symbol-value cmpl-db-prefix-symbol)))
|
|
1514
|
|
1515 (defvar inside-locate-completion-entry nil)
|
|
1516 ;; used to trap lossage in silent error correction
|
|
1517
|
|
1518 (defun locate-completion-entry (completion-entry prefix-entry)
|
|
1519 "Locates the completion entry. Returns a pointer to the element
|
|
1520 before the completion entry or nil if the completion entry is at the head.
|
|
1521 Must be called after find-exact-completion."
|
|
1522 (let ((prefix-list (cmpl-prefix-entry-head prefix-entry))
|
|
1523 next-prefix-list
|
|
1524 )
|
|
1525 (cond
|
|
1526 ((not (eq (car prefix-list) completion-entry))
|
|
1527 ;; not already at head
|
|
1528 (while (and prefix-list
|
|
1529 (not (eq completion-entry
|
|
1530 (car (setq next-prefix-list (cdr prefix-list)))
|
|
1531 )))
|
|
1532 (setq prefix-list next-prefix-list))
|
|
1533 (cond (;; found
|
|
1534 prefix-list)
|
|
1535 ;; Didn't find it. Database is messed up.
|
|
1536 (cmpl-db-debug-p
|
|
1537 ;; not found, error if debug mode
|
|
1538 (error "Completion entry exists but not on prefix list - %s"
|
|
1539 string))
|
|
1540 (inside-locate-completion-entry
|
|
1541 ;; recursive error: really scrod
|
|
1542 (locate-completion-db-error))
|
|
1543 (t
|
|
1544 ;; Patch out
|
|
1545 (set cmpl-db-symbol nil)
|
|
1546 ;; Retry
|
|
1547 (locate-completion-entry-retry completion-entry)
|
|
1548 ))))))
|
|
1549
|
|
1550 (defun locate-completion-entry-retry (old-entry)
|
|
1551 (let ((inside-locate-completion-entry t))
|
|
1552 (add-completion (completion-string old-entry)
|
|
1553 (completion-num-uses old-entry)
|
|
1554 (completion-last-use-time old-entry))
|
|
1555 (let ((cmpl-entry (find-exact-completion (completion-string old-entry)))
|
|
1556 (pref-entry
|
|
1557 (if cmpl-entry
|
|
1558 (find-cmpl-prefix-entry
|
|
1559 (substring cmpl-db-downcase-string
|
|
1560 0 *completion-prefix-min-length*))))
|
|
1561 )
|
|
1562 (if (and cmpl-entry pref-entry)
|
|
1563 ;; try again
|
|
1564 (locate-completion-entry cmpl-entry pref-entry)
|
|
1565 ;; still losing
|
|
1566 (locate-completion-db-error))
|
|
1567 )))
|
|
1568
|
|
1569 (defun locate-completion-db-error ()
|
|
1570 ;; recursive error: really scrod
|
|
1571 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.")
|
|
1572 )
|
|
1573
|
|
1574 ;;; WRITES
|
|
1575 (defun add-completion-to-tail-if-new (string)
|
|
1576 "If the string is not in the database it is added to the end of the
|
|
1577 approppriate prefix list with num-uses = 0. The database is unchanged if it
|
|
1578 is there. string must be longer than *completion-prefix-min-length*.
|
|
1579 This must be very fast.
|
|
1580 Returns the completion entry."
|
|
1581 (or (find-exact-completion string)
|
|
1582 ;; not there
|
|
1583 (let (;; create an entry
|
|
1584 (entry (make-completion string))
|
|
1585 ;; setup the prefix
|
|
1586 (prefix-entry (find-cmpl-prefix-entry
|
|
1587 (substring cmpl-db-downcase-string 0
|
|
1588 (read-time-eval
|
|
1589 *completion-prefix-min-length*))))
|
|
1590 )
|
|
1591 ;; The next two forms should happen as a unit (atomically) but
|
|
1592 ;; no fatal errors should result if that is not the case.
|
|
1593 (cond (prefix-entry
|
|
1594 ;; These two should be atomic, but nothing fatal will happen
|
|
1595 ;; if they're not.
|
|
1596 (setcdr (cmpl-prefix-entry-tail prefix-entry) entry)
|
|
1597 (set-cmpl-prefix-entry-tail prefix-entry entry))
|
|
1598 (t
|
|
1599 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))
|
|
1600 ))
|
|
1601 ;; statistics
|
|
1602 (cmpl-statistics-block
|
|
1603 (note-added-completion))
|
|
1604 ;; set symbol
|
|
1605 (set cmpl-db-symbol (car entry))
|
|
1606 )))
|
|
1607
|
|
1608 (defun add-completion-to-head (string)
|
|
1609 "If the string is not in the database it is added to the head of the
|
|
1610 approppriate prefix list. Otherwise it is moved to the head of the list.
|
|
1611 string must be longer than *completion-prefix-min-length*.
|
|
1612 Updates the saved string with the supplied string.
|
|
1613 This must be very fast.
|
|
1614 Returns the completion entry."
|
|
1615 ;; Handle pending acceptance
|
|
1616 (if completion-to-accept (accept-completion))
|
|
1617 ;; test if already in database
|
|
1618 (if (setq cmpl-db-entry (find-exact-completion string))
|
|
1619 ;; found
|
|
1620 (let* ((prefix-entry (find-cmpl-prefix-entry
|
|
1621 (substring cmpl-db-downcase-string 0
|
|
1622 (read-time-eval
|
|
1623 *completion-prefix-min-length*))))
|
|
1624 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
|
|
1625 (cmpl-ptr (cdr splice-ptr))
|
|
1626 )
|
|
1627 ;; update entry
|
|
1628 (set-completion-string cmpl-db-entry string)
|
|
1629 ;; move to head (if necessary)
|
|
1630 (cond (splice-ptr
|
|
1631 ;; These should all execute atomically but it is not fatal if
|
|
1632 ;; they don't.
|
|
1633 ;; splice it out
|
|
1634 (or (setcdr splice-ptr (cdr cmpl-ptr))
|
|
1635 ;; fix up tail if necessary
|
|
1636 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
|
|
1637 ;; splice in at head
|
|
1638 (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
|
|
1639 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)
|
|
1640 ))
|
|
1641 cmpl-db-entry)
|
|
1642 ;; not there
|
|
1643 (let (;; create an entry
|
|
1644 (entry (make-completion string))
|
|
1645 ;; setup the prefix
|
|
1646 (prefix-entry (find-cmpl-prefix-entry
|
|
1647 (substring cmpl-db-downcase-string 0
|
|
1648 (read-time-eval
|
|
1649 *completion-prefix-min-length*))))
|
|
1650 )
|
|
1651 (cond (prefix-entry
|
|
1652 ;; Splice in at head
|
|
1653 (setcdr entry (cmpl-prefix-entry-head prefix-entry))
|
|
1654 (set-cmpl-prefix-entry-head prefix-entry entry))
|
|
1655 (t
|
|
1656 ;; Start new prefix entry
|
|
1657 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))
|
|
1658 ))
|
|
1659 ;; statistics
|
|
1660 (cmpl-statistics-block
|
|
1661 (note-added-completion))
|
|
1662 ;; Add it to the symbol
|
|
1663 (set cmpl-db-symbol (car entry))
|
|
1664 )))
|
|
1665
|
|
1666 (defun delete-completion (string)
|
|
1667 "Deletes the completion from the database. string must be longer than
|
|
1668 *completion-prefix-min-length*."
|
|
1669 ;; Handle pending acceptance
|
|
1670 (if completion-to-accept (accept-completion))
|
|
1671 (if (setq cmpl-db-entry (find-exact-completion string))
|
|
1672 ;; found
|
|
1673 (let* ((prefix-entry (find-cmpl-prefix-entry
|
|
1674 (substring cmpl-db-downcase-string 0
|
|
1675 (read-time-eval
|
|
1676 *completion-prefix-min-length*))))
|
|
1677 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
|
|
1678 )
|
|
1679 ;; delete symbol reference
|
|
1680 (set cmpl-db-symbol nil)
|
|
1681 ;; remove from prefix list
|
|
1682 (cond (splice-ptr
|
|
1683 ;; not at head
|
|
1684 (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
|
|
1685 ;; fix up tail if necessary
|
|
1686 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
|
|
1687 )
|
|
1688 (t
|
|
1689 ;; at head
|
|
1690 (or (set-cmpl-prefix-entry-head
|
|
1691 prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
|
|
1692 ;; List is now empty
|
|
1693 (set cmpl-db-prefix-symbol nil))
|
|
1694 ))
|
|
1695 (cmpl-statistics-block
|
|
1696 (note-completion-deleted))
|
|
1697 )
|
|
1698 (error "Unknown completion: %s. Couldn't delete it." string)
|
|
1699 ))
|
|
1700
|
|
1701 ;;; Tests --
|
|
1702 ;;; - Add and Find -
|
|
1703 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
|
|
1704 ;;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
|
|
1705 ;;; (find-exact-completion "bana") --> nil
|
|
1706 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
|
|
1707 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
|
|
1708 ;;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
|
|
1709 ;;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
|
|
1710 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
|
|
1711 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
|
|
1712 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
|
|
1713 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
|
|
1714 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
|
|
1715 ;;;
|
|
1716 ;;; - Deleting -
|
|
1717 ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
|
|
1718 ;;; (delete-completion "banner")
|
|
1719 ;;; (find-exact-completion "banner") --> nil
|
|
1720 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
|
|
1721 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
|
|
1722 ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
|
|
1723 ;;; (delete-completion "banana")
|
|
1724 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
|
|
1725 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
|
|
1726 ;;; (delete-completion "banner")
|
|
1727 ;;; (delete-completion "banish")
|
|
1728 ;;; (find-cmpl-prefix-entry "ban") --> nil
|
|
1729 ;;; (delete-completion "banner") --> error
|
|
1730 ;;;
|
|
1731 ;;; - Tail -
|
|
1732 ;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
|
|
1733 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
|
|
1734 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
|
|
1735 ;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
|
|
1736 ;;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
|
|
1737 ;;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
|
|
1738 ;;;
|
|
1739
|
|
1740
|
|
1741 ;;;---------------------------------------------------------------------------
|
|
1742 ;;; Database Update :: Interface level routines
|
|
1743 ;;;---------------------------------------------------------------------------
|
|
1744 ;;;
|
|
1745 ;;; These lie on top of the database ref. functions but below the standard
|
|
1746 ;;; user interface level
|
|
1747
|
|
1748
|
|
1749 (defun interactive-completion-string-reader (prompt)
|
|
1750 (let* ((default (symbol-under-or-before-point))
|
|
1751 (new-prompt
|
|
1752 (if default
|
|
1753 (format "%s: (default: %s) " prompt default)
|
|
1754 (format "%s: " prompt))
|
|
1755 )
|
|
1756 (read (completing-read new-prompt cmpl-obarray))
|
|
1757 )
|
|
1758 (if (zerop (length read)) (setq read (or default "")))
|
|
1759 (list read)
|
|
1760 ))
|
|
1761
|
|
1762 (defun check-completion-length (string)
|
|
1763 (if (< (length string) *completion-min-length*)
|
|
1764 (error "The string \"%s\" is too short to be saved as a completion."
|
|
1765 string)
|
|
1766 (list string)))
|
|
1767
|
|
1768 (defun add-completion (string &optional num-uses last-use-time)
|
|
1769 "If the string is not there, it is added to the head of the completion list.
|
|
1770 Otherwise, it is moved to the head of the list.
|
|
1771 The completion is altered appropriately if num-uses and/or last-use-time is
|
|
1772 specified."
|
|
1773 (interactive (interactive-completion-string-reader "Completion to add"))
|
|
1774 (check-completion-length string)
|
|
1775 (let* ((current-completion-source (if (interactive-p)
|
|
1776 cmpl-source-interactive
|
|
1777 current-completion-source))
|
|
1778 (entry (add-completion-to-head string)))
|
|
1779
|
|
1780 (if num-uses (set-completion-num-uses entry num-uses))
|
|
1781 (if last-use-time
|
|
1782 (set-completion-last-use-time entry last-use-time))
|
|
1783 ))
|
|
1784
|
|
1785 (defun add-permanent-completion (string)
|
|
1786 "Adds string if it isn't already there and and makes it a permanent string."
|
|
1787 (interactive
|
|
1788 (interactive-completion-string-reader "Completion to add permanently"))
|
|
1789 (let ((current-completion-source (if (interactive-p)
|
|
1790 cmpl-source-interactive
|
|
1791 current-completion-source))
|
|
1792 )
|
|
1793 (add-completion string nil t)
|
|
1794 ))
|
|
1795
|
|
1796 (defun kill-completion (string)
|
|
1797 (interactive (interactive-completion-string-reader "Completion to kill"))
|
|
1798 (check-completion-length string)
|
|
1799 (delete-completion string)
|
|
1800 )
|
|
1801
|
|
1802 (defun accept-completion ()
|
|
1803 "Accepts the pending completion in completion-to-accept.
|
|
1804 This bumps num-uses. Called by add-completion-to-head and
|
|
1805 completion-search-reset."
|
|
1806 (let ((string completion-to-accept)
|
|
1807 ;; if this is added afresh here, then it must be a cdabbrev
|
|
1808 (current-completion-source cmpl-source-cdabbrev)
|
|
1809 entry
|
|
1810 )
|
|
1811 (setq completion-to-accept nil)
|
|
1812 (setq entry (add-completion-to-head string))
|
|
1813 (set-completion-num-uses entry (1+ (completion-num-uses entry)))
|
|
1814 (setq cmpl-completions-accepted-p t)
|
|
1815 ))
|
|
1816
|
|
1817 (defun use-completion-under-point ()
|
|
1818 "Call this to add the completion symbol underneath the point into
|
|
1819 the completion buffer."
|
|
1820 (let ((string (and *completep* (symbol-under-point)))
|
|
1821 (current-completion-source cmpl-source-cursor-moves))
|
|
1822 (if string (add-completion-to-head string))))
|
|
1823
|
|
1824 (defun use-completion-before-point ()
|
|
1825 "Call this to add the completion symbol before point into
|
|
1826 the completion buffer."
|
|
1827 (let ((string (and *completep* (symbol-before-point)))
|
|
1828 (current-completion-source cmpl-source-cursor-moves))
|
|
1829 (if string (add-completion-to-head string))))
|
|
1830
|
|
1831 (defun use-completion-under-or-before-point ()
|
|
1832 "Call this to add the completion symbol before point into
|
|
1833 the completion buffer."
|
|
1834 (let ((string (and *completep* (symbol-under-or-before-point)))
|
|
1835 (current-completion-source cmpl-source-cursor-moves))
|
|
1836 (if string (add-completion-to-head string))))
|
|
1837
|
|
1838 (defun use-completion-before-separator ()
|
|
1839 "Call this to add the completion symbol before point into
|
|
1840 the completion buffer. Completions added this way will automatically be
|
|
1841 saved if *separator-character-uses-completion-p* is non-nil."
|
|
1842 (let ((string (and *completep* (symbol-before-point)))
|
|
1843 (current-completion-source cmpl-source-separator)
|
|
1844 entry)
|
|
1845 (cmpl-statistics-block
|
|
1846 (note-separator-character string)
|
|
1847 )
|
|
1848 (cond (string
|
|
1849 (setq entry (add-completion-to-head string))
|
|
1850 (when (and *separator-character-uses-completion-p*
|
|
1851 (zerop (completion-num-uses entry)))
|
|
1852 (set-completion-num-uses entry 1)
|
|
1853 (setq cmpl-completions-accepted-p t)
|
|
1854 )))
|
|
1855 ))
|
|
1856
|
|
1857 ;;; Tests --
|
|
1858 ;;; - Add and Find -
|
|
1859 ;;; (add-completion "banana" 5 10)
|
|
1860 ;;; (find-exact-completion "banana") --> ("banana" 5 10 0)
|
|
1861 ;;; (add-completion "banana" 6)
|
|
1862 ;;; (find-exact-completion "banana") --> ("banana" 6 10 0)
|
|
1863 ;;; (add-completion "banish")
|
|
1864 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
|
|
1865 ;;;
|
|
1866 ;;; - Accepting -
|
|
1867 ;;; (setq completion-to-accept "banana")
|
|
1868 ;;; (accept-completion)
|
|
1869 ;;; (find-exact-completion "banana") --> ("banana" 7 10)
|
|
1870 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
|
|
1871 ;;; (setq completion-to-accept "banish")
|
|
1872 ;;; (add-completion "banner")
|
|
1873 ;;; (car (find-cmpl-prefix-entry "ban"))
|
|
1874 ;;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
|
|
1875 ;;;
|
|
1876 ;;; - Deleting -
|
|
1877 ;;; (kill-completion "banish")
|
|
1878 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
|
|
1879
|
|
1880
|
|
1881 ;;;---------------------------------------------------------------------------
|
|
1882 ;;; Searching the database
|
|
1883 ;;;---------------------------------------------------------------------------
|
|
1884 ;;; Functions outside this block must call completion-search-reset followed
|
|
1885 ;;; by calls to completion-search-next or completion-search-peek
|
|
1886 ;;;
|
|
1887
|
|
1888 ;;; Status variables
|
|
1889 ;; Commented out to improve loading speed
|
|
1890 (defvar cmpl-test-string "")
|
|
1891 ;; "The current string used by completion-search-next."
|
|
1892 (defvar cmpl-test-regexp "")
|
|
1893 ;; "The current regexp used by completion-search-next.
|
|
1894 ;; (derived from cmpl-test-string)"
|
|
1895 (defvar cmpl-last-index 0)
|
|
1896 ;; "The last index that completion-search-next was called with."
|
|
1897 (defvar cmpl-cdabbrev-reset-p nil)
|
|
1898 ;; "Set to t when cdabbrevs have been reset."
|
|
1899 (defvar cmpl-next-possibilities nil)
|
|
1900 ;; "A pointer to the element BEFORE the next set of possible completions.
|
|
1901 ;; cadr of this is the cmpl-next-possibility"
|
|
1902 (defvar cmpl-starting-possibilities nil)
|
|
1903 ;; "The initial list of starting possibilities."
|
|
1904 (defvar cmpl-next-possibility nil)
|
|
1905 ;; "The cached next possibility."
|
|
1906 (defvar cmpl-tried-list nil)
|
|
1907 ;; "A downcased list of all the completions we have tried."
|
|
1908
|
|
1909
|
|
1910 (defun completion-search-reset (string)
|
|
1911 "Given a string, sets up the get-completion and completion-search-next functions.
|
|
1912 String must be longer than *completion-prefix-min-length*."
|
|
1913 (if completion-to-accept (accept-completion))
|
|
1914 (setq cmpl-starting-possibilities
|
|
1915 (cmpl-prefix-entry-head
|
|
1916 (find-cmpl-prefix-entry (downcase (substring string 0 3))))
|
|
1917 cmpl-test-string string
|
|
1918 cmpl-test-regexp (concat (regexp-quote string) "."))
|
|
1919 (completion-search-reset-1)
|
|
1920 )
|
|
1921
|
|
1922 (defun completion-search-reset-1 ()
|
|
1923 (setq cmpl-next-possibilities cmpl-starting-possibilities
|
|
1924 cmpl-next-possibility nil
|
|
1925 cmpl-cdabbrev-reset-p nil
|
|
1926 cmpl-last-index -1
|
|
1927 cmpl-tried-list nil
|
|
1928 ))
|
|
1929
|
|
1930 (defun completion-search-next (index)
|
|
1931 "Returns the next completion entry. If index is out of sequence it resets
|
|
1932 and starts from the top. If there are no more entries it tries cdabbrev and
|
|
1933 returns only a string."
|
|
1934 (cond
|
|
1935 ((= index (setq cmpl-last-index (1+ cmpl-last-index)))
|
|
1936 (completion-search-peek t))
|
|
1937 ((minusp index)
|
|
1938 (completion-search-reset-1)
|
|
1939 (setq cmpl-last-index index)
|
|
1940 ;; reverse the possibilities list
|
|
1941 (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
|
|
1942 ;; do a "normal" search
|
|
1943 (while (and (completion-search-peek nil)
|
|
1944 (minusp (setq index (1+ index))))
|
|
1945 (setq cmpl-next-possibility nil)
|
|
1946 )
|
|
1947 (cond ((not cmpl-next-possibilities))
|
|
1948 ;; If no more possibilities, leave it that way
|
|
1949 ((= -1 cmpl-last-index)
|
|
1950 ;; next completion is at index 0. reset next-possibility list
|
|
1951 ;; to start at beginning
|
|
1952 (setq cmpl-next-possibilities cmpl-starting-possibilities))
|
|
1953 (t
|
|
1954 ;; otherwise point to one before current
|
|
1955 (setq cmpl-next-possibilities
|
|
1956 (nthcdr (- (length cmpl-starting-possibilities)
|
|
1957 (length cmpl-next-possibilities))
|
|
1958 cmpl-starting-possibilities))
|
|
1959 )))
|
|
1960 (t
|
|
1961 ;; non-negative index, reset and search
|
|
1962 ;;(prin1 'reset)
|
|
1963 (completion-search-reset-1)
|
|
1964 (setq cmpl-last-index index)
|
|
1965 (while (and (completion-search-peek t)
|
|
1966 (not (minusp (setq index (1- index)))))
|
|
1967 (setq cmpl-next-possibility nil)
|
|
1968 ))
|
|
1969 )
|
|
1970 (prog1
|
|
1971 cmpl-next-possibility
|
|
1972 (setq cmpl-next-possibility nil)
|
|
1973 ))
|
|
1974
|
|
1975
|
|
1976 (defun completion-search-peek (use-cdabbrev)
|
|
1977 "Returns the next completion entry without actually moving the pointers.
|
|
1978 Calling this again or calling completion-search-next will result in the same
|
|
1979 string being returned. Depends on case-fold-search.
|
|
1980 If there are no more entries it tries cdabbrev and then returns only a string."
|
|
1981 (cond
|
|
1982 ;; return the cached value if we have it
|
|
1983 (cmpl-next-possibility)
|
|
1984 ((and cmpl-next-possibilities
|
|
1985 ;; still a few possibilities left
|
|
1986 (progn
|
|
1987 (while
|
|
1988 (and (not (eq 0 (string-match cmpl-test-regexp
|
|
1989 (completion-string (car cmpl-next-possibilities)))))
|
|
1990 (setq cmpl-next-possibilities (cdr cmpl-next-possibilities))
|
|
1991 ))
|
|
1992 cmpl-next-possibilities
|
|
1993 ))
|
|
1994 ;; successful match
|
|
1995 (setq cmpl-next-possibility (car cmpl-next-possibilities)
|
|
1996 cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility))
|
|
1997 cmpl-tried-list)
|
|
1998 cmpl-next-possibilities (cdr cmpl-next-possibilities)
|
|
1999 )
|
|
2000 cmpl-next-possibility)
|
|
2001 (use-cdabbrev
|
|
2002 ;; unsuccessful, use cdabbrev
|
|
2003 (cond ((not cmpl-cdabbrev-reset-p)
|
|
2004 (reset-cdabbrev cmpl-test-string cmpl-tried-list)
|
|
2005 (setq cmpl-cdabbrev-reset-p t)
|
|
2006 ))
|
|
2007 (setq cmpl-next-possibility (next-cdabbrev))
|
|
2008 )
|
|
2009 ;; Completely unsuccessful, return nil
|
|
2010 ))
|
|
2011
|
|
2012 ;;; Tests --
|
|
2013 ;;; - Add and Find -
|
|
2014 ;;; (add-completion "banana")
|
|
2015 ;;; (completion-search-reset "ban")
|
|
2016 ;;; (completion-search-next 0) --> "banana"
|
|
2017 ;;;
|
|
2018 ;;; - Discrimination -
|
|
2019 ;;; (add-completion "cumberland")
|
|
2020 ;;; (add-completion "cumberbund")
|
|
2021 ;;; cumbering
|
|
2022 ;;; (completion-search-reset "cumb")
|
|
2023 ;;; (completion-search-peek t) --> "cumberbund"
|
|
2024 ;;; (completion-search-next 0) --> "cumberbund"
|
|
2025 ;;; (completion-search-peek t) --> "cumberland"
|
|
2026 ;;; (completion-search-next 1) --> "cumberland"
|
|
2027 ;;; (completion-search-peek nil) --> nil
|
|
2028 ;;; (completion-search-next 2) --> "cumbering" {cdabbrev}
|
|
2029 ;;; (completion-search-next 3) --> nil or "cumming"{depends on context}
|
|
2030 ;;; (completion-search-next 1) --> "cumberland"
|
|
2031 ;;; (completion-search-peek t) --> "cumbering" {cdabbrev}
|
|
2032 ;;;
|
|
2033 ;;; - Accepting -
|
|
2034 ;;; (completion-search-next 1) --> "cumberland"
|
|
2035 ;;; (setq completion-to-accept "cumberland")
|
|
2036 ;;; (completion-search-reset "foo")
|
|
2037 ;;; (completion-search-reset "cum")
|
|
2038 ;;; (completion-search-next 0) --> "cumberland"
|
|
2039 ;;;
|
|
2040 ;;; - Deleting -
|
|
2041 ;;; (kill-completion "cumberland")
|
|
2042 ;;; cummings
|
|
2043 ;;; (completion-search-reset "cum")
|
|
2044 ;;; (completion-search-next 0) --> "cumberbund"
|
|
2045 ;;; (completion-search-next 1) --> "cummings"
|
|
2046 ;;;
|
|
2047 ;;; - Ignoring Capitalization -
|
|
2048 ;;; (completion-search-reset "CuMb")
|
|
2049 ;;; (completion-search-next 0) --> "cumberbund"
|
|
2050
|
|
2051
|
|
2052
|
|
2053 ;;;-----------------------------------------------
|
|
2054 ;;; COMPLETE
|
|
2055 ;;;-----------------------------------------------
|
|
2056
|
|
2057 (defun completion-mode ()
|
|
2058 "Toggles whether or not new words are added to the database."
|
|
2059 (interactive)
|
|
2060 (setq *completep* (not *completep*))
|
|
2061 (message "Completion mode is now %s." (if *completep* "ON" "OFF"))
|
|
2062 )
|
|
2063
|
|
2064 (defvar cmpl-current-index 0)
|
|
2065 (defvar cmpl-original-string nil)
|
|
2066 (defvar cmpl-last-insert-location -1)
|
|
2067 (defvar cmpl-leave-point-at-start nil)
|
|
2068
|
|
2069 (defun complete (&optional arg)
|
|
2070 "Inserts a completion at point.
|
|
2071 Point is left at end. Consective calls rotate through all possibilities.
|
|
2072 Prefix args ::
|
|
2073 control-u :: leave the point at the beginning of the completion rather
|
|
2074 than at the end.
|
|
2075 a number :: rotate through the possible completions by that amount
|
|
2076 `-' :: same as -1 (insert previous completion)
|
|
2077 {See the comments at the top of completion.el for more info.}
|
|
2078 "
|
|
2079 (interactive "*p")
|
|
2080 ;;; Set up variables
|
|
2081 (cond ((eq last-command this-command)
|
|
2082 ;; Undo last one
|
|
2083 (delete-region cmpl-last-insert-location (point))
|
|
2084 ;; get next completion
|
|
2085 (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))
|
|
2086 )
|
|
2087 (t
|
|
2088 (if (not cmpl-initialized-p)
|
|
2089 (initialize-completions)) ;; make sure everything's loaded
|
|
2090 (cond ((consp current-prefix-arg) ;; control-u
|
|
2091 (setq arg 0)
|
|
2092 (setq cmpl-leave-point-at-start t)
|
|
2093 )
|
|
2094 (t
|
|
2095 (setq cmpl-leave-point-at-start nil)
|
|
2096 ))
|
|
2097 ;; get string
|
|
2098 (setq cmpl-original-string (symbol-before-point-for-complete))
|
|
2099 (cond ((not cmpl-original-string)
|
|
2100 (setq this-command 'failed-complete)
|
|
2101 (error "To complete, the point must be after a symbol at least %d character long."
|
|
2102 *completion-prefix-min-length*)))
|
|
2103 ;; get index
|
|
2104 (setq cmpl-current-index (if current-prefix-arg arg 0))
|
|
2105 ;; statistics
|
|
2106 (cmpl-statistics-block
|
|
2107 (note-complete-entered-afresh cmpl-original-string))
|
|
2108 ;; reset database
|
|
2109 (completion-search-reset cmpl-original-string)
|
|
2110 ;; erase what we've got
|
|
2111 (delete-region cmpl-symbol-start cmpl-symbol-end)
|
|
2112 ))
|
|
2113
|
|
2114 ;; point is at the point to insert the new symbol
|
|
2115 ;; Get the next completion
|
|
2116 (let* ((print-status-p
|
|
2117 (and (>= (cmpl19-baud-rate) *print-next-completion-speed-threshold*)
|
|
2118 (not (minibuffer-window-selected-p))))
|
|
2119 (insert-point (point))
|
|
2120 (entry (completion-search-next cmpl-current-index))
|
|
2121 string
|
|
2122 )
|
|
2123 ;; entry is either a completion entry or a string (if cdabbrev)
|
|
2124
|
|
2125 ;; If found, insert
|
|
2126 (cond (entry
|
|
2127 ;; Setup for proper case
|
|
2128 (setq string (if (stringp entry)
|
|
2129 entry (completion-string entry)))
|
|
2130 (setq string (cmpl-merge-string-cases
|
|
2131 string cmpl-original-string))
|
|
2132 ;; insert
|
|
2133 (insert string)
|
|
2134 ;; accept it
|
|
2135 (setq completion-to-accept string)
|
|
2136 ;; fixup and cache point
|
|
2137 (cond (cmpl-leave-point-at-start
|
|
2138 (setq cmpl-last-insert-location (point))
|
|
2139 (goto-char insert-point))
|
|
2140 (t;; point at end,
|
|
2141 (setq cmpl-last-insert-location insert-point))
|
|
2142 )
|
|
2143 ;; statistics
|
|
2144 (cmpl-statistics-block
|
|
2145 (note-complete-inserted entry cmpl-current-index))
|
|
2146 ;; Done ! cmpl-stat-complete-successful
|
|
2147 ;;display the next completion
|
|
2148 (cond
|
|
2149 ((and print-status-p
|
|
2150 ;; This updates the display and only prints if there
|
|
2151 ;; is no typeahead
|
|
2152 (cmpl19-sit-for 0)
|
|
2153 (setq entry
|
|
2154 (completion-search-peek
|
|
2155 *print-next-completion-does-cdabbrev-search-p*)))
|
|
2156 (setq string (if (stringp entry)
|
|
2157 entry (completion-string entry)))
|
|
2158 (setq string (cmpl-merge-string-cases
|
|
2159 string cmpl-original-string))
|
|
2160 (message "Next completion: %s" string)
|
|
2161 ))
|
|
2162 )
|
|
2163 (t;; none found, insert old
|
|
2164 (insert cmpl-original-string)
|
|
2165 ;; Don't accept completions
|
|
2166 (setq completion-to-accept nil)
|
|
2167 ;; print message
|
|
2168 (if (and print-status-p (cmpl19-sit-for 0))
|
|
2169 (message "No %scompletions."
|
|
2170 (if (eq this-command last-command) "more " "")))
|
|
2171 ;; statistics
|
|
2172 (cmpl-statistics-block
|
|
2173 (record-complete-failed cmpl-current-index))
|
|
2174 ;; Pretend that we were never here
|
|
2175 (setq this-command 'failed-complete)
|
|
2176 ))))
|
|
2177
|
|
2178 ;;;-----------------------------------------------
|
|
2179 ;;; "Complete" Key Keybindings
|
|
2180 ;;;-----------------------------------------------
|
|
2181
|
|
2182 ;;; Complete key definition
|
|
2183 ;;; These define c-return and meta-return
|
|
2184 ;;; In any case you really want to bind this to a single keystroke
|
|
2185 (if (fboundp 'key-for-others-chord)
|
|
2186 (condition-case e
|
|
2187 ;; this can fail if some of the prefix chars. are already used
|
|
2188 ;; as commands (this happens on wyses)
|
|
2189 (global-set-key (key-for-others-chord "return" '(control)) 'complete)
|
|
2190 (error)
|
|
2191 ))
|
|
2192 (if (fboundp 'gmacs-keycode)
|
|
2193 (global-set-key (gmacs-keycode "return" '(control)) 'complete)
|
|
2194 )
|
|
2195 (global-set-key "\M-\r" 'complete)
|
|
2196
|
|
2197 ;;; Tests -
|
|
2198 ;;; (add-completion "cumberland")
|
|
2199 ;;; (add-completion "cumberbund")
|
|
2200 ;;; cum
|
|
2201 ;;; Cumber
|
|
2202 ;;; cumbering
|
|
2203 ;;; cumb
|
|
2204
|
|
2205
|
|
2206 ;;;---------------------------------------------------------------------------
|
|
2207 ;;; Parsing definitions from files into the database
|
|
2208 ;;;---------------------------------------------------------------------------
|
|
2209
|
|
2210 ;;;-----------------------------------------------
|
|
2211 ;;; Top Level functions ::
|
|
2212 ;;;-----------------------------------------------
|
|
2213
|
|
2214 ;;; User interface
|
|
2215 (defun add-completions-from-file (file)
|
|
2216 "Parses all the definition names from a Lisp mode file and adds them to the
|
|
2217 completion database."
|
|
2218 (interactive "fFile: ")
|
|
2219 (setq file (if (fboundp 'expand-file-name-defaulting)
|
|
2220 (expand-file-name-defaulting file)
|
|
2221 (expand-file-name file)))
|
|
2222 (let* ((buffer (get-file-buffer file))
|
|
2223 (buffer-already-there-p buffer)
|
|
2224 )
|
|
2225 (when (not buffer-already-there-p)
|
|
2226 (let ((*modes-for-completion-find-file-hook* nil))
|
|
2227 (setq buffer (find-file-noselect file))
|
|
2228 ))
|
|
2229 (unwind-protect
|
|
2230 (save-excursion
|
|
2231 (set-buffer buffer)
|
|
2232 (add-completions-from-buffer)
|
|
2233 )
|
|
2234 (when (not buffer-already-there-p)
|
|
2235 (kill-buffer buffer))
|
|
2236 )))
|
|
2237
|
|
2238 (defun add-completions-from-buffer ()
|
|
2239 (interactive)
|
|
2240 (let ((current-completion-source cmpl-source-file-parsing)
|
|
2241 (start-num
|
|
2242 (cmpl-statistics-block
|
|
2243 (aref completion-add-count-vector cmpl-source-file-parsing)))
|
|
2244 mode
|
|
2245 )
|
|
2246 (cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
|
|
2247 (add-completions-from-lisp-buffer)
|
|
2248 (setq mode 'lisp)
|
|
2249 )
|
|
2250 ((memq major-mode '(c-mode))
|
|
2251 (add-completions-from-c-buffer)
|
|
2252 (setq mode 'c)
|
|
2253 )
|
|
2254 (t
|
|
2255 (error "Do not know how to parse completions in %s buffers."
|
|
2256 major-mode)
|
|
2257 ))
|
|
2258 (cmpl-statistics-block
|
|
2259 (record-cmpl-parse-file
|
|
2260 mode (point-max)
|
|
2261 (- (aref completion-add-count-vector cmpl-source-file-parsing)
|
|
2262 start-num)))
|
|
2263 ))
|
|
2264
|
|
2265 ;;; Find file hook
|
|
2266 (defun cmpl-find-file-hook ()
|
|
2267 (cond (*completep*
|
|
2268 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
|
|
2269 (memq 'lisp *modes-for-completion-find-file-hook*)
|
|
2270 )
|
|
2271 (add-completions-from-buffer))
|
|
2272 ((and (memq major-mode '(c-mode))
|
|
2273 (memq 'c *modes-for-completion-find-file-hook*)
|
|
2274 )
|
|
2275 (add-completions-from-buffer)
|
|
2276 )))
|
|
2277 ))
|
|
2278
|
|
2279 (pushnew 'cmpl-find-file-hook find-file-hooks)
|
|
2280
|
|
2281 ;;;-----------------------------------------------
|
|
2282 ;;; Tags Table Completions
|
|
2283 ;;;-----------------------------------------------
|
|
2284
|
|
2285 (defun add-completions-from-tags-table ()
|
|
2286 ;; Inspired by eero@media-lab.media.mit.edu
|
|
2287 "Add completions from the current tags-table-buffer."
|
|
2288 (interactive)
|
|
2289 (visit-tags-table-buffer) ;this will prompt if no tags-table
|
|
2290 (save-excursion
|
|
2291 (goto-char (point-min))
|
|
2292 (let (string)
|
|
2293 (condition-case e
|
|
2294 (while t
|
|
2295 (search-forward "\177")
|
|
2296 (backward-char 3)
|
|
2297 (and (setq string (symbol-under-point))
|
|
2298 (add-completion-to-tail-if-new string))
|
|
2299 (forward-char 3)
|
|
2300 )
|
|
2301 (search-failed)
|
|
2302 ))))
|
|
2303
|
|
2304
|
|
2305 ;;;-----------------------------------------------
|
|
2306 ;;; Lisp File completion parsing
|
|
2307 ;;;-----------------------------------------------
|
|
2308 ;;; This merely looks for phrases beginning with (def.... or
|
|
2309 ;;; (package:def ... and takes the next word.
|
|
2310 ;;;
|
|
2311 ;;; We tried using forward-lines and explicit searches but the regexp technique
|
|
2312 ;;; was faster. (About 100K characters per second)
|
|
2313 ;;;
|
|
2314 (defconst *lisp-def-regexp*
|
|
2315 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
|
|
2316 "A regexp that searches for lisp definition form."
|
|
2317 )
|
|
2318
|
|
2319 ;;; Tests -
|
|
2320 ;;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
|
|
2321 ;;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
|
|
2322 ;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
|
|
2323 ;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
|
|
2324
|
|
2325 (defun add-completions-from-lisp-buffer ()
|
|
2326 "Parses all the definition names from a Lisp mode buffer and adds them to
|
|
2327 the completion database."
|
|
2328 ;;; Benchmarks
|
|
2329 ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second
|
|
2330 (let (string)
|
|
2331 (save-excursion
|
|
2332 (goto-char (point-min))
|
|
2333 (condition-case e
|
|
2334 (while t
|
|
2335 (re-search-forward *lisp-def-regexp*)
|
|
2336 (and (setq string (symbol-under-point))
|
|
2337 (add-completion-to-tail-if-new string))
|
|
2338 )
|
|
2339 (search-failed)
|
|
2340 ))))
|
|
2341
|
|
2342
|
|
2343 ;;;-----------------------------------------------
|
|
2344 ;;; C file completion parsing
|
|
2345 ;;;-----------------------------------------------
|
|
2346 ;;; C :
|
|
2347 ;;; Looks for #define or [<storage class>] [<type>] <name>{,<name>}
|
|
2348 ;;; or structure, array or pointer defs.
|
|
2349 ;;; It gets most of the definition names.
|
|
2350 ;;;
|
|
2351 ;;; As you might suspect by now, we use some symbol table hackery
|
|
2352 ;;;
|
|
2353 ;;; Symbol separator chars (have whitespace syntax) --> , ; * = (
|
|
2354 ;;; Opening char --> [ {
|
|
2355 ;;; Closing char --> ] }
|
|
2356 ;;; openning and closing must be skipped over
|
|
2357 ;;; Whitespace chars (have symbol syntax)
|
|
2358 ;;; Everything else has word syntax
|
|
2359
|
|
2360 (defun make-c-def-completion-syntax-table ()
|
|
2361 (let ((table (make-vector 256 0))
|
|
2362 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r))
|
|
2363 ;; unforunately the ?( causes the parens to appear unbalanced
|
|
2364 (separator-chars '(?, ?* ?= ?\( ?\;
|
|
2365 ))
|
|
2366 )
|
|
2367 ;; default syntax is whitespace
|
|
2368 (dotimes (i 256)
|
|
2369 (modify-syntax-entry i "w" table))
|
|
2370 (dolist (char whitespace-chars)
|
|
2371 (modify-syntax-entry char "_" table))
|
|
2372 (dolist (char separator-chars)
|
|
2373 (modify-syntax-entry char " " table))
|
|
2374 (modify-syntax-entry ?\[ "(]" table)
|
|
2375 (modify-syntax-entry ?\{ "(}" table)
|
|
2376 (modify-syntax-entry ?\] ")[" table)
|
|
2377 (modify-syntax-entry ?\} "){" table)
|
|
2378 table))
|
|
2379
|
|
2380 (defconst cmpl-c-def-syntax-table (make-c-def-completion-syntax-table))
|
|
2381
|
|
2382 ;;; Regexps
|
|
2383 (defconst *c-def-regexp*
|
|
2384 ;; This stops on lines with possible definitions
|
|
2385 "\n[_a-zA-Z#]"
|
|
2386 ;; This stops after the symbol to add.
|
|
2387 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
|
|
2388 ;; This stops before the symbol to add. {Test cases in parens. below}
|
|
2389 ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)"
|
|
2390 ;; this simple version picks up too much extraneous stuff
|
|
2391 ;; "\n\\(\\w\\|\\s_\\|#\\)\\B"
|
|
2392 "A regexp that searches for a definition form."
|
|
2393 )
|
|
2394 ;
|
|
2395 ;(defconst *c-cont-regexp*
|
|
2396 ; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)"
|
|
2397 ; "This regexp should be used in a looking-at to parse for lists of variables.")
|
|
2398 ;
|
|
2399 ;(defconst *c-struct-regexp*
|
|
2400 ; "\\(*\\|\\s \\)*\\b"
|
|
2401 ; "This regexp should be used to test whether a symbol follows a structure definition.")
|
|
2402
|
|
2403 ;(defun test-c-def-regexp (regexp string)
|
|
2404 ; (and (eq 0 (string-match regexp string)) (match-end 0))
|
|
2405 ; )
|
|
2406
|
|
2407 ;;; Tests -
|
|
2408 ;;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
|
|
2409 ;;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
|
|
2410 ;;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
|
|
2411 ;;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
|
|
2412 ;;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
|
|
2413 ;;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
|
|
2414 ;;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
|
|
2415 ;;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
|
|
2416 ;;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
|
|
2417 ;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
|
|
2418 ;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
|
|
2419
|
|
2420 (defun add-completions-from-c-buffer ()
|
|
2421 "Parses all the definition names from a C mode buffer and adds them to the
|
|
2422 completion database."
|
|
2423 ;; Benchmark --
|
|
2424 ;; Sun 3/280-- 1250 lines/sec.
|
|
2425
|
|
2426 (let (string next-point char
|
|
2427 (saved-syntax (syntax-table))
|
|
2428 )
|
|
2429 (save-excursion
|
|
2430 (goto-char (point-min))
|
|
2431 (catch 'finish-add-completions
|
|
2432 (unwind-protect
|
|
2433 (while t
|
|
2434 ;; we loop here only when scan-sexps fails
|
|
2435 ;; (i.e. unbalance exps.)
|
|
2436 (set-syntax-table cmpl-c-def-syntax-table)
|
|
2437 (condition-case e
|
|
2438 (while t
|
|
2439 (re-search-forward *c-def-regexp*)
|
|
2440 (cond
|
|
2441 ((= (preceding-char) ?#)
|
|
2442 ;; preprocessor macro, see if it's one we handle
|
|
2443 (setq string (buffer-substring (point) (+ (point) 6)))
|
|
2444 (cond ((or (string-equal string "define")
|
|
2445 (string-equal string "ifdef ")
|
|
2446 )
|
|
2447 ;; skip forward over definition symbol
|
|
2448 ;; and add it to database
|
|
2449 (and (forward-word 2)
|
|
2450 (setq string (symbol-before-point))
|
|
2451 ;;(push string foo)
|
|
2452 (add-completion-to-tail-if-new string)
|
|
2453 ))))
|
|
2454 (t
|
|
2455 ;; C definition
|
|
2456 (setq next-point (point))
|
|
2457 (while (and
|
|
2458 next-point
|
|
2459 ;; scan to next separator char.
|
|
2460 (setq next-point (scan-sexps next-point 1))
|
|
2461 )
|
|
2462 ;; position the point on the word we want to add
|
|
2463 (goto-char next-point)
|
|
2464 (while (= (setq char (following-char)) ?*)
|
|
2465 ;; handle pointer ref
|
|
2466 ;; move to next separator char.
|
|
2467 (goto-char
|
|
2468 (setq next-point (scan-sexps (point) 1)))
|
|
2469 )
|
|
2470 (forward-word -1)
|
|
2471 ;; add to database
|
|
2472 (if (setq string (symbol-under-point))
|
|
2473 ;; (push string foo)
|
|
2474 (add-completion-to-tail-if-new string)
|
|
2475 ;; Local TMC hack (useful for parsing paris.h)
|
|
2476 (if (and (looking-at "_AP") ;; "ansi prototype"
|
|
2477 (progn
|
|
2478 (forward-word -1)
|
|
2479 (setq string
|
|
2480 (symbol-under-point))
|
|
2481 ))
|
|
2482 (add-completion-to-tail-if-new string)
|
|
2483 )
|
|
2484 )
|
|
2485 ;; go to next
|
|
2486 (goto-char next-point)
|
|
2487 ;; (push (format "%c" (following-char)) foo)
|
|
2488 (if (= (char-syntax char) ?\()
|
|
2489 ;; if on an opening delimiter, go to end
|
|
2490 (while (= (char-syntax char) ?\()
|
|
2491 (setq next-point (scan-sexps next-point 1)
|
|
2492 char (char-after next-point))
|
|
2493 )
|
|
2494 (or (= char ?,)
|
|
2495 ;; Current char is an end char.
|
|
2496 (setq next-point nil)
|
|
2497 ))
|
|
2498 ))))
|
|
2499 (search-failed ;;done
|
|
2500 (throw 'finish-add-completions t)
|
|
2501 )
|
|
2502 (error
|
|
2503 ;; Check for failure in scan-sexps
|
|
2504 (if (or (string-equal (second e)
|
|
2505 "Containing expression ends prematurely")
|
|
2506 (string-equal (second e) "Unbalanced parentheses"))
|
|
2507 ;; unbalanced paren., keep going
|
|
2508 ;;(ding)
|
|
2509 (forward-line 1)
|
|
2510 (message "Error parsing C buffer for completions. Please bug report.")
|
|
2511 (throw 'finish-add-completions t)
|
|
2512 ))
|
|
2513 ))
|
|
2514 (set-syntax-table saved-syntax)
|
|
2515 )))))
|
|
2516
|
|
2517
|
|
2518 ;;;---------------------------------------------------------------------------
|
|
2519 ;;; Init files
|
|
2520 ;;;---------------------------------------------------------------------------
|
|
2521
|
|
2522 (defun kill-emacs-save-completions ()
|
|
2523 "The version of save-completions-to-file called at kill-emacs
|
|
2524 time."
|
|
2525 (when (and *save-completions-p* *completep* cmpl-initialized-p)
|
|
2526 (cond
|
|
2527 ((not cmpl-completions-accepted-p)
|
|
2528 (message "Completions database has not changed - not writing."))
|
|
2529 (t
|
|
2530 (save-completions-to-file)
|
|
2531 ))
|
|
2532 ))
|
|
2533
|
|
2534 (defconst saved-cmpl-file-header
|
|
2535 ";;; Completion Initialization file.
|
|
2536 ;;; Version = %s
|
|
2537 ;;; Format is (<string> . <last-use-time>)
|
|
2538 ;;; <string> is the completion
|
|
2539 ;;; <last-use-time> is the time the completion was last used
|
|
2540 ;;; If it is t, the completion will never be pruned from the file.
|
|
2541 ;;; Otherwise it is in hours since 1900.
|
|
2542 \n")
|
|
2543
|
|
2544 (defun completion-backup-filename (filename)
|
|
2545 (concat filename ".BAK"))
|
|
2546
|
|
2547 (defun save-completions-to-file (&optional filename)
|
|
2548 "Saves a completion init file. If file is not specified,
|
|
2549 then *saved-completions-filename* is used."
|
|
2550 (interactive)
|
|
2551 (setq filename (expand-file-name (or filename *saved-completions-filename*)))
|
|
2552 (when (file-writable-p filename)
|
|
2553 (if (not cmpl-initialized-p)
|
|
2554 (initialize-completions));; make sure everything's loaded
|
|
2555 (message "Saving completions to file %s" filename)
|
|
2556
|
|
2557 (let* ((trim-versions-without-asking t)
|
|
2558 (kept-old-versions 0)
|
|
2559 (kept-new-versions *completion-file-versions-kept*)
|
|
2560 last-use-time
|
|
2561 (current-time (cmpl-hours-since-1900))
|
|
2562 (total-in-db 0)
|
|
2563 (total-perm 0)
|
|
2564 (total-saved 0)
|
|
2565 (backup-filename (completion-backup-filename filename))
|
|
2566 )
|
|
2567
|
|
2568 (save-excursion
|
|
2569 (get-buffer-create " *completion-save-buffer*")
|
|
2570 (set-buffer " *completion-save-buffer*")
|
|
2571 (setq buffer-file-name filename)
|
|
2572
|
|
2573 (when (not (verify-visited-file-modtime (current-buffer)))
|
|
2574 ;; file has changed on disk. Bring us up-to-date
|
|
2575 (message "Completion file has changed. Merging. . .")
|
|
2576 (load-completions-from-file filename t)
|
|
2577 (message "Merging finished. Saving completions to file %s" filename)
|
|
2578 )
|
|
2579
|
|
2580 ;; prepare the buffer to be modified
|
|
2581 (clear-visited-file-modtime)
|
|
2582 (erase-buffer)
|
|
2583 ;; (/ 1 0)
|
|
2584 (insert (format saved-cmpl-file-header *completion-version*))
|
|
2585 (dolist (completion (list-all-completions))
|
|
2586 (setq total-in-db (1+ total-in-db))
|
|
2587 (setq last-use-time (completion-last-use-time completion))
|
|
2588 ;; Update num uses and maybe write completion to a file
|
|
2589 (cond ((or;; Write to file if
|
|
2590 ;; permanent
|
|
2591 (and (eq last-use-time t)
|
|
2592 (setq total-perm (1+ total-perm)))
|
|
2593 ;; or if
|
|
2594 (if (plusp (completion-num-uses completion))
|
|
2595 ;; it's been used
|
|
2596 (setq last-use-time current-time)
|
|
2597 ;; or it was saved before and
|
|
2598 (and last-use-time
|
|
2599 ;; *saved-completion-retention-time* is nil
|
|
2600 (or (not *saved-completion-retention-time*)
|
|
2601 ;; or time since last use is < ...retention-time*
|
|
2602 (< (- current-time last-use-time)
|
|
2603 *saved-completion-retention-time*))
|
|
2604 )))
|
|
2605 ;; write to file
|
|
2606 (setq total-saved (1+ total-saved))
|
|
2607 (insert (prin1-to-string (cons (completion-string completion)
|
|
2608 last-use-time)) "\n")
|
|
2609 )))
|
|
2610
|
|
2611 ;; write the buffer
|
|
2612 (condition-case e
|
|
2613 (let ((file-exists-p (file-exists-p filename)))
|
|
2614 (when file-exists-p
|
|
2615 ;; If file exists . . .
|
|
2616 ;; Save a backup(so GNU doesn't screw us when we're out of disk)
|
|
2617 ;; (GNU leaves a 0 length file if it gets a disk full error!)
|
|
2618
|
|
2619 ;; If backup doesn't exit, Rename current to backup
|
|
2620 ;; {If backup exists the primary file is probably messed up}
|
|
2621 (unless (file-exists-p backup-filename)
|
|
2622 (rename-file filename backup-filename))
|
|
2623 ;; Copy the backup back to the current name
|
|
2624 ;; (so versioning works)
|
|
2625 (copy-file backup-filename filename t)
|
|
2626 )
|
|
2627 ;; Save it
|
|
2628 (save-buffer)
|
|
2629 (when file-exists-p
|
|
2630 ;; If successful, remove backup
|
|
2631 (delete-file backup-filename)
|
|
2632 ))
|
|
2633 (error
|
|
2634 (set-buffer-modified-p nil)
|
|
2635 (message "Couldn't save completion file %s." filename)
|
|
2636 ))
|
|
2637 ;; Reset accepted-p flag
|
|
2638 (setq cmpl-completions-accepted-p nil)
|
|
2639 )
|
|
2640 (cmpl-statistics-block
|
|
2641 (record-save-completions total-in-db total-perm total-saved))
|
|
2642 )))
|
|
2643
|
|
2644 (defun autosave-completions ()
|
|
2645 (when (and *save-completions-p* *completep* cmpl-initialized-p
|
|
2646 *completion-auto-save-period*
|
|
2647 (> cmpl-emacs-idle-time *completion-auto-save-period*)
|
|
2648 cmpl-completions-accepted-p)
|
|
2649 (save-completions-to-file)
|
|
2650 ))
|
|
2651
|
|
2652 (pushnew 'autosave-completions cmpl-emacs-idle-time-hooks)
|
|
2653
|
|
2654 (defun load-completions-from-file (&optional filename no-message-p)
|
|
2655 "loads a completion init file. If file is not specified,
|
|
2656 then *saved-completions-filename* is used"
|
|
2657 (interactive)
|
|
2658 (setq filename (expand-file-name (or filename *saved-completions-filename*)))
|
|
2659 (let* ((backup-filename (completion-backup-filename filename))
|
|
2660 (backup-readable-p (file-readable-p backup-filename))
|
|
2661 )
|
|
2662 (when backup-readable-p (setq filename backup-filename))
|
|
2663 (when (file-readable-p filename)
|
|
2664 (if (not no-message-p)
|
|
2665 (message "Loading completions from %sfile %s . . ."
|
|
2666 (if backup-readable-p "backup " "") filename))
|
|
2667 (save-excursion
|
|
2668 (get-buffer-create " *completion-save-buffer*")
|
|
2669 (set-buffer " *completion-save-buffer*")
|
|
2670 (setq buffer-file-name filename)
|
|
2671 ;; prepare the buffer to be modified
|
|
2672 (clear-visited-file-modtime)
|
|
2673 (erase-buffer)
|
|
2674
|
|
2675 (let ((insert-okay-p nil)
|
|
2676 (buffer (current-buffer))
|
|
2677 (current-time (cmpl-hours-since-1900))
|
|
2678 string num-uses entry last-use-time
|
|
2679 cmpl-entry cmpl-last-use-time
|
|
2680 (current-completion-source cmpl-source-init-file)
|
|
2681 (start-num
|
|
2682 (cmpl-statistics-block
|
|
2683 (aref completion-add-count-vector cmpl-source-file-parsing)))
|
|
2684 (total-in-file 0) (total-perm 0)
|
|
2685 )
|
|
2686 ;; insert the file into a buffer
|
|
2687 (condition-case e
|
|
2688 (progn (insert-file-contents filename t)
|
|
2689 (setq insert-okay-p t))
|
|
2690
|
|
2691 (file-error
|
|
2692 (message "File error trying to load completion file %s."
|
|
2693 filename)))
|
|
2694 ;; parse it
|
|
2695 (when insert-okay-p
|
|
2696 (goto-char (point-min))
|
|
2697
|
|
2698 (condition-case e
|
|
2699 (while t
|
|
2700 (setq entry (read buffer))
|
|
2701 (setq total-in-file (1+ total-in-file))
|
|
2702 (cond
|
|
2703 ((and (consp entry)
|
|
2704 (stringp (setq string (car entry)))
|
|
2705 (cond
|
|
2706 ((eq (setq last-use-time (cdr entry)) 'T)
|
|
2707 ;; handle case sensitivity
|
|
2708 (setq total-perm (1+ total-perm))
|
|
2709 (setq last-use-time t))
|
|
2710 ((eq last-use-time t)
|
|
2711 (setq total-perm (1+ total-perm)))
|
|
2712 ((integerp last-use-time))
|
|
2713 ))
|
|
2714 ;; Valid entry
|
|
2715 ;; add it in
|
|
2716 (setq cmpl-last-use-time
|
|
2717 (completion-last-use-time
|
|
2718 (setq cmpl-entry
|
|
2719 (add-completion-to-tail-if-new string))
|
|
2720 ))
|
|
2721 (if (or (eq last-use-time t)
|
|
2722 (and (> last-use-time 1000);;backcompatibility
|
|
2723 (not (eq cmpl-last-use-time t))
|
|
2724 (or (not cmpl-last-use-time)
|
|
2725 ;; more recent
|
|
2726 (> last-use-time cmpl-last-use-time))
|
|
2727 ))
|
|
2728 ;; update last-use-time
|
|
2729 (set-completion-last-use-time cmpl-entry last-use-time)
|
|
2730 ))
|
|
2731 (t
|
|
2732 ;; Bad format
|
|
2733 (message "Error: invalid saved completion - %s"
|
|
2734 (prin1-to-string entry))
|
|
2735 ;; try to get back in sync
|
|
2736 (search-forward "\n(")
|
|
2737 )))
|
|
2738 (search-failed
|
|
2739 (message "End of file while reading completions.")
|
|
2740 )
|
|
2741 (end-of-file
|
|
2742 (if (= (point) (point-max))
|
|
2743 (if (not no-message-p)
|
|
2744 (message "Loading completions from file %s . . . Done."
|
|
2745 filename))
|
|
2746 (message "End of file while reading completions.")
|
|
2747 ))
|
|
2748 ))
|
|
2749
|
|
2750 (cmpl-statistics-block
|
|
2751 (record-load-completions
|
|
2752 total-in-file total-perm
|
|
2753 (- (aref completion-add-count-vector cmpl-source-init-file)
|
|
2754 start-num)))
|
|
2755
|
|
2756 )))))
|
|
2757
|
|
2758 (defun initialize-completions ()
|
|
2759 "Loads the default completions file and sets up so that exiting emacs will
|
|
2760 automatically save the file."
|
|
2761 (interactive)
|
|
2762 (cond ((not cmpl-initialized-p)
|
|
2763 (load-completions-from-file)
|
|
2764 ))
|
|
2765 (init-cmpl-emacs-idle-process)
|
|
2766 (setq cmpl-initialized-p t)
|
|
2767 )
|
|
2768
|
|
2769
|
|
2770 ;;;-----------------------------------------------
|
|
2771 ;;; Kill EMACS patch
|
|
2772 ;;;-----------------------------------------------
|
|
2773
|
|
2774 (completion-advise kill-emacs :before
|
|
2775 ;; | All completion code should go in here
|
|
2776 ;;\ /
|
|
2777 (kill-emacs-save-completions)
|
|
2778 ;;/ \
|
|
2779 ;; | All completion code should go in here
|
|
2780 (cmpl-statistics-block
|
|
2781 (record-cmpl-kill-emacs))
|
|
2782 )
|
|
2783
|
|
2784
|
|
2785 ;;;-----------------------------------------------
|
|
2786 ;;; Kill region patch
|
|
2787 ;;;-----------------------------------------------
|
|
2788
|
|
2789 ;;; Patched to remove the most recent completion
|
|
2790 (defvar $$$cmpl-old-kill-region (symbol-function 'kill-region))
|
|
2791
|
|
2792 (defun kill-region (&optional beg end)
|
|
2793 "Kill between point and mark.
|
|
2794 The text is deleted but saved in the kill ring.
|
|
2795 The command \\[yank] can retrieve it from there.
|
|
2796 /(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
|
|
2797
|
|
2798 This is the primitive for programs to kill text (as opposed to deleting it).
|
|
2799 Supply two arguments, character numbers indicating the stretch of text
|
|
2800 to be killed.
|
|
2801 Any command that calls this function is a \"kill command\".
|
|
2802 If the previous command was also a kill command,
|
|
2803 the text killed this time appends to the text killed last time
|
|
2804 to make one entry in the kill ring.
|
|
2805 Patched to remove the most recent completion."
|
|
2806 (interactive "*")
|
|
2807 (cond ((and (eq last-command 'complete) (eq last-command-char ?\C-w))
|
|
2808 (delete-region (point) cmpl-last-insert-location)
|
|
2809 (insert cmpl-original-string)
|
|
2810 (setq completion-to-accept nil)
|
|
2811 (cmpl-statistics-block
|
|
2812 (record-complete-failed))
|
|
2813 )
|
|
2814 (t
|
|
2815 (if (not beg)
|
|
2816 (setq beg (min (point) (mark))
|
|
2817 end (max (point) (mark)))
|
|
2818 )
|
|
2819 (funcall $$$cmpl-old-kill-region beg end)
|
|
2820 )))
|
|
2821
|
|
2822 ;;;-----------------------------------------------
|
|
2823 ;;; Patches to self-insert-command.
|
|
2824 ;;;-----------------------------------------------
|
|
2825
|
|
2826 ;;; Need 2 versions: generic seperator chars. and space (to get auto fill
|
|
2827 ;;; to work)
|
|
2828
|
|
2829 ;;; All common separators (eg. space "(" ")" """) characters go through a
|
|
2830 ;;; function to add new words to the list of words to complete from:
|
|
2831 ;;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
|
|
2832 ;;; If the character before this was an alpha-numeric then this adds the
|
|
2833 ;;; symbol befoe point to the completion list (using ADD-COMPLETION).
|
|
2834
|
|
2835 (defun completion-separator-self-insert-command (arg)
|
|
2836 (interactive "p")
|
|
2837 (use-completion-before-separator)
|
|
2838 (self-insert-command arg)
|
|
2839 )
|
|
2840
|
|
2841 (defun completion-separator-self-insert-autofilling (arg)
|
|
2842 (interactive "p")
|
|
2843 (use-completion-before-separator)
|
|
2844 (self-insert-command arg)
|
|
2845 (and (> (current-column) fill-column)
|
|
2846 auto-fill-hook
|
|
2847 (funcall auto-fill-hook))
|
|
2848 )
|
|
2849
|
|
2850 ;;;-----------------------------------------------
|
|
2851 ;;; Wrapping Macro
|
|
2852 ;;;-----------------------------------------------
|
|
2853
|
|
2854 ;;; Note that because of the way byte compiling works, none of
|
|
2855 ;;; the functions defined with this macro get byte compiled.
|
|
2856
|
|
2857 (defmacro def-completion-wrapper (function-name type &optional new-name)
|
|
2858 "Add a call to update the completion database before the function is
|
|
2859 executed. TYPE is the type of the wrapper to be added. Can be :before or
|
|
2860 :under."
|
|
2861 (completion-advise-1
|
|
2862 function-name ':before
|
|
2863 (ecase type
|
|
2864 (:before '((use-completion-before-point)))
|
|
2865 (:separator '((use-completion-before-separator)))
|
|
2866 (:under '((use-completion-under-point)))
|
|
2867 (:under-or-before
|
|
2868 '((use-completion-under-or-before-point)))
|
|
2869 (:minibuffer-separator
|
|
2870 '((let ((cmpl-syntax-table cmpl-standard-syntax-table))
|
|
2871 (use-completion-before-separator))))
|
|
2872 )
|
|
2873 new-name
|
|
2874 ))
|
|
2875
|
|
2876 ;;;(defun foo (x y z) (+ x y z))
|
|
2877 ;;;foo
|
|
2878 ;;;(macroexpand '(def-completion-wrapper foo :under))
|
|
2879 ;;;(progn (defvar $$$cmpl-foo (symbol-function (quote foo))) (defun foo (&rest arglist) (progn (use-completion-under-point)) (cmpl-apply-as-top-level $$$cmpl-foo arglist)))
|
|
2880 ;;;(defun bar (x y z) "Documentation" (+ x y z))
|
|
2881 ;;;bar
|
|
2882 ;;;(macroexpand '(def-completion-wrapper bar :under))
|
|
2883 ;;;(progn (defvar $$$cmpl-bar (symbol-function (quote bar))) (defun bar (&rest arglist) "Documentation" (progn (use-completion-under-point)) (cmpl-apply-as-top-level $$$cmpl-bar arglist)))
|
|
2884 ;;;(defun quuz (x &optional y z) "Documentation" (interactive "P") (+ x y z))
|
|
2885 ;;;quuz
|
|
2886 ;;;(macroexpand '(def-completion-wrapper quuz :before))
|
|
2887 ;;;(progn (defvar $$$cmpl-quuz (symbol-function (quote quuz))) (defun quuz (&rest arglist) "Documentation" (interactive) (progn (use-completion-before-point)) (cmpl-apply-as-top-level $$$cmpl-quuz arglist)))
|
|
2888
|
|
2889
|
|
2890 ;;;---------------------------------------------------------------------------
|
|
2891 ;;; Patches to standard keymaps insert completions
|
|
2892 ;;;---------------------------------------------------------------------------
|
|
2893
|
|
2894 ;;;-----------------------------------------------
|
|
2895 ;;; Separators
|
|
2896 ;;;-----------------------------------------------
|
|
2897 ;;; We've used the completion syntax table given as a guide.
|
|
2898 ;;;
|
|
2899 ;;; Global separator chars.
|
|
2900 ;;; We left out <tab> because there are too many special cases for it. Also,
|
|
2901 ;;; in normal coding it's rarely typed after a word.
|
|
2902 (global-set-key " " 'completion-separator-self-insert-autofilling)
|
|
2903 (global-set-key "!" 'completion-separator-self-insert-command)
|
|
2904 (global-set-key "%" 'completion-separator-self-insert-command)
|
|
2905 (global-set-key "^" 'completion-separator-self-insert-command)
|
|
2906 (global-set-key "&" 'completion-separator-self-insert-command)
|
|
2907 (global-set-key "(" 'completion-separator-self-insert-command)
|
|
2908 (global-set-key ")" 'completion-separator-self-insert-command)
|
|
2909 (global-set-key "=" 'completion-separator-self-insert-command)
|
|
2910 (global-set-key "`" 'completion-separator-self-insert-command)
|
|
2911 (global-set-key "|" 'completion-separator-self-insert-command)
|
|
2912 (global-set-key "{" 'completion-separator-self-insert-command)
|
|
2913 (global-set-key "}" 'completion-separator-self-insert-command)
|
|
2914 (global-set-key "[" 'completion-separator-self-insert-command)
|
|
2915 (global-set-key "]" 'completion-separator-self-insert-command)
|
|
2916 (global-set-key ";" 'completion-separator-self-insert-command)
|
|
2917 (global-set-key "\"" 'completion-separator-self-insert-command)
|
|
2918 (global-set-key "'" 'completion-separator-self-insert-command)
|
|
2919 (global-set-key "#" 'completion-separator-self-insert-command)
|
|
2920 (global-set-key "," 'completion-separator-self-insert-command)
|
|
2921 (global-set-key "?" 'completion-separator-self-insert-command)
|
|
2922
|
|
2923 ;;; We include period and colon even though they are symbol chars because :
|
|
2924 ;;; - in text we want to pick up the last word in a sentence.
|
|
2925 ;;; - in C pointer refs. we want to pick up the first symbol
|
|
2926 ;;; - it won't make a difference for lisp mode (package names are short)
|
|
2927 (global-set-key "." 'completion-separator-self-insert-command)
|
|
2928 (global-set-key ":" 'completion-separator-self-insert-command)
|
|
2929
|
|
2930 ;;; Lisp Mode diffs
|
|
2931 (define-key lisp-mode-map "!" 'self-insert-command)
|
|
2932 (define-key lisp-mode-map "&" 'self-insert-command)
|
|
2933 (define-key lisp-mode-map "%" 'self-insert-command)
|
|
2934 (define-key lisp-mode-map "?" 'self-insert-command)
|
|
2935 (define-key lisp-mode-map "=" 'self-insert-command)
|
|
2936 (define-key lisp-mode-map "^" 'self-insert-command)
|
|
2937
|
|
2938 ;;; C mode diffs.
|
|
2939 (def-completion-wrapper electric-c-semi :separator)
|
|
2940 (define-key c-mode-map "+" 'completion-separator-self-insert-command)
|
|
2941 (define-key c-mode-map "*" 'completion-separator-self-insert-command)
|
|
2942 (define-key c-mode-map "/" 'completion-separator-self-insert-command)
|
|
2943
|
|
2944 ;;; FORTRAN mode diffs. (these are defined when fortran is called)
|
|
2945 (defun completion-setup-fortran-mode ()
|
|
2946 (define-key fortran-mode-map "+" 'completion-separator-self-insert-command)
|
|
2947 (define-key fortran-mode-map "-" 'completion-separator-self-insert-command)
|
|
2948 (define-key fortran-mode-map "*" 'completion-separator-self-insert-command)
|
|
2949 (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)
|
|
2950 )
|
|
2951
|
|
2952 ;;;-----------------------------------------------
|
|
2953 ;;; End of line chars.
|
|
2954 ;;;-----------------------------------------------
|
|
2955 (def-completion-wrapper newline :separator)
|
|
2956 (def-completion-wrapper newline-and-indent :separator)
|
|
2957 (if (function-defined-and-loaded 'shell-send-input)
|
|
2958 (def-completion-wrapper shell-send-input :separator))
|
|
2959 (def-completion-wrapper exit-minibuffer :minibuffer-separator)
|
|
2960 (def-completion-wrapper eval-print-last-sexp :separator)
|
|
2961 (def-completion-wrapper eval-last-sexp :separator)
|
|
2962 ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
|
|
2963
|
|
2964 ;;;-----------------------------------------------
|
|
2965 ;;; Cursor movement
|
|
2966 ;;;-----------------------------------------------
|
|
2967
|
|
2968 (def-completion-wrapper next-line :under-or-before)
|
|
2969 (def-completion-wrapper previous-line :under-or-before)
|
|
2970 (def-completion-wrapper beginning-of-buffer :under-or-before)
|
|
2971 (def-completion-wrapper end-of-buffer :under-or-before)
|
|
2972
|
|
2973 ;; we patch these explicitly so they byte compile and so we don't have to
|
|
2974 ;; patch the faster underlying function.
|
|
2975
|
|
2976 (defun cmpl-beginning-of-line (&optional n)
|
|
2977 "Move point to beginning of current line.\n\
|
|
2978 With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
|
|
2979 If scan reaches end of buffer, stop there without error."
|
|
2980 (interactive "p")
|
|
2981 (use-completion-under-or-before-point)
|
|
2982 (beginning-of-line n)
|
|
2983 )
|
|
2984
|
|
2985 (defun cmpl-end-of-line (&optional n)
|
|
2986 "Move point to end of current line.\n\
|
|
2987 With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
|
|
2988 If scan reaches end of buffer, stop there without error."
|
|
2989 (interactive "p")
|
|
2990 (use-completion-under-or-before-point)
|
|
2991 (end-of-line n)
|
|
2992 )
|
|
2993
|
|
2994 (defun cmpl-forward-char (n)
|
|
2995 "Move point right ARG characters (left if ARG negative).\n\
|
|
2996 On reaching end of buffer, stop and signal error."
|
|
2997 (interactive "p")
|
|
2998 (use-completion-under-or-before-point)
|
|
2999 (forward-char n)
|
|
3000 )
|
|
3001 (defun cmpl-backward-char (n)
|
|
3002 "Move point left ARG characters (right if ARG negative).\n\
|
|
3003 On attempt to pass beginning or end of buffer, stop and signal error."
|
|
3004 (interactive "p")
|
|
3005 (use-completion-under-point)
|
|
3006 (if (eq last-command 'complete)
|
|
3007 ;; probably a failed completion if you have to back up
|
|
3008 (cmpl-statistics-block (record-complete-failed)))
|
|
3009 (backward-char n)
|
|
3010 )
|
|
3011
|
|
3012 (defun cmpl-forward-word (n)
|
|
3013 "Move point forward ARG words (backward if ARG is negative).\n\
|
|
3014 Normally returns t.\n\
|
|
3015 If an edge of the buffer is reached, point is left there\n\
|
|
3016 and nil is returned."
|
|
3017 (interactive "p")
|
|
3018 (use-completion-under-or-before-point)
|
|
3019 (forward-word n)
|
|
3020 )
|
|
3021 (defun cmpl-backward-word (n)
|
|
3022 "Move backward until encountering the end of a word.
|
|
3023 With argument, do this that many times.
|
|
3024 In programs, it is faster to call forward-word with negative arg."
|
|
3025 (interactive "p")
|
|
3026 (use-completion-under-point)
|
|
3027 (if (eq last-command 'complete)
|
|
3028 ;; probably a failed completion if you have to back up
|
|
3029 (cmpl-statistics-block (record-complete-failed)))
|
|
3030 (forward-word (- n))
|
|
3031 )
|
|
3032
|
|
3033 (defun cmpl-forward-sexp (n)
|
|
3034 "Move forward across one balanced expression.
|
|
3035 With argument, do this that many times."
|
|
3036 (interactive "p")
|
|
3037 (use-completion-under-or-before-point)
|
|
3038 (forward-sexp n)
|
|
3039 )
|
|
3040 (defun cmpl-backward-sexp (n)
|
|
3041 "Move backward across one balanced expression.
|
|
3042 With argument, do this that many times."
|
|
3043 (interactive "p")
|
|
3044 (use-completion-under-point)
|
|
3045 (if (eq last-command 'complete)
|
|
3046 ;; probably a failed completion if you have to back up
|
|
3047 (cmpl-statistics-block (record-complete-failed)))
|
|
3048 (backward-sexp n)
|
|
3049 )
|
|
3050
|
|
3051 (defun cmpl-delete-backward-char (n killflag)
|
|
3052 "Delete the previous ARG characters (following, with negative ARG).\n\
|
|
3053 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
|
|
3054 Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
|
|
3055 ARG was explicitly specified."
|
|
3056 (interactive "p\nP")
|
|
3057 (if (eq last-command 'complete)
|
|
3058 ;; probably a failed completion if you have to back up
|
|
3059 (cmpl-statistics-block (record-complete-failed)))
|
|
3060 (delete-backward-char n killflag)
|
|
3061 )
|
|
3062
|
|
3063 (defvar $$$cmpl-old-backward-delete-char-untabify
|
|
3064 (symbol-function 'backward-delete-char-untabify))
|
|
3065
|
|
3066 (defun backward-delete-char-untabify (arg &optional killp)
|
|
3067 "Delete characters backward, changing tabs into spaces.
|
|
3068 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
|
|
3069 Interactively, ARG is the prefix arg (default 1)
|
|
3070 and KILLP is t if prefix arg is was specified."
|
|
3071 (interactive "*p\nP")
|
|
3072 (if (eq last-command 'complete)
|
|
3073 ;; probably a failed completion if you have to back up
|
|
3074 (cmpl-statistics-block (record-complete-failed)))
|
|
3075 (funcall $$$cmpl-old-backward-delete-char-untabify arg killp)
|
|
3076 )
|
|
3077
|
|
3078
|
|
3079 (global-set-key "\C-?" 'cmpl-delete-backward-char)
|
|
3080 (global-set-key "\M-\C-F" 'cmpl-forward-sexp)
|
|
3081 (global-set-key "\M-\C-B" 'cmpl-backward-sexp)
|
|
3082 (global-set-key "\M-F" 'cmpl-forward-word)
|
|
3083 (global-set-key "\M-B" 'cmpl-backward-word)
|
|
3084 (global-set-key "\C-F" 'cmpl-forward-char)
|
|
3085 (global-set-key "\C-B" 'cmpl-backward-char)
|
|
3086 (global-set-key "\C-A" 'cmpl-beginning-of-line)
|
|
3087 (global-set-key "\C-E" 'cmpl-end-of-line)
|
|
3088
|
|
3089 ;;;-----------------------------------------------
|
|
3090 ;;; Misc.
|
|
3091 ;;;-----------------------------------------------
|
|
3092
|
|
3093 (def-completion-wrapper electric-buffer-list :under-or-before)
|
|
3094 (def-completion-wrapper list-buffers :under-or-before)
|
|
3095 (def-completion-wrapper scroll-up :under-or-before)
|
|
3096 (def-completion-wrapper scroll-down :under-or-before)
|
|
3097 (def-completion-wrapper execute-extended-command
|
|
3098 :under-or-before)
|
|
3099 (def-completion-wrapper other-window :under-or-before)
|
|
3100
|
|
3101 ;;;-----------------------------------------------
|
|
3102 ;;; Local Thinking Machines stuff
|
|
3103 ;;;-----------------------------------------------
|
|
3104
|
|
3105 (if (fboundp 'up-ten-lines)
|
|
3106 (def-completion-wrapper up-ten-lines :under-or-before))
|
|
3107 (if (fboundp 'down-ten-lines)
|
|
3108 (def-completion-wrapper down-ten-lines :under-or-before))
|
|
3109 (if (fboundp 'tmc-scroll-up)
|
|
3110 (def-completion-wrapper tmc-scroll-up :under-or-before))
|
|
3111 (if (fboundp 'tmc-scroll-down)
|
|
3112 (def-completion-wrapper tmc-scroll-down :under-or-before))
|
|
3113 (if (fboundp 'execute-extended-command-and-check-for-bindings)
|
|
3114 (def-completion-wrapper execute-extended-command-and-check-for-bindings
|
|
3115 :under-or-before))
|
|
3116
|
|
3117 ;;; Tests --
|
|
3118 ;;; foobarbiz
|
|
3119 ;;; foobar
|
|
3120 ;;; fooquux
|
|
3121 ;;; fooper
|
|
3122
|
|
3123 (cmpl-statistics-block
|
|
3124 (record-completion-file-loaded))
|