X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6344985d2b9b17ea8cb2a03b5a13ba89aa53fbd5..758c81e87ded2bad9f5a5a6683fb498965eb508c:/lisp/find-lisp.el diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index 0398bd6e0e..bfe35c0109 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -1,18 +1,17 @@ -;;; find-lisp.el --- Emulation of find in Emacs Lisp +;;; find-lisp.el --- emulation of find in Emacs Lisp -;; Author: Peter Breton +;; Author: Peter Breton ;; Created: Fri Mar 26 1999 ;; Keywords: unix -;; Time-stamp: <1999-04-19 16:37:01 pbreton> -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1999-2012 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 2, 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -36,7 +33,7 @@ ;; user-level functions, and perhaps use some kind of forms interface ;; for medium-level queries. Really complicated queries can be ;; expressed in Lisp. -;; +;; ;;; Todo ;; @@ -45,6 +42,11 @@ ;;; Code: +(require 'dired) + +(defvar dired-buffers) +(defvar dired-subdir-alist) + ;; Internal variables (defvar find-lisp-regexp nil @@ -83,20 +85,20 @@ "True if DIR is not a dot file, and not a symlink. PARENT is the parent directory of DIR." (and find-lisp-debug - (find-lisp-debug-message + (find-lisp-debug-message (format "Processing directory %s in %s" dir parent))) ;; Skip current and parent directories (not (or (string= dir ".") (string= dir "..") ;; Skip directories which are symlinks ;; Easy way to circumvent recursive loops - (file-symlink-p dir)))) + (file-symlink-p (expand-file-name dir parent))))) (defun find-lisp-default-file-predicate (file dir) "True if FILE matches `find-lisp-regexp'. DIR is the directory containing FILE." (and find-lisp-debug - (find-lisp-debug-message + (find-lisp-debug-message (format "Processing file %s in %s" file dir))) (and (not (file-directory-p (expand-file-name file dir))) (string-match find-lisp-regexp file))) @@ -105,7 +107,7 @@ DIR is the directory containing FILE." "True if FILE is a directory. Argument DIR is the directory containing FILE." (and find-lisp-debug - (find-lisp-debug-message + (find-lisp-debug-message (format "Processing file %s in %s" file dir))) (and (file-directory-p (expand-file-name file dir)) (not (or (string= file ".") @@ -119,54 +121,50 @@ Argument DIR is the directory containing FILE." "Find files in DIRECTORY which match REGEXP." (let ((file-predicate 'find-lisp-default-file-predicate) (directory-predicate 'find-lisp-default-directory-predicate) - (find-lisp-regexp regexp) - ) - (find-lisp-find-files-internal - directory + (find-lisp-regexp regexp)) + (find-lisp-find-files-internal + directory file-predicate directory-predicate))) ;; Workhorse function -(defun find-lisp-find-files-internal (directory file-predicate +(defun find-lisp-find-files-internal (directory file-predicate directory-predicate) "Find files under DIRECTORY which satisfy FILE-PREDICATE. -FILE-PREDICATE is a function which takes two arguments: the file and its +FILE-PREDICATE is a function which takes two arguments: the file and its directory. DIRECTORY-PREDICATE is used to decide whether to descend into directories. It is a function which takes two arguments, the directory and its parent." + (setq directory (file-name-as-directory directory)) (let (results sub-results) - (mapcar - (function - (lambda(file) - (let ((fullname (expand-file-name file directory))) - (and (file-readable-p (expand-file-name file directory)) + (dolist (file (directory-files directory nil nil t)) + (let ((fullname (expand-file-name file directory))) + (when (file-readable-p (expand-file-name file directory)) + ;; If a directory, check it we should descend into it + (and (file-directory-p fullname) + (funcall directory-predicate file directory) (progn - ;; If a directory, check it we should descend into it - (and (file-directory-p fullname) - (funcall directory-predicate file directory) - (progn - (setq sub-results - (find-lisp-find-files-internal - fullname - file-predicate - directory-predicate)) - (if results - (nconc results sub-results) - (setq results sub-results)))) - ;; For all files and directories, call the file predicate - (and (funcall file-predicate file directory) - (if results - (nconc results (list fullname)) - (setq results (list fullname)))) - ))))) - (directory-files directory nil nil t)) + (setq sub-results + (find-lisp-find-files-internal + fullname + file-predicate + directory-predicate)) + (if results + (nconc results sub-results) + (setq results sub-results)))) + ;; For all files and directories, call the file predicate + (and (funcall file-predicate file directory) + (if results + (nconc results (list fullname)) + (setq results (list fullname))))))) results)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Find-dired all in Lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload (defun find-lisp-find-dired (dir regexp) "Find files in DIR, matching REGEXP." (interactive "DFind files in directory: \nsMatching regexp: ") @@ -178,6 +176,7 @@ It is a function which takes two arguments, the directory and its parent." "*Find Lisp Dired*"))) ;; Just the subdirectories +;;;###autoload (defun find-lisp-find-dired-subdirectories (dir) "Find all subdirectories of DIR." (interactive "DFind subdirectories of directory: ") @@ -188,24 +187,22 @@ It is a function which takes two arguments, the directory and its parent." "*Find Lisp Dired Subdirectories*")) ;; Most of this is lifted from find-dired.el -;; -(defun find-lisp-find-dired-internal (dir file-predicate +;; +(defun find-lisp-find-dired-internal (dir file-predicate directory-predicate buffer-name) "Run find (Lisp version) and go into Dired mode on a buffer of the output." (let ((dired-buffers dired-buffers) - buf (regexp find-lisp-regexp)) ;; Expand DIR ("" means default-directory), and make sure it has a ;; trailing slash. - (setq dir (abbreviate-file-name - (file-name-as-directory (expand-file-name dir)))) + (setq dir (file-name-as-directory (expand-file-name dir))) ;; Check that it's really a directory. (or (file-directory-p dir) (error "find-dired needs a directory: %s" dir)) - (or + (or (and (buffer-name) (string= buffer-name (buffer-name))) - (switch-to-buffer (setq buf (get-buffer-create buffer-name)))) + (switch-to-buffer (get-buffer-create buffer-name))) (widen) (kill-all-local-variables) (setq buffer-read-only nil) @@ -225,8 +222,8 @@ It is a function which takes two arguments, the directory and its parent." (make-local-variable 'revert-buffer-function) (setq revert-buffer-function (function - (lambda(ignore1 ignore2) - (find-lisp-insert-directory + (lambda (_ignore1 _ignore2) + (find-lisp-insert-directory default-directory find-lisp-file-predicate find-lisp-directory-predicate @@ -240,23 +237,23 @@ It is a function which takes two arguments, the directory and its parent." ;; and later) (dired-simple-subdir-alist) ;; else we have an ancient tree dired (or classic dired, where - ;; this does no harm) + ;; this does no harm) (set (make-local-variable 'dired-subdir-alist) (list (cons default-directory (point-min-marker))))) - (find-lisp-insert-directory + (find-lisp-insert-directory dir file-predicate directory-predicate 'ignore) (goto-char (point-min)) (dired-goto-next-file))) -(defun find-lisp-insert-directory (dir - file-predicate - directory-predicate - sort-function) +(defun find-lisp-insert-directory (dir + file-predicate + directory-predicate + _sort-function) "Insert the results of `find-lisp-find-files' in the current buffer." (let ((buffer-read-only nil) - (files (find-lisp-find-files-internal - dir - file-predicate + (files (find-lisp-find-files-internal + dir + file-predicate directory-predicate)) (len (length dir))) (erase-buffer) @@ -264,15 +261,15 @@ It is a function which takes two arguments, the directory and its parent." ;; subdir-alist points there. (insert find-lisp-line-indent dir ":\n") ;; Make second line a ``find'' line in analogy to the ``total'' or - ;; ``wildcard'' line. + ;; ``wildcard'' line. ;; ;; No analog for find-lisp? (insert find-lisp-line-indent "\n") ;; Run the find function - (mapcar + (mapc (function - (lambda(file) - (find-lisp-find-dired-insert-file + (lambda (file) + (find-lisp-find-dired-insert-file (substring file len) (current-buffer)))) (sort files 'string-lessp)) @@ -281,6 +278,7 @@ It is a function which takes two arguments, the directory and its parent." (goto-char (point-min)) (dired-goto-next-file))) +;;;###autoload (defun find-lisp-find-dired-filter (regexp) "Change the filter on a find-lisp-find-dired buffer to REGEXP." (interactive "sSet filter to regexp: ") @@ -289,8 +287,8 @@ It is a function which takes two arguments, the directory and its parent." (defun find-lisp-find-dired-insert-file (file buffer) (set-buffer buffer) - (insert find-lisp-line-indent - (find-lisp-format file (file-attributes file) (list "") + (insert find-lisp-line-indent + (find-lisp-format file (file-attributes file 'string) (list "") (current-time)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -306,18 +304,16 @@ It is a function which takes two arguments, the directory and its parent." (if (memq ?s switches) ; size in K (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) (nth 8 file-attr) ; permission bits - ;; numeric uid/gid are more confusing than helpful - ;; Emacs should be able to make strings of them. - ;; user-login-name and user-full-name could take an - ;; optional arg. (format " %3d %-8s %-8s %8d " (nth 1 file-attr) ; no. of links - (if (= (user-uid) (nth 2 file-attr)) - (user-login-name) - (int-to-string (nth 2 file-attr))) ; uid + (if (numberp (nth 2 file-attr)) + (int-to-string (nth 2 file-attr)) + (nth 2 file-attr)) ; uid (if (eq system-type 'ms-dos) "root" ; everything is root on MSDOS. - (int-to-string (nth 3 file-attr))) ; gid + (if (numberp (nth 3 file-attr)) + (int-to-string (nth 3 file-attr)) + (nth 3 file-attr))) ; gid (nth 7 file-attr) ; size in bytes ) (find-lisp-format-time file-attr switches now) @@ -359,7 +355,3 @@ It is a function which takes two arguments, the directory and its parent." (provide 'find-lisp) ;;; find-lisp.el ends here - -;; Local Variables: -;; autocompile: t -;; End: