]> code.delx.au - gnu-emacs/blobdiff - lisp/find-dired.el
Merge from emacs-23
[gnu-emacs] / lisp / find-dired.el
index 0537b6a5f84146458976c4df87b28474f4b280e6..975493e074e0688fe21f54f3337a5612878e1672 100644 (file)
@@ -1,7 +1,7 @@
 ;;; find-dired.el --- run a `find' command and dired the output
 
 ;; Copyright (C) 1992, 1994, 1995, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>,
 ;;        Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -38,9 +38,9 @@
 ;; Note -b, at least GNU find quotes spaces etc. in filenames
 ;;;###autoload
 (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.
+  (if (eq system-type 'berkeley-unix) (purecopy '("-ls" . "-gilsb"))
+    (purecopy '("-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."
@@ -49,7 +49,7 @@ LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output."
   :group 'find-dired)
 
 ;;;###autoload
-(defcustom find-ls-subdir-switches "-al"
+(defcustom find-ls-subdir-switches (purecopy "-al")
   "`ls' switches for inserting subdirectories in `*Find*' buffers.
 This should contain the \"-l\" switch.
 Use the \"-F\" or \"-b\" switches if and only if you also use
@@ -60,24 +60,24 @@ them for `find-ls-option'."
 
 ;;;###autoload
 (defcustom find-grep-options
-  (if (or (eq system-type 'berkeley-unix)
+  (purecopy (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.
+      "-s" "-q"))
+  "Option to grep to be as silent as possible.
 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)
 
-;;;###autoload
+;; This used to be autoloaded (see bug#4387).
 (defcustom find-name-arg
-  (if read-file-name-completion-ignore-case
+  (purecopy (if read-file-name-completion-ignore-case
       "-iname"
-    "-name")
-  "*Argument used to specify file name pattern.
+    "-name"))
+  "Argument used to specify file name pattern.
 If `read-file-name-completion-ignore-case' is non-nil, -iname is used so that
-find also ignores case. Otherwise, -name is used."
+find also ignores case.  Otherwise, -name is used."
   :type 'string
   :group 'find-dired
   :version "22.2")
@@ -99,7 +99,7 @@ The command run (after changing into DIR) is
 
 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)
+  (interactive (list (read-directory-name "Run find in directory: " nil "" t)
                     (read-string "Run find (with args): " find-args
                                  '(find-args-history . 1))))
   (let ((dired-buffers dired-buffers))
@@ -240,48 +240,49 @@ Thus ARG can also contain additional grep options."
        (inhibit-read-only t))
     (if (buffer-name buf)
        (with-current-buffer buf
-         (save-restriction
-           (widen)
-           (let ((buffer-read-only nil)
-                 (beg (point-max))
-                 (l-opt (and (consp find-ls-option)
-                             (string-match "l" (cdr find-ls-option))))
-                 (ls-regexp (concat "^ +[^ \t\r\n]+\\( +[^ \t\r\n]+\\) +"
-                                    "[^ \t\r\n]+ +[^ \t\r\n]+\\( +[0-9]+\\)")))
-             (goto-char beg)
-             (insert string)
-             (goto-char beg)
-             (or (looking-at "^")
-                 (forward-line 1))
-             (while (looking-at "^")
-               (insert "  ")
-               (forward-line 1))
-             ;; Convert ` ./FILE' to ` FILE'
-             ;; This would lose if the current chunk of output
-             ;; starts or ends within the ` ./', so back up a bit:
-             (goto-char (- beg 3))     ; no error if < 0
-             (while (search-forward " ./" nil t)
-               (delete-region (point) (- (point) 2)))
-             ;; Pad the number of links and file size.  This is a
-             ;; quick and dirty way of getting the columns to line up
-             ;; most of the time, but it's not foolproof.
-             (when l-opt
+         (save-excursion
+           (save-restriction
+             (widen)
+             (let ((buffer-read-only nil)
+                   (beg (point-max))
+                   (l-opt (and (consp find-ls-option)
+                               (string-match "l" (cdr find-ls-option))))
+                   (ls-regexp (concat "^ +[^ \t\r\n]+\\( +[^ \t\r\n]+\\) +"
+                                      "[^ \t\r\n]+ +[^ \t\r\n]+\\( +[0-9]+\\)")))
                (goto-char beg)
-               (goto-char (line-beginning-position))
-               (while (re-search-forward ls-regexp nil t)
-                 (replace-match (format "%4s" (match-string 1))
-                                nil nil nil 1)
-                 (replace-match (format "%9s" (match-string 2))
-                                nil nil nil 2)
-                 (forward-line 1)))
-             ;; Find all the complete lines in the unprocessed
-             ;; output and process it to add text properties.
-             (goto-char (point-max))
-             (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))))))))
+               (insert string)
+               (goto-char beg)
+               (or (looking-at "^")
+                   (forward-line 1))
+               (while (looking-at "^")
+                 (insert "  ")
+                 (forward-line 1))
+               ;; Convert ` ./FILE' to ` FILE'
+               ;; This would lose if the current chunk of output
+               ;; starts or ends within the ` ./', so back up a bit:
+               (goto-char (- beg 3))   ; no error if < 0
+               (while (search-forward " ./" nil t)
+                 (delete-region (point) (- (point) 2)))
+               ;; Pad the number of links and file size.  This is a
+               ;; quick and dirty way of getting the columns to line up
+               ;; most of the time, but it's not foolproof.
+               (when l-opt
+                 (goto-char beg)
+                 (goto-char (line-beginning-position))
+                 (while (re-search-forward ls-regexp nil t)
+                   (replace-match (format "%4s" (match-string 1))
+                                  nil nil nil 1)
+                   (replace-match (format "%9s" (match-string 2))
+                                  nil nil nil 2)
+                   (forward-line 1)))
+               ;; Find all the complete lines in the unprocessed
+               ;; output and process it to add text properties.
+               (goto-char (point-max))
+               (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))))
 
@@ -290,8 +291,7 @@ Thus ARG can also contain additional grep options."
   (let ((buf (process-buffer proc))
        (inhibit-read-only t))
     (if (buffer-name buf)
-       (save-excursion
-         (set-buffer buf)
+       (with-current-buffer buf
          (let ((buffer-read-only nil))
            (save-excursion
              (goto-char (point-max))