Re: master 4cc4344: ; Clarify and simplify time-stamp comments

[Lars Ingebrigtsen <larsi@gnus.org>]

[-- Attachment #1: Type: text/plain, Size: 697 bytes --]

stepheng+savannah@gildea.com (Stephen Gildea) writes:

>     ; Clarify and simplify time-stamp comments

I'm going through some old stuff I've got stashed in my Emacs git tree,
and I found something I was working on in 2019, but don't remember the
status of.

The main idea behind this patch (which no longer applies) is that we
could rewrite `time-stamp-string-preprocess' to just use `format-spec'.
I vaguely remember there being some corner case that `format-spec'
didn't support yet, but you've simplified the time-spec syntax a bit
meanwhile, so perhaps it's possible now.

Anyway, I'm just including the patch below -- perhaps it can be used for
inspiration, but if not, just disregard it.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: time-stamp.patch --]
[-- Type: text/x-diff, Size: 8381 bytes --]

diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index f423683852..8157abbb3c 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -36,6 +36,8 @@
 
 ;;; Code:
 
+(require 'format-spec)
+
 (defgroup time-stamp nil
   "Maintain last change time stamps in files edited by Emacs."
   :group 'data
@@ -413,192 +415,33 @@ time-stamp-string
 (defconst time-stamp-no-file "(no file)"
   "String to use when the buffer is not associated with a file.")
 
-;;; FIXME This comment was written in 1996!
-;;; time-stamp is transitioning to using the new, expanded capabilities
-;;; of format-time-string.  During the process, this function implements
-;;; intermediate, compatible formats and complains about old, soon to
-;;; be unsupported, formats.  This function will get a lot (a LOT) shorter
-;;; when the transition is complete and we can just pass most things
-;;; straight through to format-time-string.
-;;;      At all times, all the formats recommended in the doc string
-;;; of time-stamp-format will work not only in the current version of
-;;; Emacs, but in all versions that have been released within the past
-;;; two years.
-;;;      The : modifier is a temporary conversion feature used to resolve
-;;; ambiguous formats--formats that are changing (over time) incompatibly.
 (defun time-stamp-string-preprocess (format &optional time)
   "Use a FORMAT to format date, time, file, and user information.
 Optional second argument TIME is only for testing.
 Implements non-time extensions to `format-time-string'
 and all `time-stamp-format' compatibility."
-  (let ((fmt-len (length format))
-	(ind 0)
-	cur-char
-	(prev-char nil)
-	(result "")
-	field-width
-	field-result
-	alt-form change-case
-	(paren-level 0))
-    (while (< ind fmt-len)
-      (setq cur-char (aref format ind))
-      (setq
-       result
-       (concat result
-      (cond
-       ((eq cur-char ?%)
-	;; eat any additional args to allow for future expansion
-	(setq alt-form nil change-case nil field-width "")
-	(while (progn
-		 (setq ind (1+ ind))
-		 (setq cur-char (if (< ind fmt-len)
-				    (aref format ind)
-				  ?\0))
-		 (or (eq ?. cur-char)
-		     (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
-		     (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
-		     (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
-		     (and (eq ?\( cur-char)
-			  (not (eq prev-char ?\\))
-			  (setq paren-level (1+ paren-level)))
-		     (if (and (eq ?\) cur-char)
-			      (not (eq prev-char ?\\))
-			      (> paren-level 0))
-			 (setq paren-level (1- paren-level))
-		       (and (> paren-level 0)
-			    (< ind fmt-len)))
-		     (if (and (<= ?0 cur-char) (>= ?9 cur-char))
-			 ;; get format width
-			 (let ((field-index ind))
-			   (while (progn
-				    (setq ind (1+ ind))
-				    (setq cur-char (if (< ind fmt-len)
-						       (aref format ind)
-						     ?\0))
-				    (and (<= ?0 cur-char) (>= ?9 cur-char))))
-			   (setq field-width (substring format field-index ind))
-			   (setq ind (1- ind))
-			   t))))
-	  (setq prev-char cur-char)
-	  ;; some characters we actually use
-	  (cond ((eq cur-char ?:)
-		 (setq alt-form t))
-		((eq cur-char ?#)
-		 (setq change-case t))))
-	(setq field-result
-	(cond
-	 ((eq cur-char ?%)
-	  "%%")
-	 ((eq cur-char ?a)		;day of week
-	  (if change-case
-	      (time-stamp--format "%#a" time)
-	    (or alt-form (not (string-equal field-width ""))
-		(time-stamp-conv-warn "%a" "%:a"))
-	    (if (and alt-form (not (string-equal field-width "")))
-		""			;discourage "%:3a"
-	      (time-stamp--format "%A" time))))
-	 ((eq cur-char ?A)
-	  (if alt-form
-	      (time-stamp--format "%A" time)
-	    (or change-case (not (string-equal field-width ""))
-		(time-stamp-conv-warn "%A" "%#A"))
-	    (time-stamp--format "%#A" time)))
-	 ((eq cur-char ?b)		;month name
-	  (if change-case
-	      (time-stamp--format "%#b" time)
-	    (or alt-form (not (string-equal field-width ""))
-		(time-stamp-conv-warn "%b" "%:b"))
-	    (if (and alt-form (not (string-equal field-width "")))
-		""			;discourage "%:3b"
-	    (time-stamp--format "%B" time))))
-	 ((eq cur-char ?B)
-	  (if alt-form
-	      (time-stamp--format "%B" time)
-	    (or change-case (not (string-equal field-width ""))
-		(time-stamp-conv-warn "%B" "%#B"))
-	    (time-stamp--format "%#B" time)))
-	 ((eq cur-char ?d)		;day of month, 1-31
-	  (time-stamp-do-number cur-char alt-form field-width time))
-	 ((eq cur-char ?H)		;hour, 0-23
-	  (time-stamp-do-number cur-char alt-form field-width time))
-	 ((eq cur-char ?I)		;hour, 1-12
-	  (time-stamp-do-number cur-char alt-form field-width time))
-	 ((eq cur-char ?m)		;month number, 1-12
-	  (time-stamp-do-number cur-char alt-form field-width time))
-	 ((eq cur-char ?M)		;minute, 0-59
-	  (time-stamp-do-number cur-char alt-form field-width time))
-	 ((eq cur-char ?p)		;am or pm
-	  (or change-case
-	      (time-stamp-conv-warn "%p" "%#p"))
-	  (time-stamp--format "%#p" time))
-	 ((eq cur-char ?P)		;AM or PM
-	  (time-stamp--format "%p" time))
-	 ((eq cur-char ?S)		;seconds, 00-60
-	  (time-stamp-do-number cur-char alt-form field-width time))
-	 ((eq cur-char ?w)		;weekday number, Sunday is 0
-	  (time-stamp--format "%w" time))
-	 ((eq cur-char ?y)		;year
-	  (or alt-form (not (string-equal field-width ""))
-	      (time-stamp-conv-warn "%y" "%:y"))
-	  (string-to-number (time-stamp--format "%Y" time)))
-	 ((eq cur-char ?Y)		;4-digit year, new style
-	  (string-to-number (time-stamp--format "%Y" time)))
-	 ((eq cur-char ?z)		;time zone lower case
-	  (if change-case
-	      ""			;discourage %z variations
-	    (time-stamp--format "%#Z" time)))
-	 ((eq cur-char ?Z)
-	  (if change-case
-	      (time-stamp--format "%#Z" time)
-	    (time-stamp--format "%Z" time)))
-	 ((eq cur-char ?f)		;buffer-file-name, base name only
-	  (if buffer-file-name
+  (format-spec
+   format
+   `((?f .                           ;buffer-file-name, base name only
+         ,(if buffer-file-name
 	      (file-name-nondirectory buffer-file-name)
 	    time-stamp-no-file))
-	 ((eq cur-char ?F)		;buffer-file-name, full path
-	  (or buffer-file-name
+     (?F .                              ;buffer-file-name, full path
+	 ,(or buffer-file-name
 	      time-stamp-no-file))
-	 ((eq cur-char ?s)		;system name
-	  (system-name))
-	 ((eq cur-char ?u)		;user name
-	  (user-login-name))
-	 ((eq cur-char ?U)		;user full name
-	  (user-full-name))
-	 ((eq cur-char ?l)		;logname (undocumented user name alt)
-	  (user-login-name))
-	 ((eq cur-char ?L)		;(undocumented alt user full name)
-	  (user-full-name))
-	 ((eq cur-char ?h)		;mail host name
-	  (or mail-host-address (system-name)))
-	 ((eq cur-char ?q)		;(undocumented unqual hostname)
-	  (let ((qualname (system-name)))
+     (?s . ,(system-name))       ; system name
+     (?u . ,(user-login-name))   ;user name
+     (?U . ,(user-full-name))    ;user full name
+     (?l . ,(user-login-name))   ;logname (undocumented user name alt)
+     (?L . ,(user-full-name))    ;(undocumented alt user full name)
+     (?h . ,(or mail-host-address (system-name))) ;mail host name
+     (?q .                             ;(undocumented unqual hostname)
+         ,(let ((qualname (system-name)))
 	    (if (string-match "\\." qualname)
 		(substring qualname 0 (match-beginning 0))
 	      qualname)))
-	 ((eq cur-char ?Q)		;(undocumented fully-qualified host)
-	  (system-name))
-	 ))
-	(let ((padded-result
-	       (format (format "%%%s%c"
-			       field-width
-			       (if (numberp field-result) ?d ?s))
-		       (or field-result ""))))
-	  (let* ((initial-length (length padded-result))
-		 (desired-length (if (string-equal field-width "")
-				     initial-length
-				   (string-to-number field-width))))
-	    (if (> initial-length desired-length)
-		;; truncate strings on right, years on left
-		(if (stringp field-result)
-		    (substring padded-result 0 desired-length)
-		  (if (eq cur-char ?y)
-		      (substring padded-result (- desired-length))
-		    padded-result))	;non-year numbers don't truncate
-	      padded-result))))
-       (t
-	(char-to-string cur-char)))))
-      (setq ind (1+ ind)))
-    result))
+     (?Q , (system-name)))        ;(undocumented fully-qualified host)
+   t))
 
 (defun time-stamp-do-number (format-char alt-form field-width time)
   "Handle compatible FORMAT-CHAR where only default width/padding will change.