Switch to recommended form of GPLv3 permissions notice.
[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;;
e91081eb 7;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004,
409cc4a3 8;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
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$")
6b279740
RS
160 "*List of regular expressions used as filters by the file cache.
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
AS
167(defcustom file-cache-find-command "find"
168 "*External program used by `file-cache-add-directory-using-find'."
169 :type 'string
170 :group 'file-cache)
6b279740 171
6e74cce2
RS
172(defcustom file-cache-find-command-posix-flag 'not-defined
173 "*Set to t, if `file-cache-find-command' handles wildcards POSIX style.
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
AS
185(defcustom file-cache-locate-command "locate"
186 "*External program used by `file-cache-add-directory-using-locate'."
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
258 "Internal data structure to hold cache of file names.")
259
d8e1753c
SM
260(defvar file-cache-completions-keymap
261 (let ((map (make-sparse-keymap)))
262 (set-keymap-parent map completion-list-mode-map)
263 (define-key map [mouse-2] 'file-cache-mouse-choose-completion)
264 (define-key map "\C-m" 'file-cache-choose-completion)
265 map)
6b279740
RS
266 "Keymap for file cache completions buffer.")
267
268;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
269;; Functions to add files to the cache
270;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
271
3b5e5e30 272;;;###autoload
6b279740
RS
273(defun file-cache-add-directory (directory &optional regexp)
274 "Add DIRECTORY to the file cache.
24ccf465 275If the optional REGEXP argument is non-nil, only files which match it will
6b279740 276be added to the cache."
b662c4bc
RS
277 (interactive "DAdd files from directory: ")
278 ;; Not an error, because otherwise we can't use load-paths that
279 ;; contain non-existent directories.
280 (if (not (file-accessible-directory-p directory))
281 (message "Directory %s does not exist" directory)
282 (let* ((dir (expand-file-name directory))
283 (dir-files (directory-files dir t regexp))
284 )
285 ;; Filter out files we don't want to see
49176fc7 286 (mapc
b662c4bc 287 '(lambda (file)
6e74cce2
RS
288 (if (file-directory-p file)
289 (setq dir-files (delq file dir-files))
49176fc7 290 (mapc
6e74cce2
RS
291 '(lambda (regexp)
292 (if (string-match regexp file)
293 (setq dir-files (delq file dir-files))))
294 file-cache-filter-regexps)))
b662c4bc
RS
295 dir-files)
296 (file-cache-add-file-list dir-files))))
6b279740 297
3b5e5e30 298;;;###autoload
6b279740
RS
299(defun file-cache-add-directory-list (directory-list &optional regexp)
300 "Add DIRECTORY-LIST (a list of directory names) to the file cache.
24ccf465
PB
301If the optional REGEXP argument is non-nil, only files which match it
302will be added to the cache. Note that the REGEXP is applied to the files
6b279740
RS
303in each directory, not to the directory list itself."
304 (interactive "XAdd files from directory list: ")
24ccf465 305 (mapcar
6b279740
RS
306 '(lambda (dir) (file-cache-add-directory dir regexp))
307 directory-list))
308
309(defun file-cache-add-file-list (file-list)
310 "Add FILE-LIST (a list of files names) to the file cache."
311 (interactive "XFile List: ")
312 (mapcar 'file-cache-add-file file-list))
313
314;; Workhorse function
3b5e5e30
RS
315
316;;;###autoload
6b279740
RS
317(defun file-cache-add-file (file)
318 "Add FILE to the file cache."
319 (interactive "fAdd File: ")
b662c4bc 320 (if (not (file-exists-p file))
bbc66b08 321 (message "Filecache: file %s does not exist" file)
b662c4bc
RS
322 (let* ((file-name (file-name-nondirectory file))
323 (dir-name (file-name-directory file))
3750be31
RS
324 (the-entry (assoc-string
325 file-name file-cache-alist
326 file-cache-ignore-case))
b662c4bc
RS
327 )
328 ;; Does the entry exist already?
329 (if the-entry
330 (if (or (and (stringp (cdr the-entry))
331 (string= dir-name (cdr the-entry)))
332 (and (listp (cdr the-entry))
333 (member dir-name (cdr the-entry))))
334 nil
335 (setcdr the-entry (append (list dir-name) (cdr the-entry)))
336 )
337 ;; If not, add it to the cache
338 (setq file-cache-alist
24ccf465 339 (cons (cons file-name (list dir-name))
b662c4bc
RS
340 file-cache-alist)))
341 )))
24ccf465 342
3b5e5e30 343;;;###autoload
6b279740
RS
344(defun file-cache-add-directory-using-find (directory)
345 "Use the `find' command to add files to the file cache.
346Find is run in DIRECTORY."
347 (interactive "DAdd files under directory: ")
348 (let ((dir (expand-file-name directory)))
d9c1ce9d
RS
349 (when (memq system-type '(windows-nt cygwin))
350 (if (eq file-cache-find-command-posix-flag 'not-defined)
351 (setq file-cache-find-command-posix-flag
352 (executable-command-find-posix-p file-cache-find-command))))
6b279740
RS
353 (set-buffer (get-buffer-create file-cache-buffer))
354 (erase-buffer)
24ccf465 355 (call-process file-cache-find-command nil
6b279740 356 (get-buffer file-cache-buffer) nil
24ccf465 357 dir "-name"
da14d1ac
RS
358 (if (memq system-type '(windows-nt cygwin))
359 (if file-cache-find-command-posix-flag
360 "\\*"
361 "'*'")
362 "*")
6b279740
RS
363 "-print")
364 (file-cache-add-from-file-cache-buffer)))
365
3b5e5e30 366;;;###autoload
6b279740
RS
367(defun file-cache-add-directory-using-locate (string)
368 "Use the `locate' command to add files to the file cache.
369STRING is passed as an argument to the locate command."
370 (interactive "sAdd files using locate string: ")
371 (set-buffer (get-buffer-create file-cache-buffer))
372 (erase-buffer)
24ccf465 373 (call-process file-cache-locate-command nil
6b279740
RS
374 (get-buffer file-cache-buffer) nil
375 string)
376 (file-cache-add-from-file-cache-buffer))
377
3b5e5e30 378;;;###autoload
57089611
PB
379(defun file-cache-add-directory-recursively (dir &optional regexp)
380 "Adds DIR and any subdirectories to the file-cache.
381This function does not use any external programs
382If the optional REGEXP argument is non-nil, only files which match it
383will be added to the cache. Note that the REGEXP is applied to the files
384in each directory, not to the directory list itself."
385 (interactive "DAdd directory: ")
386 (require 'find-lisp)
387 (mapcar
388 (function
389 (lambda(file)
390 (or (file-directory-p file)
391 (let (filtered)
49176fc7 392 (mapc
57089611
PB
393 (function
394 (lambda(regexp)
395 (and (string-match regexp file)
396 (setq filtered t))
397 ))
398 file-cache-filter-regexps)
399 filtered)
400 (file-cache-add-file file))))
401 (find-lisp-find-files dir (if regexp regexp "^"))))
402
6b279740
RS
403(defun file-cache-add-from-file-cache-buffer (&optional regexp)
404 "Add any entries found in the file cache buffer.
405Each entry matches the regular expression `file-cache-buffer-default-regexp'
406or the optional REGEXP argument."
407 (set-buffer file-cache-buffer)
49176fc7 408 (mapc
6b279740
RS
409 (function (lambda (elt)
410 (goto-char (point-min))
411 (delete-matching-lines elt)))
412 file-cache-filter-regexps)
413 (goto-char (point-min))
414 (let ((full-filename))
415 (while (re-search-forward
24ccf465 416 (or regexp file-cache-buffer-default-regexp)
6b279740
RS
417 (point-max) t)
418 (setq full-filename (buffer-substring-no-properties
24ccf465 419 (match-beginning 0) (match-end 0)))
6b279740
RS
420 (file-cache-add-file full-filename))))
421
422;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
423;; Functions to delete from the cache
424;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
425
426(defun file-cache-clear-cache ()
427 "Clear the file cache."
428 (interactive)
429 (setq file-cache-alist nil))
430
431;; This clears *all* files with the given name
432(defun file-cache-delete-file (file)
433 "Delete FILE from the file cache."
434 (interactive
435 (list (completing-read "Delete file from cache: " file-cache-alist)))
24ccf465 436 (setq file-cache-alist
3750be31 437 (delq (assoc-string file file-cache-alist file-cache-ignore-case)
24ccf465 438 file-cache-alist)))
6b279740
RS
439
440(defun file-cache-delete-file-list (file-list)
441 "Delete FILE-LIST (a list of files) from the file cache."
442 (interactive "XFile List: ")
443 (mapcar 'file-cache-delete-file file-list))
444
445(defun file-cache-delete-file-regexp (regexp)
446 "Delete files matching REGEXP from the file cache."
447 (interactive "sRegexp: ")
448 (let ((delete-list))
49176fc7
JB
449 (mapc '(lambda (elt)
450 (and (string-match regexp (car elt))
451 (setq delete-list (cons (car elt) delete-list))))
452 file-cache-alist)
6b279740 453 (file-cache-delete-file-list delete-list)
bbc66b08
EZ
454 (message "Filecache: deleted %d files from file cache"
455 (length delete-list))))
6b279740
RS
456
457(defun file-cache-delete-directory (directory)
458 "Delete DIRECTORY from the file cache."
459 (interactive "DDelete directory from file cache: ")
460 (let ((dir (expand-file-name directory))
461 (result 0))
49176fc7 462 (mapc
24ccf465 463 '(lambda (entry)
6b279740
RS
464 (if (file-cache-do-delete-directory dir entry)
465 (setq result (1+ result))))
466 file-cache-alist)
467 (if (zerop result)
bbc66b08
EZ
468 (error "Filecache: no entries containing %s found in cache" directory)
469 (message "Filecache: deleted %d entries" result))))
6b279740
RS
470
471(defun file-cache-do-delete-directory (dir entry)
472 (let ((directory-list (cdr entry))
473 (directory (file-cache-canonical-directory dir))
474 )
475 (and (member directory directory-list)
476 (if (equal 1 (length directory-list))
24ccf465 477 (setq file-cache-alist
6b279740
RS
478 (delq entry file-cache-alist))
479 (setcdr entry (delete directory directory-list)))
480 )
481 ))
482
483(defun file-cache-delete-directory-list (directory-list)
484 "Delete DIRECTORY-LIST (a list of directories) from the file cache."
485 (interactive "XDirectory List: ")
486 (mapcar 'file-cache-delete-directory directory-list))
487
488;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
489;; Utility functions
490;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
491
492;; Returns the name of a directory for a file in the cache
493(defun file-cache-directory-name (file)
3750be31
RS
494 (let* ((directory-list (cdr (assoc-string
495 file file-cache-alist
496 file-cache-ignore-case)))
6b279740
RS
497 (len (length directory-list))
498 (directory)
499 (num)
500 )
501 (if (not (listp directory-list))
bbc66b08 502 (error "Filecache: unknown type in file-cache-alist for key %s" file))
24ccf465 503 (cond
6b279740
RS
504 ;; Single element
505 ((eq 1 len)
506 (setq directory (elt directory-list 0)))
507 ;; No elements
508 ((eq 0 len)
bbc66b08 509 (error "Filecache: no directory found for key %s" file))
6b279740
RS
510 ;; Multiple elements
511 (t
dea0a87d 512 (let* ((minibuffer-dir (file-name-directory (minibuffer-contents)))
6b279740
RS
513 (dir-list (member minibuffer-dir directory-list))
514 )
515 (setq directory
516 ;; If the directory is in the list, return the next element
517 ;; Otherwise, return the first element
24ccf465
PB
518 (if dir-list
519 (or (elt directory-list
6b279740
RS
520 (setq num (1+ (- len (length dir-list)))))
521 (elt directory-list (setq num 0)))
522 (elt directory-list (setq num 0))))
523 )
524 )
525 )
526 ;; If there were multiple directories, set up a minibuffer message
527 (setq file-cache-multiple-directory-message
528 (and num (format " [%d of %d]" (1+ num) len)))
529 directory))
530
531;; Returns the name of a file in the cache
532(defun file-cache-file-name (file)
533 (let ((directory (file-cache-directory-name file)))
534 (concat directory file)))
24ccf465 535
6b279740
RS
536;; Return a canonical directory for comparison purposes.
537;; Such a directory ends with a forward slash.
538(defun file-cache-canonical-directory (dir)
539 (let ((directory dir))
540 (if (not (char-equal ?/ (string-to-char (substring directory -1))))
541 (concat directory "/")
542 directory)))
543
544;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
545;; Minibuffer functions
546;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
547
13161e8b
RS
548;; The prefix argument works around a bug in the minibuffer completion.
549;; The completion function doesn't distinguish between the states:
24ccf465 550;;
13161e8b
RS
551;; "Multiple completions of name" (eg, Makefile, Makefile.in)
552;; "Name available in multiple directories" (/tmp/Makefile, ~me/Makefile)
24ccf465 553;;
13161e8b
RS
554;; The default is to do the former; a prefix arg forces the latter.
555
6b279740 556;;;###autoload
13161e8b
RS
557(defun file-cache-minibuffer-complete (arg)
558 "Complete a filename in the minibuffer using a preloaded cache.
559Filecache does two kinds of substitution: it completes on names in
560the cache, and, once it has found a unique name, it cycles through
24ccf465
PB
561the directories that the name is available in. With a prefix argument,
562the name is considered already unique; only the second substitution
13161e8b 563\(directories) is done."
24ccf465
PB
564 (interactive "P")
565 (let*
6b279740 566 (
b047c9b7 567 (completion-ignore-case file-cache-completion-ignore-case)
24ccf465 568 (case-fold-search file-cache-case-fold-search)
dea0a87d 569 (string (file-name-nondirectory (minibuffer-contents)))
13161e8b 570 (completion-string (try-completion string file-cache-alist))
6b279740
RS
571 (completion-list)
572 (len)
573 (file-cache-string)
574 )
24ccf465 575 (cond
13161e8b
RS
576 ;; If it's the only match, replace the original contents
577 ((or arg (eq completion-string t))
578 (setq file-cache-string (file-cache-file-name string))
dea0a87d 579 (if (string= file-cache-string (minibuffer-contents))
13161e8b 580 (file-cache-temp-minibuffer-message file-cache-sole-match-message)
dea0a87d 581 (delete-minibuffer-contents)
add91c7b 582 (insert file-cache-string)
13161e8b 583 (if file-cache-multiple-directory-message
24ccf465 584 (file-cache-temp-minibuffer-message
13161e8b
RS
585 file-cache-multiple-directory-message))
586 ))
587
6b279740
RS
588 ;; If it's the longest match, insert it
589 ((stringp completion-string)
590 ;; If we've already inserted a unique string, see if the user
591 ;; wants to use that one
592 (if (and (string= string completion-string)
3750be31
RS
593 (assoc-string string file-cache-alist
594 file-cache-ignore-case))
6b279740
RS
595 (if (and (eq last-command this-command)
596 (string= file-cache-last-completion completion-string))
24ccf465 597 (progn
dea0a87d 598 (delete-minibuffer-contents)
add91c7b 599 (insert (file-cache-file-name completion-string))
6b279740
RS
600 (setq file-cache-last-completion nil)
601 )
602 (file-cache-temp-minibuffer-message file-cache-non-unique-message)
603 (setq file-cache-last-completion string)
604 )
605 (setq file-cache-last-completion string)
606 (setq completion-list (all-completions string file-cache-alist)
607 len (length completion-list))
608 (if (> len 1)
609 (progn
610 (goto-char (point-max))
add91c7b 611 (insert
6b279740
RS
612 (substring completion-string (length string)))
613 ;; Add our own setup function to the Completions Buffer
614 (let ((completion-setup-hook
d8e1753c
SM
615 (append completion-setup-hook
616 (list 'file-cache-completion-setup-function))))
6b279740 617 (with-output-to-temp-buffer file-cache-completions-buffer
d8e1753c 618 (display-completion-list completion-list string))))
6b279740 619 (setq file-cache-string (file-cache-file-name completion-string))
dea0a87d 620 (if (string= file-cache-string (minibuffer-contents))
24ccf465 621 (file-cache-temp-minibuffer-message
13161e8b 622 file-cache-sole-match-message)
dea0a87d 623 (delete-minibuffer-contents)
add91c7b 624 (insert file-cache-string)
6b279740 625 (if file-cache-multiple-directory-message
24ccf465 626 (file-cache-temp-minibuffer-message
6b279740
RS
627 file-cache-multiple-directory-message)))
628 )))
24ccf465 629
6b279740
RS
630 ;; No match
631 ((eq completion-string nil)
632 (file-cache-temp-minibuffer-message file-cache-no-match-message))
633 )
634))
635
636;; Lifted from "complete.el"
637(defun file-cache-temp-minibuffer-message (msg)
638 "A Lisp version of `temp_minibuffer_message' from minibuf.c."
639 (let ((savemax (point-max)))
640 (save-excursion
641 (goto-char (point-max))
642 (insert msg))
643 (let ((inhibit-quit t))
644 (sit-for 2)
645 (delete-region savemax (point-max))
646 (if quit-flag
647 (setq quit-flag nil
648 unread-command-events (list 7))))))
649
650;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
651;; Completion functions
652;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
653
654(defun file-cache-completion-setup-function ()
d8e1753c
SM
655 (with-current-buffer standard-output ;; i.e. file-cache-completions-buffer
656 (use-local-map file-cache-completions-keymap)))
6b279740
RS
657
658(defun file-cache-choose-completion ()
659 "Choose a completion in the `*Completions*' buffer."
660 (interactive)
661 (let ((completion-no-auto-exit t))
662 (choose-completion)
663 (select-window (active-minibuffer-window))
13161e8b 664 (file-cache-minibuffer-complete nil)
6b279740
RS
665 )
666 )
667
668(defun file-cache-mouse-choose-completion (event)
669 "Choose a completion with the mouse."
670 (interactive "e")
671 (let ((completion-no-auto-exit t))
672 (mouse-choose-completion event)
673 (select-window (active-minibuffer-window))
13161e8b 674 (file-cache-minibuffer-complete nil)
6b279740
RS
675 )
676 )
677
57089611
PB
678(defun file-cache-complete ()
679 "Complete the word at point, using the filecache."
680 (interactive)
681 (let (start pattern completion all)
682 (save-excursion
683 (skip-syntax-backward "^\"")
684 (setq start (point)))
685 (setq pattern (buffer-substring-no-properties start (point)))
686 (setq completion (try-completion pattern file-cache-alist))
687 (setq all (all-completions pattern file-cache-alist nil))
688 (cond ((eq completion t))
689 ((null completion)
690 (message "Can't find completion for \"%s\"" pattern)
691 (ding))
692 ((not (string= pattern completion))
693 (delete-region start (point))
694 (insert completion)
695 )
696 (t
697 (with-output-to-temp-buffer "*Completions*"
f5fab556 698 (display-completion-list all pattern))
57089611
PB
699 ))
700 ))
701
b047c9b7
GM
702;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
703;; Show parts of the cache
704;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
705
706(defun file-cache-files-matching-internal (regexp)
707 "Output a list of files whose names (not including directories)
708match REGEXP."
709 (let ((results))
49176fc7 710 (mapc
b047c9b7
GM
711 (function
712 (lambda(cache-element)
713 (and (string-match regexp
714 (elt cache-element 0))
715 (if results
716 (nconc results (list (elt cache-element 0)))
717 (setq results (list (elt cache-element 0)))))))
718 file-cache-alist)
719 results))
720
721(defun file-cache-files-matching (regexp)
722 "Output a list of files whose names (not including directories)
723match REGEXP."
724 (interactive "sFind files matching regexp: ")
24ccf465 725 (let ((results
b047c9b7
GM
726 (file-cache-files-matching-internal regexp))
727 buf)
24ccf465
PB
728 (set-buffer
729 (setq buf (get-buffer-create
b047c9b7
GM
730 "*File Cache Files Matching*")))
731 (erase-buffer)
732 (insert
733 (mapconcat
734 'identity
735 results
736 "\n"))
737 (goto-char (point-min))
738 (display-buffer buf)))
739
6b279740
RS
740;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
741;; Debugging functions
742;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
743
744(defun file-cache-debug-read-from-minibuffer (file)
745 "Debugging function."
24ccf465 746 (interactive
6b279740 747 (list (completing-read "File Cache: " file-cache-alist)))
3750be31
RS
748 (message "%s" (assoc-string file file-cache-alist
749 file-cache-ignore-case))
6b279740
RS
750 )
751
57089611
PB
752(defun file-cache-display ()
753 "Display the file cache."
754 (interactive)
755 (let ((buf "*File Cache Contents*"))
756 (with-current-buffer
757 (get-buffer-create buf)
758 (erase-buffer)
49176fc7 759 (mapc
57089611 760 (function
49176fc7
JB
761 (lambda(item)
762 (insert (nth 1 item) (nth 0 item) "\n")))
763 file-cache-alist)
57089611
PB
764 (pop-to-buffer buf)
765 )))
766
6b279740
RS
767;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
768;; Keybindings
769;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
770
6b279740
RS
771(provide 'filecache)
772
cbee283d 773;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538
6b279740 774;;; filecache.el ends here