]> code.delx.au - gnu-emacs/blobdiff - lisp/dired.el
Customize.
[gnu-emacs] / lisp / dired.el
index f415ac47e4dfa92169e19effb5f9f061a2e0d58a..5f25f933d8dc88c3ed15f9133e39b0e8e7a441e3 100644 (file)
@@ -1,6 +1,6 @@
 ;;; dired.el --- directory-browsing commands
 
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
 ;; Maintainer: FSF
@@ -410,16 +410,24 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
   (or dir-or-list (setq dir-or-list default-directory))
   ;; This loses the distinction between "/foo/*/" and "/foo/*" that
   ;; some shells make:
-  (let (dirname)
+  (let (dirname initially-was-dirname)
     (if (consp dir-or-list)
        (setq dirname (car dir-or-list))
       (setq dirname dir-or-list))
+    (setq initially-was-dirname
+         (string= (file-name-as-directory dirname) dirname))
     (setq dirname (abbreviate-file-name
                   (expand-file-name (directory-file-name dirname))))
     (if find-file-visit-truename
        (setq dirname (file-truename dirname)))
-    (if (file-directory-p dirname)
-       (setq dirname (file-name-as-directory dirname)))
+    ;; If the argument was syntactically  a directory name not a file name,
+    ;; or if it happens to name a file that is a directory,
+    ;; convert it syntactically to a directory name.
+    ;; The reason for checking initially-was-dirname
+    ;; and not just file-directory-p
+    ;; is that file-directory-p is slow over ftp.
+    (if (or initially-was-dirname (file-directory-p dirname))
+       (setq dirname  (file-name-as-directory dirname)))
     (if (consp dir-or-list)
        (setq dir-or-list (cons dirname (cdr dir-or-list)))
       (setq dir-or-list dirname))
@@ -473,9 +481,11 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
                           "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
       ;; Else a new buffer
       (setq default-directory
-           (if (file-directory-p dirname)
-               dirname
-             (file-name-directory dirname)))
+           ;; We can do this unconditionally
+           ;; because dired-noselect ensures that the name
+           ;; is passed in directory name syntax
+           ;; if it was the name of a directory at all.
+           (file-name-directory dirname))
       (or switches (setq switches dired-listing-switches))
       (dired-mode dirname switches)
       (if mode (funcall mode))
@@ -1391,27 +1401,70 @@ DIR must be a directory name, not a file name."
   ;; killed buffer, it is removed from this list.
   "Alist of expanded directories and their associated dired buffers.")
 
-(defun dired-buffers-for-dir (dir)
+(defun dired-buffers-for-dir (dir &optional file)
 ;; Return a list of buffers that dired DIR (top level or in-situ subdir).
+;; If FILE is non-nil, include only those whose wildcard pattern (if any)
+;; matches FILE.
 ;; The list is in reverse order of buffer creation, most recent last.
 ;; As a side effect, killed dired buffers for DIR are removed from
 ;; dired-buffers.
   (setq dir (file-name-as-directory dir))
-  (let ((alist dired-buffers) result elt buf)
+  (let ((alist dired-buffers) result elt buf pattern)
     (while alist
       (setq elt (car alist)
            buf (cdr elt))
       (if (buffer-name buf)
          (if (dired-in-this-tree dir (car elt))
-             (if (assoc dir (save-excursion
-                              (set-buffer buf)
-                              dired-subdir-alist))
-                 (setq result (cons buf result))))
+             (with-current-buffer buf
+               (and (assoc dir dired-subdir-alist)
+                    (or (null file)
+                        (let ((wildcards
+                               (file-name-nondirectory dired-directory)))
+                          (or (= 0 (length wildcards))
+                              (string-match (dired-glob-regexp wildcards)
+                                            file))))
+                    (setq result (cons buf result)))))
        ;; else buffer is killed - clean up:
        (setq dired-buffers (delq elt dired-buffers)))
       (setq alist (cdr alist)))
     result))
 
+(defun dired-glob-regexp (pattern)
+  "Convert glob-pattern PATTERN to a regular expression."
+  (let ((matched-in-pattern 0)  ;; How many chars of PATTERN we've handled.
+       regexp)
+    (while (string-match "[[?*]" pattern matched-in-pattern)
+      (let ((op-end (match-end 0))
+           (next-op (aref pattern (match-beginning 0))))
+       (setq regexp (concat regexp
+                            (regexp-quote
+                             (substring pattern matched-in-pattern
+                                        (match-beginning 0)))))
+       (cond ((= next-op ??)
+              (setq regexp (concat regexp "."))
+              (setq matched-in-pattern op-end))
+             ((= next-op ?\[)
+              ;; Fails to handle ^ yet ????
+              (let* ((set-start (match-beginning 0))
+                     (set-cont
+                      (if (= (aref pattern (1+ set-start)) ?^)
+                          (+ 3 set-start)
+                        (+ 2 set-start)))
+                     (set-end (string-match "]" pattern set-cont))
+                     (set (substring pattern set-start (1+ set-end))))
+                (setq regexp (concat regexp set))
+                (setq matched-in-pattern (1+ set-end))))
+             ((= next-op ?*)
+              (setq regexp (concat regexp ".*"))
+              (setq matched-in-pattern op-end)))))
+    (concat "\\`"
+           regexp
+           (regexp-quote
+            (substring pattern matched-in-pattern))
+           "\\'")))
+
+                
+
 (defun dired-advertise ()
   ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
   ;; With wildcards we actually advertise too much.