X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/82d11a0b0e66b7e36df397c7c28ea9b1f7c755b6..758c81e87ded2bad9f5a5a6683fb498965eb508c:/lisp/find-lisp.el diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index e865d29ca6..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: <2000-10-04 00:17:29 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: ;; @@ -45,6 +42,11 @@ ;;; Code: +(require 'dired) + +(defvar dired-buffers) +(defvar dired-subdir-alist) + ;; Internal variables (defvar find-lisp-regexp nil @@ -90,7 +92,7 @@ PARENT is the parent directory of 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'. @@ -119,8 +121,7 @@ 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-regexp regexp)) (find-lisp-find-files-internal directory file-predicate @@ -135,40 +136,35 @@ 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." - (or (string-match "/$" directory) - (setq directory (concat directory "/"))) + (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: ") @@ -180,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: ") @@ -195,19 +192,17 @@ It is a function which takes two arguments, the directory and its parent." 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 (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) @@ -227,7 +222,7 @@ 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) + (lambda (_ignore1 _ignore2) (find-lisp-insert-directory default-directory find-lisp-file-predicate @@ -250,10 +245,10 @@ It is a function which takes two arguments, the directory and its parent." (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 @@ -271,9 +266,9 @@ It is a function which takes two arguments, the directory and its parent." ;; No analog for find-lisp? (insert find-lisp-line-indent "\n") ;; Run the find function - (mapcar + (mapc (function - (lambda(file) + (lambda (file) (find-lisp-find-dired-insert-file (substring file len) (current-buffer)))) @@ -283,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: ") @@ -292,7 +288,7 @@ 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 "") + (find-lisp-format file (file-attributes file 'string) (list "") (current-time)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -308,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) @@ -361,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: