; time-stamp: factor out two small, internal utilities

* lisp/time-stamp.el (time-stamp--message, time-stamp--system-name):
New utility functions.
(time-stamp, time-stamp-once, time-stamp-string-preprocess):
Call the new functions.

lisp/time-stamp.el

@@ -117,7 +117,7 @@ limit yourself to the formats recommended by that older version."
 (defcustom time-stamp-active t
   "Non-nil enables time-stamping of buffers by \\[time-stamp].
 Can be toggled by \\[time-stamp-toggle-active] as an easy way to
-temporarily disable time-stamp while saving a file.
+temporarily disable `time-stamp' while saving a file.
 
 This option does not affect when `time-stamp' is run, only what it
 does when it runs.  To activate automatic time-stamping of buffers
@@ -377,12 +377,10 @@ to customize the information in the time stamp and where it is written."
 	       (setq ts-end (match-string 6 time-stamp-pattern)))))
     (cond ((not (integerp line-limit))
 	   (setq line-limit 8)
-	   (message "time-stamp-line-limit is not an integer")
+           (time-stamp--message "time-stamp-line-limit is not an integer")))
-	   (sit-for 1)))
     (cond ((not (integerp ts-count))
 	   (setq ts-count 1)
-	   (message "time-stamp-count is not an integer")
+           (time-stamp--message "time-stamp-count is not an integer"))
-	   (sit-for 1))
 	  ((< ts-count 1)
 	   ;; We need to call time-stamp-once at least once
 	   ;; to output any warnings about time-stamp not being active.
@@ -395,8 +393,7 @@ to customize the information in the time stamp and where it is written."
     (cond
      ((not (and (stringp ts-start)
                 (stringp ts-end)))
-      (message "time-stamp-start or time-stamp-end is not a string")
+      (time-stamp--message "time-stamp-start or time-stamp-end is not a string"))
-      (sit-for 1))
      (t
       (let ((nl-start 0))
         (while (string-match "\n" ts-end nl-start)
@@ -466,10 +463,8 @@ Returns the end point, which is where `time-stamp' begins the next search."
 	  (cond
 	   ((not time-stamp-active)
 	    (if time-stamp-warn-inactive
-		;; don't signal an error in a hook
+                (time-stamp--message
-		(progn
+                 "Warning: time-stamp-active is off; did not time-stamp buffer."))
-		  (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
-                  (sit-for 1)))
             nil)
 	   (t
 	    (let ((new-time-stamp (time-stamp-string ts-format)))
@@ -753,7 +748,7 @@ and all `time-stamp-format' compatibility."
                       time-stamp-no-file))
 	           ((eq cur-char ?s)    ;system name, legacy
 		    (time-stamp-conv-warn "%s" "%Q")
-	            (system-name))
+                    (time-stamp--system-name :full))
 	           ((eq cur-char ?u)    ;user name, legacy
 		    (time-stamp-conv-warn "%u" "%l")
 	            (user-login-name))
@@ -765,16 +760,13 @@ and all `time-stamp-format' compatibility."
 	           ((eq cur-char ?L)    ;full name of logged-in user
 	            (user-full-name))
 	           ((eq cur-char ?h)    ;mail host name
-	            (or mail-host-address (system-name)))
+                    (or mail-host-address (time-stamp--system-name :full)))
                    ((or (eq cur-char ?q)  ;unqualified host name
                         (eq cur-char ?x)) ;short system name, experimental
-                    (let ((shortname (system-name)))
+                    (time-stamp--system-name :short))
-                      (if (string-match "\\." shortname)
-                          (substring shortname 0 (match-beginning 0))
-                        shortname)))
                    ((or (eq cur-char ?Q)  ;fully-qualified host name
                         (eq cur-char ?X)) ;full system name, experimental
-	            (system-name))
+                    (time-stamp--system-name :full))
 	           ))
             (if (numberp field-result)
                 (progn
@@ -838,7 +830,7 @@ This is an internal helper for `time-stamp-string-preprocess'."
 
 (defun time-stamp-filtered-buffer-file-name (type)
   "Return a printable string representing the buffer file name.
-Non-graphic characters are replaced by ?. TYPE is :absolute
+Non-graphic characters are 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)
@@ -857,6 +849,18 @@ for the full name or :nondirectory for base name only."
       (setq file-name (file-name-nondirectory file-name)))
     (apply #'string (mapcar safe-character-filter file-name))))
 
+(defun time-stamp--message (warning-string)
+  "Display WARNING-STRING for one second."
+  (message "%s" warning-string)
+  (sit-for 1))
+
+(defun time-stamp--system-name (type)
+  "Return the host name of this system.
+TYPE is :short for the unqualified name, :full for the full name."
+  (let ((fullname (system-name)))
+    (if (and (eq type :short) (string-match "\\." fullname))
+        (substring fullname 0 (match-beginning 0))
+      fullname)))
 
 (defvar time-stamp-conversion-warn t
   "Enable warnings for old formats in `time-stamp-format'.

test/lisp/time-stamp-tests.el

@@ -40,14 +40,9 @@
                 (lambda (old-format _new &optional _newer)
                   (ert-fail
                    (format "Unexpected format warning for '%s'" old-format))))
-               ((symbol-function 'message)
+               ((symbol-function 'time-stamp--message)
-                (lambda (format-string &rest args)
+                (lambda (msg)
-                  (ert-fail (format "Unexpected message: %s"
+                  (ert-fail (format "Unexpected message: %s" msg)))))
-                                    (apply #'format format-string args)))))
-               ((symbol-function 'sit-for)
-                (lambda (&rest _args)
-                  ;; do not wait during tests
-                  )))
        ;; Not all reference times are used in all tests;
        ;; suppress the byte compiler's "unused" warning.
        (list ref-time1 ref-time2 ref-time3)
@@ -65,10 +60,13 @@
        ,@body)))
 
 (defmacro with-time-stamp-system-name (name &rest body)
-  "Force function `system-name' to return NAME while evaluating BODY."
+  "Force `time-stamp--system-name' to return NAME while evaluating BODY."
   (declare (indent 1) (debug t))
-  `(cl-letf (((symbol-function 'system-name)
+  `(cl-letf (((symbol-function 'time-stamp--system-name)
-              (lambda () ,name)))
+              (lambda (type)
+                (if (and (eq type :short) (string-match "\\." ,name))
+                    (substring ,name 0 (match-beginning 0))
+                  ,name))))
      ,@body))
 
 
@@ -92,10 +90,10 @@
      (should ,form)))
 
 (defmacro time-stamp-should-message (variable &rest body)
-  "Output a message about VARIABLE if `message' is not called by BODY."
+  "Fail test about VARIABLE if BODY does not call `time-stamp--message'."
   (declare (indent 1) (debug t))
   `(time-stamp-test--count-function-calls
-       message (format "variable %s" ',variable)
+       time-stamp--message (format "variable %s" ',variable)
      ,@body))
 
 ;;; Tests: