find-dired+.el - extensions to GNU `find-dired.el'

[Drew Adams]

;;; find-dired+.el --- Extensions to `find-dired.el'.
;; 
;; Emacs Lisp Archive Entry
;; Filename: find-dired+.el
;; Description: Extensions to `find-dired.el'.
;; Author: Roland McGrath <address@hidden>,
;;      Sebastian Kremer <address@hidden>,
;;      Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
;; Created: Wed Jan 10 14:31:50 1996
;; Version: $Id: find-dired+.el,v 1.7 2001/01/08 22:48:49 dadams Exp $
;; Last-Updated: Mon Jan  8 14:48:43 2001
;;           By: dadams
;;     Update #: 512
;; Keywords: internal, unix, tools, matching, local
;; Compatibility: GNU Emacs 20.x
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Commentary:
;;
;;    Extensions to `find-dired.el'.
;;
;;  See also the companion file `find-dired-.el'.
;;        `find-dired-.el' should be loaded before `find-dired.el'.
;;        `find-dired+.el' should be loaded after `find-dired.el'.
;;
;;  A `find' submenu has been added to Dired's menu bar, and most of
;;  the Emacs `find-*' commands have undergone slight improvements.
;;
;;
;;  New user options (variables) defined here:
;;
;;    `find-dired-default-fn', `find-dired-hook'.
;;
;;  Other new variable defined here: `menu-bar-run-find-menu'.
;;
;;
;;  ***** NOTE: The following functions defined in `find-dired.el'
;;              have been REDEFINED HERE:
;;
;;  `find-dired' - 1. Interactive spec uses `read-from-minibuffer',
;;                    `read-file-name', `dired-regexp-history' and
;;                    `find-dired-default-fn'.
;;                 2. Runs `find-dired-hook' at end.
;;                 3. Uses `find-dired-default-fn' for default input.
;;                 4. Buffer named after dir (not named "*Find*").
;;  `find-dired-filter' - Removes lines that just list a file.
;;  `find-dired-sentinel' - 1. Highlights file lines.
;;                          2. Puts `find' in mode-line.
;;  `find-grep-dired' - Interactive spec uses `read-from-minibuffer',
;;                      `read-file-name', `dired-regexp-history' and
;;                      `find-dired-default-fn'.
;;  `find-name-dired' - Interactive spec uses `read-from-minibuffer',
;;                      `read-file-name', `dired-regexp-history' and
;;                      `find-dired-default-fn'.
;;
;;
;;  ***** NOTE: The following variable defined in `find-dired.el'
;;              has been REDEFINED HERE:
;;
;;  `find-ls-options'   - Uses `dired-listing-switches' for Windows.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Change log:
;; 
;; RCS $Log: find-dired+.el,v $
;; RCS Revision 1.7  2001/01/08 22:48:49  dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.6  2001/01/03 17:35:34  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.5  2001/01/03 00:37:21  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.4  2000/11/28 20:15:36  dadams
;; RCS Optional require's via 3rd arg=t now.
;; RCS
;; RCS Revision 1.3  2000/09/27 21:58:46  dadams
;; RCS Updated for Emacs 20.7:
;; RCS 1. Added: require find-dired-.el.
;; RCS 2. Removed: find-args-history.
;; RCS 3. find-ls-option: defcustom -> defconst.
;; RCS
;; RCS Revision 1.2  2000/09/18 17:00:09  dadams
;; RCS 1. find-dired: a) Use dired-simple-subdir-alist & find-ls-option anew
;; RCS                   (instead of dired's default switches).
;; RCS                b) Updated to Emacs20 version: define-key added.
;; RCS 2. Added: find-ls-options - redefined to treat Windows too.
;; RCS
;; RCS Revision 1.1  2000/09/14 15:58:19  dadams
;; RCS Initial revision
;; RCS
; Revision 1.3  1999/04/06  14:30:35  dadams
; 1. Added autoload for symbol-name-nearest-point.
; 2. Protected symbol-name-nearest-point with fboundp.
; 3. find-dired, find-name-dired, find-grep-dired: No default regexp
;    if grep-default-regexp-fn is nil.
;
; Revision 1.2  1999/03/31  07:05:43  dadams
; For Emacs version 34. (Renamed to find-dired+.el.)
; 1. require dired+.el.
; 2. Updated using version 34 find-dired.el. (find-dired, find-name-dired,
;    find-grep-dired, find-dired-filter, find-dired-sentinel)
; 3. Added: find-grep-options (added irix).
; 4. Removed: find-args.
; 5. Renamed: find-dired-history -> find-args-history.
; 6. find-dired: pop-to-buffer -> switch-to-buffer.
; 7. Added ###autoloads.
; 8. Menu-bar: input-needed-suffix -> "...".
;
; Revision 1.1  1999/03/30  07:56:02  dadams
; Initial revision
;
; Revision 1.15  1996/06/20  11:54:57  dadams
; (trivial)
;
; Revision 1.14  1996/06/19  08:23:19  dadams
; File header Commentary: Explained diffs from GNU version of this file.
;
; Revision 1.13  1996/06/06  13:38:32  dadams
; 1. No longer require menu-bar+.el when compile (autoloaded).
; 2. Update of file dependency comments (e.g. "Autoloaded from...").
;
; Revision 1.12  1996/04/23  07:18:56  dadams
; (trivial)
;
; Revision 1.11  1996/04/18  09:41:47  dadams
; 1. Menu is added to Dir (Subdir) menu, not This (Immediate) menu.
; 2. Require menu-bar+.el, dired+.el.
;
; Revision 1.10  1996/04/05  14:24:35  dadams
; Improved Commentary:  List redefinitions.
;
; Revision 1.9  1996/03/20  10:11:31  dadams
; 1. Added find-dired-default-fn.
; 2. find-dired, find-name-dired, find-grep-dired:
;       symbol-name-nearest-point -> find-dired-default-fn.
;
; Revision 1.8  1996/03/18  14:06:22  dadams
; Removed dired-revert, old-dired-revert to dired+.el.
;
; Revision 1.7  1996/03/07  17:14:47  dadams
; 1. Copyright.  2. drew-strings.el -> thingatpt+.el.
;
; Revision 1.6  1996/02/14  16:07:55  dadams
; symbol-around-point -> symbol-name-nearest-point
;
; Revision 1.5  1996/02/12  09:37:10  dadams
; Updated header keywords (for finder).
;
; Revision 1.4  1996/01/25  16:22:00  dadams
; find-dired-sentinel:
;   1. Use (my) dired-insert-set-properties.  So, require dired+.el.
;   2. Highlight whole file lines.
;
; Revision 1.3  1996/01/11  15:54:43  dadams
; find-dired-filter: Corrected removal of extra lines just listing a file,
; and deletion of "./" prefix.
;
; Revision 1.2  1996/01/11  09:25:25  dadams
; 1. Added redefinition of dired-revert.
; 2. Buffer used has same root name as the dir (no longer "*Find*").
; 3. Added " `find'" to mode-line-process.
;
; Revision 1.1  1996/01/10  16:28:12  dadams
; Initial revision
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; 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 2, 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.

;; You should have received a copy of the GNU General Public License
;; along with this program; 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 'cl) ;; when, unless
(require 'find-dired-) ;; for new defvars from `find-dired.el'
(require 'find-dired)

(require 'dired+ nil t) ;; (no error if not found):
                        ;; dired-insert-set-properties,
                        ;; menu-bar-dired-subdir-menu
 ;; Note: `dired+.el' does a (require 'dired): dired-mode-map
(require 'thingatpt+ nil t) ;; (no error if not found):
                            ;; symbol-name-nearest-point

(provide 'find-dired+)

;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;###autoload
(defvar find-dired-hook nil
  "*Hook to be run at the end of each `find-dired' execution.")

;;;###autoload
(defvar find-dired-default-fn (and (fboundp 'symbol-name-nearest-point)
                                    'symbol-name-nearest-point)
  "*Function of 0 args called to provide default input for \\[find-dired],
 \\[find-name-dired], and  \\[find-grep-dired].

Some reasonable choices:
`word-nearest-point', `symbol-name-nearest-point', `sexp-nearest-point'.

If this is nil, then no default input is provided.")


;; REPLACES ORIGINAL in `find-dired.el':
;; Uses `dired-listing-switches' for Windows.
;; Note: `defconst' is necessary here because this is preloaded by basic emacs: 
;; it is not sufficient to do a defvar before loading `find-dired.el'.  Too bad.
;; Otherwise, this could be just a `defvar' in `find-dired-.el'.
;;;###autoload
(defconst find-ls-option
  (cond ((eq system-type 'berkeley-unix)
         '("-ls" . "-gilsb"))
        ((eq system-type 'windows-nt)
         (cons "-ls" dired-listing-switches))
        (t
         '("-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.")


;; REPLACES ORIGINAL in `find-dired.el':
;; 1. Interactive spec uses `read-from-minibuffer', `read-file-name',
;;    `dired-regexp-history' and `find-dired-default-fn'.
;; 2. Runs `find-dired-hook' at end.
;; 3. Uses `find-dired-default-fn' to get default input text.
;; 4. Buffer used has same root name as the dir (not "*Find*").
;;;###autoload
(defun find-dired (dir args)
  "Run `find' and put its output in a buffer in Dired Mode.
Then run `find-dired-hook' and `dired-after-readin-hook'.
The `find' command run (after changing into DIR) is:

    find . \\( ARGS \\) -ls"
  (interactive
   (let ((default (and find-dired-default-fn
                       (funcall find-dired-default-fn))))
     (list (read-file-name "Run `find' in directory: " nil "" t)
           (read-from-minibuffer "Run `find' (with args): " default
                                 nil nil 'find-args-history default t))))
  (let ((dired-buffers dired-buffers))
    ;; Expand DIR ("" means default-directory), and make sure it has a
    ;; trailing slash.
    (setq dir (abbreviate-file-name
               (file-name-as-directory (expand-file-name dir))))
    (unless (file-directory-p dir)      ; Ensure that it's really a directory.
      (error "find-dired needs a directory: %s" dir))
    (switch-to-buffer (create-file-buffer (directory-file-name dir)))
    (widen)
    (kill-all-local-variables)
    (setq buffer-read-only nil)
    (erase-buffer)
    (setq default-directory dir)
    (setq 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 headerline must come first because the first marker in
    ;; `subdir-alist' points there.
    (insert "  " dir ":\n")
    ;; Make second line a "find" line in analogy to the "total" or
    ;; "wildcard" line. 
    (insert "  " args "\n")
    ;; 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 `find'"))
      (run-hooks 'find-dired-hook 'dired-after-readin-hook))))


;; REPLACES ORIGINAL in `find-dired.el':
;; Interactive spec uses `read-from-minibuffer', `read-file-name',
;; `dired-regexp-history' and `find-dired-default-fn'.
;;;###autoload
(defun find-name-dired (dir pattern)
  "Search directory DIR recursively for files matching globbing PATTERN,
and run `dired' on those files.  PATTERN may use shell wildcards, and
it need not be quoted.  It is not an Emacs regexp.
The command run (after changing into DIR) is: find . -name 'PATTERN' -ls"
  (interactive
   (let ((default (and find-dired-default-fn
                       (funcall find-dired-default-fn))))
   (list (read-file-name "Find-name (directory): " nil "" t)
         (read-from-minibuffer "Find-name (filename wildcard): " default
                               nil nil 'dired-regexp-history default t))))
  (find-dired dir (concat "-name '" pattern "'")))


;; REPLACES ORIGINAL in `find-dired.el':
;; Interactive spec uses `read-from-minibuffer', `read-file-name',
;; `dired-regexp-history' and `find-dired-default-fn'.
;;;###autoload
(defun find-grep-dired (dir regexp)
  "Find files in DIR containing a regexp REGEXP.
The output is in a Dired buffer.
The `find' command run (after changing into DIR) is:

    find . -exec grep -s REGEXP {} \\\; -ls

Thus REGEXP can also contain additional grep options."
  (interactive
   (let ((default (and find-dired-default-fn
                       (funcall find-dired-default-fn))))
     (list (read-file-name "Find-grep (directory): " nil "" t)
           (read-from-minibuffer "Find-grep (grep regexp): "
                                 nil nil 'dired-regexp-history default t))))
  ;; 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 "-type f -exec grep " find-grep-options " "
                      regexp " {} \\\; ")))


;; REPLACES ORIGINAL in `find-dired.el':
;; Removes lines that just list a file.
;;;###autoload
(defun find-dired-filter (proc string)
  ;; Filter for \\[find-dired] processes.
  (let ((buf (process-buffer proc)))
    (if (buffer-name buf)               ; not killed?
        (save-excursion
          (set-buffer buf)
          (save-restriction
            (widen)
            (save-excursion
              (let ((buffer-read-only nil)
                    (end (point-max)))
                (goto-char end)
                (insert string)
                (goto-char end)
                (unless (looking-at "^") (forward-line 1))
                (while (looking-at "^")
                  (insert "  ")
                  (forward-line 1))
                (goto-char (- end 3))   ; no error if < 0
                (save-excursion         ; Remove lines just listing the file.
                  (let ((kill-whole-line t))
                    (while (re-search-forward "^  ./" nil t)
                      (beginning-of-line) (kill-line))))
                ;; Convert ` ./FILE' to ` FILE'
                ;; This would lose if the current chunk of output
                ;; starts or ends within the ` ./', so back up a bit:
                (while (search-forward " ./" nil t)
                  (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)))))
                ))))
      (delete-process proc))))          ; The buffer was killed.


;; REPLACES ORIGINAL in `find-dired.el':
;; 1. Highlights file lines.
;; 2. Puts `find' in mode-line.
;;;###autoload
(defun find-dired-sentinel (proc state)
  ;; Sentinel for \\[find-dired] processes.
  (let ((buf (process-buffer proc)))
    (if (buffer-name buf)
        (save-excursion
          (set-buffer buf)
          (let ((buffer-read-only nil))
            (save-excursion
              (goto-char (point-max))
              (insert "\nfind " state)  ; STATE is, e.g., "finished".
              (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))
                            " `find'"))
              ;; 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)
              ;; Highlight lines of file names for mouse selection.
              (dired-insert-set-properties (point-min) (point-max))
              (force-mode-line-update)))
          (message "find-dired `%s' done." (buffer-name))))))


;; Menu bar, `find' menu.
(defvar menu-bar-run-find-menu (make-sparse-keymap "Unix `find'"))
(defalias 'menu-bar-run-find-menu (symbol-value 'menu-bar-run-find-menu))
(define-key menu-bar-run-find-menu [find-dired]
  '("`find' <anything>..." . find-dired))
(define-key menu-bar-run-find-menu [find-name-dired]
  '("Find Files Named..." . find-name-dired))
(define-key menu-bar-run-find-menu [find-grep-dired]
  '("Find Files Containing..." . find-grep-dired))
;; Add it to Dired's "Search" menu.
(when (boundp 'menu-bar-search-menu)
  (define-key dired-mode-map [menu-bar search separator-find]
    '("--"))
  (define-key dired-mode-map [menu-bar search find]
    '("Run `find' Command" . menu-bar-run-find-menu)))
;; Add it to Dired's "Dir" menu (called "Subdir" in `dired.el').
(when (boundp 'menu-bar-dired-subdir-menu) ; Defined in `dired+.el'.
  (define-key-after menu-bar-dired-subdir-menu [find]
    '("Run `find' Command" . menu-bar-run-find-menu) 'up))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `find-dired+.el' ends here