time-stamp: return quicker when inactive

* lisp/time-stamp.el (time-stamp-once): Do not look for additional
templates once we have displayed the warning about being disabled.
Move earlier the check for arguments being the correct type.
* test/lisp/time-stamp-tests.el (time-stamp-custom-messages): New test.

lisp/time-stamp.el

@@ -392,31 +392,37 @@ to customize the information in the time stamp and where it is written."
 	(let ((nl-start 0))
 	  (while (string-match "\n" ts-format nl-start)
 	    (setq format-lines (1+ format-lines) nl-start (match-end 0)))))
-    (let ((nl-start 0))
+    (cond
-      (while (string-match "\n" ts-end nl-start)
+     ((not (and (stringp ts-start)
-	(setq end-lines (1+ end-lines) nl-start (match-end 0))))
+                (stringp ts-end)))
-    ;; Find overall what lines to look at
+      (message "time-stamp-start or time-stamp-end is not a string")
-    (save-excursion
+      (sit-for 1))
-      (save-restriction
+     (t
-	(widen)
+      (let ((nl-start 0))
-	(cond ((> line-limit 0)
+        (while (string-match "\n" ts-end nl-start)
-	       (goto-char (setq start (point-min)))
+          (setq end-lines (1+ end-lines) nl-start (match-end 0))))
-	       (forward-line line-limit)
+      ;; Find overall what lines to look at
-               (setq search-limit (point-marker)))
+      (save-excursion
-	      ((< line-limit 0)
+        (save-restriction
-               (goto-char (setq search-limit (point-max-marker)))
+          (widen)
-	       (forward-line line-limit)
+          (cond ((> line-limit 0)
-	       (setq start (point)))
+                 (goto-char (setq start (point-min)))
-	      (t			;0 => no limit (use with care!)
+                 (forward-line line-limit)
-	       (setq start (point-min))
+                 (setq search-limit (point-marker)))
-               (setq search-limit (point-max-marker))))))
+                ((< line-limit 0)
-    (while (and start
+                 (goto-char (setq search-limit (point-max-marker)))
-		(< start search-limit)
+                 (forward-line line-limit)
-		(> ts-count 0))
+                 (setq start (point)))
-      (setq start (time-stamp-once start search-limit ts-start ts-end
+                (t                      ;0 => no limit (use with care!)
-				   ts-format format-lines end-lines))
+                 (setq start (point-min))
-      (setq ts-count (1- ts-count)))
+                 (setq search-limit (point-max-marker))))))
-    (set-marker search-limit nil))
+      (while (and start
+                  (< start search-limit)
+                  (> ts-count 0))
+        (setq start (time-stamp-once start search-limit ts-start ts-end
+                                     ts-format format-lines end-lines))
+        (setq ts-count (1- ts-count)))
+      (set-marker search-limit nil))))
   nil)
 
 (defun time-stamp-once (start search-limit ts-start ts-end
@@ -463,11 +469,8 @@ Returns the end point, which is where `time-stamp' begins the next search."
 		;; don't signal an error in a hook
 		(progn
 		  (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
-		  (sit-for 1))))
+                  (sit-for 1)))
-	   ((not (and (stringp ts-start)
+            nil)
-		      (stringp ts-end)))
-	    (message "time-stamp-start or time-stamp-end is not a string")
-	    (sit-for 1))
 	   (t
 	    (let ((new-time-stamp (time-stamp-string ts-format)))
 	      (if (and (stringp new-time-stamp)
@@ -484,10 +487,9 @@ Returns the end point, which is where `time-stamp' begins the next search."
 		      (if (search-backward "\t" start t)
 			  (progn
 			    (untabify start end)
-			    (setq end (point))))))))))))
+                            (setq end (point))))))))
-    ;; return the location after this time stamp, if there was one
+            ;; return the location after this time stamp
-    (and end end-length
+            (+ end (max advance-nudge end-length))))))))
-         (+ end (max advance-nudge end-length)))))
 
 
 ;;;###autoload

test/lisp/time-stamp-tests.el

