Re: dired-do-touch

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

Here's a version of dired-do-touch which operates on the selected
files in the same manner as the other Dired uppercase operations.
This version uses set-file-times, a primitive interface to
set_file_times, to touch the files.

The set-file-times primitive uses lisp_time_argument to get or parse
the time.  This requires the change to editfns.c to provide
lisp_time_argument externally.

Making this change will require the set-file-times file name handler
to be added to the list of handlers in the Elisp reference.

===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dired-aux.el,v
diff -u -r1.114 dired-aux.el
--- lisp/dired-aux.el	8 Feb 2004 22:38:51 -0000	1.114
+++ lisp/dired-aux.el	22 Mar 2004 21:53:58 -0000
@@ -2135,6 +2135,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/src/editfns.c,v
diff -u -r1.368 editfns.c
--- src/editfns.c	2 Mar 2004 21:42:03 -0000	1.368
+++ src/editfns.c	22 Mar 2004 22:01:45 -0000
@@ -73,7 +73,7 @@
 static void find_field P_ ((Lisp_Object, Lisp_Object, Lisp_Object, int *, Lisp_Object, int *));
 static void update_buffer_properties P_ ((int, int));
 static Lisp_Object region_limit P_ ((int));
-static int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
+int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
 static size_t emacs_memftimeu P_ ((char *, size_t, const char *,
 				   size_t, const struct tm *, int));
 static void general_insert_function P_ ((void (*) (const unsigned char *, int),
@@ -1377,7 +1377,7 @@
 }
 \f
 
-static int
+int
 lisp_time_argument (specified_time, result, usec)
      Lisp_Object specified_time;
      time_t *result;

===================================================================
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	22 Mar 2004 21:53:23 -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,45 @@
   XSETINT (value, (~ realmask) & 0777);
   return value;
 }
+\f
+DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
+       doc: /* Set access and modification times of file FILENAME.
+If optional second argument TIME is supplied then it is used instead
+of the current time.  TIME must be 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) < 0)
+      report_file_error ("Setting file times", Fcons (absname, Qnil));
+  }
+
+  return Qnil;
+}
 \f
 #ifdef __NetBSD__
 #define unix 42
@@ -6339,6 +6378,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 +6412,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 +6636,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);