Commit | Line | Data |
---|---|---|
6b279740 RS |
1 | ;;; filecache.el --- Find files using a pre-loaded cache |
2 | ;; | |
3 | ;; Author: Peter Breton | |
4 | ;; Created: Sun Nov 10 1996 | |
5 | ;; Version: $Id: filecache.el,v 1.13 1997/02/07 22:27:51 pbreton Exp $ | |
6 | ;; Keywords: | |
7 | ;; Time-stamp: <97/02/07 17:26:54 peter> | |
8 | ;; | |
9 | ;; Copyright (C) Peter Breton Thu Dec 12 1996 | |
10 | ;; | |
11 | ;; This is free software; you can redistribute it and/or modify | |
12 | ;; it 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 | ;; any later version. | |
15 | ;; | |
16 | ;; filecache.el is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
19 | ;; General Public License for more details. | |
20 | ;; | |
21 | ;; 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 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | ;; | |
25 | ;; LCD Archive Entry: | |
26 | ;; filecache.el|Peter Breton|pbreton@i-kinetics.com| | |
27 | ;; Find files using a pre-loaded cache| | |
28 | ;; Thu Dec 12 1996|1.0|~/misc/filecache.el.gz| | |
29 | ;; | |
30 | ;; Purpose: | |
31 | ;; | |
32 | ;; Find files using a pre-loaded cache | |
33 | ;; | |
34 | ;;; Commentary: | |
35 | ;; | |
36 | ;; The file-cache package is an attempt to make it easy to locate files | |
37 | ;; by name, without having to remember exactly where they are located. | |
38 | ;; This is very handy when working with source trees. You can also add | |
39 | ;; frequently used files to the cache to create a hotlist effect. | |
40 | ;; The cache can be used with any interactive command which takes a | |
41 | ;; filename as an argument. | |
42 | ;; | |
43 | ;; It is worth noting that this package works best when most of the files | |
44 | ;; in the cache have unique names, or (if they have the same name) exist in | |
45 | ;; only a few directories. The worst case is many files all with | |
46 | ;; the same name and in different directories, for example a big source tree | |
47 | ;; with a Makefile in each directory. In such a case, you should probably | |
48 | ;; use an alternate strategy to find the files. | |
49 | ;; | |
50 | ;; ADDING FILES TO THE CACHE: | |
51 | ;; | |
52 | ;; Use the following functions to add items to the file cache: | |
53 | ;; | |
54 | ;; * `file-cache-add-file': Adds a single file to the cache | |
55 | ;; | |
56 | ;; * `file-cache-add-file-list': Adds a list of files to the cache | |
57 | ;; | |
58 | ;; The following functions use the regular expressions in | |
59 | ;; `file-cache-delete-regexps' to eliminate unwanted files: | |
60 | ;; | |
61 | ;; * `file-cache-add-directory': Adds the files in a directory to the | |
62 | ;; cache. You can also specify a regular expression to match the files | |
63 | ;; which should be added. | |
64 | ;; | |
65 | ;; * `file-cache-add-directory-list': Same as above, but acts on a list | |
66 | ;; of directories. You can use `load-path', `exec-path' and the like. | |
67 | ;; | |
68 | ;; * `file-cache-add-directory-using-find': Uses the `find' command to | |
69 | ;; add a directory tree to the cache. | |
70 | ;; | |
71 | ;; * `file-cache-add-directory-using-locate': Uses the `locate' command to | |
72 | ;; add files matching a pattern to the cache. | |
73 | ;; | |
74 | ;; Use the function `file-cache-clear-cache' to remove all items from the | |
75 | ;; cache. There are a number of `file-cache-delete' functions provided | |
76 | ;; as well, but in general it is probably better to not worry too much | |
77 | ;; about extra files in the cache. | |
78 | ;; | |
79 | ;; The most convenient way to initialize the cache is with an | |
80 | ;; `eval-after-load' function, as noted in the INSTALLATION section. | |
81 | ;; | |
82 | ;; FINDING FILES USING THE CACHE: | |
83 | ;; | |
84 | ;; You can use the file-cache with any function that expects a filename as | |
85 | ;; an argument. For example: | |
86 | ;; | |
87 | ;; 1) Invoke a function which expects a filename as an argument: | |
88 | ;; M-x find-file | |
89 | ;; | |
90 | ;; 2) Begin typing a file name. | |
91 | ;; | |
92 | ;; 3) Invoke `file-cache-minibuffer-complete' (bound by default to | |
93 | ;; C-TAB) to complete on the filename using the cache. | |
94 | ;; | |
95 | ;; 4) When you have found a unique completion, the minibuffer contents | |
96 | ;; will change to the full name of that file. | |
97 | ;; | |
98 | ;; If there are a number of directories which contain the completion, | |
99 | ;; invoking `file-cache-minibuffer-complete' repeatedly will cycle through | |
100 | ;; them. | |
101 | ;; | |
102 | ;; 5) You can then edit the minibuffer contents, or press RETURN. | |
103 | ;; | |
104 | ;; It is much easier to simply try it than trying to explain it :) | |
105 | ;; | |
106 | ;;; INSTALLATION | |
107 | ;; | |
108 | ;; Insert the following into your .emacs: | |
109 | ;; | |
110 | ;; (autoload 'file-cache-minibuffer-complete "filecache" nil t) | |
111 | ;; | |
112 | ;; For maximum utility, you should probably define an `eval-after-load' | |
113 | ;; form which loads your favorite files: | |
114 | ;; | |
115 | ;; (eval-after-load | |
116 | ;; "filecache" | |
117 | ;; '(progn | |
118 | ;; (message "Loading file cache...") | |
119 | ;; (file-cache-add-directory-using-find "~/projects") | |
120 | ;; (file-cache-add-directory-list load-path) | |
121 | ;; (file-cache-add-directory "~/") | |
122 | ;; (file-cache-add-file-list (list "~/foo/bar" "~/baz/bar")) | |
123 | ;; )) | |
124 | ;; | |
125 | ;; If you clear and reload the cache frequently, it is probably easiest | |
126 | ;; to put your initializations in a function: | |
127 | ;; | |
128 | ;; (eval-after-load | |
129 | ;; "filecache" | |
130 | ;; '(my-file-cache-initialize)) | |
131 | ;; | |
132 | ;; (defun my-file-cache-initialize () | |
133 | ;; (interactive) | |
134 | ;; (message "Loading file cache...") | |
135 | ;; (file-cache-add-directory-using-find "~/projects") | |
136 | ;; (file-cache-add-directory-list load-path) | |
137 | ;; (file-cache-add-directory "~/") | |
138 | ;; (file-cache-add-file-list (list "~/foo/bar" "~/baz/bar")) | |
139 | ;; )) | |
140 | ;; | |
141 | ;; Of course, you can still add files to the cache afterwards, via | |
142 | ;; Lisp functions. | |
143 | ;; | |
144 | ;; RELATED WORK: | |
145 | ;; | |
146 | ;; This package is a distant relative of Noah Friedman's fff utilities. | |
147 | ;; Our goal is pretty similar, but the implementation strategies are | |
148 | ;; different. | |
149 | ;; | |
150 | ;;; Change log: | |
151 | ;; $Log: filecache.el,v $ | |
152 | ;; Revision 1.13 1997/02/07 22:27:51 pbreton | |
153 | ;; Keybindings use autoload cookies instead of variable | |
154 | ;; | |
155 | ;; Revision 1.12 1997/02/07 22:02:29 pbreton | |
156 | ;; Added small changes suggested by RMS: | |
157 | ;; Revamped the doc strings | |
158 | ;; Added keybindings (using `file-cache-default-minibuffer-key' variable) | |
159 | ;; | |
160 | ;; Revision 1.11 1997/02/01 16:44:47 pbreton | |
161 | ;; Changed `file-cache-directory-name' function. Instead of using a | |
162 | ;; completing-read, it cycles through the directory list. | |
163 | ;; | |
164 | ;; Eliminated bug where file-cache-file-name was called twice per completion. | |
165 | ;; | |
166 | ;; Revision 1.10 1997/01/26 05:44:24 pbreton | |
167 | ;; Added file-cache-delete functions | |
168 | ;; Added file-cache-completions-buffer variable | |
169 | ;; Added file-cache-completions-keymap variable | |
170 | ;; Changed file-cache-completion-setup-function to use | |
171 | ;; file-cache-completions-keymap | |
172 | ;; Added file-cache-choose-completion and file-cache-mouse-choose-completion. | |
173 | ;; These rely on a patch to 'simple.el' | |
174 | ;; Added file-cache-debug-read-from-minibuffer function | |
175 | ;; | |
176 | ;; Revision 1.9 1997/01/17 17:54:24 pbreton | |
177 | ;; File names are no longer case-insensitive; this was tolerable on NT but | |
178 | ;; not on Unix. Instead, file-cache-minibuffer-complete checks to see if the | |
179 | ;; last command was itself, and if the same string is in the minibuffer. If so, | |
180 | ;; this string is used for completion. | |
181 | ;; | |
182 | ;; Added some functions to delete from the file-cache | |
183 | ;; | |
184 | ;; Completing-read of directories requires temporary binding of | |
185 | ;; enable-recursive-minibuffers variable. | |
186 | ;; | |
187 | ;; Revision 1.8 1997/01/17 14:01:08 pbreton | |
188 | ;; Changed file-cache-minibuffer-complete so that it operates in the | |
189 | ;; minibuffer instead of as a recursive minibuffer call. | |
190 | ;; | |
191 | ;; File-cache-alist now expects a filename and a list of directories (there | |
192 | ;; should be at least one). If the list has only one element, that element | |
193 | ;; is used; if it has multiple directories, the user is prompted to choose | |
194 | ;; one. | |
195 | ;; | |
196 | ;; File names in the cache are now canonicalized to lowercase, to resolve a | |
197 | ;; problem which occurs when the cache has files like README and readme. | |
198 | ;; | |
199 | ;; Removed a lot of the extra completion functions which weren't used. | |
200 | ;; | |
201 | ;; Revision 1.7 1996/12/29 15:48:28 pbreton | |
202 | ;; Added functions: | |
203 | ;; `file-cache-minibuffer-complete-using-suffix' | |
204 | ;; `file-cache-minibuffer-complete-with-directory-filter' | |
205 | ;; `file-cache-minibuffer-complete-with-filename-filter' | |
206 | ;; Added documentation for these functions | |
207 | ;; | |
208 | ;; Revision 1.6 1996/12/24 20:27:56 pbreton | |
209 | ;; Added predicate functions to `file-cache-minibuffer-complete' | |
210 | ;; | |
211 | ;; Revision 1.5 1996/12/14 18:05:11 pbreton | |
212 | ;; Fixed uniquify bug by using `member' instead of `memq' | |
213 | ;; Made file-cache-add-* prompts more descriptive | |
214 | ;; More documentation | |
215 | ;; | |
216 | ;; Revision 1.4 1996/12/13 14:42:37 pbreton | |
217 | ;; Removed `file-cache-top-directory' variable | |
218 | ;; Changed file-cache-initialize to file-cache-add-from-file-cache-buffer | |
219 | ;; Regexp to match files in file-cache-buffer is now a variable | |
220 | ;; | |
221 | ;; Revision 1.3 1996/12/12 06:01:27 peter | |
222 | ;; Added `file-cache-add-file' and `file-cache-add-file-list' functions | |
223 | ;; | |
224 | ;; Revision 1.2 1996/12/12 05:47:49 peter | |
225 | ;; Fixed uniquifying bug | |
226 | ;; Added directory functions | |
227 | ;; `file-cache-find-file' now uses file-cache-file-name | |
228 | ;; `file-cache-minibuffer-complete' handles string completion correctly. | |
229 | ;; It also prepends `file-cache-minibuffer-prompt' to the normal prompt | |
230 | ;; | |
231 | ;; Revision 1.1 1996/11/26 12:12:43 peter | |
232 | ;; Initial revision | |
233 | ;; | |
234 | ;;; Code: | |
235 | ||
236 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
237 | ;; Variables | |
238 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
239 | ||
240 | ;; User-modifiable variables | |
241 | (defvar file-cache-filter-regexps | |
242 | (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$" | |
243 | "\\.$" "#$") | |
244 | "*List of regular expressions used as filters by the file cache. | |
245 | File names which match these expressions will not be added to the cache. | |
246 | Note that the functions `file-cache-add-file' and `file-cache-add-file-list' | |
247 | do not use this variable.") | |
248 | ||
249 | (defvar file-cache-find-command "find" | |
250 | "*External program used by `file-cache-add-directory-using-find'.") | |
251 | ||
252 | (defvar file-cache-locate-command "locate" | |
253 | "*External program used by `file-cache-add-directory-using-locate'.") | |
254 | ||
255 | ;; Minibuffer messages | |
256 | (defvar file-cache-no-match-message " [File Cache: No match]" | |
257 | "Message to display when there is no completion.") | |
258 | ||
259 | (defvar file-cache-sole-match-message " [File Cache: sole completion]" | |
260 | "Message to display when there is only one completion.") | |
261 | ||
262 | (defvar file-cache-non-unique-message " [File Cache: complete but not unique]" | |
263 | "Message to display when there is a non-unique completion.") | |
264 | ||
265 | (defvar file-cache-multiple-directory-message nil) | |
266 | ||
267 | ;; Internal variables | |
268 | ;; This should be named *Completions* because that's what the function | |
269 | ;; switch-to-completions in simple.el expects | |
270 | (defvar file-cache-completions-buffer "*Completions*" | |
271 | "Buffer to display completions when using the file cache.") | |
272 | ||
273 | (defvar file-cache-buffer "*File Cache*" | |
274 | "Buffer to hold the cache of file names.") | |
275 | ||
276 | (defvar file-cache-buffer-default-regexp "^.+$" | |
277 | "Regexp to match files in `file-cache-buffer'.") | |
278 | ||
279 | (defvar file-cache-last-completion nil) | |
280 | ||
281 | (defvar file-cache-alist nil | |
282 | "Internal data structure to hold cache of file names.") | |
283 | ||
284 | (defvar file-cache-completions-keymap nil | |
285 | "Keymap for file cache completions buffer.") | |
286 | ||
287 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
288 | ;; Functions to add files to the cache | |
289 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
290 | ||
291 | (defun file-cache-add-directory (directory &optional regexp) | |
292 | "Add DIRECTORY to the file cache. | |
293 | If the optional REGEXP argument is non-nil, only files which match it will | |
294 | be added to the cache." | |
295 | (interactive "DAdd files from directory: ") | |
296 | (let* ((dir (expand-file-name directory)) | |
297 | (dir-files (directory-files dir t regexp)) | |
298 | ) | |
299 | ;; Filter out files we don't want to see | |
300 | (mapcar | |
301 | '(lambda (file) | |
302 | (mapcar | |
303 | '(lambda (regexp) | |
304 | (if (string-match regexp file) | |
305 | (setq dir-files (delq file dir-files)))) | |
306 | file-cache-filter-regexps)) | |
307 | dir-files) | |
308 | (file-cache-add-file-list dir-files))) | |
309 | ||
310 | (defun file-cache-add-directory-list (directory-list &optional regexp) | |
311 | "Add DIRECTORY-LIST (a list of directory names) to the file cache. | |
312 | If the optional REGEXP argument is non-nil, only files which match it | |
313 | will be added to the cache. Note that the REGEXP is applied to the files | |
314 | in each directory, not to the directory list itself." | |
315 | (interactive "XAdd files from directory list: ") | |
316 | (mapcar | |
317 | '(lambda (dir) (file-cache-add-directory dir regexp)) | |
318 | directory-list)) | |
319 | ||
320 | (defun file-cache-add-file-list (file-list) | |
321 | "Add FILE-LIST (a list of files names) to the file cache." | |
322 | (interactive "XFile List: ") | |
323 | (mapcar 'file-cache-add-file file-list)) | |
324 | ||
325 | ;; Workhorse function | |
326 | (defun file-cache-add-file (file) | |
327 | "Add FILE to the file cache." | |
328 | (interactive "fAdd File: ") | |
329 | (let* ((file-name (file-name-nondirectory file)) | |
330 | (dir-name (file-name-directory file)) | |
331 | (the-entry (assoc file-name file-cache-alist)) | |
332 | ) | |
333 | ;; Does the entry exist already? | |
334 | (if the-entry | |
335 | (if (or (and (stringp (cdr the-entry)) | |
336 | (string= dir-name (cdr the-entry))) | |
337 | (and (listp (cdr the-entry)) | |
338 | (member dir-name (cdr the-entry)))) | |
339 | nil | |
340 | (setcdr the-entry (append (list dir-name) (cdr the-entry))) | |
341 | ) | |
342 | ;; If not, add it to the cache | |
343 | (setq file-cache-alist | |
344 | (cons (cons file-name (list dir-name)) | |
345 | file-cache-alist))) | |
346 | )) | |
347 | ||
348 | (defun file-cache-add-directory-using-find (directory) | |
349 | "Use the `find' command to add files to the file cache. | |
350 | Find is run in DIRECTORY." | |
351 | (interactive "DAdd files under directory: ") | |
352 | (let ((dir (expand-file-name directory))) | |
353 | (set-buffer (get-buffer-create file-cache-buffer)) | |
354 | (erase-buffer) | |
355 | (call-process file-cache-find-command nil | |
356 | (get-buffer file-cache-buffer) nil | |
357 | dir "-name" | |
358 | (if (memq system-type | |
359 | (list 'windows-nt 'ms-dos)) "'*'" "*") | |
360 | "-print") | |
361 | (file-cache-add-from-file-cache-buffer))) | |
362 | ||
363 | (defun file-cache-add-directory-using-locate (string) | |
364 | "Use the `locate' command to add files to the file cache. | |
365 | STRING is passed as an argument to the locate command." | |
366 | (interactive "sAdd files using locate string: ") | |
367 | (set-buffer (get-buffer-create file-cache-buffer)) | |
368 | (erase-buffer) | |
369 | (call-process file-cache-locate-command nil | |
370 | (get-buffer file-cache-buffer) nil | |
371 | string) | |
372 | (file-cache-add-from-file-cache-buffer)) | |
373 | ||
374 | (defun file-cache-add-from-file-cache-buffer (&optional regexp) | |
375 | "Add any entries found in the file cache buffer. | |
376 | Each entry matches the regular expression `file-cache-buffer-default-regexp' | |
377 | or the optional REGEXP argument." | |
378 | (set-buffer file-cache-buffer) | |
379 | (mapcar | |
380 | (function (lambda (elt) | |
381 | (goto-char (point-min)) | |
382 | (delete-matching-lines elt))) | |
383 | file-cache-filter-regexps) | |
384 | (goto-char (point-min)) | |
385 | (let ((full-filename)) | |
386 | (while (re-search-forward | |
387 | (or regexp file-cache-buffer-default-regexp) | |
388 | (point-max) t) | |
389 | (setq full-filename (buffer-substring-no-properties | |
390 | (match-beginning 0) (match-end 0))) | |
391 | (file-cache-add-file full-filename)))) | |
392 | ||
393 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
394 | ;; Functions to delete from the cache | |
395 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
396 | ||
397 | (defun file-cache-clear-cache () | |
398 | "Clear the file cache." | |
399 | (interactive) | |
400 | (setq file-cache-alist nil)) | |
401 | ||
402 | ;; This clears *all* files with the given name | |
403 | (defun file-cache-delete-file (file) | |
404 | "Delete FILE from the file cache." | |
405 | (interactive | |
406 | (list (completing-read "Delete file from cache: " file-cache-alist))) | |
407 | (setq file-cache-alist | |
408 | (delq (assoc file file-cache-alist) file-cache-alist))) | |
409 | ||
410 | (defun file-cache-delete-file-list (file-list) | |
411 | "Delete FILE-LIST (a list of files) from the file cache." | |
412 | (interactive "XFile List: ") | |
413 | (mapcar 'file-cache-delete-file file-list)) | |
414 | ||
415 | (defun file-cache-delete-file-regexp (regexp) | |
416 | "Delete files matching REGEXP from the file cache." | |
417 | (interactive "sRegexp: ") | |
418 | (let ((delete-list)) | |
419 | (mapcar '(lambda (elt) | |
420 | (and (string-match regexp (car elt)) | |
421 | (setq delete-list (cons (car elt) delete-list)))) | |
422 | file-cache-alist) | |
423 | (file-cache-delete-file-list delete-list) | |
424 | (message "Deleted %d files from file cache" (length delete-list)))) | |
425 | ||
426 | (defun file-cache-delete-directory (directory) | |
427 | "Delete DIRECTORY from the file cache." | |
428 | (interactive "DDelete directory from file cache: ") | |
429 | (let ((dir (expand-file-name directory)) | |
430 | (result 0)) | |
431 | (mapcar | |
432 | '(lambda (entry) | |
433 | (if (file-cache-do-delete-directory dir entry) | |
434 | (setq result (1+ result)))) | |
435 | file-cache-alist) | |
436 | (if (zerop result) | |
437 | (error "No entries containing %s found in cache" directory) | |
438 | (message "Deleted %d entries" result)))) | |
439 | ||
440 | (defun file-cache-do-delete-directory (dir entry) | |
441 | (let ((directory-list (cdr entry)) | |
442 | (directory (file-cache-canonical-directory dir)) | |
443 | ) | |
444 | (and (member directory directory-list) | |
445 | (if (equal 1 (length directory-list)) | |
446 | (setq file-cache-alist | |
447 | (delq entry file-cache-alist)) | |
448 | (setcdr entry (delete directory directory-list))) | |
449 | ) | |
450 | )) | |
451 | ||
452 | (defun file-cache-delete-directory-list (directory-list) | |
453 | "Delete DIRECTORY-LIST (a list of directories) from the file cache." | |
454 | (interactive "XDirectory List: ") | |
455 | (mapcar 'file-cache-delete-directory directory-list)) | |
456 | ||
457 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
458 | ;; Utility functions | |
459 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
460 | ||
461 | ;; Returns the name of a directory for a file in the cache | |
462 | (defun file-cache-directory-name (file) | |
463 | (let* ((directory-list (cdr (assoc file file-cache-alist))) | |
464 | (len (length directory-list)) | |
465 | (directory) | |
466 | (num) | |
467 | ) | |
468 | (if (not (listp directory-list)) | |
469 | (error "Unknown type in file-cache-alist for key %s" file)) | |
470 | (cond | |
471 | ;; Single element | |
472 | ((eq 1 len) | |
473 | (setq directory (elt directory-list 0))) | |
474 | ;; No elements | |
475 | ((eq 0 len) | |
476 | (error "No directory found for key %s" file)) | |
477 | ;; Multiple elements | |
478 | (t | |
479 | (let* ((minibuffer-dir (file-name-directory (buffer-string))) | |
480 | (dir-list (member minibuffer-dir directory-list)) | |
481 | ) | |
482 | (setq directory | |
483 | ;; If the directory is in the list, return the next element | |
484 | ;; Otherwise, return the first element | |
485 | (if dir-list | |
486 | (or (elt directory-list | |
487 | (setq num (1+ (- len (length dir-list))))) | |
488 | (elt directory-list (setq num 0))) | |
489 | (elt directory-list (setq num 0)))) | |
490 | ) | |
491 | ) | |
492 | ) | |
493 | ;; If there were multiple directories, set up a minibuffer message | |
494 | (setq file-cache-multiple-directory-message | |
495 | (and num (format " [%d of %d]" (1+ num) len))) | |
496 | directory)) | |
497 | ||
498 | ;; Returns the name of a file in the cache | |
499 | (defun file-cache-file-name (file) | |
500 | (let ((directory (file-cache-directory-name file))) | |
501 | (concat directory file))) | |
502 | ||
503 | ;; Return a canonical directory for comparison purposes. | |
504 | ;; Such a directory ends with a forward slash. | |
505 | (defun file-cache-canonical-directory (dir) | |
506 | (let ((directory dir)) | |
507 | (if (not (char-equal ?/ (string-to-char (substring directory -1)))) | |
508 | (concat directory "/") | |
509 | directory))) | |
510 | ||
511 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
512 | ;; Minibuffer functions | |
513 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
514 | ||
515 | ;;;###autoload | |
516 | (defun file-cache-minibuffer-complete () | |
517 | "Complete a filename in the minibuffer using a preloaded cache." | |
518 | (interactive) | |
519 | (let* | |
520 | ( | |
521 | (completion-ignore-case nil) | |
522 | (case-fold-search nil) | |
523 | (string (file-name-nondirectory (buffer-string))) | |
524 | (completion-string (try-completion string file-cache-alist)) | |
525 | (completion-list) | |
526 | (len) | |
527 | (file-cache-string) | |
528 | ) | |
529 | (cond | |
530 | ;; If it's the longest match, insert it | |
531 | ((stringp completion-string) | |
532 | ;; If we've already inserted a unique string, see if the user | |
533 | ;; wants to use that one | |
534 | (if (and (string= string completion-string) | |
535 | (assoc string file-cache-alist)) | |
536 | (if (and (eq last-command this-command) | |
537 | (string= file-cache-last-completion completion-string)) | |
538 | (progn | |
539 | (erase-buffer) | |
540 | (insert-string (file-cache-file-name completion-string)) | |
541 | (setq file-cache-last-completion nil) | |
542 | ) | |
543 | (file-cache-temp-minibuffer-message file-cache-non-unique-message) | |
544 | (setq file-cache-last-completion string) | |
545 | ) | |
546 | (setq file-cache-last-completion string) | |
547 | (setq completion-list (all-completions string file-cache-alist) | |
548 | len (length completion-list)) | |
549 | (if (> len 1) | |
550 | (progn | |
551 | (goto-char (point-max)) | |
552 | (insert-string | |
553 | (substring completion-string (length string))) | |
554 | ;; Add our own setup function to the Completions Buffer | |
555 | (let ((completion-setup-hook | |
556 | (reverse | |
557 | (append (list 'file-cache-completion-setup-function) | |
558 | completion-setup-hook))) | |
559 | ) | |
560 | (with-output-to-temp-buffer file-cache-completions-buffer | |
561 | (display-completion-list completion-list)) | |
562 | ) | |
563 | ) | |
564 | (setq file-cache-string (file-cache-file-name completion-string)) | |
565 | (if (string= file-cache-string (buffer-string)) | |
566 | (file-cache-temp-minibuffer-message file-cache-sole-match-message) | |
567 | (erase-buffer) | |
568 | (insert-string file-cache-string) | |
569 | (if file-cache-multiple-directory-message | |
570 | (file-cache-temp-minibuffer-message | |
571 | file-cache-multiple-directory-message))) | |
572 | ))) | |
573 | ||
574 | ;; If it's the only match, replace the original contents | |
575 | ((eq completion-string t) | |
576 | (setq file-cache-string (file-cache-file-name string)) | |
577 | (if (string= file-cache-string (buffer-string)) | |
578 | (file-cache-temp-minibuffer-message file-cache-sole-match-message) | |
579 | (erase-buffer) | |
580 | (insert-string file-cache-string) | |
581 | (if file-cache-multiple-directory-message | |
582 | (file-cache-temp-minibuffer-message | |
583 | file-cache-multiple-directory-message)) | |
584 | )) | |
585 | ||
586 | ;; No match | |
587 | ((eq completion-string nil) | |
588 | (file-cache-temp-minibuffer-message file-cache-no-match-message)) | |
589 | ) | |
590 | )) | |
591 | ||
592 | ;; Lifted from "complete.el" | |
593 | (defun file-cache-temp-minibuffer-message (msg) | |
594 | "A Lisp version of `temp_minibuffer_message' from minibuf.c." | |
595 | (let ((savemax (point-max))) | |
596 | (save-excursion | |
597 | (goto-char (point-max)) | |
598 | (insert msg)) | |
599 | (let ((inhibit-quit t)) | |
600 | (sit-for 2) | |
601 | (delete-region savemax (point-max)) | |
602 | (if quit-flag | |
603 | (setq quit-flag nil | |
604 | unread-command-events (list 7)))))) | |
605 | ||
606 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
607 | ;; Completion functions | |
608 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
609 | ||
610 | (defun file-cache-completion-setup-function () | |
611 | (set-buffer file-cache-completions-buffer) | |
612 | ||
613 | (if file-cache-completions-keymap | |
614 | nil | |
615 | (setq file-cache-completions-keymap | |
616 | (copy-keymap completion-list-mode-map)) | |
617 | (define-key file-cache-completions-keymap [mouse-2] | |
618 | 'file-cache-mouse-choose-completion) | |
619 | (define-key file-cache-completions-keymap "\C-m" | |
620 | 'file-cache-choose-completion)) | |
621 | ||
622 | (use-local-map file-cache-completions-keymap) | |
623 | ) | |
624 | ||
625 | (defun file-cache-choose-completion () | |
626 | "Choose a completion in the `*Completions*' buffer." | |
627 | (interactive) | |
628 | (let ((completion-no-auto-exit t)) | |
629 | (choose-completion) | |
630 | (select-window (active-minibuffer-window)) | |
631 | (file-cache-minibuffer-complete) | |
632 | ) | |
633 | ) | |
634 | ||
635 | (defun file-cache-mouse-choose-completion (event) | |
636 | "Choose a completion with the mouse." | |
637 | (interactive "e") | |
638 | (let ((completion-no-auto-exit t)) | |
639 | (mouse-choose-completion event) | |
640 | (select-window (active-minibuffer-window)) | |
641 | (file-cache-minibuffer-complete) | |
642 | ) | |
643 | ) | |
644 | ||
645 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
646 | ;; Debugging functions | |
647 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
648 | ||
649 | (defun file-cache-debug-read-from-minibuffer (file) | |
650 | "Debugging function." | |
651 | (interactive | |
652 | (list (completing-read "File Cache: " file-cache-alist))) | |
653 | (message "%s" (assoc file file-cache-alist)) | |
654 | ) | |
655 | ||
656 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
657 | ;; Keybindings | |
658 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
659 | ||
660 | ;;;###autoload (define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete) | |
661 | ;;;###autoload (define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete) | |
662 | ;;;###autoload (define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete) | |
663 | ||
664 | (provide 'filecache) | |
665 | ||
666 | ;;; filecache.el ends here |