home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / dired / find-dired.el < prev    next >
Encoding:
Text File  |  1995-05-12  |  8.9 KB  |  247 lines
  1. ;;; find-dired.el -- Run a `find' command and dired the output
  2. ;;; Copyright (C) 1991 Roland McGrath
  3.  
  4. ;; Keywords: dired extensions, file, grep, find, utility
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  20. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;;; Synched up with: Not synced up with FSF.
  23.  
  24. (defconst find-dired-version (substring "!Revision: 1.14 !" 11 -2)
  25.   "Id: find-dired.el,v 1.14 1992/04/16 14:22:07 sk RelBeta ")
  26.  
  27. ;;;
  28. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  29. ;;    LCD Archive Entry:
  30. ;;    find-dired|Roland McGrath, Sebastian Kremer
  31. ;;    |roland@gnu.ai.mit.edu, sk@thp.uni-koeln.de
  32. ;;    |Run a `find' command and dired the output
  33. ;;    |Date: 1992/04/16 14:22:07 |Revision: 1.14 |
  34.  
  35. ;; INSTALLATION ======================================================
  36.  
  37. ;; To use this file, byte-compile it, install it somewhere in your
  38. ;; load-path, and put:
  39.  
  40. ;;   (autoload 'find-dired "find-dired" nil t)
  41. ;;   (autoload 'find-name-dired "find-dired" nil t)
  42. ;;   (autoload 'find-grep-dired "find-dired" nil t)
  43.  
  44. ;; in your ~/.emacs, or site-init.el, etc.
  45.  
  46. ;; To bind it to a key, put, e.g.:
  47. ;;
  48. ;;   (global-set-key "\C-cf" 'find-dired)
  49. ;;   (global-set-key "\C-cn" 'find-name-dired)
  50. ;;   (global-set-key "\C-cl" 'find-grep-dired)
  51. ;;
  52. ;; in your ~/.emacs.
  53.  
  54. (require 'dired)
  55. (provide 'find-dired)
  56.  
  57. ;;;###autoload
  58. (defvar find-ls-option (purecopy
  59.             (if (eq system-type 'berkeley-unix) "-ls"
  60.               "-exec ls -ldi {} \\;"))
  61.   "*Option to `find' to produce an `ls -l'-type listing.")
  62.  
  63. ;;;###autoload
  64. (defvar find-grep-options (purecopy
  65.                (if (eq system-type 'berkeley-unix) "-s" "-l"))
  66.   "*Option to grep to be as silent as possible.
  67. On Berkeley systems, this is `-s', for others it seems impossible to
  68. suppress all output, so `-l' is used to print nothing more than the
  69. file name.")
  70.  
  71. ;;;###autoload
  72. (defvar find-dired-multiple-buffers nil
  73.   "*If non-nil, generates a new buffer for each find")
  74.  
  75. (defvar find-dired-dir-history nil
  76.   "History of directories used by find-dired")
  77.  
  78. (defvar find-args-history nil
  79.   "Last arguments given to `find' by \\[find-dired].")
  80.  
  81. ;;;###autoload
  82. (defun find-dired (dir args)
  83.   "Run `find' and go into dired-mode on a buffer of the output.
  84. The command run (after changing into DIR) is
  85.  
  86.     find . \\( ARGS \\) -ls"
  87.   (interactive (list (read-file-name "Run find in directory: "
  88.                      nil "" t nil 'find-dired-dir-history)
  89.              (if (featurep 'gmhist)
  90.              (read-with-history-in 'find-args-history
  91.                            "Run find (with args): ")
  92.                (read-string "Run find (with args): "
  93.                   (or (and (fboundp 'symbol-near-point)
  94.                        (symbol-near-point))
  95.                        (car 'find-args-history))
  96.                   'find-args-history))))
  97.   ;; Expand DIR ("" means default-directory), and make sure it has a
  98.   ;; trailing slash.
  99.   (setq dir (file-name-as-directory (expand-file-name dir)))
  100.   ;; Check that it's really a directory.
  101.   (or (file-directory-p dir)
  102.       (error "find-dired needs a directory: %s" dir))
  103.   (switch-to-buffer-other-window (if find-dired-multiple-buffers
  104.                         (generate-new-buffer (concat "*Find-in-"
  105.                                                      (file-name-nondirectory (directory-file-name dir))
  106.                                                      "/..*"))
  107.                       (get-buffer-create "*Find*")))
  108.   (widen)
  109.   (kill-all-local-variables)
  110.   (setq buffer-read-only nil)
  111.   (erase-buffer)
  112.   (setq default-directory dir
  113.     find-args-history args
  114.     args (concat "find . "
  115.              (if (string= args "")
  116.              ""
  117.                (concat "\\( " args " \\) "))
  118.              find-ls-option))
  119.   ;; The next statement will bomb in classic dired (no optional arg allowed)
  120.   ;; find(1)'s -ls corresponds to these switches.
  121.   ;; Note -b, at least GNU find quotes spaces etc. in filenames
  122.   (dired-mode dir "-gilsb")
  123.   ;; Set subdir-alist so that Tree Dired will work:
  124.   (if (fboundp 'dired-simple-subdir-alist)
  125.       ;; will work even with nested dired format (dired-nstd.el,v 1.15
  126.       ;; and later)
  127.       (dired-simple-subdir-alist)
  128.     ;; else we have an ancient tree dired (or classic dired, where
  129.     ;; this does no harm) 
  130.     (set (make-local-variable 'dired-subdir-alist)
  131.      (list (cons default-directory (point-min-marker)))))
  132.   (setq buffer-read-only nil)
  133.   ;; Subdir headlerline must come first because the first marker in
  134.   ;; subdir-alist points there.
  135.   (insert "  " dir ":\n")
  136.   ;; Make second line a ``find'' line in analogy to the ``total'' or
  137.   ;; ``wildcard'' line. 
  138.   (insert "  " args "\n")
  139.   ;; Start the find process
  140.   (message "Searching .... (but you can continue other work)")
  141.   (sit-for 0)
  142.   (set-process-filter (start-process-shell-command "find"
  143.                            (current-buffer) args)
  144.               (function find-dired-filter))
  145.   (set-process-sentinel (get-buffer-process (current-buffer))
  146.             (function find-dired-sentinel))
  147.   (setq modeline-process '(": %s")))
  148.  
  149. ;;;###autoload
  150. (defun find-name-dired (dir pattern)
  151.   "Search DIR recursively for files matching the globbing pattern PATTERN,
  152. and run dired on those files.
  153. PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
  154. The command run (after changing into DIR) is
  155.  
  156.     find . -name 'PATTERN' -ls"
  157.   (interactive
  158.    "DFind-name (directory): \nsFind-name (filename wildcard): ")
  159.   (find-dired dir (concat "-name '" pattern "'")))
  160.  
  161. ;; This functionality suggested by
  162. ;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
  163. ;; Subject: find-dired, lookfor-dired
  164. ;; Date: 10 May 91 17:50:00 GMT
  165. ;; Organization: University of Waterloo
  166.  
  167. (fset 'lookfor-dired 'find-grep-dired)
  168.  
  169. (defvar find-grep-dired-history nil
  170.   "history for find-grep-dired input")
  171.  
  172. ;;;###autoload
  173. (defun find-grep-dired (dir args)
  174.   "Find files in DIR containing a regexp ARG and start Dired on output.
  175. The command run (after changing into DIR) is
  176.  
  177.     find . (-type f -exec test -r {} \\\;-exec grep -s ARG {} \\\; -ls
  178.  
  179. Thus ARG can also contain additional grep options."
  180.   (interactive
  181.    (list (read-string "Find-grep (directory): "
  182.               default-directory 'find-dired-dir-history)
  183.      (read-string "Find-grep (grep args): " (and (fboundp 'symbol-near-point)
  184.                              (symbol-near-point))
  185.               'find-grep-dired-history)))
  186.   ;; find -exec doesn't allow shell i/o redirections in the command,
  187.   ;; or we could use `grep -l >/dev/null'
  188.   (find-dired dir
  189.               (concat "-type f -exec test -r {} \\\; -exec egrep " find-grep-options " " args " {} \\\; ")))
  190.  
  191. (defun find-dired-filter (proc string)
  192.   ;; Filter for \\[find-dired] processes.
  193.   (let ((buf (process-buffer proc)))
  194.     (if (buffer-name buf)        ; not killed?
  195.     (save-excursion
  196.       (set-buffer buf)
  197.       (save-restriction
  198.         (widen)
  199.         (save-excursion
  200.           (let ((buffer-read-only nil)
  201.             (end (point-max)))
  202.         (goto-char end)
  203.         (insert string)
  204.         (goto-char end)
  205.         (or (looking-at "^")
  206.             (forward-line 1))
  207.         (while (looking-at "^")
  208.           (insert "  ")
  209.           (forward-line 1))
  210.         ;; Convert ` ./FILE' to ` FILE'
  211.         ;; This would lose if the current chunk of output
  212.         ;; starts or ends within the ` ./', so backup up a bit:
  213.         (goto-char (- end 3))    ; no error if < 0
  214.         (while (search-forward " ./" nil t)
  215.           (delete-region (point) (- (point) 2)))))))
  216.       ;; The buffer has been killed.
  217.       (delete-process proc))))
  218.  
  219. (defun find-dired-sentinel (proc state)
  220.   ;; Sentinel for \\[find-dired] processes.
  221.   (let ((buf (process-buffer proc)))
  222.     (if (buffer-name buf)
  223.     (save-excursion
  224.       (set-buffer buf)
  225.       (toggle-read-only)
  226.       (setq modeline-process nil)
  227.       (message "find-dired %s finished." (current-buffer))))))
  228.  
  229. (or (fboundp 'start-process-shell-command)
  230.     ;; From version 19 subr.el.
  231. (defun start-process-shell-command (name buffer &rest args)
  232.   "Start a program in a subprocess.  Return the process object for it.
  233. Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
  234. NAME is name for process.  It is modified if necessary to make it unique.
  235. BUFFER is the buffer or (buffer-name) to associate with the process.
  236.  Process output goes at end of that buffer, unless you specify
  237.  an output stream or filter function to handle the output.
  238.  BUFFER may be also nil, meaning that this process is not associated
  239.  with any buffer
  240. Third arg is command name, the name of a shell command.
  241. Remaining arguments are the arguments for the command.
  242. Wildcards and redirection are handle as usual in the shell."
  243.   (if (eq system-type 'vax-vms)
  244.       (apply 'start-process name buffer args)
  245.     (start-process name buffer shell-file-name "-c"
  246.            (concat "exec " (mapconcat 'identity args " "))))))
  247.