123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690 |
- (eval-when-compile
- (require 'find-lisp))
- (defgroup file-cache nil
- "Find files using a pre-loaded cache."
- :group 'files
- :group 'convenience
- :prefix "file-cache-")
- (defcustom file-cache-filter-regexps
-
-
- (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$"
- "\\.$" "#$" "\\.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."
- :type '(repeat regexp)
- :group 'file-cache)
- (defcustom file-cache-find-command "find"
- "External program used by `file-cache-add-directory-using-find'."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-find-command-posix-flag 'not-defined
- "Set to t, if `file-cache-find-command' handles wildcards POSIX style.
- This variable is automatically set to nil or non-nil
- if it has the initial value `not-defined' whenever you first
- call the `file-cache-add-directory-using-find'.
- Under Windows operating system where Cygwin is available, this value
- should be t."
- :type '(choice (const :tag "Yes" t)
- (const :tag "No" nil)
- (const :tag "Unknown" not-defined))
- :group 'file-cache)
- (defcustom file-cache-locate-command "locate"
- "External program used by `file-cache-add-directory-using-locate'."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-no-match-message " [File Cache: No match]"
- "Message to display when there is no completion."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-sole-match-message " [File Cache: sole completion]"
- "Message to display when there is only one completion."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-non-unique-message
- " [File Cache: complete but not unique]"
- "Message to display when there is a non-unique completion."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-completion-ignore-case
- (if (memq system-type '(ms-dos windows-nt cygwin))
- t
- completion-ignore-case)
- "If non-nil, file-cache completion should ignore case.
- Defaults to the value of `completion-ignore-case'."
- :type 'boolean
- :group 'file-cache)
- (defcustom file-cache-case-fold-search
- (if (memq system-type '(ms-dos windows-nt cygwin))
- t
- case-fold-search)
- "If non-nil, file-cache completion should ignore case.
- Defaults to the value of `case-fold-search'."
- :type 'boolean
- :group 'file-cache)
- (defcustom file-cache-ignore-case
- (memq system-type '(ms-dos windows-nt cygwin))
- "Non-nil means ignore case when checking completions in the file cache.
- Defaults to nil on DOS and Windows, and t on other systems."
- :type 'boolean
- :group 'file-cache)
- (defvar file-cache-multiple-directory-message nil)
- (defcustom file-cache-completions-buffer "*Completions*"
- "Buffer to display completions when using the file cache."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-buffer "*File Cache*"
- "Buffer to hold the cache of file names."
- :type 'string
- :group 'file-cache)
- (defcustom file-cache-buffer-default-regexp "^.+$"
- "Regexp to match files in `file-cache-buffer'."
- :type 'regexp
- :group 'file-cache)
- (defvar file-cache-last-completion nil)
- (defvar file-cache-alist nil
- "Internal data structure to hold cache of file names.
- It is a list of entries of the form (FILENAME DIRNAME1 DIRNAME2 ...)
- where FILENAME is a file name component and the entry represents N
- files of names DIRNAME1/FILENAME, DIRNAME2/FILENAME, ...")
- (defvar file-cache-completions-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map completion-list-mode-map)
- (define-key map [mouse-2] 'file-cache-choose-completion)
- (define-key map "\C-m" 'file-cache-choose-completion)
- map)
- "Keymap for file cache completions buffer.")
- (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: ")
-
-
- (if (not (file-accessible-directory-p directory))
- (message "Directory %s does not exist" directory)
- (let* ((dir (expand-file-name directory))
- (dir-files (directory-files dir t regexp)))
-
- (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))))))
- (file-cache-add-file-list dir-files))))
- (defun file-cache-add-directory-list (directory-list &optional regexp)
- "Add DIRECTORY-LIST (a list of directory names) to the file cache.
- 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 files names) to the file cache."
- (interactive "XFile List: ")
- (mapcar 'file-cache-add-file file-list))
- (defun file-cache-add-file (file)
- "Add FILE to the file cache."
- (interactive "fAdd File: ")
- (if (not (file-exists-p file))
- (message "Filecache: file %s does not exist" file)
- (let* ((file-name (file-name-nondirectory file))
- (dir-name (file-name-directory file))
- (the-entry (assoc-string
- file-name file-cache-alist
- file-cache-ignore-case)))
-
- (if the-entry
- (if (or (and (stringp (cdr the-entry))
- (string= dir-name (cdr the-entry)))
- (and (listp (cdr the-entry))
- (member dir-name (cdr the-entry))))
- nil
- (setcdr the-entry (cons dir-name (cdr the-entry))))
-
- (push (list file-name dir-name) file-cache-alist)))))
- (defun file-cache-add-directory-using-find (directory)
- "Use the `find' command to add files to the file cache.
- Find is run in DIRECTORY."
- (interactive "DAdd files under directory: ")
- (let ((dir (expand-file-name directory)))
- (when (memq system-type '(windows-nt cygwin))
- (if (eq file-cache-find-command-posix-flag 'not-defined)
- (setq file-cache-find-command-posix-flag
- (executable-command-find-posix-p file-cache-find-command))))
- (set-buffer (get-buffer-create file-cache-buffer))
- (erase-buffer)
- (call-process file-cache-find-command nil
- (get-buffer file-cache-buffer) nil
- dir "-name"
- (if (memq system-type '(windows-nt cygwin))
- (if file-cache-find-command-posix-flag
- "\\*"
- "'*'")
- "*")
- "-print")
- (file-cache-add-from-file-cache-buffer)))
- (defun file-cache-add-directory-using-locate (string)
- "Use the `locate' command to add files to the file cache.
- STRING is passed as an argument to the locate command."
- (interactive "sAdd files using locate string: ")
- (set-buffer (get-buffer-create file-cache-buffer))
- (erase-buffer)
- (call-process file-cache-locate-command nil
- (get-buffer file-cache-buffer) nil
- string)
- (file-cache-add-from-file-cache-buffer))
- (defun file-cache-add-directory-recursively (dir &optional regexp)
- "Adds DIR and any subdirectories to the file-cache.
- This function does not use any external programs.
- 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 "DAdd directory: ")
- (require 'find-lisp)
- (mapcar
- (function
- (lambda (file)
- (or (file-directory-p file)
- (let (filtered)
- (dolist (regexp file-cache-filter-regexps)
- (and (string-match regexp file)
- (setq filtered t)))
- filtered)
- (file-cache-add-file file))))
- (find-lisp-find-files dir (if regexp regexp "^"))))
- (defun file-cache-add-from-file-cache-buffer (&optional regexp)
- "Add any entries found in the file cache buffer.
- Each entry matches the regular expression `file-cache-buffer-default-regexp'
- or the optional REGEXP argument."
- (set-buffer file-cache-buffer)
- (dolist (elt file-cache-filter-regexps)
- (goto-char (point-min))
- (delete-matching-lines elt))
- (goto-char (point-min))
- (let ((full-filename))
- (while (re-search-forward
- (or regexp file-cache-buffer-default-regexp)
- (point-max) t)
- (setq full-filename (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (file-cache-add-file full-filename))))
- (defun file-cache-clear-cache ()
- "Clear the file cache."
- (interactive)
- (setq file-cache-alist nil))
- (defun file-cache-delete-file (file)
- "Delete FILE from the file cache."
- (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))
- (defun file-cache-delete-file-regexp (regexp)
- "Delete files matching REGEXP from the file cache."
- (interactive "sRegexp: ")
- (let ((delete-list))
- (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))))
- (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))
- (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))))
- (defun file-cache-do-delete-directory (dir entry)
- (let ((directory-list (cdr entry))
- (directory (file-cache-canonical-directory dir)))
- (and (member directory directory-list)
- (if (equal 1 (length directory-list))
- (setq file-cache-alist
- (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-directory-name (file)
- (let* ((directory-list (cdr (assoc-string
- file file-cache-alist
- file-cache-ignore-case)))
- (len (length directory-list))
- (directory)
- (num))
- (if (not (listp directory-list))
- (error "Filecache: unknown type in file-cache-alist for key %s" file))
- (cond
-
- ((eq 1 len)
- (setq directory (elt directory-list 0)))
-
- ((eq 0 len)
- (error "Filecache: no directory found for key %s" file))
-
- (t
- (let* ((minibuffer-dir (file-name-directory (minibuffer-contents)))
- (dir-list (member minibuffer-dir directory-list)))
- (setq directory
-
-
- (if dir-list
- (or (elt directory-list
- (setq num (1+ (- len (length dir-list)))))
- (elt directory-list (setq num 0)))
- (elt directory-list (setq num 0)))))))
-
- (setq file-cache-multiple-directory-message
- (and num (format " [%d of %d]" (1+ num) len)))
- directory))
- (defun file-cache-file-name (file)
- (let ((directory (file-cache-directory-name file)))
- (concat directory file)))
- (defun file-cache-canonical-directory (dir)
- (let ((directory dir))
- (if (not (char-equal ?/ (string-to-char (substring directory -1))))
- (concat directory "/")
- directory)))
- (defun file-cache-minibuffer-complete (arg)
- "Complete a filename in the minibuffer using a preloaded cache.
- Filecache does two kinds of substitution: it completes on names in
- the cache, and, once it has found a unique name, it cycles through
- the directories that the name is available in. With a prefix argument,
- the name is considered already unique; only the second substitution
- \(directories) is done."
- (interactive "P")
- (let*
- (
- (completion-ignore-case file-cache-completion-ignore-case)
- (case-fold-search file-cache-case-fold-search)
- (string (file-name-nondirectory (minibuffer-contents)))
- (completion-string (try-completion string file-cache-alist))
- (completion-list)
- (len)
- (file-cache-string))
- (cond
-
- ((or arg (eq completion-string t))
- (setq file-cache-string (file-cache-file-name string))
- (if (string= file-cache-string (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-cache-string)
- (if file-cache-multiple-directory-message
- (minibuffer-message file-cache-multiple-directory-message))))
-
- ((stringp completion-string)
-
-
- (if (and (string= string completion-string)
- (assoc-string string file-cache-alist
- file-cache-ignore-case))
- (if (and (eq last-command this-command)
- (string= file-cache-last-completion completion-string))
- (progn
- (delete-minibuffer-contents)
- (insert (file-cache-file-name completion-string))
- (setq file-cache-last-completion nil))
- (minibuffer-message file-cache-non-unique-message)
- (setq file-cache-last-completion string))
- (setq file-cache-last-completion string)
- (setq completion-list (all-completions string file-cache-alist)
- len (length completion-list))
- (if (> len 1)
- (progn
- (goto-char (point-max))
- (insert
- (substring completion-string (length string)))
-
- (let ((completion-setup-hook
- (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))))
- (setq file-cache-string (file-cache-file-name completion-string))
- (if (string= file-cache-string (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-cache-string)
- (if file-cache-multiple-directory-message
- (minibuffer-message file-cache-multiple-directory-message)))
- )))
-
- ((eq completion-string nil)
- (minibuffer-message file-cache-no-match-message)))))
- (defun file-cache-completion-setup-function ()
- (with-current-buffer standard-output
- (use-local-map file-cache-completions-keymap)))
- (defun file-cache-choose-completion (&optional event)
- "Choose a completion in the `*Completions*' buffer."
- (interactive (list last-nonmenu-event))
- (let ((completion-no-auto-exit t))
- (choose-completion event)
- (select-window (active-minibuffer-window))
- (file-cache-minibuffer-complete nil)))
- (define-obsolete-function-alias 'file-cache-mouse-choose-completion
- 'file-cache-choose-completion "23.2")
- (defun file-cache-complete ()
- "Complete the word at point, using the filecache."
- (interactive)
- (let ((start
- (save-excursion
- (skip-syntax-backward "^\"")
- (point))))
- (completion-in-region start (point) file-cache-alist)))
- (defun file-cache-files-matching-internal (regexp)
- "Output a list of files whose names (not including directories)
- match REGEXP."
- (let ((results))
- (dolist (cache-element file-cache-alist)
- (and (string-match regexp (elt cache-element 0))
- (push (elt cache-element 0) results)))
- (nreverse results)))
- (defun file-cache-files-matching (regexp)
- "Output a list of files whose names (not including directories)
- match REGEXP."
- (interactive "sFind files matching regexp: ")
- (let ((results
- (file-cache-files-matching-internal regexp))
- buf)
- (set-buffer
- (setq buf (get-buffer-create
- "*File Cache Files Matching*")))
- (erase-buffer)
- (insert
- (mapconcat
- 'identity
- results
- "\n"))
- (goto-char (point-min))
- (display-buffer buf)))
- (defun file-cache-debug-read-from-minibuffer (file)
- "Debugging function."
- (interactive
- (list (completing-read "File Cache: " file-cache-alist)))
- (message "%s" (assoc-string file file-cache-alist
- file-cache-ignore-case)))
- (defun file-cache-display ()
- "Display the file cache."
- (interactive)
- (let ((buf "*File Cache Contents*"))
- (with-current-buffer
- (get-buffer-create buf)
- (erase-buffer)
- (dolist (item file-cache-alist)
- (insert (nth 1 item) (nth 0 item) "\n"))
- (pop-to-buffer buf))))
- (provide 'filecache)
|