X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2ac9538d674ab0aa937d22b68fef9136ddd904b9..c8109d9c4057d8cac79e2c139758cadd410e7446:/lisp/filecache.el diff --git a/lisp/filecache.el b/lisp/filecache.el index f868ef5e27..e754190d17 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -1,6 +1,6 @@ ;;; filecache.el --- find files using a pre-loaded cache -;; Copyright (C) 1996, 2000-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2000-2016 Free Software Foundation, Inc. ;; Author: Peter Breton ;; Created: Sun Nov 10 1996 @@ -154,11 +154,12 @@ ;; These are also used in buffers containing lines of file names, ;; so the end-of-name is matched with $ rather than \\'. (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$" - "\\.$" "#$" "\\.class$") + "\\.$" "#$" "\\.class$" "/\\.#") "List of regular expressions used as filters by the file cache. File names which match these expressions will not be added to the cache. Note that the functions `file-cache-add-file' and `file-cache-add-file-list' do not use this variable." + :version "25.1" ; added "/\\.#" :type '(repeat regexp) :group 'file-cache) @@ -267,44 +268,63 @@ files of names DIRNAME1/FILENAME, DIRNAME2/FILENAME, ...") ;; Functions to add files to the cache ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun file-cache--read-list (file op-prompt) + (let* ((fun (if file 'read-file-name 'read-directory-name)) + (type (if file "file" "directory")) + (prompt-1 (concat op-prompt " " type ": ")) + (prompt-2 (concat op-prompt " another " type "?")) + (continue t) + result) + (while continue + (push (funcall fun prompt-1 nil nil t) result) + (setq continue (y-or-n-p prompt-2))) + (nreverse result))) + ;;;###autoload (defun file-cache-add-directory (directory &optional regexp) - "Add DIRECTORY to the file cache. -If the optional REGEXP argument is non-nil, only files which match it will -be added to the cache." - (interactive "DAdd files from directory: ") + "Add all files in DIRECTORY to the file cache. +If called from Lisp with a non-nil REGEXP argument is non-nil, +only add files whose names match REGEXP." + (interactive (list (read-directory-name "Add files from directory: " + nil nil t) + nil)) ;; Not an error, because otherwise we can't use load-paths that ;; contain non-existent directories. - (if (not (file-accessible-directory-p directory)) - (message "Directory %s does not exist" directory) + (when (file-accessible-directory-p directory) (let* ((dir (expand-file-name directory)) (dir-files (directory-files dir t regexp))) ;; Filter out files we don't want to see (dolist (file dir-files) - (if (file-directory-p file) - (setq dir-files (delq file dir-files)) - (dolist (regexp file-cache-filter-regexps) - (if (string-match regexp file) - (setq dir-files (delq file dir-files)))))) + (if (file-directory-p file) + (setq dir-files (delq file dir-files)) + (dolist (regexp file-cache-filter-regexps) + (if (string-match regexp file) + (setq dir-files (delq file dir-files)))))) (file-cache-add-file-list dir-files)))) ;;;###autoload -(defun file-cache-add-directory-list (directory-list &optional regexp) - "Add DIRECTORY-LIST (a list of directory names) to the file cache. +(defun file-cache-add-directory-list (directories &optional regexp) + "Add DIRECTORIES (a list of directory names) to the file cache. +If called interactively, read the directory names one by one. If the optional REGEXP argument is non-nil, only files which match it will be added to the cache. Note that the REGEXP is applied to the files in each directory, not to the directory list itself." - (interactive "XAdd files from directory list: ") - (mapcar - (lambda (dir) (file-cache-add-directory dir regexp)) - directory-list)) - -(defun file-cache-add-file-list (file-list) - "Add FILE-LIST (a list of file names) to the file cache. -Interactively, FILE-LIST is read as a Lisp expression, which -should evaluate to the desired list of file names." - (interactive "XFile List: ") - (mapcar 'file-cache-add-file file-list)) + (interactive (list (file-cache--read-list nil "Add"))) + (dolist (dir directories) + (file-cache-add-directory dir regexp)) + (let ((n (length directories))) + (message "Filecache: cached file names from %d director%s." + n (if (= n 1) "y" "ies")))) + +(defun file-cache-add-file-list (files) + "Add FILES (a list of file names) to the file cache. +If called interactively, read the file names one by one." + (interactive (list (file-cache--read-list t "Add"))) + (dolist (f files) + (file-cache-add-file f)) + (let ((n (length files))) + (message "Filecache: cached %d file name%s." + n (if (= n 1) "" "s")))) ;; Workhorse function @@ -319,15 +339,18 @@ should evaluate to the desired list of file names." (dir-name (file-name-directory file)) (the-entry (assoc-string file-name file-cache-alist file-cache-ignore-case))) - ;; Does the entry exist already? - (if the-entry - (unless (or (and (stringp (cdr the-entry)) - (string= dir-name (cdr the-entry))) - (and (listp (cdr the-entry)) - (member dir-name (cdr the-entry)))) - (setcdr the-entry (cons dir-name (cdr the-entry)))) - ;; If not, add it to the cache - (push (list file-name dir-name) file-cache-alist)))) + (cond ((null the-entry) + ;; If the entry wasn't in the cache, add it. + (push (list file-name dir-name) file-cache-alist) + (if (called-interactively-p 'interactive) + (message "Filecache: cached file name %s." file))) + ((not (member dir-name (cdr the-entry))) + (setcdr the-entry (cons dir-name (cdr the-entry))) + (if (called-interactively-p 'interactive) + (message "Filecache: cached file name %s." file))) + (t + (if (called-interactively-p 'interactive) + (message "Filecache: %s is already cached." file)))))) ;;;###autoload (defun file-cache-add-directory-using-find (directory) @@ -413,17 +436,27 @@ or the optional REGEXP argument." ;; This clears *all* files with the given name (defun file-cache-delete-file (file) - "Delete FILE from the file cache." + "Delete FILE (a relative file name) from the file cache. +Return nil if FILE was not in the file cache, non-nil otherwise." (interactive (list (completing-read "Delete file from cache: " file-cache-alist))) - (setq file-cache-alist - (delq (assoc-string file file-cache-alist file-cache-ignore-case) - file-cache-alist))) - -(defun file-cache-delete-file-list (file-list) - "Delete FILE-LIST (a list of files) from the file cache." - (interactive "XFile List: ") - (mapcar 'file-cache-delete-file file-list)) + (let ((elt (assoc-string file file-cache-alist file-cache-ignore-case))) + (setq file-cache-alist (delq elt file-cache-alist)) + elt)) + +(defun file-cache-delete-file-list (files &optional message) + "Delete FILES (a list of files) from the file cache. +If called interactively, read the file names one by one. +If MESSAGE is non-nil, or if called interactively, print a +message reporting the number of file names deleted." + (interactive (list (file-cache--read-list t "Uncache") t)) + (let ((n 0)) + (dolist (f files) + (if (file-cache-delete-file f) + (setq n (1+ n)))) + (when message + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s"))))) (defun file-cache-delete-file-regexp (regexp) "Delete files matching REGEXP from the file cache." @@ -432,21 +465,18 @@ or the optional REGEXP argument." (dolist (elt file-cache-alist) (and (string-match regexp (car elt)) (push (car elt) delete-list))) - (file-cache-delete-file-list delete-list) - (message "Filecache: deleted %d files from file cache" - (length delete-list)))) + (file-cache-delete-file-list delete-list))) (defun file-cache-delete-directory (directory) "Delete DIRECTORY from the file cache." (interactive "DDelete directory from file cache: ") (let ((dir (expand-file-name directory)) - (result 0)) + (n 0)) (dolist (entry file-cache-alist) (if (file-cache-do-delete-directory dir entry) - (setq result (1+ result)))) - (if (zerop result) - (error "Filecache: no entries containing %s found in cache" directory) - (message "Filecache: deleted %d entries" result)))) + (setq n (1+ n)))) + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s")))) (defun file-cache-do-delete-directory (dir entry) (let ((directory-list (cdr entry)) @@ -457,10 +487,12 @@ or the optional REGEXP argument." (delq entry file-cache-alist)) (setcdr entry (delete directory directory-list)))))) -(defun file-cache-delete-directory-list (directory-list) - "Delete DIRECTORY-LIST (a list of directories) from the file cache." - (interactive "XDirectory List: ") - (mapcar 'file-cache-delete-directory directory-list)) +(defun file-cache-delete-directory-list (directories) + "Delete DIRECTORIES (a list of directory names) from the file cache. +If called interactively, read the directory names one by one." + (interactive (list (file-cache--read-list nil "Uncache"))) + (dolist (d directories) + (file-cache-delete-directory d))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions @@ -582,7 +614,9 @@ the name is considered already unique; only the second substitution (append completion-setup-hook (list 'file-cache-completion-setup-function)))) (with-output-to-temp-buffer file-cache-completions-buffer - (display-completion-list completion-list string)))) + (display-completion-list + (completion-hilit-commonality completion-list + (length string)))))) (setq file-cache-string (file-cache-file-name completion-string)) (if (string= file-cache-string (minibuffer-contents)) (minibuffer-message file-cache-sole-match-message) @@ -649,10 +683,7 @@ match REGEXP." "*File Cache Files Matching*"))) (erase-buffer) (insert - (mapconcat - 'identity - results - "\n")) + (mapconcat #'identity results "\n")) (goto-char (point-min)) (display-buffer buf)))