time-stamp: Don't get confused by newline in file name

* lisp/time-stamp.el (time-stamp-filtered-buffer-file-name): New helper
* test/lisp/time-stamp-tests.el: (time-stamp-custom-file-name): New test
This commit is contained in:
Stephen Gildea 2025-01-27 10:44:37 -08:00
parent 2d386fc449
commit 29c6dad78d
2 changed files with 46 additions and 6 deletions

View file

@ -726,11 +726,12 @@ and all `time-stamp-format' compatibility."
(time-stamp--format "%Z" time)))
((eq cur-char ?f) ;buffer-file-name, base name only
(if buffer-file-name
(file-name-nondirectory buffer-file-name)
(time-stamp-filtered-buffer-file-name :nondirectory)
time-stamp-no-file))
((eq cur-char ?F) ;buffer-file-name, absolute name
(or buffer-file-name
time-stamp-no-file))
(if buffer-file-name
(time-stamp-filtered-buffer-file-name :absolute)
time-stamp-no-file))
((eq cur-char ?s) ;system name, legacy
(time-stamp-conv-warn "%s" "%Q")
(system-name))
@ -803,6 +804,26 @@ This is an internal helper for `time-stamp-string-preprocess'."
"" ;discourage "%:2d" and the like
(string-to-number (time-stamp--format format-string time)))))
(defun time-stamp-filtered-buffer-file-name (type)
"Return the buffer file name, but with non-graphic characters replaced by ?.
TYPE is :absolute for the full name or :nondirectory for base name only."
(declare (ftype (function ((member :absolute :nondirectory)) string)))
(let ((file-name buffer-file-name)
(safe-character-filter
(lambda (chr)
(let ((category (get-char-code-property chr 'general-category)))
(if (or
;; Letter, Mark, Number, Punctuation, or Symbol
(member (aref (symbol-name category) 0) '(?L ?M ?N ?P ?S))
;; spaces of various widths, but not ctrl chars like CR or LF
(eq category 'Zs))
chr
;; substitute "?" for format or control character
??)))))
(when (eq type :nondirectory)
(setq file-name (file-name-nondirectory file-name)))
(apply #'string (mapcar safe-character-filter file-name))))
(defvar time-stamp-conversion-warn t
"Enable warnings about soon-to-be-unsupported forms in `time-stamp-format'.

View file

@ -29,7 +29,7 @@
(declare (indent 0) (debug t))
`(let ((user-login-name "test-logname")
(user-full-name "100%d Tester") ;verify "%" passed unchanged
(buffer-file-name "/emacs/test/time-stamped-file")
(buffer-file-name "/emacs/test/0-9AZaz (time)_stamped.file$+^")
(mail-host-address "test-mail-host-name")
(ref-time1 '(17337 16613)) ;Monday, Jan 2, 2006, 3:04:05 PM
(ref-time2 '(22574 61591)) ;Friday, Nov 18, 2016, 12:14:15 PM
@ -286,6 +286,24 @@
(time-stamp)
(should (equal (buffer-string) buffer-expected-2)))))))
(ert-deftest time-stamp-custom-file-name ()
"Test that `time-stamp' isn't confused by a newline in the file name."
(with-time-stamp-test-env
(let ((time-stamp-format "1 %f") ;changed later in the test
(buffer-original-contents "Time-stamp: <>")
(expected-1 "Time-stamp: <1 Embedded?Newline>")
(expected-2 "Time-stamp: <2 Embedded?Newline>"))
(with-temp-buffer
(let ((buffer-file-name "Embedded\nNewline"))
(insert buffer-original-contents)
(time-stamp)
(should (equal (buffer-string) expected-1))
;; If the first time-stamp inserted an unexpected newline, the
;; next time-stamp would be unable to find the end pattern.
(setq time-stamp-format "2 %f")
(time-stamp)
(should (equal (buffer-string) expected-2)))))))
;;; Tests of time-stamp-string formatting
(ert-deftest time-stamp-format-day-of-week ()
@ -690,9 +708,10 @@
;; implemented and recommended since 1995
(should (equal (time-stamp-string "%%" ref-time1) "%")) ;% last char
(should (equal (time-stamp-string "%%P" ref-time1) "%P")) ;% not last char
(should (equal (time-stamp-string "%f" ref-time1) "time-stamped-file"))
(should (equal (time-stamp-string "%f" ref-time1)
"0-9AZaz (time)_stamped.file$+^"))
(should (equal (time-stamp-string "%F" ref-time1)
"/emacs/test/time-stamped-file"))
"/emacs/test/0-9AZaz (time)_stamped.file$+^"))
(with-temp-buffer
(should (equal (time-stamp-string "%f" ref-time1) "(no file)"))
(should (equal (time-stamp-string "%F" ref-time1) "(no file)")))