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