@@ -34,11 +34,20 @@
          (ref-time1 '(17337 16613))    ;Monday, Jan 2, 2006, 3:04:05 PM
          (ref-time2 '(22574 61591))    ;Friday, Nov 18, 2016, 12:14:15 PM
          (ref-time3 '(21377 34956))    ;Sunday, May 25, 2014, 06:07:08 AM
+         (time-stamp-active t)         ;default, but user may have changed it
          (time-stamp-time-zone t))     ;use UTC
      (cl-letf (((symbol-function 'time-stamp-conv-warn)
                 (lambda (old-format _new &optional _newer)
                   (ert-fail
-                   (format "Unexpected format warning for '%s'" old-format)))))
+                   (format "Unexpected format warning for '%s'" old-format))))
+               ((symbol-function 'message)
+                (lambda (format-string &rest args)
+                  (ert-fail (format "Unexpected message: %s"
+                                    (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)
@@ -62,17 +71,32 @@
               (lambda () ,name)))
      ,@body))
 
+
+(defmacro time-stamp-test--count-function-calls (fn errmsg &rest forms)
+  "Return a form verifying that FN is called while FORMS are evaluated."
+  (declare (debug t) (indent 2))
+  (cl-with-gensyms (g-warning-count)
+    `(let ((,g-warning-count 0))
+       (cl-letf (((symbol-function ',fn)
+                  (lambda (&rest _args)
+                    (incf ,g-warning-count))))
+         ,@forms
+         (unless (= ,g-warning-count 1)
+           (ert-fail (format "Should have warned about %s" ,errmsg)))))))
+
 (defmacro time-stamp-should-warn (form)
   "Similar to `should' and also verify that FORM generates a format warning."
   (declare (debug t))
-  (cl-with-gensyms (g-warning-count)
+  `(time-stamp-test--count-function-calls
-    `(let ((,g-warning-count 0))
+       time-stamp-conv-warn (format "format: %S" ',form)
-       (cl-letf (((symbol-function 'time-stamp-conv-warn)
+     (should ,form)))
-                  (lambda (_old _new &optional _newer)
+
-                    (incf ,g-warning-count))))
+(defmacro time-stamp-should-message (variable &rest body)
-         (should ,form)
+  "Output a message about VARIABLE if `message' is not called by BODY."
-         (unless (= ,g-warning-count 1)
+  (declare (indent 1) (debug t))
-           (ert-fail (format "Should have warned about format: %S" ',form)))))))
+  `(time-stamp-test--count-function-calls
+       message (format "variable %s" ',variable)
+     ,@body))
 
 ;;; Tests:
 
@@ -331,6 +355,31 @@
           (time-stamp)
           (should (equal (buffer-string) expected-2)))))))
 
+(ert-deftest time-stamp-custom-messages ()
+  "Test that various incorrect variable values warn and do not crash."
+  (with-time-stamp-test-env
+    (let ((time-stamp-line-limit 8.5))
+      (time-stamp-should-message time-stamp-line-limit
+        (time-stamp)))
+    (let ((time-stamp-count 1.5))
+      (time-stamp-should-message time-stamp-count
+        (time-stamp)))
+    (let ((time-stamp-start 17))
+      (time-stamp-should-message time-stamp-start
+        (time-stamp)))
+    (let ((time-stamp-end 17))
+      (time-stamp-should-message time-stamp-end
+        (time-stamp)))
+    (let ((time-stamp-active nil)
+          (buffer-original-contents "Time-stamp: <>"))
+      (with-temp-buffer
+        (time-stamp)                    ;with no template, no message
+        (insert buffer-original-contents)
+        (time-stamp-should-message time-stamp-active
+          (time-stamp))
+        (should (equal (buffer-string) buffer-original-contents))))
+    ))
+
 ;;; Tests of time-stamp-string formatting
 
 (eval-and-compile                       ;utility functions used by macros
@@ -1213,6 +1262,7 @@ Return non-nil if the definition is found."
 ;; eval: (put 'with-time-stamp-test-env 'lisp-indent-function 0)
 ;; eval: (put 'with-time-stamp-test-time 'lisp-indent-function 1)
 ;; eval: (put 'with-time-stamp-system-name 'lisp-indent-function 1)
+;; eval: (put 'time-stamp-should-message 'lisp-indent-function 1)
 ;; eval: (put 'define-formatz-tests 'lisp-indent-function 1)
 ;; End: