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