X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ffe832ea680b4820f5ff399191f7f2d41350ee2e..b6bd159922608fa474026837771d63bf7eadcf97:/lisp/filecache.el diff --git a/lisp/filecache.el b/lisp/filecache.el index 821afd6a60..ef41fb4190 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -1,18 +1,17 @@ ;;; filecache.el --- find files using a pre-loaded cache -;; + +;; Copyright (C) 1996, 2000-2011 Free Software Foundation, Inc. + ;; Author: Peter Breton ;; Created: Sun Nov 10 1996 ;; Keywords: convenience -;; -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -157,9 +154,11 @@ ;; User-modifiable variables (defcustom file-cache-filter-regexps + ;; 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$") - "*List of regular expressions used as filters by the file cache. + "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." @@ -167,12 +166,12 @@ do not use this variable." :group 'file-cache) (defcustom file-cache-find-command "find" - "*External program used by `file-cache-add-directory-using-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. + "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'. @@ -185,7 +184,7 @@ should be t." :group 'file-cache) (defcustom file-cache-locate-command "locate" - "*External program used by `file-cache-add-directory-using-locate'." + "External program used by `file-cache-add-directory-using-locate'." :type 'string :group 'file-cache) @@ -207,32 +206,29 @@ should be t." :group 'file-cache) (defcustom file-cache-completion-ignore-case - (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (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 'sexp - :group 'file-cache - ) + :type 'boolean + :group 'file-cache) (defcustom file-cache-case-fold-search - (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (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 'sexp - :group 'file-cache - ) + :type 'boolean + :group 'file-cache) (defcustom file-cache-ignore-case - (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (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 'sexp - :group 'file-cache - ) + :type 'boolean + :group 'file-cache) (defvar file-cache-multiple-directory-message nil) @@ -257,9 +253,17 @@ Defaults to nil on DOS and Windows, and t on other systems." (defvar file-cache-last-completion nil) (defvar file-cache-alist nil - "Internal data structure to hold cache of file names.") - -(defvar file-cache-completions-keymap 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.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -277,30 +281,25 @@ be added to the cache." (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)) - ) + (dir-files (directory-files dir t regexp))) ;; Filter out files we don't want to see - (mapc - '(lambda (file) - (if (file-directory-p file) - (setq dir-files (delq file dir-files)) - (mapc - '(lambda (regexp) - (if (string-match regexp file) - (setq dir-files (delq file dir-files)))) - file-cache-filter-regexps))) - dir-files) + (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)))) ;;;###autoload (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." +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)) + (lambda (dir) (file-cache-add-directory dir regexp)) directory-list)) (defun file-cache-add-file-list (file-list) @@ -320,8 +319,7 @@ in each directory, not to the directory list itself." (dir-name (file-name-directory file)) (the-entry (assoc-string file-name file-cache-alist - file-cache-ignore-case)) - ) + file-cache-ignore-case))) ;; Does the entry exist already? (if the-entry (if (or (and (stringp (cdr the-entry)) @@ -329,13 +327,9 @@ in each directory, not to the directory list itself." (and (listp (cdr the-entry)) (member dir-name (cdr the-entry)))) nil - (setcdr the-entry (append (list dir-name) (cdr the-entry))) - ) + (setcdr the-entry (cons dir-name (cdr the-entry)))) ;; If not, add it to the cache - (setq file-cache-alist - (cons (cons file-name (list dir-name)) - file-cache-alist))) - ))) + (push (list file-name dir-name) file-cache-alist))))) ;;;###autoload (defun file-cache-add-directory-using-find (directory) @@ -375,25 +369,21 @@ STRING is passed as an argument to the locate command." ;;;###autoload (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 +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." +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) + (lambda (file) (or (file-directory-p file) (let (filtered) - (mapc - (function - (lambda(regexp) - (and (string-match regexp file) - (setq filtered t)) - )) - file-cache-filter-regexps) - 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 "^")))) @@ -402,11 +392,9 @@ in each directory, not to the directory list itself." Each entry matches the regular expression `file-cache-buffer-default-regexp' or the optional REGEXP argument." (set-buffer file-cache-buffer) - (mapc - (function (lambda (elt) - (goto-char (point-min)) - (delete-matching-lines elt))) - file-cache-filter-regexps) + (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 @@ -443,10 +431,9 @@ or the optional REGEXP argument." "Delete files matching REGEXP from the file cache." (interactive "sRegexp: ") (let ((delete-list)) - (mapc '(lambda (elt) - (and (string-match regexp (car elt)) - (setq delete-list (cons (car elt) delete-list)))) - file-cache-alist) + (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)))) @@ -456,26 +443,21 @@ or the optional REGEXP argument." (interactive "DDelete directory from file cache: ") (let ((dir (expand-file-name directory)) (result 0)) - (mapc - '(lambda (entry) - (if (file-cache-do-delete-directory dir entry) - (setq result (1+ result)))) - file-cache-alist) + (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)) - ) + (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))) - ) - )) + (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." @@ -493,8 +475,7 @@ or the optional REGEXP argument." file-cache-ignore-case))) (len (length directory-list)) (directory) - (num) - ) + (num)) (if (not (listp directory-list)) (error "Filecache: unknown type in file-cache-alist for key %s" file)) (cond @@ -507,8 +488,7 @@ or the optional REGEXP argument." ;; Multiple elements (t (let* ((minibuffer-dir (file-name-directory (minibuffer-contents))) - (dir-list (member minibuffer-dir directory-list)) - ) + (dir-list (member minibuffer-dir directory-list))) (setq directory ;; If the directory is in the list, return the next element ;; Otherwise, return the first element @@ -516,10 +496,7 @@ or the optional REGEXP argument." (or (elt directory-list (setq num (1+ (- len (length dir-list))))) (elt directory-list (setq num 0))) - (elt directory-list (setq num 0)))) - ) - ) - ) + (elt directory-list (setq num 0))))))) ;; If there were multiple directories, set up a minibuffer message (setq file-cache-multiple-directory-message (and num (format " [%d of %d]" (1+ num) len))) @@ -567,20 +544,17 @@ the name is considered already unique; only the second substitution (completion-string (try-completion string file-cache-alist)) (completion-list) (len) - (file-cache-string) - ) + (file-cache-string)) (cond ;; If it's the only match, replace the original contents ((or arg (eq completion-string t)) (setq file-cache-string (file-cache-file-name string)) (if (string= file-cache-string (minibuffer-contents)) - (file-cache-temp-minibuffer-message file-cache-sole-match-message) + (minibuffer-message file-cache-sole-match-message) (delete-minibuffer-contents) (insert file-cache-string) (if file-cache-multiple-directory-message - (file-cache-temp-minibuffer-message - file-cache-multiple-directory-message)) - )) + (minibuffer-message file-cache-multiple-directory-message)))) ;; If it's the longest match, insert it ((stringp completion-string) @@ -594,11 +568,9 @@ the name is considered already unique; only the second substitution (progn (delete-minibuffer-contents) (insert (file-cache-file-name completion-string)) - (setq file-cache-last-completion nil) - ) - (file-cache-temp-minibuffer-message file-cache-non-unique-message) - (setq file-cache-last-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)) @@ -609,107 +581,50 @@ the name is considered already unique; only the second substitution (substring completion-string (length string))) ;; Add our own setup function to the Completions Buffer (let ((completion-setup-hook - (reverse - (append (list 'file-cache-completion-setup-function) - 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)) - ) - ) + (display-completion-list completion-list string)))) (setq file-cache-string (file-cache-file-name completion-string)) (if (string= file-cache-string (minibuffer-contents)) - (file-cache-temp-minibuffer-message - file-cache-sole-match-message) + (minibuffer-message file-cache-sole-match-message) (delete-minibuffer-contents) (insert file-cache-string) (if file-cache-multiple-directory-message - (file-cache-temp-minibuffer-message - file-cache-multiple-directory-message))) + (minibuffer-message file-cache-multiple-directory-message))) ))) ;; No match ((eq completion-string nil) - (file-cache-temp-minibuffer-message file-cache-no-match-message)) - ) -)) - -;; Lifted from "complete.el" -(defun file-cache-temp-minibuffer-message (msg) - "A Lisp version of `temp_minibuffer_message' from minibuf.c." - (let ((savemax (point-max))) - (save-excursion - (goto-char (point-max)) - (insert msg)) - (let ((inhibit-quit t)) - (sit-for 2) - (delete-region savemax (point-max)) - (if quit-flag - (setq quit-flag nil - unread-command-events (list 7)))))) + (minibuffer-message file-cache-no-match-message))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Completion functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun file-cache-completion-setup-function () - (set-buffer file-cache-completions-buffer) - - (if file-cache-completions-keymap - nil - (setq file-cache-completions-keymap - (copy-keymap completion-list-mode-map)) - (define-key file-cache-completions-keymap [mouse-2] - 'file-cache-mouse-choose-completion) - (define-key file-cache-completions-keymap "\C-m" - 'file-cache-choose-completion)) - - (use-local-map file-cache-completions-keymap) - ) + (with-current-buffer standard-output ;; i.e. file-cache-completions-buffer + (use-local-map file-cache-completions-keymap))) -(defun file-cache-choose-completion () +(defun file-cache-choose-completion (&optional event) "Choose a completion in the `*Completions*' buffer." - (interactive) + (interactive (list last-nonmenu-event)) (let ((completion-no-auto-exit t)) - (choose-completion) + (choose-completion event) (select-window (active-minibuffer-window)) - (file-cache-minibuffer-complete nil) - ) - ) + (file-cache-minibuffer-complete nil))) -(defun file-cache-mouse-choose-completion (event) - "Choose a completion with the mouse." - (interactive "e") - (let ((completion-no-auto-exit t)) - (mouse-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 pattern completion all) + (let ((start (save-excursion (skip-syntax-backward "^\"") - (setq start (point))) - (setq pattern (buffer-substring-no-properties start (point))) - (setq completion (try-completion pattern file-cache-alist)) - (setq all (all-completions pattern file-cache-alist nil)) - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region start (point)) - (insert completion) - ) - (t - (with-output-to-temp-buffer "*Completions*" - (display-completion-list all pattern)) - )) - )) + (point)))) + (completion-in-region start (point) file-cache-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Show parts of the cache @@ -719,16 +634,10 @@ the name is considered already unique; only the second substitution "Output a list of files whose names (not including directories) match REGEXP." (let ((results)) - (mapc - (function - (lambda(cache-element) - (and (string-match regexp - (elt cache-element 0)) - (if results - (nconc results (list (elt cache-element 0))) - (setq results (list (elt cache-element 0))))))) - file-cache-alist) - 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) @@ -758,8 +667,7 @@ match REGEXP." (interactive (list (completing-read "File Cache: " file-cache-alist))) (message "%s" (assoc-string file file-cache-alist - file-cache-ignore-case)) - ) + file-cache-ignore-case))) (defun file-cache-display () "Display the file cache." @@ -768,13 +676,9 @@ match REGEXP." (with-current-buffer (get-buffer-create buf) (erase-buffer) - (mapc - (function - (lambda(item) - (insert (nth 1 item) (nth 0 item) "\n"))) - file-cache-alist) - (pop-to-buffer buf) - ))) + (dolist (item file-cache-alist) + (insert (nth 1 item) (nth 0 item) "\n")) + (pop-to-buffer buf)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Keybindings @@ -782,5 +686,4 @@ match REGEXP." (provide 'filecache) -;;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538 ;;; filecache.el ends here