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