mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
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.
This commit is contained in:
parent
1677c4681a
commit
9f2b1c43c9
2 changed files with 95 additions and 43 deletions
|
|
@ -392,6 +392,12 @@ to customize the information in the time stamp and where it is written."
|
||||||
(let ((nl-start 0))
|
(let ((nl-start 0))
|
||||||
(while (string-match "\n" ts-format nl-start)
|
(while (string-match "\n" ts-format nl-start)
|
||||||
(setq format-lines (1+ format-lines) nl-start (match-end 0)))))
|
(setq format-lines (1+ format-lines) nl-start (match-end 0)))))
|
||||||
|
(cond
|
||||||
|
((not (and (stringp ts-start)
|
||||||
|
(stringp ts-end)))
|
||||||
|
(message "time-stamp-start or time-stamp-end is not a string")
|
||||||
|
(sit-for 1))
|
||||||
|
(t
|
||||||
(let ((nl-start 0))
|
(let ((nl-start 0))
|
||||||
(while (string-match "\n" ts-end nl-start)
|
(while (string-match "\n" ts-end nl-start)
|
||||||
(setq end-lines (1+ end-lines) nl-start (match-end 0))))
|
(setq end-lines (1+ end-lines) nl-start (match-end 0))))
|
||||||
|
|
@ -416,7 +422,7 @@ to customize the information in the time stamp and where it is written."
|
||||||
(setq start (time-stamp-once start search-limit ts-start ts-end
|
(setq start (time-stamp-once start search-limit ts-start ts-end
|
||||||
ts-format format-lines end-lines))
|
ts-format format-lines end-lines))
|
||||||
(setq ts-count (1- ts-count)))
|
(setq ts-count (1- ts-count)))
|
||||||
(set-marker search-limit nil))
|
(set-marker search-limit nil))))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(defun time-stamp-once (start search-limit ts-start ts-end
|
(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
|
;; don't signal an error in a hook
|
||||||
(progn
|
(progn
|
||||||
(message "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))))
|
(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
|
(t
|
||||||
(let ((new-time-stamp (time-stamp-string ts-format)))
|
(let ((new-time-stamp (time-stamp-string ts-format)))
|
||||||
(if (and (stringp new-time-stamp)
|
(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)
|
(if (search-backward "\t" start t)
|
||||||
(progn
|
(progn
|
||||||
(untabify start end)
|
(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
|
;;;###autoload
|
||||||
|
|
|
||||||
|
|
@ -34,11 +34,20 @@
|
||||||
(ref-time1 '(17337 16613)) ;Monday, Jan 2, 2006, 3:04:05 PM
|
(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-time2 '(22574 61591)) ;Friday, Nov 18, 2016, 12:14:15 PM
|
||||||
(ref-time3 '(21377 34956)) ;Sunday, May 25, 2014, 06:07:08 AM
|
(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
|
(time-stamp-time-zone t)) ;use UTC
|
||||||
(cl-letf (((symbol-function 'time-stamp-conv-warn)
|
(cl-letf (((symbol-function 'time-stamp-conv-warn)
|
||||||
(lambda (old-format _new &optional _newer)
|
(lambda (old-format _new &optional _newer)
|
||||||
(ert-fail
|
(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;
|
;; Not all reference times are used in all tests;
|
||||||
;; suppress the byte compiler's "unused" warning.
|
;; suppress the byte compiler's "unused" warning.
|
||||||
(list ref-time1 ref-time2 ref-time3)
|
(list ref-time1 ref-time2 ref-time3)
|
||||||
|
|
@ -62,17 +71,32 @@
|
||||||
(lambda () ,name)))
|
(lambda () ,name)))
|
||||||
,@body))
|
,@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)
|
(defmacro time-stamp-should-warn (form)
|
||||||
"Similar to `should' and also verify that FORM generates a format warning."
|
"Similar to `should' and also verify that FORM generates a format warning."
|
||||||
(declare (debug t))
|
(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:
|
;;; Tests:
|
||||||
|
|
||||||
|
|
@ -331,6 +355,31 @@
|
||||||
(time-stamp)
|
(time-stamp)
|
||||||
(should (equal (buffer-string) expected-2)))))))
|
(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
|
;;; Tests of time-stamp-string formatting
|
||||||
|
|
||||||
(eval-and-compile ;utility functions used by macros
|
(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-env 'lisp-indent-function 0)
|
||||||
;; eval: (put 'with-time-stamp-test-time 'lisp-indent-function 1)
|
;; eval: (put 'with-time-stamp-test-time 'lisp-indent-function 1)
|
||||||
;; eval: (put 'with-time-stamp-system-name '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)
|
;; eval: (put 'define-formatz-tests 'lisp-indent-function 1)
|
||||||
;; End:
|
;; End:
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue