Re-indent.
[emacs.git] / lisp / find-lisp.el
blob771dbdc3eb96b3adb973ad364f43a7349930f783
1 ;;; find-lisp.el --- emulation of find in Emacs Lisp
3 ;; Author: Peter Breton
4 ;; Created: Fri Mar 26 1999
5 ;; Keywords: unix
7 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
8 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
27 ;;; Commentary:
29 ;; This is a very generalized form of find; it basically implements a
30 ;; recursive directory descent. The conditions which bound the search
31 ;; are expressed as predicates, and I have not addressed the question
32 ;; of how to wrap up the common chores that find does in a simpler
33 ;; format than writing code for all the various predicates.
35 ;; Some random thoughts are to express simple queries directly with
36 ;; user-level functions, and perhaps use some kind of forms interface
37 ;; for medium-level queries. Really complicated queries can be
38 ;; expressed in Lisp.
41 ;;; Todo
43 ;; It would be nice if we could sort the results without running the find
44 ;; again. Maybe that could work by storing the original file attributes?
46 ;;; Code:
48 (require 'dired)
50 (defvar dired-buffers)
51 (defvar dired-subdir-alist)
53 ;; Internal variables
55 (defvar find-lisp-regexp nil
56 "Internal variable.")
58 (defconst find-lisp-line-indent " "
59 "Indentation for dired file lines.")
61 (defvar find-lisp-file-predicate nil
62 "Predicate for choosing to include files.")
64 (defvar find-lisp-directory-predicate nil
65 "Predicate for choosing to descend into directories.")
67 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68 ;; Debugging Code
69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71 (defvar find-lisp-debug-buffer "*Find Lisp Debug*"
72 "Buffer for debugging information.")
74 (defvar find-lisp-debug nil
75 "Whether debugging is enabled.")
77 (defun find-lisp-debug-message (message)
78 "Print a debug message MESSAGE in `find-lisp-debug-buffer'."
79 (set-buffer (get-buffer-create find-lisp-debug-buffer))
80 (goto-char (point-max))
81 (insert message "\n"))
83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84 ;; Directory and File predicates
85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87 (defun find-lisp-default-directory-predicate (dir parent)
88 "True if DIR is not a dot file, and not a symlink.
89 PARENT is the parent directory of DIR."
90 (and find-lisp-debug
91 (find-lisp-debug-message
92 (format "Processing directory %s in %s" dir parent)))
93 ;; Skip current and parent directories
94 (not (or (string= dir ".")
95 (string= dir "..")
96 ;; Skip directories which are symlinks
97 ;; Easy way to circumvent recursive loops
98 (file-symlink-p (expand-file-name dir parent)))))
100 (defun find-lisp-default-file-predicate (file dir)
101 "True if FILE matches `find-lisp-regexp'.
102 DIR is the directory containing FILE."
103 (and find-lisp-debug
104 (find-lisp-debug-message
105 (format "Processing file %s in %s" file dir)))
106 (and (not (file-directory-p (expand-file-name file dir)))
107 (string-match find-lisp-regexp file)))
109 (defun find-lisp-file-predicate-is-directory (file dir)
110 "True if FILE is a directory.
111 Argument DIR is the directory containing FILE."
112 (and find-lisp-debug
113 (find-lisp-debug-message
114 (format "Processing file %s in %s" file dir)))
115 (and (file-directory-p (expand-file-name file dir))
116 (not (or (string= file ".")
117 (string= file "..")))))
119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
120 ;; Find functions
121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
123 (defun find-lisp-find-files (directory regexp)
124 "Find files in DIRECTORY which match REGEXP."
125 (let ((file-predicate 'find-lisp-default-file-predicate)
126 (directory-predicate 'find-lisp-default-directory-predicate)
127 (find-lisp-regexp regexp))
128 (find-lisp-find-files-internal
129 directory
130 file-predicate
131 directory-predicate)))
133 ;; Workhorse function
134 (defun find-lisp-find-files-internal (directory file-predicate
135 directory-predicate)
136 "Find files under DIRECTORY which satisfy FILE-PREDICATE.
137 FILE-PREDICATE is a function which takes two arguments: the file and its
138 directory.
140 DIRECTORY-PREDICATE is used to decide whether to descend into directories.
141 It is a function which takes two arguments, the directory and its parent."
142 (setq directory (file-name-as-directory directory))
143 (let (results sub-results)
144 (dolist (file (directory-files directory nil nil t))
145 (let ((fullname (expand-file-name file directory)))
146 (when (file-readable-p (expand-file-name file directory))
147 ;; If a directory, check it we should descend into it
148 (and (file-directory-p fullname)
149 (funcall directory-predicate file directory)
150 (progn
151 (setq sub-results
152 (find-lisp-find-files-internal
153 fullname
154 file-predicate
155 directory-predicate))
156 (if results
157 (nconc results sub-results)
158 (setq results sub-results))))
159 ;; For all files and directories, call the file predicate
160 (and (funcall file-predicate file directory)
161 (if results
162 (nconc results (list fullname))
163 (setq results (list fullname)))))))
164 results))
166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
167 ;; Find-dired all in Lisp
168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
170 ;;;###autoload
171 (defun find-lisp-find-dired (dir regexp)
172 "Find files in DIR, matching REGEXP."
173 (interactive "DFind files in directory: \nsMatching regexp: ")
174 (let ((find-lisp-regexp regexp))
175 (find-lisp-find-dired-internal
177 'find-lisp-default-file-predicate
178 'find-lisp-default-directory-predicate
179 "*Find Lisp Dired*")))
181 ;; Just the subdirectories
182 ;;;###autoload
183 (defun find-lisp-find-dired-subdirectories (dir)
184 "Find all subdirectories of DIR."
185 (interactive "DFind subdirectories of directory: ")
186 (find-lisp-find-dired-internal
188 'find-lisp-file-predicate-is-directory
189 'find-lisp-default-directory-predicate
190 "*Find Lisp Dired Subdirectories*"))
192 ;; Most of this is lifted from find-dired.el
194 (defun find-lisp-find-dired-internal (dir file-predicate
195 directory-predicate buffer-name)
196 "Run find (Lisp version) and go into Dired mode on a buffer of the output."
197 (let ((dired-buffers dired-buffers)
199 (regexp find-lisp-regexp))
200 ;; Expand DIR ("" means default-directory), and make sure it has a
201 ;; trailing slash.
202 (setq dir (file-name-as-directory (expand-file-name dir)))
203 ;; Check that it's really a directory.
204 (or (file-directory-p dir)
205 (error "find-dired needs a directory: %s" dir))
207 (and (buffer-name)
208 (string= buffer-name (buffer-name)))
209 (switch-to-buffer (setq buf (get-buffer-create buffer-name))))
210 (widen)
211 (kill-all-local-variables)
212 (setq buffer-read-only nil)
213 (erase-buffer)
214 (setq default-directory dir)
215 (dired-mode dir)
217 (use-local-map (append (make-sparse-keymap) (current-local-map)))
219 (make-local-variable 'find-lisp-file-predicate)
220 (setq find-lisp-file-predicate file-predicate)
221 (make-local-variable 'find-lisp-directory-predicate)
222 (setq find-lisp-directory-predicate directory-predicate)
223 (make-local-variable 'find-lisp-regexp)
224 (setq find-lisp-regexp regexp)
226 (make-local-variable 'revert-buffer-function)
227 (setq revert-buffer-function
228 (function
229 (lambda(ignore1 ignore2)
230 (find-lisp-insert-directory
231 default-directory
232 find-lisp-file-predicate
233 find-lisp-directory-predicate
234 'ignore)
238 ;; Set subdir-alist so that Tree Dired will work:
239 (if (fboundp 'dired-simple-subdir-alist)
240 ;; will work even with nested dired format (dired-nstd.el,v 1.15
241 ;; and later)
242 (dired-simple-subdir-alist)
243 ;; else we have an ancient tree dired (or classic dired, where
244 ;; this does no harm)
245 (set (make-local-variable 'dired-subdir-alist)
246 (list (cons default-directory (point-min-marker)))))
247 (find-lisp-insert-directory
248 dir file-predicate directory-predicate 'ignore)
249 (goto-char (point-min))
250 (dired-goto-next-file)))
252 (defun find-lisp-insert-directory (dir
253 file-predicate
254 directory-predicate
255 sort-function)
256 "Insert the results of `find-lisp-find-files' in the current buffer."
257 (let ((buffer-read-only nil)
258 (files (find-lisp-find-files-internal
260 file-predicate
261 directory-predicate))
262 (len (length dir)))
263 (erase-buffer)
264 ;; Subdir headlerline must come first because the first marker in
265 ;; subdir-alist points there.
266 (insert find-lisp-line-indent dir ":\n")
267 ;; Make second line a ``find'' line in analogy to the ``total'' or
268 ;; ``wildcard'' line.
270 ;; No analog for find-lisp?
271 (insert find-lisp-line-indent "\n")
272 ;; Run the find function
273 (mapc
274 (function
275 (lambda(file)
276 (find-lisp-find-dired-insert-file
277 (substring file len)
278 (current-buffer))))
279 (sort files 'string-lessp))
280 ;; FIXME: Sort function is ignored for now
281 ;; (funcall sort-function files))
282 (goto-char (point-min))
283 (dired-goto-next-file)))
285 ;;;###autoload
286 (defun find-lisp-find-dired-filter (regexp)
287 "Change the filter on a find-lisp-find-dired buffer to REGEXP."
288 (interactive "sSet filter to regexp: ")
289 (setq find-lisp-regexp regexp)
290 (revert-buffer))
292 (defun find-lisp-find-dired-insert-file (file buffer)
293 (set-buffer buffer)
294 (insert find-lisp-line-indent
295 (find-lisp-format file (file-attributes file 'string) (list "")
296 (current-time))))
298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
299 ;; Lifted from ls-lisp. We don't want to require it, because that
300 ;; would alter the insert-directory function.
301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
303 (defun find-lisp-format (file-name file-attr switches now)
304 (let ((file-type (nth 0 file-attr)))
305 (concat (if (memq ?i switches) ; inode number
306 (format "%6d " (nth 10 file-attr)))
307 ;; nil is treated like "" in concat
308 (if (memq ?s switches) ; size in K
309 (format "%4d " (1+ (/ (nth 7 file-attr) 1024))))
310 (nth 8 file-attr) ; permission bits
311 (format " %3d %-8s %-8s %8d "
312 (nth 1 file-attr) ; no. of links
313 (if (numberp (nth 2 file-attr))
314 (int-to-string (nth 2 file-attr))
315 (nth 2 file-attr)) ; uid
316 (if (eq system-type 'ms-dos)
317 "root" ; everything is root on MSDOS.
318 (if (numberp (nth 3 file-attr))
319 (int-to-string (nth 3 file-attr))
320 (nth 3 file-attr))) ; gid
321 (nth 7 file-attr) ; size in bytes
323 (find-lisp-format-time file-attr switches now)
325 file-name
326 (if (stringp file-type) ; is a symbolic link
327 (concat " -> " file-type)
329 "\n")))
331 (defun find-lisp-time-index (switches)
332 ;; Return index into file-attributes according to ls SWITCHES.
333 (cond
334 ((memq ?c switches) 6) ; last mode change
335 ((memq ?u switches) 4) ; last access
336 ;; default is last modtime
337 (t 5)))
339 (defun find-lisp-format-time (file-attr switches now)
340 ;; Format time string for file with attributes FILE-ATTR according
341 ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
342 ;; Use the same method as `ls' to decide whether to show time-of-day or year,
343 ;; depending on distance between file date and NOW.
344 (let* ((time (nth (find-lisp-time-index switches) file-attr))
345 (diff16 (- (car time) (car now)))
346 (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now)))))
347 (past-cutoff (- (* 6 30 24 60 60))) ; 6 30-day months
348 (future-cutoff (* 60 60))) ; 1 hour
349 (format-time-string
350 (if (and
351 (<= past-cutoff diff) (<= diff future-cutoff)
352 ;; Sanity check in case `diff' computation overflowed.
353 (<= (1- (ash past-cutoff -16)) diff16)
354 (<= diff16 (1+ (ash future-cutoff -16))))
355 "%b %e %H:%M"
356 "%b %e %Y")
357 time)))
359 (provide 'find-lisp)
361 ;;; arch-tag: a711374c-f12a-46f6-aa18-ba7d77b9602a
362 ;;; find-lisp.el ends here