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