Comment change.
[bpt/emacs.git] / lisp / find-dired.el
index ab5e3c4..43246c0 100644 (file)
@@ -1,78 +1,82 @@
-;; find-dired.el --- run a `find' command and dired the output
-
-;;; Copyright (C) 1991 Roland McGrath
-
-(defconst find-dired-version (substring "$Revision: 1.9 $" 11 -2)
-  "$Id: find-dired.el,v 1.9 1991/11/11 13:24:31 sk Exp $")
-
-;;; This program 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 1, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; A copy of the GNU General Public License can be obtained from this
-;;; program's author (send electronic mail to roland@ai.mit.edu) or from
-;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
-;;; 02139, USA.
-;;;
-;; LISPDIR ENTRY for the Elisp Archive ===============================
-;;    LCD Archive Entry:
-;;    find-dired|Roland McGrath, Sebastian Kremer
-;;    |roland@gnu.ai.mit.edu, sk@thp.uni-koeln.de
-;;    |Run a `find' command and dired the output
-;;    |$Date: 1991/11/11 13:24:31 $|$Revision: 1.9 $|
-
-;; INSTALLATION ======================================================
-
-;; To use this file, byte-compile it, install it somewhere in your
-;; load-path, and put:
-
-;;   (autoload 'find-dired "find-dired" nil t)
-;;   (autoload 'find-name-dired "find-dired" nil t)
-;;   (autoload 'find-grep-dired "find-dired" nil t)
-
-;; in your ~/.emacs, or site-init.el, etc.
-
-;; To bind it to a key, put, e.g.:
-;;
-;;   (global-set-key "\C-cf" 'find-dired)
-;;   (global-set-key "\C-cn" 'find-name-dired)
-;;   (global-set-key "\C-cl" 'find-grep-dired)
-;;
-;; in your ~/.emacs.
+;;; find-dired.el --- run a `find' command and dired the output
+
+;; Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc.
+
+;; Author: Roland McGrath <roland@gnu.ai.mit.edu>,
+;;        Sebastian Kremer <sk@thp.uni-koeln.de>
+;; Maintainer: FSF
+;; Keywords: unix
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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.
+
+;;; Code:
 
 (require 'dired)
+
+(defgroup find-dired nil
+  "Run a `find' command and dired the output."
+  :group 'dired
+  :prefix "find-")
+
+;; find's -ls corresponds to these switches.
+;; Note -b, at least GNU find quotes spaces etc. in filenames
 ;;;###autoload
-(defvar find-ls-option (if (eq system-type 'berkeley-unix) "-ls"
-                        "-exec ls -ldi {} \\;")
-  "*Option to `find' to produce an `ls -l'-type listing.")
+(defcustom find-ls-option
+  (if (eq system-type 'berkeley-unix) '("-ls" . "-gilsb")
+    '("-exec ls -ld {} \\;" . "-ld"))
+  "*Description of the option to `find' to produce an `ls -l'-type listing.
+This is a cons of two strings (FIND-OPTION . LS-SWITCHES).  FIND-OPTION
+gives the option (or options) to `find' that produce the desired output.
+LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output."
+  :type '(cons (string :tag "Find Option")
+              (string :tag "Ls Switches"))
+  :group 'find-dired)
 
 ;;;###autoload
-(defvar find-grep-options (if (eq system-type 'berkeley-unix) "-s" "-l")
+(defcustom find-grep-options
+  (if (or (eq system-type 'berkeley-unix)
+         (string-match "solaris2" system-configuration)
+         (string-match "irix" system-configuration))
+      "-s" "-q")
   "*Option to grep to be as silent as possible.
-On Berkeley systems, this is `-s', for others it seems impossible to
-suppress all output, so `-l' is used to print nothing more than the
-file name.")
+On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
+On other systems, the closest you can come is to use `-l'."
+  :type 'string
+  :group 'find-dired)
 
 (defvar find-args nil
   "Last arguments given to `find' by \\[find-dired].")
 
+;; History of find-args values entered in the minibuffer.
+(defvar find-args-history nil)
+
 ;;;###autoload
 (defun find-dired (dir args)
   "Run `find' and go into dired-mode on a buffer of the output.
 The command run (after changing into DIR) is
 
-    find . \\( ARGS \\) -ls"
+    find . \\( ARGS \\) -ls
+
+except that the variable `find-ls-option' specifies what to use
+as the final argument."
   (interactive (list (read-file-name "Run find in directory: " nil "" t)
-                    (if (featurep 'gmhist)
-                        (read-with-history-in 'find-args-history
-                                              "Run find (with args): ")
-                      (read-string "Run find (with args): " find-args))))
+                    (read-string "Run find (with args): " find-args
+                                 '(find-args-history . 1))))
   ;; Expand DIR ("" means default-directory), and make sure it has a
   ;; trailing slash.
   (setq dir (file-name-as-directory (expand-file-name dir)))
@@ -85,15 +89,27 @@ The command run (after changing into DIR) is
   (setq buffer-read-only nil)
   (erase-buffer)
   (setq default-directory dir
-       find-args args
-       args (concat "find . " (if (string= args "") ""
-                                (concat "\\( " args " \\) ")) find-ls-option))
-  (dired-mode dir "-gils");; find(1)'s -ls corresponds to `ls -gilds'
-                         ;; (but we don't want -d, of course)
-  ;; Set subdir-alist so that Tree Dired will work (but STILL NOT with
-  ;; dired-nstd.el):
-  (set (make-local-variable 'dired-subdir-alist)
-       (list (cons default-directory (point-marker)))) ; we are at point-min
+       find-args args                  ; save for next interactive call
+       args (concat "find . "
+                    (if (string= args "")
+                        ""
+                      (concat "\\( " args " \\) "))
+                    (car find-ls-option)))
+  ;; The next statement will bomb in classic dired (no optional arg allowed)
+  (dired-mode dir (cdr find-ls-option))
+  ;; This really should rerun the find command, but I don't
+  ;; have time for that.
+  (use-local-map (append (make-sparse-keymap) (current-local-map)))
+  (define-key (current-local-map) "g" 'undefined)
+  ;; Set subdir-alist so that Tree Dired will work:
+  (if (fboundp 'dired-simple-subdir-alist)
+      ;; will work even with nested dired format (dired-nstd.el,v 1.15
+      ;; and later)
+      (dired-simple-subdir-alist)
+    ;; else we have an ancient tree dired (or classic dired, where
+    ;; this does no harm) 
+    (set (make-local-variable 'dired-subdir-alist)
+        (list (cons default-directory (point-min-marker)))))
   (setq buffer-read-only nil)
   ;; Subdir headlerline must come first because the first marker in
   ;; subdir-alist points there.
@@ -101,13 +117,13 @@ The command run (after changing into DIR) is
   ;; Make second line a ``find'' line in analogy to the ``total'' or
   ;; ``wildcard'' line. 
   (insert "  " args "\n")
-  ;; Start the find process
-  (set-process-filter (start-process-shell-command "find"
-                                                  (current-buffer) args)
-                     (function find-dired-filter))
-  (set-process-sentinel (get-buffer-process (current-buffer))
-                       (function find-dired-sentinel))
-  (setq mode-line-process '(": %s")))
+  ;; Start the find process.
+  (let ((proc (start-process-shell-command "find" (current-buffer) args)))
+    (set-process-filter proc (function find-dired-filter))
+    (set-process-sentinel proc (function find-dired-sentinel))
+    ;; Initialize the process marker; it is used by the filter.
+    (move-marker (process-mark proc) 1 (current-buffer)))
+  (setq mode-line-process '(":%s")))
 
 ;;;###autoload
 (defun find-name-dired (dir pattern)
@@ -127,7 +143,7 @@ The command run (after changing into DIR) is
 ;; Date: 10 May 91 17:50:00 GMT
 ;; Organization: University of Waterloo
 
-(fset 'lookfor-dired 'find-grep-dired)
+(defalias 'lookfor-dired 'find-grep-dired)
 ;;;###autoload
 (defun find-grep-dired (dir args)
   "Find files in DIR containing a regexp ARG and start Dired on output.
@@ -136,15 +152,18 @@ The command run (after changing into DIR) is
     find . -exec grep -s ARG {} \\\; -ls
 
 Thus ARG can also contain additional grep options."
-  (interactive "DFind-grep (directory): \nsFind-grep (grep args): ")
+  (interactive "DFind-grep (directory): \nsFind-grep (grep regexp): ")
   ;; find -exec doesn't allow shell i/o redirections in the command,
   ;; or we could use `grep -l >/dev/null'
+  ;; We use -type f, not ! -type d, to avoid getting screwed
+  ;; by FIFOs and devices.  I'm not sure what's best to do
+  ;; about symlinks, so as far as I know this is not wrong.
   (find-dired dir
-             (concat "-exec grep " find-grep-options " " args " {} \\\; ")))
+             (concat "-type f -exec grep " find-grep-options " "
+                     args " {} \\\; ")))
 
 (defun find-dired-filter (proc string)
   ;; Filter for \\[find-dired] processes.
-  (dired-log "``%s''\n" string)
   (let ((buf (process-buffer proc)))
     (if (buffer-name buf)              ; not killed?
        (save-excursion
@@ -164,10 +183,19 @@ Thus ARG can also contain additional grep options."
                  (forward-line 1))
                ;; Convert ` ./FILE' to ` FILE'
                ;; This would lose if the current chunk of output
-               ;; starts or ends within the ` ./', so backup up a bit:
+               ;; starts or ends within the ` ./', so back up a bit:
                (goto-char (- end 3))   ; no error if < 0
                (while (search-forward " ./" nil t)
-                 (delete-region (point) (- (point) 2)))))))
+                 (delete-region (point) (- (point) 2)))
+               ;; Find all the complete lines in the unprocessed
+               ;; output and process it to add text properties.
+               (goto-char end)
+               (if (search-backward "\n" (process-mark proc) t)
+                   (progn
+                     (dired-insert-set-properties (process-mark proc)
+                                                  (1+ (point)))
+                     (move-marker (process-mark proc) (1+ (point)))))
+               ))))
       ;; The buffer has been killed.
       (delete-process proc))))
 
@@ -177,28 +205,23 @@ Thus ARG can also contain additional grep options."
     (if (buffer-name buf)
        (save-excursion
          (set-buffer buf)
-         (setq mode-line-process nil)
+         (let ((buffer-read-only nil))
+           (save-excursion
+             (goto-char (point-max))
+             (insert "\nfind " state)
+             (forward-char -1)         ;Back up before \n at end of STATE.
+             (insert " at " (substring (current-time-string) 0 19))
+             (forward-char 1)
+             (setq mode-line-process
+                   (concat ":"
+                           (symbol-name (process-status proc))))
+             ;; Since the buffer and mode line will show that the
+             ;; process is dead, we can delete it now.  Otherwise it
+             ;; will stay around until M-x list-processes.
+             (delete-process proc)
+             (force-mode-line-update)))
          (message "find-dired %s finished." (current-buffer))))))
-
-(or (fboundp 'start-process-shell-command)
-    ;; From version 19 subr.el.
-    (defun start-process-shell-command (name buffer &rest args)
-      "Start a program in a subprocess.  Return the process object for it.
-Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
-NAME is name for process.  It is modified if necessary to make it unique.
-BUFFER is the buffer or (buffer-name) to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is command name, the name of a shell command.
-Remaining arguments are the arguments for the command.
-Wildcards and redirection are handle as usual in the shell."
-      (if (eq system-type 'vax-vms)
-         (apply 'start-process name buffer args)
-       (start-process name buffer shell-file-name "-c"
-                      (concat "exec " (mapconcat 'identity args " "))))))
-
+\f
 (provide 'find-dired)
 
 ;;; find-dired.el ends here