(dired-do-create-files): On DOS/Windows, allow to

[gnu-emacs] / lisp / dired.el

diff --git a/lisp/dired.el b/lisp/dired.el
index 872eef3eacd7063d8674dd320cca74859e0ad349..393635452a171c2c01d842fbadd009314d6ed298 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -33,8 +33,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'dired-aux))
-
 ;;; Customizable variables
 
 (defgroup dired nil
@@ -1766,7 +1764,13 @@ Returns the new value of the alist."
   (save-excursion
     (let ((count 0)
          (buffer-read-only nil)
-         new-dir-name)
+         new-dir-name
+         (R-ftp-base-dir-regex
+          ;; Used to expand subdirectory names correctly in recursive
+          ;; ange-ftp listings.
+          (and (string-match "R" dired-actual-switches)
+               (string-match "\\`/.*:\\(/.*\\)" default-directory)
+               (concat "\\`" (match-string 1 default-directory)))))
       (goto-char (point-min))
       (setq dired-subdir-alist nil)
       (while (and (re-search-forward dired-subdir-regexp nil t)
@@ -1780,7 +1784,15 @@ Returns the new value of the alist."
        (save-excursion
          (goto-char (match-beginning 1))
          (setq new-dir-name
-               (expand-file-name (buffer-substring (point) (match-end 1))))
+               (buffer-substring-no-properties (point) (match-end 1))
+               new-dir-name
+               (save-match-data
+                 (if (and R-ftp-base-dir-regex
+                          (not (string= new-dir-name default-directory))
+                          (string-match R-ftp-base-dir-regex new-dir-name))
+                     (concat default-directory
+                             (substring new-dir-name (match-end 0)))
+                   (expand-file-name new-dir-name))))
          (delete-region (point) (match-end 1))
          (insert new-dir-name))
        (setq count (1+ count))
@@ -2634,9 +2646,45 @@ With a prefix argument you can edit the current listing switches instead."
   ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the
   ;; minor mode accordingly, others appear literally in the mode line.
   ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
+  (dired-sort-R-check switches)
   (setq dired-actual-switches switches)
   (if (eq major-mode 'dired-mode) (dired-sort-set-modeline))
   (or no-revert (revert-buffer)))
+
+(make-variable-buffer-local
+ (defvar dired-subdir-alist-pre-R nil
+   "Value of `dired-subdir-alist' before -R switch added."))
+
+(defun dired-sort-R-check (switches)
+  "Additional processing of -R in ls option string SWITCHES.
+Saves `dired-subdir-alist' when R is set and restores saved value
+minus any directories explicitly deleted when R is cleared.
+To be called first in body of `dired-sort-other', etc."
+  (cond
+   ((and (string-match "R" switches)
+        (not (string-match "R" dired-actual-switches)))
+    ;; Adding -R to ls switches -- save `dired-subdir-alist':
+    (setq dired-subdir-alist-pre-R dired-subdir-alist))
+   ((and (string-match "R" dired-actual-switches)
+        (not (string-match "R" switches)))
+    ;; Deleting -R from ls switches -- revert to pre-R subdirs
+    ;; that are still present:
+    (setq dired-subdir-alist
+         (if dired-subdir-alist-pre-R
+             (let (subdirs)
+               (while dired-subdir-alist-pre-R
+                 (if (assoc (caar dired-subdir-alist-pre-R)
+                            dired-subdir-alist)
+                     ;; subdir still present...
+                     (setq subdirs
+                           (cons (car dired-subdir-alist-pre-R)
+                                 subdirs)))
+                 (setq dired-subdir-alist-pre-R
+                       (cdr dired-subdir-alist-pre-R)))
+               (reverse subdirs))
+           ;; No pre-R subdir alist, so revert to main directory
+           ;; listing:
+           (list (car (reverse dired-subdir-alist))))))))
 \f
 ;; To make this file smaller, the less common commands
 ;; go in a separate file.  But autoload them here