Re: dired-do-touch

[Juri Linkov]

I am very happy with the following patch.  So if you want to use
primitive functions instead of external programs, please make them
possible to co-exist with useful features I implemented below: the
default input string guessing for chmod, chown, chgrp and touch.

And if you want to achieve independence of external programs
then other commands should be changed to use primitives too:
dired-do-chmod, dired-do-chown, dired-do-chgrp.

Index: emacs/lisp/dired.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dired.el,v
retrieving revision 1.276
diff -c -r1.276 dired.el
*** emacs/lisp/dired.el 25 Mar 2004 10:40:59 -0000      1.276
--- emacs/lisp/dired.el 25 Mar 2004 14:30:37 -0000
***************
*** 79,84 ****
--- 79,87 ----
  (defvar dired-chmod-program "chmod"
    "Name of chmod command (usually `chmod').")
  
+ (defvar dired-touch-program "touch"
+   "Name of touch command (usually `touch').")
+ 
  ;;;###autoload
  (defcustom dired-ls-F-marks-symlinks nil
    "*Informs dired about how `ls -lF' marks symbolic links.
***************
*** 919,924 ****
--- 922,928 ----
      (define-key map "Q" 'dired-do-query-replace-regexp)
      (define-key map "R" 'dired-do-rename)
      (define-key map "S" 'dired-do-symlink)
+     (define-key map "T" 'dired-do-touch)
      (define-key map "X" 'dired-do-shell-command)
      (define-key map "Z" 'dired-do-compress)
      (define-key map "!" 'dired-do-shell-command)
***************
*** 1189,1194 ****
--- 1193,1201 ----
      (define-key map [menu-bar operate chmod]
        '(menu-item "Change Mode..." dired-do-chmod
                  :help "Change mode (attributes) of marked files"))
+     (define-key map [menu-bar operate touch]
+       '(menu-item "Change Timestamp..." dired-do-touch
+                 :help "Change timestamp of marked files"))
      (define-key map [menu-bar operate load]
        '(menu-item "Load" dired-do-load
                  :help "Load marked Emacs Lisp files"))
***************
*** 2338,2345 ****
  (defvar dired-no-confirm nil
    "A list of symbols for commands dired should not confirm.
  Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
! `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink' and
! `uncompress'.")
  
  (defun dired-mark-pop-up (bufname op-symbol files function &rest args)
    "Return FUNCTION's result on ARGS after showing which files are marked.
--- 2345,2352 ----
  (defvar dired-no-confirm nil
    "A list of symbols for commands dired should not confirm.
  Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
! `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink',
! `touch' and `uncompress'.")
  
  (defun dired-mark-pop-up (bufname op-symbol files function &rest args)
    "Return FUNCTION's result on ARGS after showing which files are marked.
***************
*** 2980,2985 ****
--- 2987,2996 ----
  
  (autoload 'dired-do-chown "dired-aux"
    "Change the owner of the marked (or next ARG) files."
+   t)
+ 
+ (autoload 'dired-do-touch "dired-aux"
+   "Change the timestamp of the marked (or next ARG) files."
    t)
  
  (autoload 'dired-do-print "dired-aux"
Index: emacs/lisp/dired-aux.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dired-aux.el,v
retrieving revision 1.115
diff -c -r1.115 dired-aux.el
*** emacs/lisp/dired-aux.el     23 Mar 2004 07:39:35 -0000      1.115
--- emacs/lisp/dired-aux.el     25 Mar 2004 14:30:38 -0000
***************
*** 185,209 ****
               (file-attributes full-file-name))))
     (directory-files dir)))
  
  (defun dired-do-chxxx (attribute-name program op-symbol arg)
!   ;; Change file attributes (mode, group, owner) of marked files and
    ;; refresh their file lines.
    ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
    ;; PROGRAM is the program used to change the attribute.
    ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
    ;; ARG describes which files to use, as in dired-get-marked-files.
    (let* ((files (dired-get-marked-files t arg))
         (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
          (dired-bunch-files 10000
                             (function dired-check-process)
                             (append
!                             (list operation program new-attribute)
                              (if (string-match "gnu" system-configuration)
                                  '("--") nil))
                             files))
--- 185,270 ----
               (file-attributes full-file-name))))
     (directory-files dir)))
  
+ (defvar dired-show-initial t
+   "Show initial value for chmod, chown, chgrp, touch.")
+ 
+ (defun dired-create-initial (op-symbol files)
+   (cond ((eq op-symbol 'chmod)
+          (dired-create-initial-chmod files))
+         ((eq op-symbol 'chown)
+          (dired-create-initial-chown files))
+         ((eq op-symbol 'chgrp)
+          (dired-create-initial-chgrp files))
+         ((eq op-symbol 'touch)
+          (dired-create-initial-touch files))))
+ 
+ (defun dired-create-initial-chmod (files)
+   "Create initial input value for `chmod' command."
+   (let (initial)
+     (while files
+       (let ((current (file-modes (car files))))
+         (if (and initial (not (equal initial current)))
+             (setq initial (default-file-modes) files nil)
+           (setq initial current))
+         (setq files (cdr files))))
+     (format "%o" initial)))
+ 
+ (defun dired-create-initial-chown (files)
+   "Create initial input value for `chown' command."
+   (let (initial)
+     (while files
+       (let ((current (nth 2 (file-attributes (car files) 'string))))
+         (if (and initial (not (equal initial current)))
+             (setq initial user-login-name files nil)
+           (setq initial current))
+         (setq files (cdr files))))
+     initial))
+ 
+ (defun dired-create-initial-chgrp (files)
+   "Create initial input value for `chgrp' command."
+   (let (initial)
+     (while files
+       (let ((current (nth 3 (file-attributes (car files) 'string))))
+         (if (and initial (not (equal initial current)))
+             (setq initial user-login-name files nil)
+           (setq initial current))
+         (setq files (cdr files))))
+     initial))
+ 
+ (defun dired-create-initial-touch (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.
    ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
    ;; PROGRAM is the program used to change the attribute.
    ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
    ;; ARG describes which files to use, as in dired-get-marked-files.
    (let* ((files (dired-get-marked-files t arg))
+          (initial (if dired-show-initial (dired-create-initial op-symbol 
files)))
         (new-attribute
          (dired-mark-read-string
           (concat "Change " attribute-name " of %s to: ")
!          initial op-symbol arg files))
         (operation (concat program " " new-attribute))
         failures)
      (setq failures
          (dired-bunch-files 10000
                             (function dired-check-process)
                             (append
!                             (list operation program)
!                             (if (eq op-symbol 'touch)
!                                 '("-t") nil)
!                             (list new-attribute)
                              (if (string-match "gnu" system-configuration)
                                  '("--") nil))
                             files))
***************
*** 235,240 ****
--- 296,307 ----
    (if (memq system-type '(ms-dos windows-nt))
        (error "chown not supported on this system"))
    (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
+ 
+ (defun dired-do-touch (&optional arg)
+   "Change the timestamp of the marked (or next ARG) files.
+ This calls touch."
+   (interactive "P")
+   (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
  
  ;; Process all the files in FILES in batches of a convenient size,
  ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).

-- 
Juri Linkov
http://www.jurta.org/emacs/