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