Add arch taglines
[bpt/emacs.git] / lisp / filecache.el
CommitLineData
ec3476d0 1;;; filecache.el --- find files using a pre-loaded cache
6b279740 2;;
b662c4bc 3;; Author: Peter Breton <pbreton@cs.umb.edu>
6b279740 4;; Created: Sun Nov 10 1996
f5f727f8 5;; Keywords: convenience
6b279740 6;;
dea0a87d 7;; Copyright (C) 1996, 2000 Free Software Foundation, Inc.
13161e8b
RS
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
6b279740
RS
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.
13161e8b
RS
15
16;; GNU Emacs is distributed in the hope that it will be useful,
6b279740 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13161e8b
RS
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
6b279740 21;; You should have received a copy of the GNU General Public License
13161e8b
RS
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
6b279740
RS
26;;; Commentary:
27;;
28;; The file-cache package is an attempt to make it easy to locate files
29;; by name, without having to remember exactly where they are located.
30;; This is very handy when working with source trees. You can also add
31;; frequently used files to the cache to create a hotlist effect.
32;; The cache can be used with any interactive command which takes a
33;; filename as an argument.
34;;
35;; It is worth noting that this package works best when most of the files
36;; in the cache have unique names, or (if they have the same name) exist in
37;; only a few directories. The worst case is many files all with
38;; the same name and in different directories, for example a big source tree
39;; with a Makefile in each directory. In such a case, you should probably
40;; use an alternate strategy to find the files.
41;;
42;; ADDING FILES TO THE CACHE:
43;;
44;; Use the following functions to add items to the file cache:
24ccf465 45;;
6b279740
RS
46;; * `file-cache-add-file': Adds a single file to the cache
47;;
48;; * `file-cache-add-file-list': Adds a list of files to the cache
49;;
50;; The following functions use the regular expressions in
51;; `file-cache-delete-regexps' to eliminate unwanted files:
24ccf465 52;;
6b279740
RS
53;; * `file-cache-add-directory': Adds the files in a directory to the
54;; cache. You can also specify a regular expression to match the files
55;; which should be added.
56;;
57;; * `file-cache-add-directory-list': Same as above, but acts on a list
58;; of directories. You can use `load-path', `exec-path' and the like.
59;;
60;; * `file-cache-add-directory-using-find': Uses the `find' command to
61;; add a directory tree to the cache.
62;;
63;; * `file-cache-add-directory-using-locate': Uses the `locate' command to
64;; add files matching a pattern to the cache.
65;;
57089611
PB
66;; * `file-cache-add-directory-recursively': Uses the find-lisp package to
67;; add all files matching a pattern to the cache.
68;;
6b279740
RS
69;; Use the function `file-cache-clear-cache' to remove all items from the
70;; cache. There are a number of `file-cache-delete' functions provided
71;; as well, but in general it is probably better to not worry too much
72;; about extra files in the cache.
73;;
74;; The most convenient way to initialize the cache is with an
b662c4bc
RS
75;; `eval-after-load' function, as noted in the ADDING FILES
76;; AUTOMATICALLY section.
6b279740
RS
77;;
78;; FINDING FILES USING THE CACHE:
79;;
80;; You can use the file-cache with any function that expects a filename as
81;; an argument. For example:
82;;
83;; 1) Invoke a function which expects a filename as an argument:
84;; M-x find-file
85;;
86;; 2) Begin typing a file name.
87;;
88;; 3) Invoke `file-cache-minibuffer-complete' (bound by default to
89;; C-TAB) to complete on the filename using the cache.
90;;
91;; 4) When you have found a unique completion, the minibuffer contents
92;; will change to the full name of that file.
24ccf465 93;;
6b279740
RS
94;; If there are a number of directories which contain the completion,
95;; invoking `file-cache-minibuffer-complete' repeatedly will cycle through
96;; them.
97;;
98;; 5) You can then edit the minibuffer contents, or press RETURN.
99;;
100;; It is much easier to simply try it than trying to explain it :)
101;;
b662c4bc 102;;; ADDING FILES AUTOMATICALLY
6b279740
RS
103;;
104;; For maximum utility, you should probably define an `eval-after-load'
105;; form which loads your favorite files:
106;;
24ccf465 107;; (eval-after-load
6b279740
RS
108;; "filecache"
109;; '(progn
110;; (message "Loading file cache...")
111;; (file-cache-add-directory-using-find "~/projects")
112;; (file-cache-add-directory-list load-path)
113;; (file-cache-add-directory "~/")
114;; (file-cache-add-file-list (list "~/foo/bar" "~/baz/bar"))
115;; ))
116;;
117;; If you clear and reload the cache frequently, it is probably easiest
118;; to put your initializations in a function:
119;;
24ccf465 120;; (eval-after-load
6b279740
RS
121;; "filecache"
122;; '(my-file-cache-initialize))
24ccf465 123;;
6b279740
RS
124;; (defun my-file-cache-initialize ()
125;; (interactive)
126;; (message "Loading file cache...")
127;; (file-cache-add-directory-using-find "~/projects")
128;; (file-cache-add-directory-list load-path)
129;; (file-cache-add-directory "~/")
130;; (file-cache-add-file-list (list "~/foo/bar" "~/baz/bar"))
131;; ))
132;;
133;; Of course, you can still add files to the cache afterwards, via
134;; Lisp functions.
135;;
136;; RELATED WORK:
24ccf465 137;;
6b279740
RS
138;; This package is a distant relative of Noah Friedman's fff utilities.
139;; Our goal is pretty similar, but the implementation strategies are
140;; different.
13161e8b 141
6b279740
RS
142;;; Code:
143
57089611
PB
144(eval-when-compile
145 (require 'find-lisp))
146
33933d45
AS
147(defgroup file-cache nil
148 "Find files using a pre-loaded cache."
149 :group 'files
f5f727f8 150 :group 'convenience
33933d45
AS
151 :prefix "file-cache-")
152
6b279740 153;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
b662c4bc 154;; Customization Variables
6b279740
RS
155;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
156
157;; User-modifiable variables
24ccf465
PB
158(defcustom file-cache-filter-regexps
159 (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$"
0a162908 160 "\\.$" "#$" "\\.class$")
6b279740
RS
161 "*List of regular expressions used as filters by the file cache.
162File names which match these expressions will not be added to the cache.
24ccf465 163Note that the functions `file-cache-add-file' and `file-cache-add-file-list'
33933d45
AS
164do not use this variable."
165 :type '(repeat regexp)
166 :group 'file-cache)
6b279740 167
33933d45
AS
168(defcustom file-cache-find-command "find"
169 "*External program used by `file-cache-add-directory-using-find'."
170 :type 'string
171 :group 'file-cache)
6b279740 172
33933d45
AS
173(defcustom file-cache-locate-command "locate"
174 "*External program used by `file-cache-add-directory-using-locate'."
175 :type 'string
176 :group 'file-cache)
6b279740
RS
177
178;; Minibuffer messages
33933d45
AS
179(defcustom file-cache-no-match-message " [File Cache: No match]"
180 "Message to display when there is no completion."
181 :type 'string
182 :group 'file-cache)
183
184(defcustom file-cache-sole-match-message " [File Cache: sole completion]"
185 "Message to display when there is only one completion."
186 :type 'string
187 :group 'file-cache)
188
189(defcustom file-cache-non-unique-message
190 " [File Cache: complete but not unique]"
191 "Message to display when there is a non-unique completion."
192 :type 'string
193 :group 'file-cache)
6b279740 194
24ccf465 195(defcustom file-cache-completion-ignore-case
c60ee5e7 196 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
24ccf465
PB
197 t
198 completion-ignore-case)
b047c9b7
GM
199 "If non-nil, file-cache completion should ignore case.
200Defaults to the value of `completion-ignore-case'."
201 :type 'sexp
202 :group 'file-cache
203 )
204
24ccf465 205(defcustom file-cache-case-fold-search
c60ee5e7 206 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
24ccf465
PB
207 t
208 case-fold-search)
209 "If non-nil, file-cache completion should ignore case.
210Defaults to the value of `case-fold-search'."
211 :type 'sexp
212 :group 'file-cache
213 )
214
215(defcustom file-cache-assoc-function
c60ee5e7 216 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
24ccf465
PB
217 'assoc-ignore-case
218 'assoc)
219 "Function to use to check completions in the file cache.
220Defaults to `assoc-ignore-case' on DOS and Windows, and `assoc' on
221other systems."
222 :type 'sexp
223 :group 'file-cache
224 )
225
6b279740
RS
226(defvar file-cache-multiple-directory-message nil)
227
228;; Internal variables
229;; This should be named *Completions* because that's what the function
230;; switch-to-completions in simple.el expects
33933d45
AS
231(defcustom file-cache-completions-buffer "*Completions*"
232 "Buffer to display completions when using the file cache."
233 :type 'string
234 :group 'file-cache)
235
24ccf465 236(defcustom file-cache-buffer "*File Cache*"
33933d45
AS
237 "Buffer to hold the cache of file names."
238 :type 'string
239 :group 'file-cache)
240
241(defcustom file-cache-buffer-default-regexp "^.+$"
242 "Regexp to match files in `file-cache-buffer'."
243 :type 'regexp
244 :group 'file-cache)
6b279740
RS
245
246(defvar file-cache-last-completion nil)
247
248(defvar file-cache-alist nil
249 "Internal data structure to hold cache of file names.")
250
251(defvar file-cache-completions-keymap nil
252 "Keymap for file cache completions buffer.")
253
254;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
255;; Functions to add files to the cache
256;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
257
258(defun file-cache-add-directory (directory &optional regexp)
259 "Add DIRECTORY to the file cache.
24ccf465 260If the optional REGEXP argument is non-nil, only files which match it will
6b279740 261be added to the cache."
b662c4bc
RS
262 (interactive "DAdd files from directory: ")
263 ;; Not an error, because otherwise we can't use load-paths that
264 ;; contain non-existent directories.
265 (if (not (file-accessible-directory-p directory))
266 (message "Directory %s does not exist" directory)
267 (let* ((dir (expand-file-name directory))
268 (dir-files (directory-files dir t regexp))
269 )
270 ;; Filter out files we don't want to see
271 (mapcar
272 '(lambda (file)
24ccf465 273 (mapcar
6b279740
RS
274 '(lambda (regexp)
275 (if (string-match regexp file)
276 (setq dir-files (delq file dir-files))))
277 file-cache-filter-regexps))
b662c4bc
RS
278 dir-files)
279 (file-cache-add-file-list dir-files))))
6b279740
RS
280
281(defun file-cache-add-directory-list (directory-list &optional regexp)
282 "Add DIRECTORY-LIST (a list of directory names) to the file cache.
24ccf465
PB
283If the optional REGEXP argument is non-nil, only files which match it
284will be added to the cache. Note that the REGEXP is applied to the files
6b279740
RS
285in each directory, not to the directory list itself."
286 (interactive "XAdd files from directory list: ")
24ccf465 287 (mapcar
6b279740
RS
288 '(lambda (dir) (file-cache-add-directory dir regexp))
289 directory-list))
290
291(defun file-cache-add-file-list (file-list)
292 "Add FILE-LIST (a list of files names) to the file cache."
293 (interactive "XFile List: ")
294 (mapcar 'file-cache-add-file file-list))
295
296;; Workhorse function
297(defun file-cache-add-file (file)
298 "Add FILE to the file cache."
299 (interactive "fAdd File: ")
b662c4bc
RS
300 (if (not (file-exists-p file))
301 (message "File %s does not exist" file)
302 (let* ((file-name (file-name-nondirectory file))
303 (dir-name (file-name-directory file))
24ccf465
PB
304 (the-entry (funcall file-cache-assoc-function
305 file-name file-cache-alist))
b662c4bc
RS
306 )
307 ;; Does the entry exist already?
308 (if the-entry
309 (if (or (and (stringp (cdr the-entry))
310 (string= dir-name (cdr the-entry)))
311 (and (listp (cdr the-entry))
312 (member dir-name (cdr the-entry))))
313 nil
314 (setcdr the-entry (append (list dir-name) (cdr the-entry)))
315 )
316 ;; If not, add it to the cache
317 (setq file-cache-alist
24ccf465 318 (cons (cons file-name (list dir-name))
b662c4bc
RS
319 file-cache-alist)))
320 )))
24ccf465 321
6b279740
RS
322(defun file-cache-add-directory-using-find (directory)
323 "Use the `find' command to add files to the file cache.
324Find is run in DIRECTORY."
325 (interactive "DAdd files under directory: ")
326 (let ((dir (expand-file-name directory)))
327 (set-buffer (get-buffer-create file-cache-buffer))
328 (erase-buffer)
24ccf465 329 (call-process file-cache-find-command nil
6b279740 330 (get-buffer file-cache-buffer) nil
24ccf465 331 dir "-name"
29ddd8fe 332 (if (eq system-type 'windows-nt) "'*'" "*")
6b279740
RS
333 "-print")
334 (file-cache-add-from-file-cache-buffer)))
335
336(defun file-cache-add-directory-using-locate (string)
337 "Use the `locate' command to add files to the file cache.
338STRING is passed as an argument to the locate command."
339 (interactive "sAdd files using locate string: ")
340 (set-buffer (get-buffer-create file-cache-buffer))
341 (erase-buffer)
24ccf465 342 (call-process file-cache-locate-command nil
6b279740
RS
343 (get-buffer file-cache-buffer) nil
344 string)
345 (file-cache-add-from-file-cache-buffer))
346
57089611
PB
347(defun file-cache-add-directory-recursively (dir &optional regexp)
348 "Adds DIR and any subdirectories to the file-cache.
349This function does not use any external programs
350If the optional REGEXP argument is non-nil, only files which match it
351will be added to the cache. Note that the REGEXP is applied to the files
352in each directory, not to the directory list itself."
353 (interactive "DAdd directory: ")
354 (require 'find-lisp)
355 (mapcar
356 (function
357 (lambda(file)
358 (or (file-directory-p file)
359 (let (filtered)
360 (mapcar
361 (function
362 (lambda(regexp)
363 (and (string-match regexp file)
364 (setq filtered t))
365 ))
366 file-cache-filter-regexps)
367 filtered)
368 (file-cache-add-file file))))
369 (find-lisp-find-files dir (if regexp regexp "^"))))
370
6b279740
RS
371(defun file-cache-add-from-file-cache-buffer (&optional regexp)
372 "Add any entries found in the file cache buffer.
373Each entry matches the regular expression `file-cache-buffer-default-regexp'
374or the optional REGEXP argument."
375 (set-buffer file-cache-buffer)
24ccf465 376 (mapcar
6b279740
RS
377 (function (lambda (elt)
378 (goto-char (point-min))
379 (delete-matching-lines elt)))
380 file-cache-filter-regexps)
381 (goto-char (point-min))
382 (let ((full-filename))
383 (while (re-search-forward
24ccf465 384 (or regexp file-cache-buffer-default-regexp)
6b279740
RS
385 (point-max) t)
386 (setq full-filename (buffer-substring-no-properties
24ccf465 387 (match-beginning 0) (match-end 0)))
6b279740
RS
388 (file-cache-add-file full-filename))))
389
390;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
391;; Functions to delete from the cache
392;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
393
394(defun file-cache-clear-cache ()
395 "Clear the file cache."
396 (interactive)
397 (setq file-cache-alist nil))
398
399;; This clears *all* files with the given name
400(defun file-cache-delete-file (file)
401 "Delete FILE from the file cache."
402 (interactive
403 (list (completing-read "Delete file from cache: " file-cache-alist)))
24ccf465
PB
404 (setq file-cache-alist
405 (delq (funcall file-cache-assoc-function file file-cache-alist)
406 file-cache-alist)))
6b279740
RS
407
408(defun file-cache-delete-file-list (file-list)
409 "Delete FILE-LIST (a list of files) from the file cache."
410 (interactive "XFile List: ")
411 (mapcar 'file-cache-delete-file file-list))
412
413(defun file-cache-delete-file-regexp (regexp)
414 "Delete files matching REGEXP from the file cache."
415 (interactive "sRegexp: ")
416 (let ((delete-list))
24ccf465 417 (mapcar '(lambda (elt)
6b279740
RS
418 (and (string-match regexp (car elt))
419 (setq delete-list (cons (car elt) delete-list))))
420 file-cache-alist)
421 (file-cache-delete-file-list delete-list)
422 (message "Deleted %d files from file cache" (length delete-list))))
423
424(defun file-cache-delete-directory (directory)
425 "Delete DIRECTORY from the file cache."
426 (interactive "DDelete directory from file cache: ")
427 (let ((dir (expand-file-name directory))
428 (result 0))
24ccf465
PB
429 (mapcar
430 '(lambda (entry)
6b279740
RS
431 (if (file-cache-do-delete-directory dir entry)
432 (setq result (1+ result))))
433 file-cache-alist)
434 (if (zerop result)
435 (error "No entries containing %s found in cache" directory)
436 (message "Deleted %d entries" result))))
437
438(defun file-cache-do-delete-directory (dir entry)
439 (let ((directory-list (cdr entry))
440 (directory (file-cache-canonical-directory dir))
441 )
442 (and (member directory directory-list)
443 (if (equal 1 (length directory-list))
24ccf465 444 (setq file-cache-alist
6b279740
RS
445 (delq entry file-cache-alist))
446 (setcdr entry (delete directory directory-list)))
447 )
448 ))
449
450(defun file-cache-delete-directory-list (directory-list)
451 "Delete DIRECTORY-LIST (a list of directories) from the file cache."
452 (interactive "XDirectory List: ")
453 (mapcar 'file-cache-delete-directory directory-list))
454
455;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
456;; Utility functions
457;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
458
459;; Returns the name of a directory for a file in the cache
460(defun file-cache-directory-name (file)
24ccf465
PB
461 (let* ((directory-list (cdr (funcall file-cache-assoc-function
462 file file-cache-alist)))
6b279740
RS
463 (len (length directory-list))
464 (directory)
465 (num)
466 )
467 (if (not (listp directory-list))
468 (error "Unknown type in file-cache-alist for key %s" file))
24ccf465 469 (cond
6b279740
RS
470 ;; Single element
471 ((eq 1 len)
472 (setq directory (elt directory-list 0)))
473 ;; No elements
474 ((eq 0 len)
475 (error "No directory found for key %s" file))
476 ;; Multiple elements
477 (t
dea0a87d 478 (let* ((minibuffer-dir (file-name-directory (minibuffer-contents)))
6b279740
RS
479 (dir-list (member minibuffer-dir directory-list))
480 )
481 (setq directory
482 ;; If the directory is in the list, return the next element
483 ;; Otherwise, return the first element
24ccf465
PB
484 (if dir-list
485 (or (elt directory-list
6b279740
RS
486 (setq num (1+ (- len (length dir-list)))))
487 (elt directory-list (setq num 0)))
488 (elt directory-list (setq num 0))))
489 )
490 )
491 )
492 ;; If there were multiple directories, set up a minibuffer message
493 (setq file-cache-multiple-directory-message
494 (and num (format " [%d of %d]" (1+ num) len)))
495 directory))
496
497;; Returns the name of a file in the cache
498(defun file-cache-file-name (file)
499 (let ((directory (file-cache-directory-name file)))
500 (concat directory file)))
24ccf465 501
6b279740
RS
502;; Return a canonical directory for comparison purposes.
503;; Such a directory ends with a forward slash.
504(defun file-cache-canonical-directory (dir)
505 (let ((directory dir))
506 (if (not (char-equal ?/ (string-to-char (substring directory -1))))
507 (concat directory "/")
508 directory)))
509
510;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
511;; Minibuffer functions
512;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
513
13161e8b
RS
514;; The prefix argument works around a bug in the minibuffer completion.
515;; The completion function doesn't distinguish between the states:
24ccf465 516;;
13161e8b
RS
517;; "Multiple completions of name" (eg, Makefile, Makefile.in)
518;; "Name available in multiple directories" (/tmp/Makefile, ~me/Makefile)
24ccf465 519;;
13161e8b
RS
520;; The default is to do the former; a prefix arg forces the latter.
521
6b279740 522;;;###autoload
13161e8b
RS
523(defun file-cache-minibuffer-complete (arg)
524 "Complete a filename in the minibuffer using a preloaded cache.
525Filecache does two kinds of substitution: it completes on names in
526the cache, and, once it has found a unique name, it cycles through
24ccf465
PB
527the directories that the name is available in. With a prefix argument,
528the name is considered already unique; only the second substitution
13161e8b 529\(directories) is done."
24ccf465
PB
530 (interactive "P")
531 (let*
6b279740 532 (
b047c9b7 533 (completion-ignore-case file-cache-completion-ignore-case)
24ccf465 534 (case-fold-search file-cache-case-fold-search)
dea0a87d 535 (string (file-name-nondirectory (minibuffer-contents)))
13161e8b 536 (completion-string (try-completion string file-cache-alist))
6b279740
RS
537 (completion-list)
538 (len)
539 (file-cache-string)
540 )
24ccf465 541 (cond
13161e8b
RS
542 ;; If it's the only match, replace the original contents
543 ((or arg (eq completion-string t))
544 (setq file-cache-string (file-cache-file-name string))
dea0a87d 545 (if (string= file-cache-string (minibuffer-contents))
13161e8b 546 (file-cache-temp-minibuffer-message file-cache-sole-match-message)
dea0a87d 547 (delete-minibuffer-contents)
add91c7b 548 (insert file-cache-string)
13161e8b 549 (if file-cache-multiple-directory-message
24ccf465 550 (file-cache-temp-minibuffer-message
13161e8b
RS
551 file-cache-multiple-directory-message))
552 ))
553
6b279740
RS
554 ;; If it's the longest match, insert it
555 ((stringp completion-string)
556 ;; If we've already inserted a unique string, see if the user
557 ;; wants to use that one
558 (if (and (string= string completion-string)
24ccf465 559 (funcall file-cache-assoc-function string file-cache-alist))
6b279740
RS
560 (if (and (eq last-command this-command)
561 (string= file-cache-last-completion completion-string))
24ccf465 562 (progn
dea0a87d 563 (delete-minibuffer-contents)
add91c7b 564 (insert (file-cache-file-name completion-string))
6b279740
RS
565 (setq file-cache-last-completion nil)
566 )
567 (file-cache-temp-minibuffer-message file-cache-non-unique-message)
568 (setq file-cache-last-completion string)
569 )
570 (setq file-cache-last-completion string)
571 (setq completion-list (all-completions string file-cache-alist)
572 len (length completion-list))
573 (if (> len 1)
574 (progn
575 (goto-char (point-max))
add91c7b 576 (insert
6b279740
RS
577 (substring completion-string (length string)))
578 ;; Add our own setup function to the Completions Buffer
579 (let ((completion-setup-hook
24ccf465 580 (reverse
6b279740
RS
581 (append (list 'file-cache-completion-setup-function)
582 completion-setup-hook)))
583 )
584 (with-output-to-temp-buffer file-cache-completions-buffer
585 (display-completion-list completion-list))
586 )
587 )
588 (setq file-cache-string (file-cache-file-name completion-string))
dea0a87d 589 (if (string= file-cache-string (minibuffer-contents))
24ccf465 590 (file-cache-temp-minibuffer-message
13161e8b 591 file-cache-sole-match-message)
dea0a87d 592 (delete-minibuffer-contents)
add91c7b 593 (insert file-cache-string)
6b279740 594 (if file-cache-multiple-directory-message
24ccf465 595 (file-cache-temp-minibuffer-message
6b279740
RS
596 file-cache-multiple-directory-message)))
597 )))
24ccf465 598
6b279740
RS
599 ;; No match
600 ((eq completion-string nil)
601 (file-cache-temp-minibuffer-message file-cache-no-match-message))
602 )
603))
604
605;; Lifted from "complete.el"
606(defun file-cache-temp-minibuffer-message (msg)
607 "A Lisp version of `temp_minibuffer_message' from minibuf.c."
608 (let ((savemax (point-max)))
609 (save-excursion
610 (goto-char (point-max))
611 (insert msg))
612 (let ((inhibit-quit t))
613 (sit-for 2)
614 (delete-region savemax (point-max))
615 (if quit-flag
616 (setq quit-flag nil
617 unread-command-events (list 7))))))
618
619;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
620;; Completion functions
621;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
622
623(defun file-cache-completion-setup-function ()
624 (set-buffer file-cache-completions-buffer)
625
626 (if file-cache-completions-keymap
627 nil
24ccf465 628 (setq file-cache-completions-keymap
6b279740 629 (copy-keymap completion-list-mode-map))
24ccf465
PB
630 (define-key file-cache-completions-keymap [mouse-2]
631 'file-cache-mouse-choose-completion)
632 (define-key file-cache-completions-keymap "\C-m"
6b279740
RS
633 'file-cache-choose-completion))
634
635 (use-local-map file-cache-completions-keymap)
636 )
637
638(defun file-cache-choose-completion ()
639 "Choose a completion in the `*Completions*' buffer."
640 (interactive)
641 (let ((completion-no-auto-exit t))
642 (choose-completion)
643 (select-window (active-minibuffer-window))
13161e8b 644 (file-cache-minibuffer-complete nil)
6b279740
RS
645 )
646 )
647
648(defun file-cache-mouse-choose-completion (event)
649 "Choose a completion with the mouse."
650 (interactive "e")
651 (let ((completion-no-auto-exit t))
652 (mouse-choose-completion event)
653 (select-window (active-minibuffer-window))
13161e8b 654 (file-cache-minibuffer-complete nil)
6b279740
RS
655 )
656 )
657
57089611
PB
658(defun file-cache-complete ()
659 "Complete the word at point, using the filecache."
660 (interactive)
661 (let (start pattern completion all)
662 (save-excursion
663 (skip-syntax-backward "^\"")
664 (setq start (point)))
665 (setq pattern (buffer-substring-no-properties start (point)))
666 (setq completion (try-completion pattern file-cache-alist))
667 (setq all (all-completions pattern file-cache-alist nil))
668 (cond ((eq completion t))
669 ((null completion)
670 (message "Can't find completion for \"%s\"" pattern)
671 (ding))
672 ((not (string= pattern completion))
673 (delete-region start (point))
674 (insert completion)
675 )
676 (t
677 (with-output-to-temp-buffer "*Completions*"
678 (display-completion-list all))
679 ))
680 ))
681
b047c9b7
GM
682;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
683;; Show parts of the cache
684;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
685
686(defun file-cache-files-matching-internal (regexp)
687 "Output a list of files whose names (not including directories)
688match REGEXP."
689 (let ((results))
690 (mapcar
691 (function
692 (lambda(cache-element)
693 (and (string-match regexp
694 (elt cache-element 0))
695 (if results
696 (nconc results (list (elt cache-element 0)))
697 (setq results (list (elt cache-element 0)))))))
698 file-cache-alist)
699 results))
700
701(defun file-cache-files-matching (regexp)
702 "Output a list of files whose names (not including directories)
703match REGEXP."
704 (interactive "sFind files matching regexp: ")
24ccf465 705 (let ((results
b047c9b7
GM
706 (file-cache-files-matching-internal regexp))
707 buf)
24ccf465
PB
708 (set-buffer
709 (setq buf (get-buffer-create
b047c9b7
GM
710 "*File Cache Files Matching*")))
711 (erase-buffer)
712 (insert
713 (mapconcat
714 'identity
715 results
716 "\n"))
717 (goto-char (point-min))
718 (display-buffer buf)))
719
6b279740
RS
720;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
721;; Debugging functions
722;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
723
724(defun file-cache-debug-read-from-minibuffer (file)
725 "Debugging function."
24ccf465 726 (interactive
6b279740 727 (list (completing-read "File Cache: " file-cache-alist)))
24ccf465 728 (message "%s" (funcall file-cache-assoc-function file file-cache-alist))
6b279740
RS
729 )
730
57089611
PB
731(defun file-cache-display ()
732 "Display the file cache."
733 (interactive)
734 (let ((buf "*File Cache Contents*"))
735 (with-current-buffer
736 (get-buffer-create buf)
737 (erase-buffer)
738 (mapcar
739 (function
740 (lambda(item)
741 (insert (nth 1 item) (nth 0 item) "\n")))
742 file-cache-alist)
743 (pop-to-buffer buf)
744 )))
745
6b279740
RS
746;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
747;; Keybindings
748;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
749
750;;;###autoload (define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete)
751;;;###autoload (define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete)
752;;;###autoload (define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete)
753
754(provide 'filecache)
755
ab5796a9 756;;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538
6b279740 757;;; filecache.el ends here