1;;; filecache.el --- find files using a pre-loaded cache 2;; 3;; Author: Peter Breton <pbreton@cs.umb.edu> 4;; Created: Sun Nov 10 1996 5;; Keywords: convenience 6;; 7;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, 8;; 2005, 2006, 2007 Free Software Foundation, Inc. 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 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: 46;; 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: 53;; 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;; 67;; * `file-cache-add-directory-recursively': Uses the find-lisp package to 68;; add all files matching a pattern to the cache. 69;; 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 76;; `eval-after-load' function, as noted in the ADDING FILES 77;; AUTOMATICALLY section. 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. 94;; 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;; 103;;; ADDING FILES AUTOMATICALLY 104;; 105;; For maximum utility, you should probably define an `eval-after-load' 106;; form which loads your favorite files: 107;; 108;; (eval-after-load 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;; 121;; (eval-after-load 122;; "filecache" 123;; '(my-file-cache-initialize)) 124;; 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: 138;; 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. 142 143;;; Code: 144 145(eval-when-compile 146 (require 'find-lisp)) 147 148(defgroup file-cache nil 149 "Find files using a pre-loaded cache." 150 :group 'files 151 :group 'convenience 152 :prefix "file-cache-") 153 154;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 155;; Customization Variables 156;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 157 158;; User-modifiable variables 159(defcustom file-cache-filter-regexps 160 (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$" 161 "\\.$" "#$" "\\.class$") 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. 164Note that the functions `file-cache-add-file' and `file-cache-add-file-list' 165do not use this variable." 166 :type '(repeat regexp) 167 :group 'file-cache) 168 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) 173 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 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) 191 192;; Minibuffer messages 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) 208 209(defcustom file-cache-completion-ignore-case 210 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) 211 t 212 completion-ignore-case) 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 219(defcustom file-cache-case-fold-search 220 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) 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 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." 233 :type 'sexp 234 :group 'file-cache 235 ) 236 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 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 247(defcustom file-cache-buffer "*File Cache*" 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) 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 269;;;###autoload 270(defun file-cache-add-directory (directory &optional regexp) 271 "Add DIRECTORY to the file cache. 272If the optional REGEXP argument is non-nil, only files which match it will 273be added to the cache." 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) 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))) 292 dir-files) 293 (file-cache-add-file-list dir-files)))) 294 295;;;###autoload 296(defun file-cache-add-directory-list (directory-list &optional regexp) 297 "Add DIRECTORY-LIST (a list of directory names) to the file cache. 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 300in each directory, not to the directory list itself." 301 (interactive "XAdd files from directory list: ") 302 (mapcar 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 312 313;;;###autoload 314(defun file-cache-add-file (file) 315 "Add FILE to the file cache." 316 (interactive "fAdd File: ") 317 (if (not (file-exists-p file)) 318 (message "Filecache: file %s does not exist" file) 319 (let* ((file-name (file-name-nondirectory file)) 320 (dir-name (file-name-directory file)) 321 (the-entry (assoc-string 322 file-name file-cache-alist 323 file-cache-ignore-case)) 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 336 (cons (cons file-name (list dir-name)) 337 file-cache-alist))) 338 ))) 339 340;;;###autoload 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))) 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)))) 350 (set-buffer (get-buffer-create file-cache-buffer)) 351 (erase-buffer) 352 (call-process file-cache-find-command nil 353 (get-buffer file-cache-buffer) nil 354 dir "-name" 355 (if (memq system-type '(windows-nt cygwin)) 356 (if file-cache-find-command-posix-flag 357 "\\*" 358 "'*'") 359 "*") 360 "-print") 361 (file-cache-add-from-file-cache-buffer))) 362 363;;;###autoload 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) 370 (call-process file-cache-locate-command nil 371 (get-buffer file-cache-buffer) nil 372 string) 373 (file-cache-add-from-file-cache-buffer)) 374 375;;;###autoload 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 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) 405 (mapcar 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 413 (or regexp file-cache-buffer-default-regexp) 414 (point-max) t) 415 (setq full-filename (buffer-substring-no-properties 416 (match-beginning 0) (match-end 0))) 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))) 433 (setq file-cache-alist 434 (delq (assoc-string file file-cache-alist file-cache-ignore-case) 435 file-cache-alist))) 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)) 446 (mapcar '(lambda (elt) 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) 451 (message "Filecache: deleted %d files from file cache" 452 (length delete-list)))) 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)) 459 (mapcar 460 '(lambda (entry) 461 (if (file-cache-do-delete-directory dir entry) 462 (setq result (1+ result)))) 463 file-cache-alist) 464 (if (zerop result) 465 (error "Filecache: no entries containing %s found in cache" directory) 466 (message "Filecache: deleted %d entries" result)))) 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)) 474 (setq file-cache-alist 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) 491 (let* ((directory-list (cdr (assoc-string 492 file file-cache-alist 493 file-cache-ignore-case))) 494 (len (length directory-list)) 495 (directory) 496 (num) 497 ) 498 (if (not (listp directory-list)) 499 (error "Filecache: unknown type in file-cache-alist for key %s" file)) 500 (cond 501 ;; Single element 502 ((eq 1 len) 503 (setq directory (elt directory-list 0))) 504 ;; No elements 505 ((eq 0 len) 506 (error "Filecache: no directory found for key %s" file)) 507 ;; Multiple elements 508 (t 509 (let* ((minibuffer-dir (file-name-directory (minibuffer-contents))) 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 515 (if dir-list 516 (or (elt directory-list 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))) 532 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 545;; The prefix argument works around a bug in the minibuffer completion. 546;; The completion function doesn't distinguish between the states: 547;; 548;; "Multiple completions of name" (eg, Makefile, Makefile.in) 549;; "Name available in multiple directories" (/tmp/Makefile, ~me/Makefile) 550;; 551;; The default is to do the former; a prefix arg forces the latter. 552 553;;;###autoload 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 558the directories that the name is available in. With a prefix argument, 559the name is considered already unique; only the second substitution 560\(directories) is done." 561 (interactive "P") 562 (let* 563 ( 564 (completion-ignore-case file-cache-completion-ignore-case) 565 (case-fold-search file-cache-case-fold-search) 566 (string (file-name-nondirectory (minibuffer-contents))) 567 (completion-string (try-completion string file-cache-alist)) 568 (completion-list) 569 (len) 570 (file-cache-string) 571 ) 572 (cond 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)) 576 (if (string= file-cache-string (minibuffer-contents)) 577 (file-cache-temp-minibuffer-message file-cache-sole-match-message) 578 (delete-minibuffer-contents) 579 (insert file-cache-string) 580 (if file-cache-multiple-directory-message 581 (file-cache-temp-minibuffer-message 582 file-cache-multiple-directory-message)) 583 )) 584 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) 590 (assoc-string string file-cache-alist 591 file-cache-ignore-case)) 592 (if (and (eq last-command this-command) 593 (string= file-cache-last-completion completion-string)) 594 (progn 595 (delete-minibuffer-contents) 596 (insert (file-cache-file-name completion-string)) 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)) 608 (insert 609 (substring completion-string (length string))) 610 ;; Add our own setup function to the Completions Buffer 611 (let ((completion-setup-hook 612 (reverse 613 (append (list 'file-cache-completion-setup-function) 614 completion-setup-hook))) 615 ) 616 (with-output-to-temp-buffer file-cache-completions-buffer 617 (display-completion-list completion-list string)) 618 ) 619 ) 620 (setq file-cache-string (file-cache-file-name completion-string)) 621 (if (string= file-cache-string (minibuffer-contents)) 622 (file-cache-temp-minibuffer-message 623 file-cache-sole-match-message) 624 (delete-minibuffer-contents) 625 (insert file-cache-string) 626 (if file-cache-multiple-directory-message 627 (file-cache-temp-minibuffer-message 628 file-cache-multiple-directory-message))) 629 ))) 630 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 660 (setq file-cache-completions-keymap 661 (copy-keymap completion-list-mode-map)) 662 (define-key file-cache-completions-keymap [mouse-2] 663 'file-cache-mouse-choose-completion) 664 (define-key file-cache-completions-keymap "\C-m" 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)) 676 (file-cache-minibuffer-complete nil) 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)) 686 (file-cache-minibuffer-complete nil) 687 ) 688 ) 689 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*" 710 (display-completion-list all pattern)) 711 )) 712 )) 713 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: ") 737 (let ((results 738 (file-cache-files-matching-internal regexp)) 739 buf) 740 (set-buffer 741 (setq buf (get-buffer-create 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 752;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 753;; Debugging functions 754;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 755 756(defun file-cache-debug-read-from-minibuffer (file) 757 "Debugging function." 758 (interactive 759 (list (completing-read "File Cache: " file-cache-alist))) 760 (message "%s" (assoc-string file file-cache-alist 761 file-cache-ignore-case)) 762 ) 763 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 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 789;;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538 790;;; filecache.el ends here 791