Synch with Gnus trunk:
[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,
114f9c96 4;; 2008, 2009, 2010 Free Software Foundation, Inc.
ae732337 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 157(defcustom file-cache-filter-regexps
20565545
SM
158 ;; These are also used in buffers containing lines of file names,
159 ;; so the end-of-name is matched with $ rather than \\'.
24ccf465 160 (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$"
0a162908 161 "\\.$" "#$" "\\.class$")
9201cc28 162 "List of regular expressions used as filters by the file cache.
6b279740 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 169(defcustom file-cache-find-command "find"
9201cc28 170 "External program used by `file-cache-add-directory-using-find'."
33933d45
AS
171 :type 'string
172 :group 'file-cache)
6b279740 173
6e74cce2 174(defcustom file-cache-find-command-posix-flag 'not-defined
9201cc28 175 "Set to t, if `file-cache-find-command' handles wildcards POSIX style.
6e74cce2
RS
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 187(defcustom file-cache-locate-command "locate"
9201cc28 188 "External program used by `file-cache-add-directory-using-locate'."
33933d45
AS
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'."
20565545
SM
215 :type 'boolean
216 :group 'file-cache)
b047c9b7 217
24ccf465 218(defcustom file-cache-case-fold-search
c60ee5e7 219 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
24ccf465
PB
220 t
221 case-fold-search)
222 "If non-nil, file-cache completion should ignore case.
223Defaults to the value of `case-fold-search'."
20565545
SM
224 :type 'boolean
225 :group 'file-cache)
24ccf465 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."
20565545
SM
231 :type 'boolean
232 :group 'file-cache)
24ccf465 233
6b279740
RS
234(defvar file-cache-multiple-directory-message nil)
235
236;; Internal variables
237;; This should be named *Completions* because that's what the function
238;; switch-to-completions in simple.el expects
33933d45
AS
239(defcustom file-cache-completions-buffer "*Completions*"
240 "Buffer to display completions when using the file cache."
241 :type 'string
242 :group 'file-cache)
243
24ccf465 244(defcustom file-cache-buffer "*File Cache*"
33933d45
AS
245 "Buffer to hold the cache of file names."
246 :type 'string
247 :group 'file-cache)
248
249(defcustom file-cache-buffer-default-regexp "^.+$"
250 "Regexp to match files in `file-cache-buffer'."
251 :type 'regexp
252 :group 'file-cache)
6b279740
RS
253
254(defvar file-cache-last-completion nil)
255
256(defvar file-cache-alist nil
bed4c972
SM
257 "Internal data structure to hold cache of file names.
258It is a list of entries of the form (FILENAME DIRNAME1 DIRNAME2 ...)
259where FILENAME is a file name component and the entry represents N
260files of names DIRNAME1/FILENAME, DIRNAME2/FILENAME, ...")
6b279740 261
d8e1753c
SM
262(defvar file-cache-completions-keymap
263 (let ((map (make-sparse-keymap)))
264 (set-keymap-parent map completion-list-mode-map)
ae732337 265 (define-key map [mouse-2] 'file-cache-choose-completion)
d8e1753c
SM
266 (define-key map "\C-m" 'file-cache-choose-completion)
267 map)
6b279740
RS
268 "Keymap for file cache completions buffer.")
269
270;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
271;; Functions to add files to the cache
272;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
273
3b5e5e30 274;;;###autoload
6b279740
RS
275(defun file-cache-add-directory (directory &optional regexp)
276 "Add DIRECTORY to the file cache.
24ccf465 277If the optional REGEXP argument is non-nil, only files which match it will
6b279740 278be added to the cache."
b662c4bc
RS
279 (interactive "DAdd files from directory: ")
280 ;; Not an error, because otherwise we can't use load-paths that
281 ;; contain non-existent directories.
282 (if (not (file-accessible-directory-p directory))
283 (message "Directory %s does not exist" directory)
284 (let* ((dir (expand-file-name directory))
20565545 285 (dir-files (directory-files dir t regexp)))
b662c4bc 286 ;; Filter out files we don't want to see
20565545
SM
287 (dolist (file dir-files)
288 (if (file-directory-p file)
289 (setq dir-files (delq file dir-files))
290 (dolist (regexp file-cache-filter-regexps)
291 (if (string-match regexp file)
292 (setq dir-files (delq file dir-files))))))
b662c4bc 293 (file-cache-add-file-list dir-files))))
6b279740 294
3b5e5e30 295;;;###autoload
6b279740
RS
296(defun file-cache-add-directory-list (directory-list &optional regexp)
297 "Add DIRECTORY-LIST (a list of directory names) to the file cache.
24ccf465
PB
298If the optional REGEXP argument is non-nil, only files which match it
299will be added to the cache. Note that the REGEXP is applied to the files
6b279740
RS
300in each directory, not to the directory list itself."
301 (interactive "XAdd files from directory list: ")
24ccf465 302 (mapcar
20565545 303 (lambda (dir) (file-cache-add-directory dir regexp))
6b279740
RS
304 directory-list))
305
306(defun file-cache-add-file-list (file-list)
307 "Add FILE-LIST (a list of files names) to the file cache."
308 (interactive "XFile List: ")
309 (mapcar 'file-cache-add-file file-list))
310
311;; Workhorse function
3b5e5e30
RS
312
313;;;###autoload
6b279740
RS
314(defun file-cache-add-file (file)
315 "Add FILE to the file cache."
316 (interactive "fAdd File: ")
b662c4bc 317 (if (not (file-exists-p file))
bbc66b08 318 (message "Filecache: file %s does not exist" file)
b662c4bc
RS
319 (let* ((file-name (file-name-nondirectory file))
320 (dir-name (file-name-directory file))
3750be31
RS
321 (the-entry (assoc-string
322 file-name file-cache-alist
20565545 323 file-cache-ignore-case)))
b662c4bc
RS
324 ;; Does the entry exist already?
325 (if the-entry
326 (if (or (and (stringp (cdr the-entry))
327 (string= dir-name (cdr the-entry)))
328 (and (listp (cdr the-entry))
329 (member dir-name (cdr the-entry))))
330 nil
bed4c972 331 (setcdr the-entry (cons dir-name (cdr the-entry))))
b662c4bc 332 ;; If not, add it to the cache
bed4c972 333 (push (list file-name dir-name) file-cache-alist)))))
24ccf465 334
3b5e5e30 335;;;###autoload
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
3b5e5e30 358;;;###autoload
6b279740
RS
359(defun file-cache-add-directory-using-locate (string)
360 "Use the `locate' command to add files to the file cache.
361STRING is passed as an argument to the locate command."
362 (interactive "sAdd files using locate string: ")
363 (set-buffer (get-buffer-create file-cache-buffer))
364 (erase-buffer)
24ccf465 365 (call-process file-cache-locate-command nil
6b279740
RS
366 (get-buffer file-cache-buffer) nil
367 string)
368 (file-cache-add-from-file-cache-buffer))
369
3b5e5e30 370;;;###autoload
57089611
PB
371(defun file-cache-add-directory-recursively (dir &optional regexp)
372 "Adds DIR and any subdirectories to the file-cache.
373This function does not use any external programs
374If the optional REGEXP argument is non-nil, only files which match it
375will be added to the cache. Note that the REGEXP is applied to the files
376in each directory, not to the directory list itself."
377 (interactive "DAdd directory: ")
378 (require 'find-lisp)
379 (mapcar
380 (function
20565545 381 (lambda (file)
57089611
PB
382 (or (file-directory-p file)
383 (let (filtered)
20565545
SM
384 (dolist (regexp file-cache-filter-regexps)
385 (and (string-match regexp file)
386 (setq filtered t)))
387 filtered)
57089611
PB
388 (file-cache-add-file file))))
389 (find-lisp-find-files dir (if regexp regexp "^"))))
390
6b279740
RS
391(defun file-cache-add-from-file-cache-buffer (&optional regexp)
392 "Add any entries found in the file cache buffer.
393Each entry matches the regular expression `file-cache-buffer-default-regexp'
394or the optional REGEXP argument."
395 (set-buffer file-cache-buffer)
20565545
SM
396 (dolist (elt file-cache-filter-regexps)
397 (goto-char (point-min))
398 (delete-matching-lines elt))
6b279740
RS
399 (goto-char (point-min))
400 (let ((full-filename))
401 (while (re-search-forward
24ccf465 402 (or regexp file-cache-buffer-default-regexp)
6b279740
RS
403 (point-max) t)
404 (setq full-filename (buffer-substring-no-properties
24ccf465 405 (match-beginning 0) (match-end 0)))
6b279740
RS
406 (file-cache-add-file full-filename))))
407
408;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
409;; Functions to delete from the cache
410;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
411
412(defun file-cache-clear-cache ()
413 "Clear the file cache."
414 (interactive)
415 (setq file-cache-alist nil))
416
417;; This clears *all* files with the given name
418(defun file-cache-delete-file (file)
419 "Delete FILE from the file cache."
420 (interactive
421 (list (completing-read "Delete file from cache: " file-cache-alist)))
24ccf465 422 (setq file-cache-alist
3750be31 423 (delq (assoc-string file file-cache-alist file-cache-ignore-case)
24ccf465 424 file-cache-alist)))
6b279740
RS
425
426(defun file-cache-delete-file-list (file-list)
427 "Delete FILE-LIST (a list of files) from the file cache."
428 (interactive "XFile List: ")
429 (mapcar 'file-cache-delete-file file-list))
430
431(defun file-cache-delete-file-regexp (regexp)
432 "Delete files matching REGEXP from the file cache."
433 (interactive "sRegexp: ")
434 (let ((delete-list))
20565545
SM
435 (dolist (elt file-cache-alist)
436 (and (string-match regexp (car elt))
437 (push (car elt) delete-list)))
6b279740 438 (file-cache-delete-file-list delete-list)
bbc66b08
EZ
439 (message "Filecache: deleted %d files from file cache"
440 (length delete-list))))
6b279740
RS
441
442(defun file-cache-delete-directory (directory)
443 "Delete DIRECTORY from the file cache."
444 (interactive "DDelete directory from file cache: ")
445 (let ((dir (expand-file-name directory))
446 (result 0))
20565545
SM
447 (dolist (entry file-cache-alist)
448 (if (file-cache-do-delete-directory dir entry)
449 (setq result (1+ result))))
6b279740 450 (if (zerop result)
bbc66b08
EZ
451 (error "Filecache: no entries containing %s found in cache" directory)
452 (message "Filecache: deleted %d entries" result))))
6b279740
RS
453
454(defun file-cache-do-delete-directory (dir entry)
455 (let ((directory-list (cdr entry))
20565545 456 (directory (file-cache-canonical-directory dir)))
6b279740
RS
457 (and (member directory directory-list)
458 (if (equal 1 (length directory-list))
24ccf465 459 (setq file-cache-alist
6b279740 460 (delq entry file-cache-alist))
20565545 461 (setcdr entry (delete directory directory-list))))))
6b279740
RS
462
463(defun file-cache-delete-directory-list (directory-list)
464 "Delete DIRECTORY-LIST (a list of directories) from the file cache."
465 (interactive "XDirectory List: ")
466 (mapcar 'file-cache-delete-directory directory-list))
467
468;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
469;; Utility functions
470;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
471
472;; Returns the name of a directory for a file in the cache
473(defun file-cache-directory-name (file)
3750be31
RS
474 (let* ((directory-list (cdr (assoc-string
475 file file-cache-alist
476 file-cache-ignore-case)))
6b279740
RS
477 (len (length directory-list))
478 (directory)
20565545 479 (num))
6b279740 480 (if (not (listp directory-list))
bbc66b08 481 (error "Filecache: unknown type in file-cache-alist for key %s" file))
24ccf465 482 (cond
6b279740
RS
483 ;; Single element
484 ((eq 1 len)
485 (setq directory (elt directory-list 0)))
486 ;; No elements
487 ((eq 0 len)
bbc66b08 488 (error "Filecache: no directory found for key %s" file))
6b279740
RS
489 ;; Multiple elements
490 (t
dea0a87d 491 (let* ((minibuffer-dir (file-name-directory (minibuffer-contents)))
20565545 492 (dir-list (member minibuffer-dir directory-list)))
6b279740
RS
493 (setq directory
494 ;; If the directory is in the list, return the next element
495 ;; Otherwise, return the first element
24ccf465
PB
496 (if dir-list
497 (or (elt directory-list
6b279740
RS
498 (setq num (1+ (- len (length dir-list)))))
499 (elt directory-list (setq num 0)))
20565545 500 (elt directory-list (setq num 0)))))))
6b279740
RS
501 ;; If there were multiple directories, set up a minibuffer message
502 (setq file-cache-multiple-directory-message
503 (and num (format " [%d of %d]" (1+ num) len)))
504 directory))
505
506;; Returns the name of a file in the cache
507(defun file-cache-file-name (file)
508 (let ((directory (file-cache-directory-name file)))
509 (concat directory file)))
24ccf465 510
6b279740
RS
511;; Return a canonical directory for comparison purposes.
512;; Such a directory ends with a forward slash.
513(defun file-cache-canonical-directory (dir)
514 (let ((directory dir))
515 (if (not (char-equal ?/ (string-to-char (substring directory -1))))
516 (concat directory "/")
517 directory)))
518
519;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
520;; Minibuffer functions
521;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
522
13161e8b
RS
523;; The prefix argument works around a bug in the minibuffer completion.
524;; The completion function doesn't distinguish between the states:
24ccf465 525;;
13161e8b
RS
526;; "Multiple completions of name" (eg, Makefile, Makefile.in)
527;; "Name available in multiple directories" (/tmp/Makefile, ~me/Makefile)
24ccf465 528;;
13161e8b
RS
529;; The default is to do the former; a prefix arg forces the latter.
530
6b279740 531;;;###autoload
13161e8b
RS
532(defun file-cache-minibuffer-complete (arg)
533 "Complete a filename in the minibuffer using a preloaded cache.
534Filecache does two kinds of substitution: it completes on names in
535the cache, and, once it has found a unique name, it cycles through
24ccf465
PB
536the directories that the name is available in. With a prefix argument,
537the name is considered already unique; only the second substitution
13161e8b 538\(directories) is done."
24ccf465
PB
539 (interactive "P")
540 (let*
6b279740 541 (
b047c9b7 542 (completion-ignore-case file-cache-completion-ignore-case)
24ccf465 543 (case-fold-search file-cache-case-fold-search)
dea0a87d 544 (string (file-name-nondirectory (minibuffer-contents)))
13161e8b 545 (completion-string (try-completion string file-cache-alist))
6b279740
RS
546 (completion-list)
547 (len)
20565545 548 (file-cache-string))
24ccf465 549 (cond
13161e8b
RS
550 ;; If it's the only match, replace the original contents
551 ((or arg (eq completion-string t))
552 (setq file-cache-string (file-cache-file-name string))
dea0a87d 553 (if (string= file-cache-string (minibuffer-contents))
20565545 554 (minibuffer-message file-cache-sole-match-message)
dea0a87d 555 (delete-minibuffer-contents)
add91c7b 556 (insert file-cache-string)
13161e8b 557 (if file-cache-multiple-directory-message
20565545 558 (minibuffer-message file-cache-multiple-directory-message))))
13161e8b 559
6b279740
RS
560 ;; If it's the longest match, insert it
561 ((stringp completion-string)
562 ;; If we've already inserted a unique string, see if the user
563 ;; wants to use that one
564 (if (and (string= string completion-string)
3750be31
RS
565 (assoc-string string file-cache-alist
566 file-cache-ignore-case))
6b279740
RS
567 (if (and (eq last-command this-command)
568 (string= file-cache-last-completion completion-string))
24ccf465 569 (progn
dea0a87d 570 (delete-minibuffer-contents)
add91c7b 571 (insert (file-cache-file-name completion-string))
20565545
SM
572 (setq file-cache-last-completion nil))
573 (minibuffer-message file-cache-non-unique-message)
574 (setq file-cache-last-completion string))
6b279740
RS
575 (setq file-cache-last-completion string)
576 (setq completion-list (all-completions string file-cache-alist)
577 len (length completion-list))
578 (if (> len 1)
579 (progn
580 (goto-char (point-max))
add91c7b 581 (insert
6b279740
RS
582 (substring completion-string (length string)))
583 ;; Add our own setup function to the Completions Buffer
584 (let ((completion-setup-hook
d8e1753c
SM
585 (append completion-setup-hook
586 (list 'file-cache-completion-setup-function))))
6b279740 587 (with-output-to-temp-buffer file-cache-completions-buffer
d8e1753c 588 (display-completion-list completion-list string))))
6b279740 589 (setq file-cache-string (file-cache-file-name completion-string))
dea0a87d 590 (if (string= file-cache-string (minibuffer-contents))
20565545 591 (minibuffer-message file-cache-sole-match-message)
dea0a87d 592 (delete-minibuffer-contents)
add91c7b 593 (insert file-cache-string)
6b279740 594 (if file-cache-multiple-directory-message
20565545 595 (minibuffer-message file-cache-multiple-directory-message)))
6b279740 596 )))
24ccf465 597
6b279740
RS
598 ;; No match
599 ((eq completion-string nil)
20565545 600 (minibuffer-message file-cache-no-match-message)))))
6b279740
RS
601
602;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
603;; Completion functions
604;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605
606(defun file-cache-completion-setup-function ()
d8e1753c
SM
607 (with-current-buffer standard-output ;; i.e. file-cache-completions-buffer
608 (use-local-map file-cache-completions-keymap)))
6b279740 609
ae732337 610(defun file-cache-choose-completion (&optional event)
6b279740 611 "Choose a completion in the `*Completions*' buffer."
ae732337 612 (interactive (list last-nonmenu-event))
6b279740 613 (let ((completion-no-auto-exit t))
ae732337 614 (choose-completion event)
6b279740 615 (select-window (active-minibuffer-window))
ae732337 616 (file-cache-minibuffer-complete nil)))
6b279740 617
ae732337
GM
618(define-obsolete-function-alias 'file-cache-mouse-choose-completion
619 'file-cache-choose-completion "23.2")
6b279740 620
57089611
PB
621(defun file-cache-complete ()
622 "Complete the word at point, using the filecache."
623 (interactive)
bed4c972 624 (let ((start
57089611
PB
625 (save-excursion
626 (skip-syntax-backward "^\"")
bed4c972
SM
627 (point))))
628 (completion-in-region start (point) file-cache-alist)))
57089611 629
b047c9b7
GM
630;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
631;; Show parts of the cache
632;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
633
634(defun file-cache-files-matching-internal (regexp)
635 "Output a list of files whose names (not including directories)
636match REGEXP."
637 (let ((results))
20565545
SM
638 (dolist (cache-element file-cache-alist)
639 (and (string-match regexp (elt cache-element 0))
640 (push (elt cache-element 0) results)))
641 (nreverse results)))
b047c9b7
GM
642
643(defun file-cache-files-matching (regexp)
644 "Output a list of files whose names (not including directories)
645match REGEXP."
646 (interactive "sFind files matching regexp: ")
24ccf465 647 (let ((results
b047c9b7
GM
648 (file-cache-files-matching-internal regexp))
649 buf)
24ccf465
PB
650 (set-buffer
651 (setq buf (get-buffer-create
b047c9b7
GM
652 "*File Cache Files Matching*")))
653 (erase-buffer)
654 (insert
655 (mapconcat
656 'identity
657 results
658 "\n"))
659 (goto-char (point-min))
660 (display-buffer buf)))
661
6b279740
RS
662;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
663;; Debugging functions
664;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
665
666(defun file-cache-debug-read-from-minibuffer (file)
667 "Debugging function."
24ccf465 668 (interactive
6b279740 669 (list (completing-read "File Cache: " file-cache-alist)))
3750be31 670 (message "%s" (assoc-string file file-cache-alist
20565545 671 file-cache-ignore-case)))
6b279740 672
57089611
PB
673(defun file-cache-display ()
674 "Display the file cache."
675 (interactive)
676 (let ((buf "*File Cache Contents*"))
677 (with-current-buffer
678 (get-buffer-create buf)
679 (erase-buffer)
20565545
SM
680 (dolist (item file-cache-alist)
681 (insert (nth 1 item) (nth 0 item) "\n"))
682 (pop-to-buffer buf))))
57089611 683
6b279740
RS
684;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
685;; Keybindings
686;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
687
6b279740
RS
688(provide 'filecache)
689
cbee283d 690;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538
6b279740 691;;; filecache.el ends here