Mercurial > hg > xemacs-beta

comparison lisp/packages/completion.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; completion.el --- dynamic word-completion code 1 ;;; completion.el --- dynamic word-completion code
2
2 ;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc. 3 ;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc.
3 4
4 ;; Maintainer: FSF 5 ;; Maintainer: FSF
5 ;; Keywords: abbrev 6 ;; Keywords: abbrev
6 ;; Author: Jim Salem <salem@think.com> of Thinking Machines Inc. 7 ;; Author: Jim Salem <salem@bbnplanet.com> of Thinking Machines Inc.
7 ;; (ideas suggested by Brewster Kahle) 8 ;; (ideas suggested by Brewster Kahle)
8 9
9 ;; This file is part of GNU Emacs. 10 ;; This file is part of XEmacs.
10 11
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; it under the terms of the GNU General Public License as published by 13 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option) 14 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version. 15 ;; any later version.
15 16
16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; GNU General Public License for more details. 20 ;; General Public License for more details.
20 21
21 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 25 ;; 02111-1307, USA.
25 ;;; Synched up with: FSF 19.30. 26
27 ;;; Synched up with: FSF 19.34.
26 28
27 ;;; Commentary: 29 ;;; Commentary:
28 ;;; 30
29 ;;; What to put in .emacs 31 ;; What to put in .emacs
30 ;;;----------------------- 32 ;;-----------------------
31 ;;; (load "completion") 33 ;; (load "completion")
32 ;;; (initialize-completions) 34 ;; (initialize-completions)
33 35
34 ;;;--------------------------------------------------------------------------- 36 ;;---------------------------------------------------------------------------
35 ;;; Documentation [Slightly out of date] 37 ;; Documentation [Slightly out of date]
36 ;;;--------------------------------------------------------------------------- 38 ;;---------------------------------------------------------------------------
37 ;;; (also check the documentation string of the functions) 39 ;; (also check the documentation string of the functions)
38 ;;; 40 ;;
39 ;;; Introduction 41 ;; Introduction
40 ;;;--------------- 42 ;;---------------
41 ;;; 43 ;;
42 ;;; After you type a few characters, pressing the "complete" key inserts 44 ;; After you type a few characters, pressing the "complete" key inserts
43 ;;; the rest of the word you are likely to type. 45 ;; the rest of the word you are likely to type.
44 ;;; 46 ;;
45 ;;; This watches all the words that you type and remembers them. When 47 ;; This watches all the words that you type and remembers them. When
46 ;;; typing a new word, pressing "complete" (meta-return) "completes" the 48 ;; typing a new word, pressing "complete" (meta-return) "completes" the
47 ;;; word by inserting the most recently used word that begins with the 49 ;; word by inserting the most recently used word that begins with the
48 ;;; same characters. If you press meta-return repeatedly, it cycles 50 ;; same characters. If you press meta-return repeatedly, it cycles
49 ;;; through all the words it knows about. 51 ;; through all the words it knows about.
50 ;;; 52 ;;
51 ;;; If you like the completion then just continue typing, it is as if you 53 ;; If you like the completion then just continue typing, it is as if you
52 ;;; entered the text by hand. If you want the inserted extra characters 54 ;; entered the text by hand. If you want the inserted extra characters
53 ;;; to go away, type control-w or delete. More options are described below. 55 ;; to go away, type control-w or delete. More options are described below.
54 ;;; 56 ;;
55 ;;; The guesses are made in the order of the most recently "used". Typing 57 ;; The guesses are made in the order of the most recently "used". Typing
56 ;;; in a word and then typing a separator character (such as a space) "uses" 58 ;; in a word and then typing a separator character (such as a space) "uses"
57 ;;; the word. So does moving a cursor over the word. If no words are found, 59 ;; the word. So does moving a cursor over the word. If no words are found,
58 ;;; it uses an extended version of the dabbrev style completion. 60 ;; it uses an extended version of the dabbrev style completion.
59 ;;; 61 ;;
60 ;;; You automatically save the completions you use to a file between 62 ;; You automatically save the completions you use to a file between
61 ;;; sessions. 63 ;; sessions.
62 ;;; 64 ;;
63 ;;; Completion enables programmers to enter longer, more descriptive 65 ;; Completion enables programmers to enter longer, more descriptive
64 ;;; variable names while typing fewer keystrokes than they normally would. 66 ;; variable names while typing fewer keystrokes than they normally would.
65 ;;; 67 ;;
66 ;;; 68 ;;
67 ;;; Full documentation 69 ;; Full documentation
68 ;;;--------------------- 70 ;;---------------------
69 ;;; 71 ;;
70 ;;; A "word" is any string containing characters with either word or symbol 72 ;; A "word" is any string containing characters with either word or symbol
71 ;;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.] 73 ;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.]
72 ;;; Unless you change the constants, you must type at least three characters 74 ;; Unless you change the constants, you must type at least three characters
73 ;;; for the word to be recognized. Only words longer than 6 characters are 75 ;; for the word to be recognized. Only words longer than 6 characters are
74 ;;; saved. 76 ;; saved.
75 ;;; 77 ;;
76 ;;; When you load this file, completion will be on. I suggest you use the 78 ;; When you load this file, completion will be on. I suggest you use the
77 ;;; compiled version (because it is noticeably faster). 79 ;; compiled version (because it is noticeably faster).
78 ;;; 80 ;;
79 ;;; M-X completion-mode toggles whether or not new words are added to the 81 ;; M-X completion-mode toggles whether or not new words are added to the
80 ;;; database by changing the value of enable-completion. 82 ;; database by changing the value of enable-completion.
81 ;;; 83 ;;
82 ;;; SAVING/LOADING COMPLETIONS 84 ;; SAVING/LOADING COMPLETIONS
83 ;;; Completions are automatically saved from one session to another 85 ;; Completions are automatically saved from one session to another
84 ;;; (unless save-completions-flag or enable-completion is nil). 86 ;; (unless save-completions-flag or enable-completion is nil).
85 ;;; Loading this file (or calling initialize-completions) causes EMACS 87 ;; Loading this file (or calling initialize-completions) causes EMACS
86 ;;; to load a completions database for a saved completions file 88 ;; to load a completions database for a saved completions file
87 ;;; (default: ~/.completions). When you exit, EMACS saves a copy of the 89 ;; (default: ~/.completions). When you exit, EMACS saves a copy of the
88 ;;; completions that you 90 ;; completions that you
89 ;;; often use. When you next start, EMACS loads in the saved completion file. 91 ;; often use. When you next start, EMACS loads in the saved completion file.
90 ;;; 92 ;;
91 ;;; The number of completions saved depends loosely on 93 ;; The number of completions saved depends loosely on
92 ;;; *saved-completions-decay-factor*. Completions that have never been 94 ;; *saved-completions-decay-factor*. Completions that have never been
93 ;;; inserted via "complete" are not saved. You are encouraged to experiment 95 ;; inserted via "complete" are not saved. You are encouraged to experiment
94 ;;; with different functions (see compute-completion-min-num-uses). 96 ;; with different functions (see compute-completion-min-num-uses).
95 ;;; 97 ;;
96 ;;; Some completions are permanent and are always saved out. These 98 ;; Some completions are permanent and are always saved out. These
97 ;;; completions have their num-uses slot set to T. Use 99 ;; completions have their num-uses slot set to T. Use
98 ;;; add-permanent-completion to do this 100 ;; add-permanent-completion to do this
99 ;;; 101 ;;
100 ;;; Completions are saved only if enable-completion is T. The number of old 102 ;; Completions are saved only if enable-completion is T. The number of old
101 ;;; versions kept of the saved completions file is controlled by 103 ;; versions kept of the saved completions file is controlled by
102 ;;; completions-file-versions-kept. 104 ;; completions-file-versions-kept.
103 ;;; 105 ;;
104 ;;; COMPLETE KEY OPTIONS 106 ;; COMPLETE KEY OPTIONS
105 ;;; The complete function takes a numeric arguments. 107 ;; The complete function takes a numeric arguments.
106 ;;; control-u :: leave the point at the beginning of the completion rather 108 ;; control-u :: leave the point at the beginning of the completion rather
107 ;;; than the middle. 109 ;; than the middle.
108 ;;; a number :: rotate through the possible completions by that amount 110 ;; a number :: rotate through the possible completions by that amount
109 ;;; `-' :: same as -1 (insert previous completion) 111 ;; `-' :: same as -1 (insert previous completion)
110 ;;; 112 ;;
111 ;;; HOW THE DATABASE IS MAINTAINED 113 ;; HOW THE DATABASE IS MAINTAINED
112 ;;; <write> 114 ;; <write>
113 ;;; 115 ;;
114 ;;; UPDATING THE DATABASE MANUALLY 116 ;; UPDATING THE DATABASE MANUALLY
115 ;;; m-x kill-completion 117 ;; m-x kill-completion
116 ;;; kills the completion at point. 118 ;; kills the completion at point.
117 ;;; m-x add-completion 119 ;; m-x add-completion
118 ;;; m-x add-permanent-completion 120 ;; m-x add-permanent-completion
119 ;;; 121 ;;
120 ;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE 122 ;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
121 ;;; m-x add-completions-from-buffer 123 ;; m-x add-completions-from-buffer
122 ;;; Parses all the definition names from a C or LISP mode buffer and 124 ;; Parses all the definition names from a C or LISP mode buffer and
123 ;;; adds them to the completion database. 125 ;; adds them to the completion database.
124 ;;; 126 ;;
125 ;;; m-x add-completions-from-lisp-file 127 ;; m-x add-completions-from-lisp-file
126 ;;; Parses all the definition names from a C or Lisp mode file and 128 ;; Parses all the definition names from a C or Lisp mode file and
127 ;;; adds them to the completion database. 129 ;; adds them to the completion database.
128 ;;; 130 ;;
129 ;;; UPDATING THE DATABASE FROM A TAGS TABLE 131 ;; UPDATING THE DATABASE FROM A TAGS TABLE
130 ;;; m-x add-completions-from-tags-table 132 ;; m-x add-completions-from-tags-table
131 ;;; Adds completions from the current tags-table-buffer. 133 ;; Adds completions from the current tags-table-buffer.
132 ;;; 134 ;;
133 ;;; HOW A COMPLETION IS FOUND 135 ;; HOW A COMPLETION IS FOUND
134 ;;; <write> 136 ;; <write>
135 ;;; 137 ;;
136 ;;; STRING CASING 138 ;; STRING CASING
137 ;;; Completion is string case independent if case-fold-search has its 139 ;; Completion is string case independent if case-fold-search has its
138 ;;; normal default of T. Also when the completion is inserted the case of the 140 ;; normal default of T. Also when the completion is inserted the case of the
139 ;;; entry is coerced appropriately. 141 ;; entry is coerced appropriately.
140 ;;; [E.G. APP --> APPROPRIATELY app --> appropriately 142 ;; [E.G. APP --> APPROPRIATELY app --> appropriately
141 ;;; App --> Appropriately] 143 ;; App --> Appropriately]
142 ;;; 144 ;;
143 ;;; INITIALIZATION 145 ;; INITIALIZATION
144 ;;; The form `(initialize-completions)' initializes the completion system by 146 ;; The form `(initialize-completions)' initializes the completion system by
145 ;;; trying to load in the user's completions. After the first cal, further 147 ;; trying to load in the user's completions. After the first cal, further
146 ;;; calls have no effect so one should be careful not to put the form in a 148 ;; calls have no effect so one should be careful not to put the form in a
147 ;;; site's standard site-init file. 149 ;; site's standard site-init file.
148 ;;; 150 ;;
149 ;;;--------------------------------------------------------------------------- 151 ;;---------------------------------------------------------------------------
150 ;;; 152 ;;
151 ;;; 153 ;;
152 154
153 ;;;--------------------------------------------------------------------------- 155 ;;---------------------------------------------------------------------------
154 ;;; Functions you might like to call 156 ;; Functions you might like to call
155 ;;;--------------------------------------------------------------------------- 157 ;;---------------------------------------------------------------------------
156 ;;; 158 ;;
157 ;;; add-completion string &optional num-uses 159 ;; add-completion string &optional num-uses
158 ;;; Adds a new string to the database 160 ;; Adds a new string to the database
159 ;;; 161 ;;
160 ;;; add-permanent-completion string 162 ;; add-permanent-completion string
161 ;;; Adds a new string to the database with num-uses = T 163 ;; Adds a new string to the database with num-uses = T
162 ;;; 164 ;;
163 165
164 ;;; kill-completion string 166 ;; kill-completion string
165 ;;; Kills the completion from the database. 167 ;; Kills the completion from the database.
166 ;;; 168 ;;
167 ;;; clear-all-completions 169 ;; clear-all-completions
168 ;;; Clears the database 170 ;; Clears the database
169 ;;; 171 ;;
170 ;;; list-all-completions 172 ;; list-all-completions
171 ;;; Returns a list of all completions. 173 ;; Returns a list of all completions.
172 ;;; 174 ;;
173 ;;; 175 ;;
174 ;;; next-completion string &optional index 176 ;; next-completion string &optional index
175 ;;; Returns a completion entry that starts with string. 177 ;; Returns a completion entry that starts with string.
176 ;;; 178 ;;
177 ;;; find-exact-completion string 179 ;; find-exact-completion string
178 ;;; Returns a completion entry that exactly matches string. 180 ;; Returns a completion entry that exactly matches string.
179 ;;; 181 ;;
180 ;;; complete 182 ;; complete
181 ;;; Inserts a completion at point 183 ;; Inserts a completion at point
182 ;;; 184 ;;
183 ;;; initialize-completions 185 ;; initialize-completions
184 ;;; Loads the completions file and sets up so that exiting emacs will 186 ;; Loads the completions file and sets up so that exiting emacs will
185 ;;; save them. 187 ;; save them.
186 ;;; 188 ;;
187 ;;; save-completions-to-file &optional filename 189 ;; save-completions-to-file &optional filename
188 ;;; load-completions-from-file &optional filename 190 ;; load-completions-from-file &optional filename
189 ;;; 191 ;;
190 ;;;----------------------------------------------- 192 ;;-----------------------------------------------
191 ;;; Other functions 193 ;; Other functions
192 ;;;----------------------------------------------- 194 ;;-----------------------------------------------
193 ;;; 195 ;;
194 ;;; get-completion-list string 196 ;; get-completion-list string
195 ;;; 197 ;;
196 ;;; These things are for manipulating the structure 198 ;; These things are for manipulating the structure
197 ;;; make-completion string num-uses 199 ;; make-completion string num-uses
198 ;;; completion-num-uses completion 200 ;; completion-num-uses completion
199 ;;; completion-string completion 201 ;; completion-string completion
200 ;;; set-completion-num-uses completion num-uses 202 ;; set-completion-num-uses completion num-uses
201 ;;; set-completion-string completion string 203 ;; set-completion-string completion string
202 ;;; 204 ;;
203 ;;; 205 ;;
204 206
205 ;;;----------------------------------------------- 207 ;;-----------------------------------------------
206 ;;; To Do :: (anybody ?) 208 ;; To Do :: (anybody ?)
207 ;;;----------------------------------------------- 209 ;;-----------------------------------------------
208 ;;; 210 ;;
209 ;;; Implement Lookup and keyboard interface in C 211 ;; Implement Lookup and keyboard interface in C
210 ;;; Add package prefix smarts (for Common Lisp) 212 ;; Add package prefix smarts (for Common Lisp)
211 ;;; Add autoprompting of possible completions after every keystroke (fast 213 ;; Add autoprompting of possible completions after every keystroke (fast
212 ;;; terminals only !) 214 ;; terminals only !)
213 ;;; Add doc. to texinfo 215 ;; Add doc. to texinfo
214 ;;; 216 ;;
215 ;;; 217 ;;
216 ;;;----------------------------------------------- 218 ;;-----------------------------------------------
217 ;;; Change Log: 219 ;;; Change Log:
218 ;;;----------------------------------------------- 220 ;;-----------------------------------------------
219 ;;; Sometime in '84 Brewster implemented a somewhat buggy version for 221 ;; Sometime in '84 Brewster implemented a somewhat buggy version for
220 ;;; Symbolics LISPMs. 222 ;; Symbolics LISPMs.
221 ;;; Jan. '85 Jim became enamored of the idea and implemented a faster, 223 ;; Jan. '85 Jim became enamored of the idea and implemented a faster,
222 ;;; more robust version. 224 ;; more robust version.
223 ;;; With input from many users at TMC, (rose, craig, and gls come to mind), 225 ;; With input from many users at TMC, (rose, craig, and gls come to mind),
224 ;;; the current style of interface was developed. 226 ;; the current style of interface was developed.
225 ;;; 9/87, Jim and Brewster took terminals home. Yuck. After 227 ;; 9/87, Jim and Brewster took terminals home. Yuck. After
226 ;;; complaining for a while Brewester implemented a subset of the current 228 ;; complaining for awhile Brewster implemented a subset of the current
227 ;;; LISPM version for GNU Emacs. 229 ;; LISPM version for GNU Emacs.
228 ;;; 8/88 After complaining for a while (and with sufficient 230 ;; 8/88 After complaining for a while (and with sufficient
229 ;;; promised rewards), Jim reimplemented a version of GNU completion 231 ;; promised rewards), Jim reimplemented a version of GNU completion
230 ;;; superior to that of the LISPM version. 232 ;; superior to that of the LISPM version.
231 ;;; 233 ;;
232 ;;;----------------------------------------------- 234 ;;-----------------------------------------------
233 ;;; Acknowledgements 235 ;; Acknowledgements
234 ;;;----------------------------------------------- 236 ;;-----------------------------------------------
235 ;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), 237 ;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
236 ;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, 238 ;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
237 ;;; 239 ;;
238 ;;;----------------------------------------------- 240 ;;-----------------------------------------------
239 ;;; Change Log 241 ;; Change Log
240 ;;;----------------------------------------------- 242 ;;-----------------------------------------------
241 ;;; From version 9 to 10 243 ;; From version 9 to 10
242 ;;; - Allowance for non-integral *completion-version* nos. 244 ;; - Allowance for non-integral *completion-version* nos.
243 ;;; - Fix cmpl-apply-as-top-level for keyboard macros 245 ;; - Fix cmpl-apply-as-top-level for keyboard macros
244 ;;; - Fix broken completion merging (in save-completions-to-file) 246 ;; - Fix broken completion merging (in save-completions-to-file)
245 ;;; - More misc. fixes for version 19.0 of emacs 247 ;; - More misc. fixes for version 19.0 of emacs
246 ;;; 248 ;;
247 ;;; From Version 8 to 9 249 ;; From Version 8 to 9
248 ;;; - Ported to version 19.0 of emacs (backcompatible with version 18) 250 ;; - Ported to version 19.0 of emacs (backcompatible with version 18)
249 ;;; - Added add-completions-from-tags-table (with thanks to eero@media-lab) 251 ;; - Added add-completions-from-tags-table (with thanks to eero@media-lab)
250 ;;; 252 ;;
251 ;;; From Version 7 to 8 253 ;; From Version 7 to 8
252 ;;; - Misc. changes to comments 254 ;; - Misc. changes to comments
253 ;;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e 255 ;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e
254 ;;; - cdabbrev now checks all the visible window buffers and the "other buffer" 256 ;; - cdabbrev now checks all the visible window buffers and the "other buffer"
255 ;;; - `%' is now a symbol character rather than a separator (except in C mode) 257 ;; - `%' is now a symbol character rather than a separator (except in C mode)
256 ;;; 258 ;;
257 ;;; From Version 6 to 7 259 ;; From Version 6 to 7
258 ;;; - Fixed bug with saving out .completion file the first time 260 ;; - Fixed bug with saving out .completion file the first time
259 ;;; 261 ;;
260 ;;; From Version 5 to 6 262 ;; From Version 5 to 6
261 ;;; - removed statistics recording 263 ;; - removed statistics recording
262 ;;; - reworked advise to handle autoloads 264 ;; - reworked advise to handle autoloads
263 ;;; - Fixed fortran mode support 265 ;; - Fixed fortran mode support
264 ;;; - Added new cursor motion triggers 266 ;; - Added new cursor motion triggers
265 ;;; 267 ;;
266 ;;; From Version 4 to 5 268 ;; From Version 4 to 5
267 ;;; - doesn't bother saving if nothing has changed 269 ;; - doesn't bother saving if nothing has changed
268 ;;; - auto-save if haven't used for a 1/2 hour 270 ;; - auto-save if haven't used for a 1/2 hour
269 ;;; - save period extended to two weeks 271 ;; - save period extended to two weeks
270 ;;; - minor fix to capitalization code 272 ;; - minor fix to capitalization code
271 ;;; - added *completion-auto-save-period* to variables recorded. 273 ;; - added *completion-auto-save-period* to variables recorded.
272 ;;; - added reenter protection to cmpl-record-statistics-filter 274 ;; - added reenter protection to cmpl-record-statistics-filter
273 ;;; - added backup protection to save-completions-to-file (prevents 275 ;; - added backup protection to save-completions-to-file (prevents
274 ;;; problems with disk full errors) 276 ;; problems with disk full errors)
275 277
276 ;;; Code: 278 ;;; Code:
277 279
278 ;;;--------------------------------------------------------------------------- 280 ;;---------------------------------------------------------------------------
279 ;;; User changeable parameters 281 ;; User changeable parameters
280 ;;;--------------------------------------------------------------------------- 282 ;;---------------------------------------------------------------------------
281 283
282 (defvar enable-completion t 284 (defvar enable-completion t
283 "*Non-nil means enable recording and saving of completions. 285 "*Non-nil means enable recording and saving of completions.
284 If nil, no new words added to the database or saved to the init file.") 286 If nil, no new words added to the database or saved to the init file.")
285 287
286 (defvar save-completions-flag t 288 (defvar save-completions-flag t
287 "*Non-nil means save most-used completions when exiting Emacs. 289 "*Non-nil means save most-used completions when exiting Emacs.
288 See also `saved-completions-retention-time'.") 290 See also `saved-completions-retention-time'.")
289 291
290 (defvar save-completions-file-name "~/.completions" 292 (defvar save-completions-file-name (convert-standard-filename "~/.completions")
291 "*The filename to save completions to.") 293 "*The filename to save completions to.")
292 294
293 (defvar save-completions-retention-time 336 295 (defvar save-completions-retention-time 336
294 "*Discard a completion if unused for this many hours. 296 "*Discard a completion if unused for this many hours.
295 \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions 297 \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
316 (defvar completions-merging-modes '(lisp c) 318 (defvar completions-merging-modes '(lisp c)
317 "*List of modes {`c' or `lisp'} for automatic completions merging. 319 "*List of modes {`c' or `lisp'} for automatic completions merging.
318 Definitions from visited files which have these modes 320 Definitions from visited files which have these modes
319 are automatically added to the completion database.") 321 are automatically added to the completion database.")
320 322
321 ;;;(defvar *record-cmpl-statistics-p* nil 323 ;;(defvar *record-cmpl-statistics-p* nil
322 ;;; "*If non-nil, record completion statistics.") 324 ;; "*If non-nil, record completion statistics.")
323 325
324 ;;;(defvar *completion-auto-save-period* 1800 326 ;;(defvar *completion-auto-save-period* 1800
325 ;;; "*The period in seconds to wait for emacs to be idle before autosaving 327 ;; "*The period in seconds to wait for emacs to be idle before autosaving
326 ;;;the completions. Default is a 1/2 hour.") 328 ;;the completions. Default is a 1/2 hour.")
327 329
328 (defconst completion-min-length nil ;; defined below in eval-when 330 (defconst completion-min-length nil ;; defined below in eval-when
329 "*The minimum length of a stored completion. 331 "*The minimum length of a stored completion.
330 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") 332 DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
331 333
374 (setq completion-max-length 200) 376 (setq completion-max-length 200)
375 (setq completion-prefix-min-length 3))) 377 (setq completion-prefix-min-length 3)))
376 378
377 (completion-eval-when) 379 (completion-eval-when)
378 380
379 ;;;--------------------------------------------------------------------------- 381 ;;---------------------------------------------------------------------------
380 ;;; Internal Variables 382 ;; Internal Variables
381 ;;;--------------------------------------------------------------------------- 383 ;;---------------------------------------------------------------------------
382 384
383 (defvar cmpl-initialized-p nil 385 (defvar cmpl-initialized-p nil
384 "Set to t when the completion system is initialized. 386 "Set to t when the completion system is initialized.
385 Indicates that the old completion file has been read in.") 387 Indicates that the old completion file has been read in.")
386 388
390 392
391 (defvar cmpl-preceding-syntax) 393 (defvar cmpl-preceding-syntax)
392 394
393 (defvar completion-string) 395 (defvar completion-string)
394 396
395 ;;;--------------------------------------------------------------------------- 397 ;;---------------------------------------------------------------------------
396 ;;; Low level tools 398 ;; Low level tools
397 ;;;--------------------------------------------------------------------------- 399 ;;---------------------------------------------------------------------------
398 400
399 ;;;----------------------------------------------- 401 ;;-----------------------------------------------
400 ;;; Misc. 402 ;; Misc.
401 ;;;----------------------------------------------- 403 ;;-----------------------------------------------
402 404
403 (defun minibuffer-window-selected-p () 405 (defun minibuffer-window-selected-p ()
404 "True iff the current window is the minibuffer." 406 "True iff the current window is the minibuffer."
405 (window-minibuffer-p (selected-window))) 407 (window-minibuffer-p (selected-window)))
406 408
407 ;; This used to be `(eval form)'. Eval FORM at run time now. 409 ;; This used to be `(eval form)'. Eval FORM at run time now.
408 (defmacro cmpl-read-time-eval (form) 410 (defmacro cmpl-read-time-eval (form)
409 form) 411 form)
410 412
411 ;;;----------------------------------------------- 413 ;;-----------------------------------------------
412 ;;; String case coercion 414 ;; String case coercion
413 ;;;----------------------------------------------- 415 ;;-----------------------------------------------
414 416
415 (defun cmpl-string-case-type (string) 417 (defun cmpl-string-case-type (string)
416 "Returns :capitalized, :up, :down, :mixed, or :neither." 418 "Returns :capitalized, :up, :down, :mixed, or :neither."
417 (let ((case-fold-search nil)) 419 (let ((case-fold-search nil))
418 (cond ((string-match "[a-z]" string) 420 (cond ((string-match "[a-z]" string)
427 (cond ((string-match "[A-Z]" string) 429 (cond ((string-match "[A-Z]" string)
428 ':up) 430 ':up)
429 (t ':neither)))) 431 (t ':neither))))
430 )) 432 ))
431 433
432 ;;; Tests - 434 ;; Tests -
433 ;;; (cmpl-string-case-type "123ABCDEF456") --> :up 435 ;; (cmpl-string-case-type "123ABCDEF456") --> :up
434 ;;; (cmpl-string-case-type "123abcdef456") --> :down 436 ;; (cmpl-string-case-type "123abcdef456") --> :down
435 ;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed 437 ;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
436 ;;; (cmpl-string-case-type "123456") --> :neither 438 ;; (cmpl-string-case-type "123456") --> :neither
437 ;;; (cmpl-string-case-type "Abcde123") --> :capitalized 439 ;; (cmpl-string-case-type "Abcde123") --> :capitalized
438 440
439 (defun cmpl-coerce-string-case (string case-type) 441 (defun cmpl-coerce-string-case (string case-type)
440 (cond ((eq case-type ':down) (downcase string)) 442 (cond ((eq case-type ':down) (downcase string))
441 ((eq case-type ':up) (upcase string)) 443 ((eq case-type ':up) (upcase string))
442 ((eq case-type ':capitalized) 444 ((eq case-type ':capitalized)
459 ;; If the found string is in some unusual case, just insert it 461 ;; If the found string is in some unusual case, just insert it
460 ;; as is 462 ;; as is
461 string-to-coerce) 463 string-to-coerce)
462 ))) 464 )))
463 465
464 ;;; Tests - 466 ;; Tests -
465 ;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 467 ;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
466 ;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 468 ;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
467 ;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 469 ;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
468 ;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 470 ;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
469 471
470 472
471 (defun cmpl-hours-since-origin () 473 (defun cmpl-hours-since-origin ()
472 (let ((time (current-time))) 474 (let ((time (current-time)))
473 (truncate 475 (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600)))
474 (+ (* (/ (car time) 3600.0) (lsh 1 16))
475 (/ (nth 2 time) 3600.0)))))
476 476
477 ;;;--------------------------------------------------------------------------- 477 ;;---------------------------------------------------------------------------
478 ;;; "Symbol" parsing functions 478 ;; "Symbol" parsing functions
479 ;;;--------------------------------------------------------------------------- 479 ;;---------------------------------------------------------------------------
480 ;;; The functions symbol-before-point, symbol-under-point, etc. quickly return 480 ;; The functions symbol-before-point, symbol-under-point, etc. quickly return
481 ;;; an appropriate symbol string. The strategy is to temporarily change 481 ;; an appropriate symbol string. The strategy is to temporarily change
482 ;;; the syntax table to enable fast symbol searching. There are three classes 482 ;; the syntax table to enable fast symbol searching. There are three classes
483 ;;; of syntax in these "symbol" syntax tables :: 483 ;; of syntax in these "symbol" syntax tables ::
484 ;;; 484 ;;
485 ;;; syntax (?_) - "symbol" chars (e.g. alphanumerics) 485 ;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
486 ;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). 486 ;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).
487 ;;; syntax (? ) - everything else 487 ;; syntax (? ) - everything else
488 ;;; 488 ;;
489 ;;; Thus by judicious use of scan-sexps and forward-word, we can get 489 ;; Thus by judicious use of scan-sexps and forward-word, we can get
490 ;;; the word we want relatively fast and without consing. 490 ;; the word we want relatively fast and without consing.
491 ;;; 491 ;;
492 ;;; Why do we need a separate category for "symbol chars to ignore at ends" ? 492 ;; Why do we need a separate category for "symbol chars to ignore at ends" ?
493 ;;; For example, in LISP we want starting :'s trimmed 493 ;; For example, in LISP we want starting :'s trimmed
494 ;;; so keyword argument specifiers also define the keyword completion. And, 494 ;; so keyword argument specifiers also define the keyword completion. And,
495 ;;; for example, in C we want `.' appearing in a structure ref. to 495 ;; for example, in C we want `.' appearing in a structure ref. to
496 ;;; be kept intact in order to store the whole structure ref.; however, if 496 ;; be kept intact in order to store the whole structure ref.; however, if
497 ;;; it appears at the end of a symbol it should be discarded because it is 497 ;; it appears at the end of a symbol it should be discarded because it is
498 ;;; probably used as a period. 498 ;; probably used as a period.
499 499
500 ;;; Here is the default completion syntax :: 500 ;; Here is the default completion syntax ::
501 ;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > % 501 ;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
502 ;;; Symbol chars to ignore at ends :: _ : . - 502 ;; Symbol chars to ignore at ends :: _ : . -
503 ;;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' # 503 ;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
504 ;;; , ? <Everything else> 504 ;; , ? <Everything else>
505 505
506 ;;; Mode specific differences and notes :: 506 ;; Mode specific differences and notes ::
507 ;;; LISP diffs -> 507 ;; LISP diffs ->
508 ;;; Symbol chars :: ! & ? = ^ 508 ;; Symbol chars :: ! & ? = ^
509 ;;; 509 ;;
510 ;;; C diffs -> 510 ;; C diffs ->
511 ;;; Separator chars :: + * / : % 511 ;; Separator chars :: + * / : %
512 ;;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator 512 ;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator
513 ;;; char., however, we wanted to have completion symbols include pointer 513 ;; char., however, we wanted to have completion symbols include pointer
514 ;;; references. For example, "foo->bar" is a symbol as far as completion is 514 ;; references. For example, "foo->bar" is a symbol as far as completion is
515 ;;; concerned. 515 ;; concerned.
516 ;;; 516 ;;
517 ;;; FORTRAN diffs -> 517 ;; FORTRAN diffs ->
518 ;;; Separator chars :: + - * / : 518 ;; Separator chars :: + - * / :
519 ;;; 519 ;;
520 ;;; Pathname diffs -> 520 ;; Pathname diffs ->
521 ;;; Symbol chars :: . 521 ;; Symbol chars :: .
522 ;;; Of course there is no pathname "mode" and in fact we have not implemented 522 ;; Of course there is no pathname "mode" and in fact we have not implemented
523 ;;; this table. However, if there was such a mode, this is what it would look 523 ;; this table. However, if there was such a mode, this is what it would look
524 ;;; like. 524 ;; like.
525 525
526 ;;;----------------------------------------------- 526 ;;-----------------------------------------------
527 ;;; Table definitions 527 ;; Table definitions
528 ;;;----------------------------------------------- 528 ;;-----------------------------------------------
529 529
530 (defun cmpl-make-standard-completion-syntax-table () 530 (defun cmpl-make-standard-completion-syntax-table ()
531 ;; XEmacs change: Left the original code alone. -sb
531 (let ((table (make-vector 256 0)) ;; default syntax is whitespace 532 (let ((table (make-vector 256 0)) ;; default syntax is whitespace
532 i) 533 i)
533 ;; alpha chars 534 ;; alpha chars
534 (setq i 0) 535 (setq i 0)
535 (while (< i 26) 536 (while (< i 26)
585 586
586 (defvar cmpl-syntax-table cmpl-standard-syntax-table 587 (defvar cmpl-syntax-table cmpl-standard-syntax-table
587 "This variable holds the current completion syntax table.") 588 "This variable holds the current completion syntax table.")
588 (make-variable-buffer-local 'cmpl-syntax-table) 589 (make-variable-buffer-local 'cmpl-syntax-table)
589 590
590 ;;;----------------------------------------------- 591 ;;-----------------------------------------------
591 ;;; Installing the appropriate mode tables 592 ;; Installing the appropriate mode tables
592 ;;;----------------------------------------------- 593 ;;-----------------------------------------------
593 594
594 (add-hook 'lisp-mode-hook 595 (add-hook 'lisp-mode-hook
595 '(lambda () 596 '(lambda ()
596 (setq cmpl-syntax-table cmpl-lisp-syntax-table))) 597 (setq cmpl-syntax-table cmpl-lisp-syntax-table)))
597 598
602 (add-hook 'fortran-mode-hook 603 (add-hook 'fortran-mode-hook
603 '(lambda () 604 '(lambda ()
604 (setq cmpl-syntax-table cmpl-fortran-syntax-table) 605 (setq cmpl-syntax-table cmpl-fortran-syntax-table)
605 (completion-setup-fortran-mode))) 606 (completion-setup-fortran-mode)))
606 607
607 ;;;----------------------------------------------- 608 ;;-----------------------------------------------
608 ;;; Symbol functions 609 ;; Symbol functions
609 ;;;----------------------------------------------- 610 ;;-----------------------------------------------
610 (defvar cmpl-symbol-start nil 611 (defvar cmpl-symbol-start nil
611 "Holds first character of symbol, after any completion symbol function.") 612 "Holds first character of symbol, after any completion symbol function.")
612 (defvar cmpl-symbol-end nil 613 (defvar cmpl-symbol-end nil
613 "Holds last character of symbol, after any completion symbol function.") 614 "Holds last character of symbol, after any completion symbol function.")
614 ;;; These are temp. vars. we use to avoid using let. 615 ;; These are temp. vars. we use to avoid using let.
615 ;;; Why ? Small speed improvement. 616 ;; Why ? Small speed improvement.
616 (defvar cmpl-saved-syntax nil) 617 (defvar cmpl-saved-syntax nil)
617 (defvar cmpl-saved-point nil) 618 (defvar cmpl-saved-point nil)
618 619
619 (defun symbol-under-point () 620 (defun symbol-under-point ()
620 "Returns the symbol that the point is currently on. 621 "Returns the symbol that the point is currently on.
621 But only if it is longer than `completion-min-length'." 622 But only if it is longer than `completion-min-length'."
622 (setq cmpl-saved-syntax (syntax-table)) 623 (setq cmpl-saved-syntax (syntax-table))
624 ;; XEmacs change
623 (set-syntax-table cmpl-syntax-table) 625 (set-syntax-table cmpl-syntax-table)
624 (cond 626 (cond
625 ;; Cursor is on following-char and after preceding-char 627 ;; Cursor is on following-char and after preceding-char
626 ((memq (char-syntax (following-char)) '(?w ?_)) 628 ((memq (char-syntax (following-char)) '(?w ?_))
627 (setq cmpl-saved-point (point) 629 (setq cmpl-saved-point (point)
654 ;; restore table if no symbol 656 ;; restore table if no symbol
655 (set-syntax-table cmpl-saved-syntax) 657 (set-syntax-table cmpl-saved-syntax)
656 nil) 658 nil)
657 )) 659 ))
658 660
659 ;;; tests for symbol-under-point 661 ;; tests for symbol-under-point
660 ;;; `^' indicates cursor pos. where value is returned 662 ;; `^' indicates cursor pos. where value is returned
661 ;;; simple-word-test 663 ;; simple-word-test
662 ;;; ^^^^^^^^^^^^^^^^ --> simple-word-test 664 ;; ^^^^^^^^^^^^^^^^ --> simple-word-test
663 ;;; _harder_word_test_ 665 ;; _harder_word_test_
664 ;;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test 666 ;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test
665 ;;; .___.______. 667 ;; .___.______.
666 ;;; --> nil 668 ;; --> nil
667 ;;; /foo/bar/quux.hello 669 ;; /foo/bar/quux.hello
668 ;;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello 670 ;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
669 ;;; 671 ;;
670 672
671 (defun symbol-before-point () 673 (defun symbol-before-point ()
672 "Returns a string of the symbol immediately before point. 674 "Returns a string of the symbol immediately before point.
673 Returns nil if there isn't one longer than `completion-min-length'." 675 Returns nil if there isn't one longer than `completion-min-length'."
674 ;; This is called when a word separator is typed so it must be FAST ! 676 ;; This is called when a word separator is typed so it must be FAST !
675 (setq cmpl-saved-syntax (syntax-table)) 677 (setq cmpl-saved-syntax (syntax-table))
678 ;; XEmacs change
676 (set-syntax-table cmpl-syntax-table) 679 (set-syntax-table cmpl-syntax-table)
677 ;; Cursor is on following-char and after preceding-char 680 ;; Cursor is on following-char and after preceding-char
678 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) 681 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
679 ;; No chars. to ignore at end 682 ;; No chars. to ignore at end
680 (setq cmpl-symbol-end (point) 683 (setq cmpl-symbol-end (point)
681 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) 684 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1)
682 ) 685 )
686 ;; XEmacs change
683 ;; remove chars to ignore at the start 687 ;; remove chars to ignore at the start
684 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 688 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
685 (goto-char cmpl-symbol-start) 689 (goto-char cmpl-symbol-start)
686 (forward-word 1) 690 (forward-word 1)
687 (setq cmpl-symbol-start (point)) 691 (setq cmpl-symbol-start (point))
722 ;; restore table if no symbol 726 ;; restore table if no symbol
723 (set-syntax-table cmpl-saved-syntax) 727 (set-syntax-table cmpl-saved-syntax)
724 nil) 728 nil)
725 )) 729 ))
726 730
727 ;;; tests for symbol-before-point 731 ;; tests for symbol-before-point
728 ;;; `^' indicates cursor pos. where value is returned 732 ;; `^' indicates cursor pos. where value is returned
729 ;;; simple-word-test 733 ;; simple-word-test
730 ;;; ^ --> nil 734 ;; ^ --> nil
731 ;;; ^ --> nil 735 ;; ^ --> nil
732 ;;; ^ --> simple-w 736 ;; ^ --> simple-w
733 ;;; ^ --> simple-word-test 737 ;; ^ --> simple-word-test
734 ;;; _harder_word_test_ 738 ;; _harder_word_test_
735 ;;; ^ --> harder_word_test 739 ;; ^ --> harder_word_test
736 ;;; ^ --> harder_word_test 740 ;; ^ --> harder_word_test
737 ;;; ^ --> harder 741 ;; ^ --> harder
738 ;;; .___.... 742 ;; .___....
739 ;;; --> nil 743 ;; --> nil
740 744
741 (defun symbol-under-or-before-point () 745 (defun symbol-under-or-before-point ()
742 ;;; This could be made slightly faster but it is better to avoid 746 ;; This could be made slightly faster but it is better to avoid
743 ;;; copying all the code. 747 ;; copying all the code.
744 ;;; However, it is only used by the completion string prompter. 748 ;; However, it is only used by the completion string prompter.
745 ;;; If it comes into common use, it could be rewritten. 749 ;; If it comes into common use, it could be rewritten.
750 ;; XEmacs change
746 (setq cmpl-saved-syntax (syntax-table)) 751 (setq cmpl-saved-syntax (syntax-table))
747 (set-syntax-table cmpl-syntax-table) 752 (set-syntax-table cmpl-syntax-table)
748 (cond ((memq (char-syntax (following-char)) '(?w ?_)) 753 (cond ((memq (char-syntax (following-char)) '(?w ?_))
749 (set-syntax-table cmpl-saved-syntax) 754 (set-syntax-table cmpl-saved-syntax)
750 (symbol-under-point)) 755 (symbol-under-point))
751 (t 756 (t
757 ;; XEmacs change
752 (set-syntax-table cmpl-saved-syntax) 758 (set-syntax-table cmpl-saved-syntax)
753 (symbol-before-point)) 759 (symbol-before-point))
754 )) 760 ))
755 761
756 762
758 ;; "Returns a string of the symbol immediately before point 764 ;; "Returns a string of the symbol immediately before point
759 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the 765 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the
760 ;; end chars." 766 ;; end chars."
761 ;; Cursor is on following-char and after preceding-char 767 ;; Cursor is on following-char and after preceding-char
762 (setq cmpl-saved-syntax (syntax-table)) 768 (setq cmpl-saved-syntax (syntax-table))
769 ;; XEmacs change
763 (set-syntax-table cmpl-syntax-table) 770 (set-syntax-table cmpl-syntax-table)
764 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) 771 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
765 '(?_ ?w)) 772 '(?_ ?w))
766 (setq cmpl-symbol-end (point) 773 (setq cmpl-symbol-end (point)
767 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) 774 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1)
787 ;; restore table if no symbol 794 ;; restore table if no symbol
788 (set-syntax-table cmpl-saved-syntax) 795 (set-syntax-table cmpl-saved-syntax)
789 nil) 796 nil)
790 )) 797 ))
791 798
792 ;;; tests for symbol-before-point-for-complete 799 ;; tests for symbol-before-point-for-complete
793 ;;; `^' indicates cursor pos. where value is returned 800 ;; `^' indicates cursor pos. where value is returned
794 ;;; simple-word-test 801 ;; simple-word-test
795 ;;; ^ --> nil 802 ;; ^ --> nil
796 ;;; ^ --> nil 803 ;; ^ --> nil
797 ;;; ^ --> simple-w 804 ;; ^ --> simple-w
798 ;;; ^ --> simple-word-test 805 ;; ^ --> simple-word-test
799 ;;; _harder_word_test_ 806 ;; _harder_word_test_
800 ;;; ^ --> harder_word_test 807 ;; ^ --> harder_word_test
801 ;;; ^ --> harder_word_test_ 808 ;; ^ --> harder_word_test_
802 ;;; ^ --> harder_ 809 ;; ^ --> harder_
803 ;;; .___.... 810 ;; .___....
804 ;;; --> nil 811 ;; --> nil
805 812
806 813
807 814
808 ;;;--------------------------------------------------------------------------- 815 ;;---------------------------------------------------------------------------
809 ;;; Statistics Recording 816 ;; Statistics Recording
810 ;;;--------------------------------------------------------------------------- 817 ;;---------------------------------------------------------------------------
811 818
812 ;;; Note that the guts of this has been turned off. The guts 819 ;; Note that the guts of this has been turned off. The guts
813 ;;; are in completion-stats.el. 820 ;; are in completion-stats.el.
814 821
815 ;;;----------------------------------------------- 822 ;;-----------------------------------------------
816 ;;; Conditionalizing code on *record-cmpl-statistics-p* 823 ;; Conditionalizing code on *record-cmpl-statistics-p*
817 ;;;----------------------------------------------- 824 ;;-----------------------------------------------
818 ;;; All statistics code outside this block should use this 825 ;; All statistics code outside this block should use this
819 (defmacro cmpl-statistics-block (&rest body)) 826 (defmacro cmpl-statistics-block (&rest body))
820 ;;; "Only executes body if we are recording statistics." 827 ;; "Only executes body if we are recording statistics."
821 ;;; (list 'cond 828 ;; (list 'cond
822 ;;; (list* '*record-cmpl-statistics-p* body) 829 ;; (list* '*record-cmpl-statistics-p* body)
823 ;;; )) 830 ;; ))
824 831
825 ;;;----------------------------------------------- 832 ;;-----------------------------------------------
826 ;;; Completion Sources 833 ;; Completion Sources
827 ;;;----------------------------------------------- 834 ;;-----------------------------------------------
828 835
829 ;; ID numbers 836 ;; ID numbers
830 (defconst cmpl-source-unknown 0) 837 (defconst cmpl-source-unknown 0)
831 (defconst cmpl-source-init-file 1) 838 (defconst cmpl-source-init-file 1)
832 (defconst cmpl-source-file-parsing 2) 839 (defconst cmpl-source-file-parsing 2)
837 (defconst num-cmpl-sources 7) 844 (defconst num-cmpl-sources 7)
838 (defvar current-completion-source cmpl-source-unknown) 845 (defvar current-completion-source cmpl-source-unknown)
839 846
840 847
841 848
842 ;;;--------------------------------------------------------------------------- 849 ;;---------------------------------------------------------------------------
843 ;;; Completion Method #2: dabbrev-expand style 850 ;; Completion Method #2: dabbrev-expand style
844 ;;;--------------------------------------------------------------------------- 851 ;;---------------------------------------------------------------------------
845 ;;; 852 ;;
846 ;;; This method is used if there are no useful stored completions. It is 853 ;; This method is used if there are no useful stored completions. It is
847 ;;; based on dabbrev-expand with these differences : 854 ;; based on dabbrev-expand with these differences :
848 ;;; 1) Faster (we don't use regexps) 855 ;; 1) Faster (we don't use regexps)
849 ;;; 2) case coercion handled correctly 856 ;; 2) case coercion handled correctly
850 ;;; This is called cdabbrev to differentiate it. 857 ;; This is called cdabbrev to differentiate it.
851 ;;; We simply search backwards through the file looking for words which 858 ;; We simply search backwards through the file looking for words which
852 ;;; start with the same letters we are trying to complete. 859 ;; start with the same letters we are trying to complete.
853 ;;; 860 ;;
854 861
855 (defvar cdabbrev-completions-tried nil) 862 (defvar cdabbrev-completions-tried nil)
856 ;;; "A list of all the cdabbrev completions since the last reset.") 863 ;; "A list of all the cdabbrev completions since the last reset.")
857 864
858 (defvar cdabbrev-current-point 0) 865 (defvar cdabbrev-current-point 0)
859 ;;; "The current point position the cdabbrev search is at.") 866 ;; "The current point position the cdabbrev search is at.")
860 867
861 (defvar cdabbrev-current-window nil) 868 (defvar cdabbrev-current-window nil)
862 ;;; "The current window we are looking for cdabbrevs in. T if looking in 869 ;; "The current window we are looking for cdabbrevs in. T if looking in
863 ;;; (other-buffer), NIL if no more cdabbrevs.") 870 ;; (other-buffer), NIL if no more cdabbrevs.")
864 871
865 (defvar cdabbrev-wrapped-p nil) 872 (defvar cdabbrev-wrapped-p nil)
866 ;;; "T if the cdabbrev search has wrapped around the file.") 873 ;; "T if the cdabbrev search has wrapped around the file.")
867 874
868 (defvar cdabbrev-abbrev-string "") 875 (defvar cdabbrev-abbrev-string "")
869 (defvar cdabbrev-start-point 0) 876 (defvar cdabbrev-start-point 0)
870 (defvar cdabbrev-stop-point) 877 (defvar cdabbrev-stop-point)
871 878
872 ;;; Test strings for cdabbrev 879 ;; Test strings for cdabbrev
873 ;;; cdat-upcase ;;same namestring 880 ;; cdat-upcase ;;same namestring
874 ;;; CDAT-UPCASE ;;ok 881 ;; CDAT-UPCASE ;;ok
875 ;;; cdat2 ;;too short 882 ;; cdat2 ;;too short
876 ;;; cdat-1-2-3-4 ;;ok 883 ;; cdat-1-2-3-4 ;;ok
877 ;;; a-cdat-1 ;;doesn't start correctly 884 ;; a-cdat-1 ;;doesn't start correctly
878 ;;; cdat-simple ;;ok 885 ;; cdat-simple ;;ok
879 886
880 887
881 (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) 888 (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried)
882 "Resets the cdabbrev search to search for abbrev-string. 889 "Resets the cdabbrev search to search for abbrev-string.
883 INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore 890 INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore
1012 ;; If no expansion, go to next window 1019 ;; If no expansion, go to next window
1013 (cond (expansion) 1020 (cond (expansion)
1014 (t (reset-cdabbrev-window) 1021 (t (reset-cdabbrev-window)
1015 (next-cdabbrev)))))) 1022 (next-cdabbrev))))))
1016 1023
1017 ;;; The following must be eval'd in the minibuffer :: 1024 ;; The following must be eval'd in the minibuffer ::
1018 ;;; (reset-cdabbrev "cdat") 1025 ;; (reset-cdabbrev "cdat")
1019 ;;; (next-cdabbrev) --> "cdat-simple" 1026 ;; (next-cdabbrev) --> "cdat-simple"
1020 ;;; (next-cdabbrev) --> "cdat-1-2-3-4" 1027 ;; (next-cdabbrev) --> "cdat-1-2-3-4"
1021 ;;; (next-cdabbrev) --> "CDAT-UPCASE" 1028 ;; (next-cdabbrev) --> "CDAT-UPCASE"
1022 ;;; (next-cdabbrev) --> "cdat-wrapping" 1029 ;; (next-cdabbrev) --> "cdat-wrapping"
1023 ;;; (next-cdabbrev) --> "cdat_start_sym" 1030 ;; (next-cdabbrev) --> "cdat_start_sym"
1024 ;;; (next-cdabbrev) --> nil 1031 ;; (next-cdabbrev) --> nil
1025 ;;; (next-cdabbrev) --> nil 1032 ;; (next-cdabbrev) --> nil
1026 ;;; (next-cdabbrev) --> nil 1033 ;; (next-cdabbrev) --> nil
1027 1034
1028 ;;; _cdat_start_sym 1035 ;; _cdat_start_sym
1029 ;;; cdat-wrapping 1036 ;; cdat-wrapping
1030 1037
1031 1038
1032 ;;;--------------------------------------------------------------------------- 1039 ;;---------------------------------------------------------------------------
1033 ;;; Completion Database 1040 ;; Completion Database
1034 ;;;--------------------------------------------------------------------------- 1041 ;;---------------------------------------------------------------------------
1035 1042
1036 ;;; We use two storage modes for the two search types :: 1043 ;; We use two storage modes for the two search types ::
1037 ;;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions 1044 ;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions
1038 ;;; Used by search-completion-next 1045 ;; Used by search-completion-next
1039 ;;; the value of the symbol is nil or a cons of head and tail pointers 1046 ;; the value of the symbol is nil or a cons of head and tail pointers
1040 ;;; 2) Interning {cmpl-obarray} to see if it's in the database 1047 ;; 2) Interning {cmpl-obarray} to see if it's in the database
1041 ;;; Used by find-exact-completion, completion-in-database-p 1048 ;; Used by find-exact-completion, completion-in-database-p
1042 ;;; The value of the symbol is the completion entry 1049 ;; The value of the symbol is the completion entry
1043 1050
1044 ;;; bad things may happen if this length is changed due to the way 1051 ;; bad things may happen if this length is changed due to the way
1045 ;;; GNU implements obarrays 1052 ;; GNU implements obarrays
1046 (defconst cmpl-obarray-length 511) 1053 (defconst cmpl-obarray-length 511)
1047 1054
1048 (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) 1055 (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
1049 "An obarray used to store the downcased completion prefixes. 1056 "An obarray used to store the downcased completion prefixes.
1050 Each symbol is bound to a list of completion entries.") 1057 Each symbol is bound to a list of completion entries.")
1051 1058
1052 (defvar cmpl-obarray (make-vector cmpl-obarray-length 0) 1059 (defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
1053 "An obarray used to store the downcased completions. 1060 "An obarray used to store the downcased completions.
1054 Each symbol is bound to a single completion entry.") 1061 Each symbol is bound to a single completion entry.")
1055 1062
1056 ;;;----------------------------------------------- 1063 ;;-----------------------------------------------
1057 ;;; Completion Entry Structure Definition 1064 ;; Completion Entry Structure Definition
1058 ;;;----------------------------------------------- 1065 ;;-----------------------------------------------
1059 1066
1060 ;;; A completion entry is a LIST of string, prefix-symbol num-uses, and 1067 ;; A completion entry is a LIST of string, prefix-symbol num-uses, and
1061 ;;; last-use-time (the time the completion was last used) 1068 ;; last-use-time (the time the completion was last used)
1062 ;;; last-use-time is T if the string should be kept permanently 1069 ;; last-use-time is T if the string should be kept permanently
1063 ;;; num-uses is incremented everytime the completion is used. 1070 ;; num-uses is incremented every time the completion is used.
1064 1071
1065 ;;; We chose lists because (car foo) is faster than (aref foo 0) and the 1072 ;; We chose lists because (car foo) is faster than (aref foo 0) and the
1066 ;;; creation time is about the same. 1073 ;; creation time is about the same.
1067 1074
1068 ;;; READER MACROS 1075 ;; READER MACROS
1069 1076
1070 (defmacro completion-string (completion-entry) 1077 (defmacro completion-string (completion-entry)
1071 (list 'car completion-entry)) 1078 (list 'car completion-entry))
1072 1079
1073 (defmacro completion-num-uses (completion-entry) 1080 (defmacro completion-num-uses (completion-entry)
1081 (list 'nth 2 completion-entry)) 1088 (list 'nth 2 completion-entry))
1082 1089
1083 (defmacro completion-source (completion-entry) 1090 (defmacro completion-source (completion-entry)
1084 (list 'nth 3 completion-entry)) 1091 (list 'nth 3 completion-entry))
1085 1092
1086 ;;; WRITER MACROS 1093 ;; WRITER MACROS
1087 (defmacro set-completion-string (completion-entry string) 1094 (defmacro set-completion-string (completion-entry string)
1088 (list 'setcar completion-entry string)) 1095 (list 'setcar completion-entry string))
1089 1096
1090 (defmacro set-completion-num-uses (completion-entry num-uses) 1097 (defmacro set-completion-num-uses (completion-entry num-uses)
1091 (list 'setcar (list 'cdr completion-entry) num-uses)) 1098 (list 'setcar (list 'cdr completion-entry) num-uses))
1092 1099
1093 (defmacro set-completion-last-use-time (completion-entry last-use-time) 1100 (defmacro set-completion-last-use-time (completion-entry last-use-time)
1094 (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time)) 1101 (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time))
1095 1102
1096 ;;; CONSTRUCTOR 1103 ;; CONSTRUCTOR
1097 (defun make-completion (string) 1104 (defun make-completion (string)
1098 "Returns a list of a completion entry." 1105 "Returns a list of a completion entry."
1099 (list (list string 0 nil current-completion-source))) 1106 (list (list string 0 nil current-completion-source)))
1100 1107
1101 ;; Obsolete 1108 ;; Obsolete
1102 ;;(defmacro cmpl-prefix-entry-symbol (completion-entry) 1109 ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
1103 ;; (list 'car (list 'cdr completion-entry))) 1110 ;; (list 'car (list 'cdr completion-entry)))
1104 1111
1105 1112
1106 1113
1107 ;;;----------------------------------------------- 1114 ;;-----------------------------------------------
1108 ;;; Prefix symbol entry definition 1115 ;; Prefix symbol entry definition
1109 ;;;----------------------------------------------- 1116 ;;-----------------------------------------------
1110 ;;; A cons of (head . tail) 1117 ;; A cons of (head . tail)
1111 1118
1112 ;;; READER Macros 1119 ;; READER Macros
1113 1120
1114 (defmacro cmpl-prefix-entry-head (prefix-entry) 1121 (defmacro cmpl-prefix-entry-head (prefix-entry)
1115 (list 'car prefix-entry)) 1122 (list 'car prefix-entry))
1116 1123
1117 (defmacro cmpl-prefix-entry-tail (prefix-entry) 1124 (defmacro cmpl-prefix-entry-tail (prefix-entry)
1118 (list 'cdr prefix-entry)) 1125 (list 'cdr prefix-entry))
1119 1126
1120 ;;; WRITER Macros 1127 ;; WRITER Macros
1121 1128
1122 (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head) 1129 (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head)
1123 (list 'setcar prefix-entry new-head)) 1130 (list 'setcar prefix-entry new-head))
1124 1131
1125 (defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail) 1132 (defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
1126 (list 'setcdr prefix-entry new-tail)) 1133 (list 'setcdr prefix-entry new-tail))
1127 1134
1128 ;;; Constructor 1135 ;; Constructor
1129 1136
1130 (defun make-cmpl-prefix-entry (completion-entry-list) 1137 (defun make-cmpl-prefix-entry (completion-entry-list)
1131 "Makes a new prefix entry containing only completion-entry." 1138 "Makes a new prefix entry containing only completion-entry."
1132 (cons completion-entry-list completion-entry-list)) 1139 (cons completion-entry-list completion-entry-list))
1133 1140
1134 ;;;----------------------------------------------- 1141 ;;-----------------------------------------------
1135 ;;; Completion Database - Utilities 1142 ;; Completion Database - Utilities
1136 ;;;----------------------------------------------- 1143 ;;-----------------------------------------------
1137 1144
1138 (defun clear-all-completions () 1145 (defun clear-all-completions ()
1139 "Initializes the completion storage. All existing completions are lost." 1146 "Initializes the completion storage. All existing completions are lost."
1140 (interactive) 1147 (interactive)
1141 (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) 1148 (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
1169 (setq completions-list-return-value 1176 (setq completions-list-return-value
1170 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) 1177 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
1171 completions-list-return-value)))) 1178 completions-list-return-value))))
1172 1179
1173 1180
1174 ;;;----------------------------------------------- 1181 ;;-----------------------------------------------
1175 ;;; Updating the database 1182 ;; Updating the database
1176 ;;;----------------------------------------------- 1183 ;;-----------------------------------------------
1177 ;;; 1184 ;;
1178 ;;; These are the internal functions used to update the datebase 1185 ;; These are the internal functions used to update the datebase
1179 ;;; 1186 ;;
1180 ;;; 1187 ;;
1181 (defvar completion-to-accept nil) 1188 (defvar completion-to-accept nil)
1182 ;;"Set to a string that is pending its acceptance." 1189 ;;"Set to a string that is pending its acceptance."
1183 ;; this checked by the top level reading functions 1190 ;; this checked by the top level reading functions
1184 1191
1185 (defvar cmpl-db-downcase-string nil) 1192 (defvar cmpl-db-downcase-string nil)
1191 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string." 1198 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."
1192 (defvar cmpl-db-entry nil) 1199 (defvar cmpl-db-entry nil)
1193 (defvar cmpl-db-debug-p nil 1200 (defvar cmpl-db-debug-p nil
1194 "Set to T if you want to debug the database.") 1201 "Set to T if you want to debug the database.")
1195 1202
1196 ;;; READS 1203 ;; READS
1197 (defun find-exact-completion (string) 1204 (defun find-exact-completion (string)
1198 "Returns the completion entry for string or nil. 1205 "Returns the completion entry for string or nil.
1199 Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'." 1206 Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'."
1200 (and (boundp (setq cmpl-db-symbol 1207 (and (boundp (setq cmpl-db-symbol
1201 (intern (setq cmpl-db-downcase-string (downcase string)) 1208 (intern (setq cmpl-db-downcase-string (downcase string))
1270 (defun locate-completion-db-error () 1277 (defun locate-completion-db-error ()
1271 ;; recursive error: really scrod 1278 ;; recursive error: really scrod
1272 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.") 1279 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.")
1273 ) 1280 )
1274 1281
1275 ;;; WRITES 1282 ;; WRITES
1276 (defun add-completion-to-tail-if-new (string) 1283 (defun add-completion-to-tail-if-new (string)
1277 "If STRING is not in the database add it to appropriate prefix list. 1284 "If STRING is not in the database add it to appropriate prefix list.
1278 STRING is added to the end of the appropriate prefix list with 1285 STRING is added to the end of the appropriate prefix list with
1279 num-uses = 0. The database is unchanged if it is there. STRING must be 1286 num-uses = 0. The database is unchanged if it is there. STRING must be
1280 longer than `completion-prefix-min-length'. 1287 longer than `completion-prefix-min-length'.
1399 (note-completion-deleted)) 1406 (note-completion-deleted))
1400 ) 1407 )
1401 (error "Unknown completion `%s'" completion-string) 1408 (error "Unknown completion `%s'" completion-string)
1402 )) 1409 ))
1403 1410
1404 ;;; Tests -- 1411 ;; Tests --
1405 ;;; - Add and Find - 1412 ;; - Add and Find -
1406 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) 1413 ;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1407 ;;; (find-exact-completion "banana") --> ("banana" 0 nil 0) 1414 ;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
1408 ;;; (find-exact-completion "bana") --> nil 1415 ;; (find-exact-completion "bana") --> nil
1409 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1416 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1410 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1417 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1411 ;;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) 1418 ;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
1412 ;;; (find-exact-completion "banish") --> ("banish" 0 nil 0) 1419 ;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
1413 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) 1420 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1414 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1421 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1415 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) 1422 ;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
1416 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) 1423 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1417 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) 1424 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1418 ;;; 1425 ;;
1419 ;;; - Deleting - 1426 ;; - Deleting -
1420 ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) 1427 ;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1421 ;;; (delete-completion "banner") 1428 ;; (delete-completion "banner")
1422 ;;; (find-exact-completion "banner") --> nil 1429 ;; (find-exact-completion "banner") --> nil
1423 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) 1430 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1424 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) 1431 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1425 ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) 1432 ;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
1426 ;;; (delete-completion "banana") 1433 ;; (delete-completion "banana")
1427 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) 1434 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
1428 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) 1435 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
1429 ;;; (delete-completion "banner") 1436 ;; (delete-completion "banner")
1430 ;;; (delete-completion "banish") 1437 ;; (delete-completion "banish")
1431 ;;; (find-cmpl-prefix-entry "ban") --> nil 1438 ;; (find-cmpl-prefix-entry "ban") --> nil
1432 ;;; (delete-completion "banner") --> error 1439 ;; (delete-completion "banner") --> error
1433 ;;; 1440 ;;
1434 ;;; - Tail - 1441 ;; - Tail -
1435 ;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) 1442 ;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
1436 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1443 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1437 ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1444 ;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
1438 ;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) 1445 ;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
1439 ;;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) 1446 ;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
1440 ;;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) 1447 ;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
1441 ;;; 1448 ;;
1442 1449
1443 1450
1444 ;;;--------------------------------------------------------------------------- 1451 ;;---------------------------------------------------------------------------
1445 ;;; Database Update :: Interface level routines 1452 ;; Database Update :: Interface level routines
1446 ;;;--------------------------------------------------------------------------- 1453 ;;---------------------------------------------------------------------------
1447 ;;; 1454 ;;
1448 ;;; These lie on top of the database ref. functions but below the standard 1455 ;; These lie on top of the database ref. functions but below the standard
1449 ;;; user interface level 1456 ;; user interface level
1450 1457
1451 1458
1452 (defun interactive-completion-string-reader (prompt) 1459 (defun interactive-completion-string-reader (prompt)
1453 (let* ((default (symbol-under-or-before-point)) 1460 (let* ((default (symbol-under-or-before-point))
1454 (new-prompt 1461 (new-prompt
1551 (progn 1558 (progn
1552 (set-completion-num-uses entry 1) 1559 (set-completion-num-uses entry 1)
1553 (setq cmpl-completions-accepted-p t))))) 1560 (setq cmpl-completions-accepted-p t)))))
1554 )) 1561 ))
1555 1562
1556 ;;; Tests -- 1563 ;; Tests --
1557 ;;; - Add and Find - 1564 ;; - Add and Find -
1558 ;;; (add-completion "banana" 5 10) 1565 ;; (add-completion "banana" 5 10)
1559 ;;; (find-exact-completion "banana") --> ("banana" 5 10 0) 1566 ;; (find-exact-completion "banana") --> ("banana" 5 10 0)
1560 ;;; (add-completion "banana" 6) 1567 ;; (add-completion "banana" 6)
1561 ;;; (find-exact-completion "banana") --> ("banana" 6 10 0) 1568 ;; (find-exact-completion "banana") --> ("banana" 6 10 0)
1562 ;;; (add-completion "banish") 1569 ;; (add-completion "banish")
1563 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) 1570 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
1564 ;;; 1571 ;;
1565 ;;; - Accepting - 1572 ;; - Accepting -
1566 ;;; (setq completion-to-accept "banana") 1573 ;; (setq completion-to-accept "banana")
1567 ;;; (accept-completion) 1574 ;; (accept-completion)
1568 ;;; (find-exact-completion "banana") --> ("banana" 7 10) 1575 ;; (find-exact-completion "banana") --> ("banana" 7 10)
1569 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) 1576 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
1570 ;;; (setq completion-to-accept "banish") 1577 ;; (setq completion-to-accept "banish")
1571 ;;; (add-completion "banner") 1578 ;; (add-completion "banner")
1572 ;;; (car (find-cmpl-prefix-entry "ban")) 1579 ;; (car (find-cmpl-prefix-entry "ban"))
1573 ;;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) 1580 ;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
1574 ;;; 1581 ;;
1575 ;;; - Deleting - 1582 ;; - Deleting -
1576 ;;; (kill-completion "banish") 1583 ;; (kill-completion "banish")
1577 ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) 1584 ;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
1578 1585
1579 1586
1580 ;;;--------------------------------------------------------------------------- 1587 ;;---------------------------------------------------------------------------
1581 ;;; Searching the database 1588 ;; Searching the database
1582 ;;;--------------------------------------------------------------------------- 1589 ;;---------------------------------------------------------------------------
1583 ;;; Functions outside this block must call completion-search-reset followed 1590 ;; Functions outside this block must call completion-search-reset followed
1584 ;;; by calls to completion-search-next or completion-search-peek 1591 ;; by calls to completion-search-next or completion-search-peek
1585 ;;; 1592 ;;
1586 1593
1587 ;;; Status variables 1594 ;; Status variables
1588 ;; Commented out to improve loading speed 1595 ;; Commented out to improve loading speed
1589 (defvar cmpl-test-string "") 1596 (defvar cmpl-test-string "")
1590 ;; "The current string used by completion-search-next." 1597 ;; "The current string used by completion-search-next."
1591 (defvar cmpl-test-regexp "") 1598 (defvar cmpl-test-regexp "")
1592 ;; "The current regexp used by completion-search-next. 1599 ;; "The current regexp used by completion-search-next.
1707 (setq cmpl-next-possibility (next-cdabbrev)) 1714 (setq cmpl-next-possibility (next-cdabbrev))
1708 ) 1715 )
1709 ;; Completely unsuccessful, return nil 1716 ;; Completely unsuccessful, return nil
1710 )) 1717 ))
1711 1718
1712 ;;; Tests -- 1719 ;; Tests --
1713 ;;; - Add and Find - 1720 ;; - Add and Find -
1714 ;;; (add-completion "banana") 1721 ;; (add-completion "banana")
1715 ;;; (completion-search-reset "ban") 1722 ;; (completion-search-reset "ban")
1716 ;;; (completion-search-next 0) --> "banana" 1723 ;; (completion-search-next 0) --> "banana"
1717 ;;; 1724 ;;
1718 ;;; - Discrimination - 1725 ;; - Discrimination -
1719 ;;; (add-completion "cumberland") 1726 ;; (add-completion "cumberland")
1720 ;;; (add-completion "cumberbund") 1727 ;; (add-completion "cumberbund")
1721 ;;; cumbering 1728 ;; cumbering
1722 ;;; (completion-search-reset "cumb") 1729 ;; (completion-search-reset "cumb")
1723 ;;; (completion-search-peek t) --> "cumberbund" 1730 ;; (completion-search-peek t) --> "cumberbund"
1724 ;;; (completion-search-next 0) --> "cumberbund" 1731 ;; (completion-search-next 0) --> "cumberbund"
1725 ;;; (completion-search-peek t) --> "cumberland" 1732 ;; (completion-search-peek t) --> "cumberland"
1726 ;;; (completion-search-next 1) --> "cumberland" 1733 ;; (completion-search-next 1) --> "cumberland"
1727 ;;; (completion-search-peek nil) --> nil 1734 ;; (completion-search-peek nil) --> nil
1728 ;;; (completion-search-next 2) --> "cumbering" {cdabbrev} 1735 ;; (completion-search-next 2) --> "cumbering" {cdabbrev}
1729 ;;; (completion-search-next 3) --> nil or "cumming"{depends on context} 1736 ;; (completion-search-next 3) --> nil or "cumming"{depends on context}
1730 ;;; (completion-search-next 1) --> "cumberland" 1737 ;; (completion-search-next 1) --> "cumberland"
1731 ;;; (completion-search-peek t) --> "cumbering" {cdabbrev} 1738 ;; (completion-search-peek t) --> "cumbering" {cdabbrev}
1732 ;;; 1739 ;;
1733 ;;; - Accepting - 1740 ;; - Accepting -
1734 ;;; (completion-search-next 1) --> "cumberland" 1741 ;; (completion-search-next 1) --> "cumberland"
1735 ;;; (setq completion-to-accept "cumberland") 1742 ;; (setq completion-to-accept "cumberland")
1736 ;;; (completion-search-reset "foo") 1743 ;; (completion-search-reset "foo")
1737 ;;; (completion-search-reset "cum") 1744 ;; (completion-search-reset "cum")
1738 ;;; (completion-search-next 0) --> "cumberland" 1745 ;; (completion-search-next 0) --> "cumberland"
1739 ;;; 1746 ;;
1740 ;;; - Deleting - 1747 ;; - Deleting -
1741 ;;; (kill-completion "cumberland") 1748 ;; (kill-completion "cumberland")
1742 ;;; cummings 1749 ;; cummings
1743 ;;; (completion-search-reset "cum") 1750 ;; (completion-search-reset "cum")
1744 ;;; (completion-search-next 0) --> "cumberbund" 1751 ;; (completion-search-next 0) --> "cumberbund"
1745 ;;; (completion-search-next 1) --> "cummings" 1752 ;; (completion-search-next 1) --> "cummings"
1746 ;;; 1753 ;;
1747 ;;; - Ignoring Capitalization - 1754 ;; - Ignoring Capitalization -
1748 ;;; (completion-search-reset "CuMb") 1755 ;; (completion-search-reset "CuMb")
1749 ;;; (completion-search-next 0) --> "cumberbund" 1756 ;; (completion-search-next 0) --> "cumberbund"
1750 1757
1751 1758
1752 1759
1753 ;;;----------------------------------------------- 1760 ;;-----------------------------------------------
1754 ;;; COMPLETE 1761 ;; COMPLETE
1755 ;;;----------------------------------------------- 1762 ;;-----------------------------------------------
1756 1763
1757 (defun completion-mode () 1764 (defun completion-mode ()
1758 "Toggles whether or not to add new words to the completion database." 1765 "Toggles whether or not to add new words to the completion database."
1759 (interactive) 1766 (interactive)
1760 (setq enable-completion (not enable-completion)) 1767 (setq enable-completion (not enable-completion))
1774 than at the end. 1781 than at the end.
1775 a number :: rotate through the possible completions by that amount 1782 a number :: rotate through the possible completions by that amount
1776 `-' :: same as -1 (insert previous completion) 1783 `-' :: same as -1 (insert previous completion)
1777 {See the comments at the top of `completion.el' for more info.}" 1784 {See the comments at the top of `completion.el' for more info.}"
1778 (interactive "*p") 1785 (interactive "*p")
1779 ;;; Set up variables 1786 ;; Set up variables
1780 (cond ((eq last-command this-command) 1787 (cond ((eq last-command this-command)
1781 ;; Undo last one 1788 ;; Undo last one
1782 (delete-region cmpl-last-insert-location (point)) 1789 (delete-region cmpl-last-insert-location (point))
1783 ;; get next completion 1790 ;; get next completion
1784 (setq cmpl-current-index (+ cmpl-current-index (or arg 1))) 1791 (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))
1875 (record-complete-failed cmpl-current-index)) 1882 (record-complete-failed cmpl-current-index))
1876 ;; Pretend that we were never here 1883 ;; Pretend that we were never here
1877 (setq this-command 'failed-complete) 1884 (setq this-command 'failed-complete)
1878 )))) 1885 ))))
1879 1886
1880 ;;;----------------------------------------------- 1887 ;;-----------------------------------------------
1881 ;;; "Complete" Key Keybindings 1888 ;; "Complete" Key Keybindings
1882 ;;;----------------------------------------------- 1889 ;;-----------------------------------------------
1883 1890
1884 ;; XEmacs change 1891 ;; XEmacs change
1885 ;;(global-set-key "\M-\r" 'complete) 1892 ;;(global-set-key "\M-\r" 'complete)
1886 ;;(global-set-key [?\C-\r] 'complete) 1893 ;;(global-set-key [?\C-\r] 'complete)
1887 ;;(define-key function-key-map [C-return] [?\C-\r]) 1894 ;;(define-key function-key-map [C-return] [?\C-\r])
1888 (global-set-key '(meta return) 'complete) 1895 (global-set-key '(meta return) 'complete)
1889 (global-set-key '(control return) 'complete) 1896 (global-set-key '(control return) 'complete)
1890 ;; XEmacs: #### still need to take care of function-key-map 1897 ;; XEmacs: #### still need to take care of function-key-map
1891 1898
1892 ;;; Tests - 1899 ;; Tests -
1893 ;;; (add-completion "cumberland") 1900 ;; (add-completion "cumberland")
1894 ;;; (add-completion "cumberbund") 1901 ;; (add-completion "cumberbund")
1895 ;;; cum 1902 ;; cum
1896 ;;; Cumber 1903 ;; Cumber
1897 ;;; cumbering 1904 ;; cumbering
1898 ;;; cumb 1905 ;; cumb
1899 1906
1900 1907
1901 ;;;--------------------------------------------------------------------------- 1908 ;;---------------------------------------------------------------------------
1902 ;;; Parsing definitions from files into the database 1909 ;; Parsing definitions from files into the database
1903 ;;;--------------------------------------------------------------------------- 1910 ;;---------------------------------------------------------------------------
1904 1911
1905 ;;;----------------------------------------------- 1912 ;;-----------------------------------------------
1906 ;;; Top Level functions :: 1913 ;; Top Level functions ::
1907 ;;;----------------------------------------------- 1914 ;;-----------------------------------------------
1908 1915
1909 ;;; User interface 1916 ;; User interface
1910 (defun add-completions-from-file (file) 1917 (defun add-completions-from-file (file)
1911 "Parse possible completions from a file and add them to data base." 1918 "Parse possible completions from a file and add them to data base."
1912 (interactive "fFile: ") 1919 (interactive "fFile: ")
1913 (setq file (expand-file-name file)) 1920 (setq file (expand-file-name file))
1914 (let* ((buffer (get-file-buffer file)) 1921 (let* ((buffer (get-file-buffer file))
1950 mode (point-max) 1957 mode (point-max)
1951 (- (aref completion-add-count-vector cmpl-source-file-parsing) 1958 (- (aref completion-add-count-vector cmpl-source-file-parsing)
1952 start-num))) 1959 start-num)))
1953 )) 1960 ))
1954 1961
1955 ;;; Find file hook 1962 ;; Find file hook
1956 (defun cmpl-find-file-hook () 1963 (defun cmpl-find-file-hook ()
1957 (cond (enable-completion 1964 (cond (enable-completion
1958 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) 1965 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
1959 (memq 'lisp completions-merging-modes) 1966 (memq 'lisp completions-merging-modes)
1960 ) 1967 )
1966 ))) 1973 )))
1967 )) 1974 ))
1968 1975
1969 (add-hook 'find-file-hooks 'cmpl-find-file-hook) 1976 (add-hook 'find-file-hooks 'cmpl-find-file-hook)
1970 1977
1971 ;;;----------------------------------------------- 1978 ;;-----------------------------------------------
1972 ;;; Tags Table Completions 1979 ;; Tags Table Completions
1973 ;;;----------------------------------------------- 1980 ;;-----------------------------------------------
1974 1981
1975 (defun add-completions-from-tags-table () 1982 (defun add-completions-from-tags-table ()
1976 ;; Inspired by eero@media-lab.media.mit.edu 1983 ;; Inspired by eero@media-lab.media.mit.edu
1977 "Add completions from the current tags table." 1984 "Add completions from the current tags table."
1978 (interactive) 1985 (interactive)
1990 ) 1997 )
1991 (search-failed) 1998 (search-failed)
1992 )))) 1999 ))))
1993 2000
1994 2001
1995 ;;;----------------------------------------------- 2002 ;;-----------------------------------------------
1996 ;;; Lisp File completion parsing 2003 ;; Lisp File completion parsing
1997 ;;;----------------------------------------------- 2004 ;;-----------------------------------------------
1998 ;;; This merely looks for phrases beginning with (def.... or 2005 ;; This merely looks for phrases beginning with (def.... or
1999 ;;; (package:def ... and takes the next word. 2006 ;; (package:def ... and takes the next word.
2000 ;;; 2007 ;;
2001 ;;; We tried using forward-lines and explicit searches but the regexp technique 2008 ;; We tried using forward-lines and explicit searches but the regexp technique
2002 ;;; was faster. (About 100K characters per second) 2009 ;; was faster. (About 100K characters per second)
2003 ;;; 2010 ;;
2004 (defconst *lisp-def-regexp* 2011 (defconst *lisp-def-regexp*
2005 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" 2012 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
2006 "A regexp that searches for lisp definition form." 2013 "A regexp that searches for lisp definition form."
2007 ) 2014 )
2008 2015
2009 ;;; Tests - 2016 ;; Tests -
2010 ;;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 2017 ;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
2011 ;;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 2018 ;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
2012 ;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 2019 ;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
2013 ;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 2020 ;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
2014 2021
2015 ;;; Parses all the definition names from a Lisp mode buffer and adds them to 2022 ;; Parses all the definition names from a Lisp mode buffer and adds them to
2016 ;;; the completion database. 2023 ;; the completion database.
2017 (defun add-completions-from-lisp-buffer () 2024 (defun add-completions-from-lisp-buffer ()
2018 ;;; Benchmarks 2025 ;; Benchmarks
2019 ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second 2026 ;; Sun-3/280 - 1500 to 3000 lines of lisp code per second
2020 (let (string) 2027 (let (string)
2021 (save-excursion 2028 (save-excursion
2022 (goto-char (point-min)) 2029 (goto-char (point-min))
2023 (condition-case e 2030 (condition-case e
2024 (while t 2031 (while t
2028 ) 2035 )
2029 (search-failed) 2036 (search-failed)
2030 )))) 2037 ))))
2031 2038
2032 2039
2033 ;;;----------------------------------------------- 2040 ;;-----------------------------------------------
2034 ;;; C file completion parsing 2041 ;; C file completion parsing
2035 ;;;----------------------------------------------- 2042 ;;-----------------------------------------------
2036 ;;; C : 2043 ;; C :
2037 ;;; Looks for #define or [<storage class>] [<type>] <name>{,<name>} 2044 ;; Looks for #define or [<storage class>] [<type>] <name>{,<name>}
2038 ;;; or structure, array or pointer defs. 2045 ;; or structure, array or pointer defs.
2039 ;;; It gets most of the definition names. 2046 ;; It gets most of the definition names.
2040 ;;; 2047 ;;
2041 ;;; As you might suspect by now, we use some symbol table hackery 2048 ;; As you might suspect by now, we use some symbol table hackery
2042 ;;; 2049 ;;
2043 ;;; Symbol separator chars (have whitespace syntax) --> , ; * = ( 2050 ;; Symbol separator chars (have whitespace syntax) --> , ; * = (
2044 ;;; Opening char --> [ { 2051 ;; Opening char --> [ {
2045 ;;; Closing char --> ] } 2052 ;; Closing char --> ] }
2046 ;;; opening and closing must be skipped over 2053 ;; opening and closing must be skipped over
2047 ;;; Whitespace chars (have symbol syntax) 2054 ;; Whitespace chars (have symbol syntax)
2048 ;;; Everything else has word syntax 2055 ;; Everything else has word syntax
2049 2056
2050 (defun cmpl-make-c-def-completion-syntax-table () 2057 (defun cmpl-make-c-def-completion-syntax-table ()
2058 ;; XEmacs change
2051 (let ((table (make-vector 256 0)) 2059 (let ((table (make-vector 256 0))
2052 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) 2060 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r))
2053 ;; unfortunately the ?( causes the parens to appear unbalanced 2061 ;; unfortunately the ?( causes the parens to appear unbalanced
2054 (separator-chars '(?, ?* ?= ?\( ?\; 2062 (separator-chars '(?, ?* ?= ?\( ?\;
2055 )) 2063 ))
2069 (modify-syntax-entry ?\} "){" table) 2077 (modify-syntax-entry ?\} "){" table)
2070 table)) 2078 table))
2071 2079
2072 (defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) 2080 (defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table))
2073 2081
2074 ;;; Regexps 2082 ;; Regexps
2075 (defconst *c-def-regexp* 2083 (defconst *c-def-regexp*
2076 ;; This stops on lines with possible definitions 2084 ;; This stops on lines with possible definitions
2077 "\n[_a-zA-Z#]" 2085 "\n[_a-zA-Z#]"
2078 ;; This stops after the symbol to add. 2086 ;; This stops after the symbol to add.
2079 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)" 2087 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
2094 2102
2095 ;(defun test-c-def-regexp (regexp string) 2103 ;(defun test-c-def-regexp (regexp string)
2096 ; (and (eq 0 (string-match regexp string)) (match-end 0)) 2104 ; (and (eq 0 (string-match regexp string)) (match-end 0))
2097 ; ) 2105 ; )
2098 2106
2099 ;;; Tests - 2107 ;; Tests -
2100 ;;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9) 2108 ;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
2101 ;;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6) 2109 ;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
2102 ;;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5) 2110 ;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
2103 ;;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil 2111 ;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
2104 ;;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4 2112 ;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
2105 ;;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5 2113 ;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
2106 ;;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10 2114 ;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
2107 ;;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil 2115 ;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
2108 ;;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9 2116 ;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
2109 ;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 2117 ;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
2110 ;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil 2118 ;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
2111 2119
2112 ;;; Parses all the definition names from a C mode buffer and adds them to the 2120 ;; Parses all the definition names from a C mode buffer and adds them to the
2113 ;;; completion database. 2121 ;; completion database.
2114 (defun add-completions-from-c-buffer () 2122 (defun add-completions-from-c-buffer ()
2115 ;; Benchmark -- 2123 ;; Benchmark --
2116 ;; Sun 3/280-- 1250 lines/sec. 2124 ;; Sun 3/280-- 1250 lines/sec.
2117 2125
2118 (let (string next-point char 2126 (let (string next-point char
2205 )) 2213 ))
2206 (set-syntax-table saved-syntax) 2214 (set-syntax-table saved-syntax)
2207 ))))) 2215 )))))
2208 2216
2209 2217
2210 ;;;--------------------------------------------------------------------------- 2218 ;;---------------------------------------------------------------------------
2211 ;;; Init files 2219 ;; Init files
2212 ;;;--------------------------------------------------------------------------- 2220 ;;---------------------------------------------------------------------------
2213 2221
2214 ;;; The version of save-completions-to-file called at kill-emacs time. 2222 ;; The version of save-completions-to-file called at kill-emacs time.
2215 (defun kill-emacs-save-completions () 2223 (defun kill-emacs-save-completions ()
2216 (if (and save-completions-flag enable-completion cmpl-initialized-p) 2224 (if (and save-completions-flag enable-completion cmpl-initialized-p)
2217 (cond 2225 (cond
2218 ((not cmpl-completions-accepted-p) 2226 ((not cmpl-completions-accepted-p)
2219 (message "Completions database has not changed - not writing.")) 2227 (message "Completions database has not changed - not writing."))
2225 ;; for people that have saved completions. 2233 ;; for people that have saved completions.
2226 (defconst completion-version "11") 2234 (defconst completion-version "11")
2227 2235
2228 (defconst saved-cmpl-file-header 2236 (defconst saved-cmpl-file-header
2229 ";;; Completion Initialization file. 2237 ";;; Completion Initialization file.
2230 ;;; Version = %s 2238 ;; Version = %s
2231 ;;; Format is (<string> . <last-use-time>) 2239 ;; Format is (<string> . <last-use-time>)
2232 ;;; <string> is the completion 2240 ;; <string> is the completion
2233 ;;; <last-use-time> is the time the completion was last used 2241 ;; <last-use-time> is the time the completion was last used
2234 ;;; If it is t, the completion will never be pruned from the file. 2242 ;; If it is t, the completion will never be pruned from the file.
2235 ;;; Otherwise it is in hours since origin. 2243 ;; Otherwise it is in hours since origin.
2236 \n") 2244 \n")
2237 2245
2238 (defun completion-backup-filename (filename) 2246 (defun completion-backup-filename (filename)
2239 (concat filename ".BAK")) 2247 (concat filename ".BAK"))
2240 2248
2333 ) 2341 )
2334 (cmpl-statistics-block 2342 (cmpl-statistics-block
2335 (record-save-completions total-in-db total-perm total-saved)) 2343 (record-save-completions total-in-db total-perm total-saved))
2336 )))) 2344 ))))
2337 2345
2338 ;;;(defun autosave-completions () 2346 ;;(defun autosave-completions ()
2339 ;;; (if (and save-completions-flag enable-completion cmpl-initialized-p 2347 ;; (if (and save-completions-flag enable-completion cmpl-initialized-p
2340 ;;; *completion-auto-save-period* 2348 ;; *completion-auto-save-period*
2341 ;;; (> cmpl-emacs-idle-time *completion-auto-save-period*) 2349 ;; (> cmpl-emacs-idle-time *completion-auto-save-period*)
2342 ;;; cmpl-completions-accepted-p) 2350 ;; cmpl-completions-accepted-p)
2343 ;;; (save-completions-to-file))) 2351 ;; (save-completions-to-file)))
2344 2352
2345 ;;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions) 2353 ;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions)
2346 2354
2347 (defun load-completions-from-file (&optional filename no-message-p) 2355 (defun load-completions-from-file (&optional filename no-message-p)
2348 "Loads a completion init file FILENAME. 2356 "Loads a completion init file FILENAME.
2349 If file is not specified, then use `save-completions-file-name'." 2357 If file is not specified, then use `save-completions-file-name'."
2350 (interactive) 2358 (interactive)
2459 )) 2467 ))
2460 (setq cmpl-initialized-p t) 2468 (setq cmpl-initialized-p t)
2461 ) 2469 )
2462 2470
2463 2471
2464 ;;;----------------------------------------------- 2472 ;;-----------------------------------------------
2465 ;;; Kill EMACS patch 2473 ;; Kill EMACS patch
2466 ;;;----------------------------------------------- 2474 ;;-----------------------------------------------
2467 2475
2468 (add-hook 'kill-emacs-hook 2476 (add-hook 'kill-emacs-hook
2469 '(lambda () 2477 '(lambda ()
2470 (kill-emacs-save-completions) 2478 (kill-emacs-save-completions)
2471 (cmpl-statistics-block 2479 (cmpl-statistics-block
2472 (record-cmpl-kill-emacs)))) 2480 (record-cmpl-kill-emacs))))
2473 2481
2474 ;;;----------------------------------------------- 2482 ;;-----------------------------------------------
2475 ;;; Kill region patch 2483 ;; Kill region patch
2476 ;;;----------------------------------------------- 2484 ;;-----------------------------------------------
2477 2485
2478 (defun completion-kill-region (&optional beg end) 2486 (defun completion-kill-region (&optional beg end)
2479 "Kill between point and mark. 2487 "Kill between point and mark.
2480 The text is deleted but saved in the kill ring. 2488 The text is deleted but saved in the kill ring.
2481 The command \\[yank] can retrieve it from there. 2489 The command \\[yank] can retrieve it from there.
2499 (t 2507 (t
2500 (kill-region beg end)))) 2508 (kill-region beg end))))
2501 2509
2502 (global-set-key "\C-w" 'completion-kill-region) 2510 (global-set-key "\C-w" 'completion-kill-region)
2503 2511
2504 ;;;----------------------------------------------- 2512 ;;-----------------------------------------------
2505 ;;; Patches to self-insert-command. 2513 ;; Patches to self-insert-command.
2506 ;;;----------------------------------------------- 2514 ;;-----------------------------------------------
2507 2515
2508 ;;; Need 2 versions: generic separator chars. and space (to get auto fill 2516 ;; Need 2 versions: generic separator chars. and space (to get auto fill
2509 ;;; to work) 2517 ;; to work)
2510 2518
2511 ;;; All common separators (eg. space "(" ")" """) characters go through a 2519 ;; All common separators (eg. space "(" ")" """) characters go through a
2512 ;;; function to add new words to the list of words to complete from: 2520 ;; function to add new words to the list of words to complete from:
2513 ;;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). 2521 ;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
2514 ;;; If the character before this was an alpha-numeric then this adds the 2522 ;; If the character before this was an alpha-numeric then this adds the
2515 ;;; symbol before point to the completion list (using ADD-COMPLETION). 2523 ;; symbol before point to the completion list (using ADD-COMPLETION).
2516 2524
2517 (defun completion-separator-self-insert-command (arg) 2525 (defun completion-separator-self-insert-command (arg)
2518 (interactive "p") 2526 (interactive "p")
2519 (use-completion-before-separator) 2527 (use-completion-before-separator)
2520 (self-insert-command arg) 2528 (self-insert-command arg)
2526 (self-insert-command arg) 2534 (self-insert-command arg)
2527 (and auto-fill-function 2535 (and auto-fill-function
2528 (funcall auto-fill-function)) 2536 (funcall auto-fill-function))
2529 ) 2537 )
2530 2538
2531 ;;;----------------------------------------------- 2539 ;;-----------------------------------------------
2532 ;;; Wrapping Macro 2540 ;; Wrapping Macro
2533 ;;;----------------------------------------------- 2541 ;;-----------------------------------------------
2534 2542
2535 ;;; Note that because of the way byte compiling works, none of 2543 ;; Note that because of the way byte compiling works, none of
2536 ;;; the functions defined with this macro get byte compiled. 2544 ;; the functions defined with this macro get byte compiled.
2537 2545
2538 (defmacro def-completion-wrapper (function-name type &optional new-name) 2546 (defmacro def-completion-wrapper (function-name type &optional new-name)
2539 "Add a call to update the completion database before function execution. 2547 "Add a call to update the completion database before function execution.
2540 TYPE is the type of the wrapper to be added. Can be :before or :under." 2548 TYPE is the type of the wrapper to be added. Can be :before or :under."
2541 (cond ((eq type ':separator) 2549 (cond ((eq type ':separator)
2580 (get this-command 'completion-function)) 2588 (get this-command 'completion-function))
2581 'use-completion-under-or-before-point))) 2589 'use-completion-under-or-before-point)))
2582 (add-hook 'pre-command-hook 'completion-before-command) 2590 (add-hook 'pre-command-hook 'completion-before-command)
2583 2591
2584 2592
2585 ;;;--------------------------------------------------------------------------- 2593 ;;---------------------------------------------------------------------------
2586 ;;; Patches to standard keymaps insert completions 2594 ;; Patches to standard keymaps insert completions
2587 ;;;--------------------------------------------------------------------------- 2595 ;;---------------------------------------------------------------------------
2588 2596
2589 ;;;----------------------------------------------- 2597 ;;-----------------------------------------------
2590 ;;; Separators 2598 ;; Separators
2591 ;;;----------------------------------------------- 2599 ;;-----------------------------------------------
2592 ;;; We've used the completion syntax table given as a guide. 2600 ;; We've used the completion syntax table given as a guide.
2593 ;;; 2601 ;;
2594 ;;; Global separator chars. 2602 ;; Global separator chars.
2595 ;;; We left out <tab> because there are too many special cases for it. Also, 2603 ;; We left out <tab> because there are too many special cases for it. Also,
2596 ;;; in normal coding it's rarely typed after a word. 2604 ;; in normal coding it's rarely typed after a word.
2597 (global-set-key " " 'completion-separator-self-insert-autofilling) 2605 (global-set-key " " 'completion-separator-self-insert-autofilling)
2598 (global-set-key "!" 'completion-separator-self-insert-command) 2606 (global-set-key "!" 'completion-separator-self-insert-command)
2599 (global-set-key "%" 'completion-separator-self-insert-command) 2607 (global-set-key "%" 'completion-separator-self-insert-command)
2600 (global-set-key "^" 'completion-separator-self-insert-command) 2608 (global-set-key "^" 'completion-separator-self-insert-command)
2601 (global-set-key "&" 'completion-separator-self-insert-command) 2609 (global-set-key "&" 'completion-separator-self-insert-command)
2613 (global-set-key "'" 'completion-separator-self-insert-command) 2621 (global-set-key "'" 'completion-separator-self-insert-command)
2614 (global-set-key "#" 'completion-separator-self-insert-command) 2622 (global-set-key "#" 'completion-separator-self-insert-command)
2615 (global-set-key "," 'completion-separator-self-insert-command) 2623 (global-set-key "," 'completion-separator-self-insert-command)
2616 (global-set-key "?" 'completion-separator-self-insert-command) 2624 (global-set-key "?" 'completion-separator-self-insert-command)
2617 2625
2618 ;;; We include period and colon even though they are symbol chars because : 2626 ;; We include period and colon even though they are symbol chars because :
2619 ;;; - in text we want to pick up the last word in a sentence. 2627 ;; - in text we want to pick up the last word in a sentence.
2620 ;;; - in C pointer refs. we want to pick up the first symbol 2628 ;; - in C pointer refs. we want to pick up the first symbol
2621 ;;; - it won't make a difference for lisp mode (package names are short) 2629 ;; - it won't make a difference for lisp mode (package names are short)
2622 (global-set-key "." 'completion-separator-self-insert-command) 2630 (global-set-key "." 'completion-separator-self-insert-command)
2623 (global-set-key ":" 'completion-separator-self-insert-command) 2631 (global-set-key ":" 'completion-separator-self-insert-command)
2624 2632
2625 ;;; Lisp Mode diffs 2633 ;; Lisp Mode diffs
2626 (define-key lisp-mode-map "!" 'self-insert-command) 2634 (define-key lisp-mode-map "!" 'self-insert-command)
2627 (define-key lisp-mode-map "&" 'self-insert-command) 2635 (define-key lisp-mode-map "&" 'self-insert-command)
2628 (define-key lisp-mode-map "%" 'self-insert-command) 2636 (define-key lisp-mode-map "%" 'self-insert-command)
2629 (define-key lisp-mode-map "?" 'self-insert-command) 2637 (define-key lisp-mode-map "?" 'self-insert-command)
2630 (define-key lisp-mode-map "=" 'self-insert-command) 2638 (define-key lisp-mode-map "=" 'self-insert-command)
2631 (define-key lisp-mode-map "^" 'self-insert-command) 2639 (define-key lisp-mode-map "^" 'self-insert-command)
2632 2640
2633 ;;; C mode diffs. 2641 ;; Avoid warnings.
2642 (defvar c-mode-map)
2643 (defvar fortran-mode-map)
2644
2645 ;; C mode diffs.
2634 (defun completion-c-mode-hook () 2646 (defun completion-c-mode-hook ()
2635 (def-completion-wrapper electric-c-semi :separator) 2647 (def-completion-wrapper electric-c-semi :separator)
2636 (define-key c-mode-map "+" 'completion-separator-self-insert-command) 2648 (define-key c-mode-map "+" 'completion-separator-self-insert-command)
2637 (define-key c-mode-map "*" 'completion-separator-self-insert-command) 2649 (define-key c-mode-map "*" 'completion-separator-self-insert-command)
2638 (define-key c-mode-map "/" 'completion-separator-self-insert-command)) 2650 (define-key c-mode-map "/" 'completion-separator-self-insert-command))
2639 ;; Do this either now or whenever C mode is loaded. 2651 ;; Do this either now or whenever C mode is loaded.
2640 (if (featurep 'cc-mode) 2652 (if (featurep 'cc-mode)
2641 (completion-c-mode-hook) 2653 (completion-c-mode-hook)
2642 (add-hook 'c-mode-hook 'completion-c-mode-hook)) 2654 (add-hook 'c-mode-hook 'completion-c-mode-hook))
2643 2655
2644 ;;; FORTRAN mode diffs. (these are defined when fortran is called) 2656 ;; FORTRAN mode diffs. (these are defined when fortran is called)
2645 (defun completion-setup-fortran-mode () 2657 (defun completion-setup-fortran-mode ()
2646 (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) 2658 (define-key fortran-mode-map "+" 'completion-separator-self-insert-command)
2647 (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) 2659 (define-key fortran-mode-map "-" 'completion-separator-self-insert-command)
2648 (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) 2660 (define-key fortran-mode-map "*" 'completion-separator-self-insert-command)
2649 (define-key fortran-mode-map "/" 'completion-separator-self-insert-command) 2661 (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)
2650 ) 2662 )
2651 2663
2652 ;;;----------------------------------------------- 2664 ;;-----------------------------------------------
2653 ;;; End of line chars. 2665 ;; End of line chars.
2654 ;;;----------------------------------------------- 2666 ;;-----------------------------------------------
2655 (def-completion-wrapper newline :separator) 2667 (def-completion-wrapper newline :separator)
2656 (def-completion-wrapper newline-and-indent :separator) 2668 (def-completion-wrapper newline-and-indent :separator)
2657 (def-completion-wrapper comint-send-input :separator) 2669 (def-completion-wrapper comint-send-input :separator)
2658 (def-completion-wrapper exit-minibuffer :minibuffer-separator) 2670 (def-completion-wrapper exit-minibuffer :minibuffer-separator)
2659 (def-completion-wrapper eval-print-last-sexp :separator) 2671 (def-completion-wrapper eval-print-last-sexp :separator)
2660 (def-completion-wrapper eval-last-sexp :separator) 2672 (def-completion-wrapper eval-last-sexp :separator)
2661 ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) 2673 ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
2662 2674
2663 ;;;----------------------------------------------- 2675 ;;-----------------------------------------------
2664 ;;; Cursor movement 2676 ;; Cursor movement
2665 ;;;----------------------------------------------- 2677 ;;-----------------------------------------------
2666 2678
2667 (def-completion-wrapper next-line :under-or-before) 2679 (def-completion-wrapper next-line :under-or-before)
2668 (def-completion-wrapper previous-line :under-or-before) 2680 (def-completion-wrapper previous-line :under-or-before)
2669 (def-completion-wrapper beginning-of-buffer :under-or-before) 2681 (def-completion-wrapper beginning-of-buffer :under-or-before)
2670 (def-completion-wrapper end-of-buffer :under-or-before) 2682 (def-completion-wrapper end-of-buffer :under-or-before)
2678 (def-completion-wrapper backward-sexp :backward-under) 2690 (def-completion-wrapper backward-sexp :backward-under)
2679 2691
2680 (def-completion-wrapper delete-backward-char :backward) 2692 (def-completion-wrapper delete-backward-char :backward)
2681 (def-completion-wrapper delete-backward-char-untabify :backward) 2693 (def-completion-wrapper delete-backward-char-untabify :backward)
2682 2694
2683 ;;; Tests -- 2695 ;; Tests --
2684 ;;; foobarbiz 2696 ;; foobarbiz
2685 ;;; foobar 2697 ;; foobar
2686 ;;; fooquux 2698 ;; fooquux
2687 ;;; fooper 2699 ;; fooper
2688 2700
2689 (cmpl-statistics-block 2701 (cmpl-statistics-block
2690 (record-completion-file-loaded)) 2702 (record-completion-file-loaded))
2691 2703
2704 (provide 'completion)
2705
2692 ;;; completion.el ends here 2706 ;;; completion.el ends here