Re: dired-do-touch

[Matthew Mundell <matt@mundell.ukfsn.org>]

Richard Stallman <rms@gnu.org> writes:

> The changes in dired.el and fileio.c look ok to me.
> The changes in dired-aux.el were omitted.

The changes to dired-aux.el were the same as in the original post.
Here are all the changes, with change logs.  Fset_file_times in
fileio.c now silently ignores failures on DOS_NT systems, at Eli's
suggestion, and returns t or nil, at Kim's suggestion.


2004-03-23  Matthew Mundell  <matt@mundell.ukfsn.org>

	* fileio.c (Fset_file_times): New function.
    Suggested by Lars Hansen <larsh@math.ku.dk>.
    (Qset_file_times): New variable.
    (lisp_time_argument): New declaration.
	(syms_of_fileio): staticpro and intern new variable, defsubr new
	function.

	* editfns.c (lisp_time_argument): Provide externally.


2004-03-23  Matthew Mundell  <matt@mundell.ukfsn.org>

	* dired-aux.el (dired-touch, dired-do-touch): New defuns.

    * dired.el: Bind dired-do-touch to T.


===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dired-aux.el,v
diff -u -r1.115 dired-aux.el
--- lisp/dired-aux.el	23 Mar 2004 07:39:35 -0000	1.115
+++ lisp/dired-aux.el	26 Mar 2004 16:32:37 -0000
@@ -2139,6 +2139,29 @@
       (backward-delete-char 1))
     (message "%s" (buffer-string))))

+(defun dired-touch ()
+  "Touch current file.  Return file name on failure, else nil."
+  (let ((file (dired-get-filename))
+	fail)
+    (condition-case err
+	(set-file-times file (current-time))
+      (error (setq fail err)))
+    (if fail
+	(progn
+	  (dired-log "Setting time on `%s' failed:\n%s\n"
+		     file fail)
+	  (dired-make-relative file)))))
+
+;;;###autoload
+(defun dired-do-touch (&optional arg)
+  "Set the selected files' access and mod times to the current time.
+
+With non-zero prefix argument ARG, the command operates on the
+next ARG files.  Otherwise, it operates on all the marked files,
+or the current file if none are marked."
+  (interactive "P")
+  (dired-map-over-marks-check (function dired-touch) arg 'touch nil))
+
 (provide 'dired-aux)

 ;;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60


===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dired.el,v
diff -u -r1.276 dired.el
--- lisp/dired.el	25 Mar 2004 10:40:59 -0000	1.276
+++ lisp/dired.el	26 Mar 2004 16:31:59 -0000
@@ -919,6 +919,7 @@
     (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)


===================================================================
RCS file: /cvsroot/emacs/emacs/src/fileio.c,v
diff -u -r1.499 fileio.c
--- src/fileio.c	18 Mar 2004 02:58:45 -0000	1.499
+++ src/fileio.c	26 Mar 2004 16:34:06 -0000
@@ -323,6 +323,7 @@
 Lisp_Object Qfile_accessible_directory_p;
 Lisp_Object Qfile_modes;
 Lisp_Object Qset_file_modes;
+Lisp_Object Qset_file_times;
 Lisp_Object Qfile_newer_than_file_p;
 Lisp_Object Qinsert_file_contents;
 Lisp_Object Qwrite_region;
@@ -3438,7 +3439,59 @@
   XSETINT (value, (~ realmask) & 0777);
   return value;
 }
+\f
+extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
+
+DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
+       doc: /* Set times of file FILENAME to TIME.
+Set both access and modification times.
+Return t on success, else nil.
+Use the current time if TIME is nil.  TIME is in the format of
+`current-time'. */)
+  (filename, time)
+     Lisp_Object filename, time;
+{
+  Lisp_Object absname, encoded_absname;
+  Lisp_Object handler;
+  time_t sec;
+  int usec;
+
+  if (! lisp_time_argument (time, &sec, &usec))
+    error ("Invalid time specification");
+
+  absname = Fexpand_file_name (filename, current_buffer->directory);
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = Ffind_file_name_handler (absname, Qset_file_times);
+  if (!NILP (handler))
+    return call3 (handler, Qset_file_times, absname, time);
+
+  encoded_absname = ENCODE_FILE (absname);
+
+  {
+    EMACS_TIME t;
+
+    EMACS_SET_SECS (t, sec);
+    EMACS_SET_USECS (t, usec);
+
+    if (set_file_times (SDATA (encoded_absname), t, t))
+      {
+#ifdef DOS_NT
+        struct stat st;

+        /* Setting times on a directory always fails.  */
+        if (stat (SDATA (encoded_absname), &st) == 0
+            && (st.st_mode & S_IFMT) == S_IFDIR)
+          return Qnil;
+#endif
+        report_file_error ("Setting file times", Fcons (absname, Qnil));
+        return Qnil;
+      }
+  }
+
+  return Qt;
+}
 \f
 #ifdef __NetBSD__
 #define unix 42
@@ -6339,6 +6392,7 @@
   Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
   Qfile_modes = intern ("file-modes");
   Qset_file_modes = intern ("set-file-modes");
+  Qset_file_times = intern ("set-file-times");
   Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
   Qinsert_file_contents = intern ("insert-file-contents");
   Qwrite_region = intern ("write-region");
@@ -6372,6 +6426,7 @@
   staticpro (&Qfile_accessible_directory_p);
   staticpro (&Qfile_modes);
   staticpro (&Qset_file_modes);
+  staticpro (&Qset_file_times);
   staticpro (&Qfile_newer_than_file_p);
   staticpro (&Qinsert_file_contents);
   staticpro (&Qwrite_region);
@@ -6595,6 +6650,7 @@
   defsubr (&Sfile_regular_p);
   defsubr (&Sfile_modes);
   defsubr (&Sset_file_modes);
+  defsubr (&Sset_file_times);
   defsubr (&Sset_default_file_modes);
   defsubr (&Sdefault_file_modes);
   defsubr (&Sfile_newer_than_file_p);