| 1 | ;;; find-lisp.el --- Emulation of find in Emacs Lisp |
| 2 | |
| 3 | ;; Author: Peter Breton |
| 4 | ;; Created: Fri Mar 26 1999 |
| 5 | ;; Keywords: unix |
| 6 | ;; Time-stamp: <2000-10-04 00:17:29 pbreton> |
| 7 | |
| 8 | ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. |
| 9 | |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | |
| 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 2, or (at your option) |
| 15 | ;; any later version. |
| 16 | |
| 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. |
| 21 | |
| 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., 59 Temple Place - Suite 330, |
| 25 | ;; Boston, MA 02111-1307, USA. |
| 26 | |
| 27 | ;;; Commentary: |
| 28 | ;; |
| 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. |
| 34 | ;; |
| 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. |
| 39 | ;; |
| 40 | |
| 41 | ;;; Todo |
| 42 | ;; |
| 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? |
| 45 | |
| 46 | ;;; Code: |
| 47 | |
| 48 | ;; Internal variables |
| 49 | |
| 50 | (defvar find-lisp-regexp nil |
| 51 | "Internal variable.") |
| 52 | |
| 53 | (defconst find-lisp-line-indent " " |
| 54 | "Indentation for dired file lines.") |
| 55 | |
| 56 | (defvar find-lisp-file-predicate nil |
| 57 | "Predicate for choosing to include files.") |
| 58 | |
| 59 | (defvar find-lisp-directory-predicate nil |
| 60 | "Predicate for choosing to descend into directories.") |
| 61 | |
| 62 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 63 | ;; Debugging Code |
| 64 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 65 | |
| 66 | (defvar find-lisp-debug-buffer "*Find Lisp Debug*" |
| 67 | "Buffer for debugging information.") |
| 68 | |
| 69 | (defvar find-lisp-debug nil |
| 70 | "Whether debugging is enabled.") |
| 71 | |
| 72 | (defun find-lisp-debug-message (message) |
| 73 | "Print a debug message MESSAGE in `find-lisp-debug-buffer'." |
| 74 | (set-buffer (get-buffer-create find-lisp-debug-buffer)) |
| 75 | (goto-char (point-max)) |
| 76 | (insert message "\n")) |
| 77 | |
| 78 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 79 | ;; Directory and File predicates |
| 80 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 81 | |
| 82 | (defun find-lisp-default-directory-predicate (dir parent) |
| 83 | "True if DIR is not a dot file, and not a symlink. |
| 84 | PARENT is the parent directory of DIR." |
| 85 | (and find-lisp-debug |
| 86 | (find-lisp-debug-message |
| 87 | (format "Processing directory %s in %s" dir parent))) |
| 88 | ;; Skip current and parent directories |
| 89 | (not (or (string= dir ".") |
| 90 | (string= dir "..") |
| 91 | ;; Skip directories which are symlinks |
| 92 | ;; Easy way to circumvent recursive loops |
| 93 | (file-symlink-p dir)))) |
| 94 | |
| 95 | (defun find-lisp-default-file-predicate (file dir) |
| 96 | "True if FILE matches `find-lisp-regexp'. |
| 97 | DIR is the directory containing FILE." |
| 98 | (and find-lisp-debug |
| 99 | (find-lisp-debug-message |
| 100 | (format "Processing file %s in %s" file dir))) |
| 101 | (and (not (file-directory-p (expand-file-name file dir))) |
| 102 | (string-match find-lisp-regexp file))) |
| 103 | |
| 104 | (defun find-lisp-file-predicate-is-directory (file dir) |
| 105 | "True if FILE is a directory. |
| 106 | Argument DIR is the directory containing FILE." |
| 107 | (and find-lisp-debug |
| 108 | (find-lisp-debug-message |
| 109 | (format "Processing file %s in %s" file dir))) |
| 110 | (and (file-directory-p (expand-file-name file dir)) |
| 111 | (not (or (string= file ".") |
| 112 | (string= file ".."))))) |
| 113 | |
| 114 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 115 | ;; Find functions |
| 116 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 117 | |
| 118 | (defun find-lisp-find-files (directory regexp) |
| 119 | "Find files in DIRECTORY which match REGEXP." |
| 120 | (let ((file-predicate 'find-lisp-default-file-predicate) |
| 121 | (directory-predicate 'find-lisp-default-directory-predicate) |
| 122 | (find-lisp-regexp regexp) |
| 123 | ) |
| 124 | (find-lisp-find-files-internal |
| 125 | directory |
| 126 | file-predicate |
| 127 | directory-predicate))) |
| 128 | |
| 129 | ;; Workhorse function |
| 130 | (defun find-lisp-find-files-internal (directory file-predicate |
| 131 | directory-predicate) |
| 132 | "Find files under DIRECTORY which satisfy FILE-PREDICATE. |
| 133 | FILE-PREDICATE is a function which takes two arguments: the file and its |
| 134 | directory. |
| 135 | |
| 136 | DIRECTORY-PREDICATE is used to decide whether to descend into directories. |
| 137 | It is a function which takes two arguments, the directory and its parent." |
| 138 | (or (string-match "/$" directory) |
| 139 | (setq directory (concat directory "/"))) |
| 140 | (let (results sub-results) |
| 141 | (mapcar |
| 142 | (function |
| 143 | (lambda(file) |
| 144 | (let ((fullname (expand-file-name file directory))) |
| 145 | (and (file-readable-p (expand-file-name file directory)) |
| 146 | (progn |
| 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 | ))))) |
| 165 | (directory-files directory nil nil t)) |
| 166 | results)) |
| 167 | |
| 168 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 169 | ;; Find-dired all in Lisp |
| 170 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 171 | |
| 172 | (defun find-lisp-find-dired (dir regexp) |
| 173 | "Find files in DIR, matching REGEXP." |
| 174 | (interactive "DFind files in directory: \nsMatching regexp: ") |
| 175 | (let ((find-lisp-regexp regexp)) |
| 176 | (find-lisp-find-dired-internal |
| 177 | dir |
| 178 | 'find-lisp-default-file-predicate |
| 179 | 'find-lisp-default-directory-predicate |
| 180 | "*Find Lisp Dired*"))) |
| 181 | |
| 182 | ;; Just the subdirectories |
| 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 |
| 187 | dir |
| 188 | 'find-lisp-file-predicate-is-directory |
| 189 | 'find-lisp-default-directory-predicate |
| 190 | "*Find Lisp Dired Subdirectories*")) |
| 191 | |
| 192 | ;; Most of this is lifted from find-dired.el |
| 193 | ;; |
| 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) |
| 198 | buf |
| 199 | (regexp find-lisp-regexp)) |
| 200 | ;; Expand DIR ("" means default-directory), and make sure it has a |
| 201 | ;; trailing slash. |
| 202 | (setq dir (abbreviate-file-name |
| 203 | (file-name-as-directory (expand-file-name dir)))) |
| 204 | ;; Check that it's really a directory. |
| 205 | (or (file-directory-p dir) |
| 206 | (error "find-dired needs a directory: %s" dir)) |
| 207 | (or |
| 208 | (and (buffer-name) |
| 209 | (string= buffer-name (buffer-name))) |
| 210 | (switch-to-buffer (setq buf (get-buffer-create buffer-name)))) |
| 211 | (widen) |
| 212 | (kill-all-local-variables) |
| 213 | (setq buffer-read-only nil) |
| 214 | (erase-buffer) |
| 215 | (setq default-directory dir) |
| 216 | (dired-mode dir) |
| 217 | |
| 218 | (use-local-map (append (make-sparse-keymap) (current-local-map))) |
| 219 | |
| 220 | (make-local-variable 'find-lisp-file-predicate) |
| 221 | (setq find-lisp-file-predicate file-predicate) |
| 222 | (make-local-variable 'find-lisp-directory-predicate) |
| 223 | (setq find-lisp-directory-predicate directory-predicate) |
| 224 | (make-local-variable 'find-lisp-regexp) |
| 225 | (setq find-lisp-regexp regexp) |
| 226 | |
| 227 | (make-local-variable 'revert-buffer-function) |
| 228 | (setq revert-buffer-function |
| 229 | (function |
| 230 | (lambda(ignore1 ignore2) |
| 231 | (find-lisp-insert-directory |
| 232 | default-directory |
| 233 | find-lisp-file-predicate |
| 234 | find-lisp-directory-predicate |
| 235 | 'ignore) |
| 236 | ) |
| 237 | )) |
| 238 | |
| 239 | ;; Set subdir-alist so that Tree Dired will work: |
| 240 | (if (fboundp 'dired-simple-subdir-alist) |
| 241 | ;; will work even with nested dired format (dired-nstd.el,v 1.15 |
| 242 | ;; and later) |
| 243 | (dired-simple-subdir-alist) |
| 244 | ;; else we have an ancient tree dired (or classic dired, where |
| 245 | ;; this does no harm) |
| 246 | (set (make-local-variable 'dired-subdir-alist) |
| 247 | (list (cons default-directory (point-min-marker))))) |
| 248 | (find-lisp-insert-directory |
| 249 | dir file-predicate directory-predicate 'ignore) |
| 250 | (goto-char (point-min)) |
| 251 | (dired-goto-next-file))) |
| 252 | |
| 253 | (defun find-lisp-insert-directory (dir |
| 254 | file-predicate |
| 255 | directory-predicate |
| 256 | sort-function) |
| 257 | "Insert the results of `find-lisp-find-files' in the current buffer." |
| 258 | (let ((buffer-read-only nil) |
| 259 | (files (find-lisp-find-files-internal |
| 260 | dir |
| 261 | file-predicate |
| 262 | directory-predicate)) |
| 263 | (len (length dir))) |
| 264 | (erase-buffer) |
| 265 | ;; Subdir headlerline must come first because the first marker in |
| 266 | ;; subdir-alist points there. |
| 267 | (insert find-lisp-line-indent dir ":\n") |
| 268 | ;; Make second line a ``find'' line in analogy to the ``total'' or |
| 269 | ;; ``wildcard'' line. |
| 270 | ;; |
| 271 | ;; No analog for find-lisp? |
| 272 | (insert find-lisp-line-indent "\n") |
| 273 | ;; Run the find function |
| 274 | (mapcar |
| 275 | (function |
| 276 | (lambda(file) |
| 277 | (find-lisp-find-dired-insert-file |
| 278 | (substring file len) |
| 279 | (current-buffer)))) |
| 280 | (sort files 'string-lessp)) |
| 281 | ;; FIXME: Sort function is ignored for now |
| 282 | ;; (funcall sort-function files)) |
| 283 | (goto-char (point-min)) |
| 284 | (dired-goto-next-file))) |
| 285 | |
| 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)) |
| 291 | |
| 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) (list "") |
| 296 | (current-time)))) |
| 297 | |
| 298 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 299 | ;; Lifted from ls-lisp. We don't want to require it, because that |
| 300 | ;; would alter the insert-directory function. |
| 301 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 302 | |
| 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 | ;; numeric uid/gid are more confusing than helpful |
| 312 | ;; Emacs should be able to make strings of them. |
| 313 | ;; user-login-name and user-full-name could take an |
| 314 | ;; optional arg. |
| 315 | (format " %3d %-8s %-8s %8d " |
| 316 | (nth 1 file-attr) ; no. of links |
| 317 | (if (= (user-uid) (nth 2 file-attr)) |
| 318 | (user-login-name) |
| 319 | (int-to-string (nth 2 file-attr))) ; uid |
| 320 | (if (eq system-type 'ms-dos) |
| 321 | "root" ; everything is root on MSDOS. |
| 322 | (int-to-string (nth 3 file-attr))) ; gid |
| 323 | (nth 7 file-attr) ; size in bytes |
| 324 | ) |
| 325 | (find-lisp-format-time file-attr switches now) |
| 326 | " " |
| 327 | file-name |
| 328 | (if (stringp file-type) ; is a symbolic link |
| 329 | (concat " -> " file-type) |
| 330 | "") |
| 331 | "\n"))) |
| 332 | |
| 333 | (defun find-lisp-time-index (switches) |
| 334 | ;; Return index into file-attributes according to ls SWITCHES. |
| 335 | (cond |
| 336 | ((memq ?c switches) 6) ; last mode change |
| 337 | ((memq ?u switches) 4) ; last access |
| 338 | ;; default is last modtime |
| 339 | (t 5))) |
| 340 | |
| 341 | (defun find-lisp-format-time (file-attr switches now) |
| 342 | ;; Format time string for file with attributes FILE-ATTR according |
| 343 | ;; to SWITCHES (a list of ls option letters of which c and u are recognized). |
| 344 | ;; Use the same method as `ls' to decide whether to show time-of-day or year, |
| 345 | ;; depending on distance between file date and NOW. |
| 346 | (let* ((time (nth (find-lisp-time-index switches) file-attr)) |
| 347 | (diff16 (- (car time) (car now))) |
| 348 | (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now))))) |
| 349 | (past-cutoff (- (* 6 30 24 60 60))) ; 6 30-day months |
| 350 | (future-cutoff (* 60 60))) ; 1 hour |
| 351 | (format-time-string |
| 352 | (if (and |
| 353 | (<= past-cutoff diff) (<= diff future-cutoff) |
| 354 | ;; Sanity check in case `diff' computation overflowed. |
| 355 | (<= (1- (ash past-cutoff -16)) diff16) |
| 356 | (<= diff16 (1+ (ash future-cutoff -16)))) |
| 357 | "%b %e %H:%M" |
| 358 | "%b %e %Y") |
| 359 | time))) |
| 360 | |
| 361 | (provide 'find-lisp) |
| 362 | |
| 363 | ;;; find-lisp.el ends here |
| 364 | |
| 365 | ;; Local Variables: |
| 366 | ;; autocompile: t |
| 367 | ;; End: |