[Emacs-diffs] Changes to emacs/lisp/dired-aux.el [emacs-unicode-2]

[Miles Bader]

Index: emacs/lisp/dired-aux.el
diff -c emacs/lisp/dired-aux.el:1.110.6.1 emacs/lisp/dired-aux.el:1.110.6.2
*** emacs/lisp/dired-aux.el:1.110.6.1   Fri Apr 16 12:49:49 2004
--- emacs/lisp/dired-aux.el     Mon Jun 28 07:28:28 2004
***************
*** 64,70 ****
                                   (if default
                                       (concat "(default " default ") ")
                                     ""))
!                          (dired-current-directory) default t)
           (if current-prefix-arg
               (read-string "Options for diff: "
                            (if (stringp diff-switches)
--- 64,73 ----
                                   (if default
                                       (concat "(default " default ") ")
                                     ""))
!                          (if default
!                              (dired-current-directory)
!                            (dired-dwim-target-directory))
!                          default t)
           (if current-prefix-arg
               (read-string "Options for diff: "
                            (if (stringp diff-switches)
***************
*** 185,190 ****
--- 188,205 ----
               (file-attributes full-file-name))))
     (directory-files dir)))
  
+ 
+ (defun dired-touch-initial (files)
+   "Create initial input value for `touch' command."
+   (let (initial)
+     (while files
+       (let ((current (nth 5 (file-attributes (car files)))))
+         (if (and initial (not (equal initial current)))
+             (setq initial (current-time) files nil)
+           (setq initial current))
+         (setq files (cdr files))))
+     (format-time-string "%Y%m%d%H%M.%S" initial)))
+ 
  (defun dired-do-chxxx (attribute-name program op-symbol arg)
    ;; Change file attributes (mode, group, owner, timestamp) of marked files 
and
    ;; refresh their file lines.
***************
*** 196,202 ****
         (new-attribute
          (dired-mark-read-string
           (concat "Change " attribute-name " of %s to: ")
!          nil op-symbol arg files))
         (operation (concat program " " new-attribute))
         failures)
      (setq failures
--- 211,218 ----
         (new-attribute
          (dired-mark-read-string
           (concat "Change " attribute-name " of %s to: ")
!          (if (eq op-symbol 'touch) (dired-touch-initial files))
!          op-symbol arg files))
         (operation (concat program " " new-attribute))
         failures)
      (setq failures
***************
*** 239,244 ****
--- 255,261 ----
        (error "chown not supported on this system"))
    (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
  
+ ;;;###autoload
  (defun dired-do-touch (&optional arg)
    "Change the timestamp of the marked (or next ARG) files.
  This calls touch."
***************
*** 326,331 ****
--- 343,349 ----
  
  (defvar dired-file-version-alist)
  
+ ;;;###autoload
  (defun dired-clean-directory (keep)
    "Flag numerical backups for deletion.
  Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
***************
*** 535,540 ****
--- 553,559 ----
        (funcall stuff-it files)))))
  
  ;; This is an extra function so that it can be redefined by ange-ftp.
+ ;;;###autoload
  (defun dired-run-shell-command (command)
    (let ((handler
         (find-file-name-handler (directory-file-name default-directory)
***************
*** 789,794 ****
--- 808,814 ----
      ;; None of these keys quit - use C-g for that.
      ))
  
+ ;;;###autoload
  (defun dired-query (qs-var qs-prompt &rest qs-args)
    ;; Query user and return nil or t.
    ;; Store answer in symbol VAR (which must initially be bound to nil).
***************
*** 875,887 ****
  (defun dired-do-redisplay (&optional arg test-for-subdir)
    "Redisplay all marked (or next ARG) files.
  If on a subdir line, redisplay that subdirectory.  In that case,
! a prefix arg lets you edit the `ls' switches used for the new listing."
    ;; Moves point if the next ARG files are redisplayed.
    (interactive "P\np")
    (if (and test-for-subdir (dired-get-subdir))
!       (dired-insert-subdir
!        (dired-get-subdir)
!        (if arg (read-string "Switches for listing: " dired-actual-switches)))
      (message "Redisplaying...")
      ;; message much faster than making dired-map-over-marks show progress
      (dired-uncache
--- 895,921 ----
  (defun dired-do-redisplay (&optional arg test-for-subdir)
    "Redisplay all marked (or next ARG) files.
  If on a subdir line, redisplay that subdirectory.  In that case,
! a prefix arg lets you edit the `ls' switches used for the new listing.
! 
! Dired remembers switches specified with a prefix arg, so that reverting
! the buffer will not reset them.  However, using `dired-undo' to re-insert
! or delete subdirectories can bypass this machinery.  Hence, you sometimes
! may have to reset some subdirectory switches after a `dired-undo'.
! You can reset all subdirectory switches to the default using
! \\<dired-mode-map>\\[dired-reset-subdir-switches].
! See Info node `(emacs-xtra)Subdir switches' for more details."
    ;; Moves point if the next ARG files are redisplayed.
    (interactive "P\np")
    (if (and test-for-subdir (dired-get-subdir))
!       (let* ((dir (dired-get-subdir))
!            (switches (cdr (assoc-string dir dired-switches-alist))))
!       (dired-insert-subdir
!        dir
!        (when arg
!          (read-string "Switches for listing: "
!                       (or switches
!                           dired-subdir-switches
!                           dired-actual-switches)))))
      (message "Redisplaying...")
      ;; message much faster than making dired-map-over-marks show progress
      (dired-uncache
***************
*** 892,897 ****
--- 926,937 ----
                          arg)
      (dired-move-to-filename)
      (message "Redisplaying...done")))
+ 
+ (defun dired-reset-subdir-switches ()
+   "Set `dired-switches-alist' to nil and revert dired buffer."
+   (interactive)
+   (setq dired-switches-alist nil)
+   (revert-buffer))
  
  (defun dired-update-file-line (file)
    ;; Delete the current line, and insert an entry for FILE.
***************
*** 1191,1199 ****
          (dired-advertise)))))
  
  (defun dired-rename-subdir-2 (elt dir to)
!   ;; Update the headerline and dired-subdir-alist element of directory
!   ;; described by alist-element ELT to reflect the moving of DIR to TO.
!   ;; Thus, ELT describes either DIR itself or a subdir of DIR.
    (save-excursion
      (let ((regexp (regexp-quote (directory-file-name dir)))
          (newtext (directory-file-name to))
--- 1231,1240 ----
          (dired-advertise)))))
  
  (defun dired-rename-subdir-2 (elt dir to)
!   ;; Update the headerline and dired-subdir-alist element, as well as
!   ;; dired-switches-alist element, of directory described by
!   ;; alist-element ELT to reflect the moving of DIR to TO.  Thus, ELT
!   ;; describes either DIR itself or a subdir of DIR.
    (save-excursion
      (let ((regexp (regexp-quote (directory-file-name dir)))
          (newtext (directory-file-name to))
***************
*** 1207,1216 ****
        (if (re-search-forward regexp (match-end 1) t)
            (replace-match newtext t t)
          (error "Expected to find `%s' in headerline of %s" dir (car elt))))
!       ;; Update buffer-local dired-subdir-alist
!       (setcar elt
!             (dired-normalize-subdir
!              (dired-replace-in-string regexp newtext (car elt)))))))
  
  ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
  (defun dired-create-files (file-creator operation fn-list name-constructor
--- 1248,1259 ----
        (if (re-search-forward regexp (match-end 1) t)
            (replace-match newtext t t)
          (error "Expected to find `%s' in headerline of %s" dir (car elt))))
!       ;; Update buffer-local dired-subdir-alist and dired-switches-alist
!       (let ((cons (assoc-string (car elt) dired-switches-alist))
!           (cur-dir (dired-normalize-subdir
!                     (dired-replace-in-string regexp newtext (car elt)))))
!       (setcar elt cur-dir)
!       (when cons (setcar cons cur-dir))))))
  
  ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
  (defun dired-create-files (file-creator operation fn-list name-constructor
***************
*** 1702,1712 ****
  With a prefix arg, you may edit the ls switches used for this listing.
    You can add `R' to the switches to expand the whole tree starting at
    this subdirectory.
! This function takes some pains to conform to `ls -lR' output."
    (interactive
     (list (dired-get-filename)
         (if current-prefix-arg
!            (read-string "Switches for listing: " dired-actual-switches))))
    (let ((opoint (point)))
      ;; We don't need a marker for opoint as the subdir is always
      ;; inserted *after* opoint.
--- 1745,1764 ----
  With a prefix arg, you may edit the ls switches used for this listing.
    You can add `R' to the switches to expand the whole tree starting at
    this subdirectory.
! This function takes some pains to conform to `ls -lR' output.
! 
! Dired remembers switches specified with a prefix arg, so that reverting
! the buffer will not reset them.  However, using `dired-undo' to re-insert
! or delete subdirectories can bypass this machinery.  Hence, you sometimes
! may have to reset some subdirectory switches after a `dired-undo'.
! You can reset all subdirectory switches to the default using
! \\<dired-mode-map>\\[dired-reset-subdir-switches].
! See Info node `(emacs-xtra)Subdir switches' for more details."
    (interactive
     (list (dired-get-filename)
         (if current-prefix-arg
!            (read-string "Switches for listing: "
!                         (or dired-subdir-switches dired-actual-switches)))))
    (let ((opoint (point)))
      ;; We don't need a marker for opoint as the subdir is always
      ;; inserted *after* opoint.
***************
*** 1733,1746 ****
    (interactive
     (list (dired-get-filename)
         (if current-prefix-arg
!            (read-string "Switches for listing: " dired-actual-switches))))
    (setq dirname (file-name-as-directory (expand-file-name dirname)))
-   (dired-insert-subdir-validate dirname switches)
    (or no-error-if-not-dir-p
        (file-directory-p dirname)
        (error  "Attempt to insert a non-directory: %s" dirname))
    (let ((elt (assoc dirname dired-subdir-alist))
!        switches-have-R mark-alist case-fold-search buffer-read-only)
      ;; case-fold-search is nil now, so we can test for capital `R':
      (if (setq switches-have-R (and switches (string-match "R" switches)))
        ;; avoid duplicated subdirs
--- 1785,1803 ----
    (interactive
     (list (dired-get-filename)
         (if current-prefix-arg
!            (read-string "Switches for listing: "
!                         (or dired-subdir-switches dired-actual-switches)))))
    (setq dirname (file-name-as-directory (expand-file-name dirname)))
    (or no-error-if-not-dir-p
        (file-directory-p dirname)
        (error  "Attempt to insert a non-directory: %s" dirname))
    (let ((elt (assoc dirname dired-subdir-alist))
!       (cons (assoc-string dirname dired-switches-alist))
!       (modflag (buffer-modified-p))
!       (old-switches switches)
!       switches-have-R mark-alist case-fold-search buffer-read-only)
!     (and (not switches) cons (setq switches (cdr cons)))
!     (dired-insert-subdir-validate dirname switches)
      ;; case-fold-search is nil now, so we can test for capital `R':
      (if (setq switches-have-R (and switches (string-match "R" switches)))
        ;; avoid duplicated subdirs
***************
*** 1751,1759 ****
        (dired-insert-subdir-newpos dirname)) ; else compute new position
      (dired-insert-subdir-doupdate
       dirname elt (dired-insert-subdir-doinsert dirname switches))
!     (if switches-have-R (dired-build-subdir-alist switches))
      (dired-initial-position dirname)
!     (save-excursion (dired-mark-remembered mark-alist))))
  
  ;; This is a separate function for dired-vms.
  (defun dired-insert-subdir-validate (dirname &optional switches)
--- 1808,1830 ----
        (dired-insert-subdir-newpos dirname)) ; else compute new position
      (dired-insert-subdir-doupdate
       dirname elt (dired-insert-subdir-doinsert dirname switches))
!     (when old-switches
!       (if cons
!         (setcdr cons switches)
!       (push (cons dirname switches) dired-switches-alist)))
!     (when switches-have-R
!       (dired-build-subdir-alist switches)
!       (setq switches (dired-replace-in-string "R" "" switches))
!       (dolist (cur-ass dired-subdir-alist)
!       (let ((cur-dir (car cur-ass)))
!         (and (dired-in-this-tree cur-dir dirname)
!              (let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
!                (if cur-cons
!                    (setcdr cur-cons switches)
!                  (push (cons cur-dir switches) dired-switches-alist)))))))
      (dired-initial-position dirname)
!     (save-excursion (dired-mark-remembered mark-alist))
!     (restore-buffer-modified-p modflag)))
  
  ;; This is a separate function for dired-vms.
  (defun dired-insert-subdir-validate (dirname &optional switches)
***************
*** 1761,1777 ****
    ;; Signal an error if invalid (e.g. user typed `i' on `..').
    (or (dired-in-this-tree dirname (expand-file-name default-directory))
        (error  "%s: not in this directory tree" dirname))
!   (if switches
        (let (case-fold-search)
        (mapcar
         (function
          (lambda (x)
!           (or (eq (null (string-match x switches))
                    (null (string-match x dired-actual-switches)))
!               (error "Can't have dirs with and without -%s switches together"
!                      x))))
         ;; all switches that make a difference to dired-get-filename:
!        '("F" "b")))))
  
  (defun dired-alist-add (dir new-marker)
    ;; Add new DIR at NEW-MARKER.  Sort alist.
--- 1832,1849 ----
    ;; Signal an error if invalid (e.g. user typed `i' on `..').
    (or (dired-in-this-tree dirname (expand-file-name default-directory))
        (error  "%s: not in this directory tree" dirname))
!   (let ((real-switches (or switches dired-subdir-switches)))
!     (when real-switches
        (let (case-fold-search)
        (mapcar
         (function
          (lambda (x)
!           (or (eq (null (string-match x real-switches))
                    (null (string-match x dired-actual-switches)))
!               (error
!                "Can't have dirs with and without -%s switches together" x))))
         ;; all switches that make a difference to dired-get-filename:
!        '("F" "b"))))))
  
  (defun dired-alist-add (dir new-marker)
    ;; Add new DIR at NEW-MARKER.  Sort alist.
***************
*** 1786,1804 ****
                          (> (dired-get-subdir-min elt1)
                             (dired-get-subdir-min elt2)))))))
  
! (defun dired-kill-tree (dirname &optional remember-marks)
    "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
! With optional arg REMEMBER-MARKS, return an alist of marked files."
!   (interactive "DKill tree below directory: ")
!   (setq dirname (expand-file-name dirname))
    (let ((s-alist dired-subdir-alist) dir m-alist)
      (while s-alist
        (setq dir (car (car s-alist))
            s-alist (cdr s-alist))
!       (if (and (not (string-equal dir dirname))
!              (dired-in-this-tree dir dirname)
!              (dired-goto-subdir dir))
!         (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
      m-alist))
  
  (defun dired-insert-subdir-newpos (new-dir)
--- 1858,1880 ----
                          (> (dired-get-subdir-min elt1)
                             (dired-get-subdir-min elt2)))))))
  
! (defun dired-kill-tree (dirname &optional remember-marks kill-root)
    "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
! Interactively, you can kill DIRNAME as well by using a prefix argument.
! In interactive use, the command prompts for DIRNAME.
! 
! When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist
! of marked files.  If KILL-ROOT is non-nil, kill DIRNAME as well."
!   (interactive "DKill tree below directory: \ni\nP")
!   (setq dirname (file-name-as-directory (expand-file-name dirname)))
    (let ((s-alist dired-subdir-alist) dir m-alist)
      (while s-alist
        (setq dir (car (car s-alist))
            s-alist (cdr s-alist))
!       (and (or kill-root (not (string-equal dir dirname)))
!          (dired-in-this-tree dir dirname)
!          (dired-goto-subdir dir)
!          (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
      m-alist))
  
  (defun dired-insert-subdir-newpos (new-dir)
***************
*** 1839,1854 ****
    ;; Return the boundary of the inserted text (as list of BEG and END).
    (save-excursion
      (let ((begin (point)))
-       (message "Reading directory %s..." dirname)
        (let ((dired-actual-switches
             (or switches
                 (dired-replace-in-string "R" "" dired-actual-switches))))
        (if (equal dirname (car (car (last dired-subdir-alist))))
            ;; If doing the top level directory of the buffer,
            ;; redo it as specified in dired-directory.
            (dired-readin-insert)
          (dired-insert-directory dirname dired-actual-switches nil nil t)))
-       (message "Reading directory %s...done" dirname)
        (list begin (point)))))
  
  (defun dired-insert-subdir-doupdate (dirname elt beg-end)
--- 1915,1929 ----
    ;; Return the boundary of the inserted text (as list of BEG and END).
    (save-excursion
      (let ((begin (point)))
        (let ((dired-actual-switches
             (or switches
+                dired-subdir-switches
                 (dired-replace-in-string "R" "" dired-actual-switches))))
        (if (equal dirname (car (car (last dired-subdir-alist))))
            ;; If doing the top level directory of the buffer,
            ;; redo it as specified in dired-directory.
            (dired-readin-insert)
          (dired-insert-directory dirname dired-actual-switches nil nil t)))
        (list begin (point)))))
  
  (defun dired-insert-subdir-doupdate (dirname elt beg-end)
***************
*** 1991,2000 ****
  Lower levels are unaffected."
    ;; With optional REMEMBER-MARKS, return a mark-alist.
    (interactive)
!   (let ((beg (dired-subdir-min))
!       (end (dired-subdir-max))
!       buffer-read-only cur-dir)
!     (setq cur-dir (dired-current-directory))
      (if (equal cur-dir default-directory)
        (error "Attempt to kill top level directory"))
      (prog1
--- 2066,2077 ----
  Lower levels are unaffected."
    ;; With optional REMEMBER-MARKS, return a mark-alist.
    (interactive)
!   (let* ((beg (dired-subdir-min))
!        (end (dired-subdir-max))
!        (modflag (buffer-modified-p))
!        (cur-dir (dired-current-directory))
!        (cons (assoc-string cur-dir dired-switches-alist))
!        buffer-read-only)
      (if (equal cur-dir default-directory)
        (error "Attempt to kill top level directory"))
      (prog1
***************
*** 2002,2008 ****
        (delete-region beg end)
        (if (eobp)                      ; don't leave final blank line
          (delete-char -1))
!       (dired-unsubdir cur-dir))))
  
  (defun dired-unsubdir (dir)
    ;; Remove DIR from the alist
--- 2079,2088 ----
        (delete-region beg end)
        (if (eobp)                      ; don't leave final blank line
          (delete-char -1))
!       (dired-unsubdir cur-dir)
!       (when cons
!       (setq dired-switches-alist (delete cons dired-switches-alist)))
!       (restore-buffer-modified-p modflag))))
  
  (defun dired-unsubdir (dir)
    ;; Remove DIR from the alist
***************
*** 2061,2079 ****
  Use \\[dired-hide-all] to (un)hide all directories."
    (interactive "p")
    (dired-hide-check)
!   (while (>=  (setq arg (1- arg)) 0)
!     (let* ((cur-dir (dired-current-directory))
!          (hidden-p (dired-subdir-hidden-p cur-dir))
!          (elt (assoc cur-dir dired-subdir-alist))
!          (end-pos (1- (dired-get-subdir-max elt)))
!          buffer-read-only)
!       ;; keep header line visible, hide rest
!       (goto-char (dired-get-subdir-min elt))
!       (skip-chars-forward "^\n\r")
!       (if hidden-p
!         (subst-char-in-region (point) end-pos ?\r ?\n)
!       (subst-char-in-region (point) end-pos ?\n ?\r)))
!     (dired-next-subdir 1 t)))
  
  ;;;###autoload
  (defun dired-hide-all (arg)
--- 2141,2161 ----
  Use \\[dired-hide-all] to (un)hide all directories."
    (interactive "p")
    (dired-hide-check)
!   (let ((modflag (buffer-modified-p)))
!     (while (>=  (setq arg (1- arg)) 0)
!       (let* ((cur-dir (dired-current-directory))
!            (hidden-p (dired-subdir-hidden-p cur-dir))
!            (elt (assoc cur-dir dired-subdir-alist))
!            (end-pos (1- (dired-get-subdir-max elt)))
!            buffer-read-only)
!       ;; keep header line visible, hide rest
!       (goto-char (dired-get-subdir-min elt))
!       (skip-chars-forward "^\n\r")
!       (if hidden-p
!           (subst-char-in-region (point) end-pos ?\r ?\n)
!         (subst-char-in-region (point) end-pos ?\n ?\r)))
!       (dired-next-subdir 1 t))
!     (restore-buffer-modified-p modflag)))
  
  ;;;###autoload
  (defun dired-hide-all (arg)
***************
*** 2082,2088 ****
  Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
    (interactive "P")
    (dired-hide-check)
!   (let (buffer-read-only)
      (if (save-excursion
          (goto-char (point-min))
          (search-forward "\r" nil t))
--- 2164,2171 ----
  Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
    (interactive "P")
    (dired-hide-check)
!   (let ((modflag (buffer-modified-p))
!       buffer-read-only)
      (if (save-excursion
          (goto-char (point-min))
          (search-forward "\r" nil t))
***************
*** 2091,2097 ****
        ;; hide
        (let ((pos (point-max))         ; pos of end of last directory
            (alist dired-subdir-alist))
!       (while alist                    ; while there are dirs before pos
          (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of 
prev dir
                                (save-excursion
                                  (goto-char pos) ; current dir
--- 2174,2180 ----
        ;; hide
        (let ((pos (point-max))         ; pos of end of last directory
            (alist dired-subdir-alist))
!       (while alist                    ; while there are dirs before pos
          (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of 
prev dir
                                (save-excursion
                                  (goto-char pos) ; current dir
***************
*** 2100,2106 ****
                                  (point))
                                ?\n ?\r)
          (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current 
dir
!         (setq alist (cdr alist)))))))
  
  ;;;###end dired-ins.el
  
--- 2183,2190 ----
                                  (point))
                                ?\n ?\r)
          (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current 
dir
!         (setq alist (cdr alist)))))
!     (restore-buffer-modified-p modflag)))
  
  ;;;###end dired-ins.el