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