From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.devel Subject: Re: dired-do-touch Date: Thu, 25 Mar 2004 16:54:43 +0200 Organization: JURTA Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <8765ctkmdo.fsf@mail.jurta.org> References: <8765czqqyj.fsf@sno.mundell.ukfsn.org> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1080226853 29678 80.91.224.253 (25 Mar 2004 15:00:53 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Thu, 25 Mar 2004 15:00:53 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Thu Mar 25 16:00:43 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B6WLb-0007fA-00 for ; Thu, 25 Mar 2004 16:00:43 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B6WLa-00082N-00 for ; Thu, 25 Mar 2004 16:00:42 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B6WLN-0002eD-NB for emacs-devel@quimby.gnus.org; Thu, 25 Mar 2004 10:00:29 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1B6WLH-0002db-4k for emacs-devel@gnu.org; Thu, 25 Mar 2004 10:00:23 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1B6WKh-0002ZL-4q for emacs-devel@gnu.org; Thu, 25 Mar 2004 10:00:18 -0500 Original-Received: from [66.33.219.4] (helo=spork.dreamhost.com) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B6WKg-0002Z5-Ed for emacs-devel@gnu.org; Thu, 25 Mar 2004 09:59:46 -0500 Original-Received: from mail.jurta.org (80-235-33-137-dsl.mus.estpak.ee [80.235.33.137]) by spork.dreamhost.com (Postfix) with ESMTP id A686611DC31; Thu, 25 Mar 2004 06:59:37 -0800 (PST) Original-To: Matthew Mundell In-Reply-To: <8765czqqyj.fsf@sno.mundell.ukfsn.org> (Matthew Mundell's message of "20 Mar 2004 19:05:40 +0000") User-Agent: Gnus/5.110002 (No Gnus v0.2) Emacs/21.3.50 (gnu/linux) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:20902 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20902 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/