branch: externals/org
commit 829b3556d725d6417c27504589a4431d6e4ef4ac
Author: Jens Schmidt <[email protected]>
Commit: Ihor Radchenko <[email protected]>
Improve support for weekday-less timestamps
* lisp/org.el (org-ts-regexp1, org-timestamp-formats): Doc fixes.
(org-timestamp-change): Test for presence of optional groups before
accessing them.
* testing/lisp/test-org.el (test-org/at-timestamp-p): Add tests for
timestamps with time and without weekday name.
(test-org/org-timestamp-change): New test.
Link:
https://list.orgmode.org/[email protected]/
---
lisp/org.el | 28 ++++++++++++++++++---
testing/lisp/test-org.el | 64 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 88 insertions(+), 4 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index 9dcf103215..ee1e4b4b7e 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -448,7 +448,16 @@ This one does not require the space after the date, so it
can be used
on a string that terminates immediately after the date.")
(defconst org-ts-regexp1
"\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\(?:
*\\([^]+0-9>\r\n -]+\\)\\)?\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.")
+ "Regular expression matching time strings for analysis.
+This regular expression provides the following groups:
+ 1: everything (required for embedding)
+ 2: year
+ 3: month
+ 4: day
+ 5: weekday name (optional)
+ 6: time part (optional)
+ 7: hour
+ 8: minute")
(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
"Regular expression matching time stamps, with groups.")
@@ -479,6 +488,13 @@ The time stamps may be either active or inactive.")
"Regular expression for specifying repeated events.
After a match, group 1 contains the repeat expression.")
+;; The weekday name "%a" is considered semi-optional in these formats,
+;; see https://list.orgmode.org/87fricxatw.fsf@localhost/. It is
+;; "optional" because the `org-timestamp-*' functions work alright on
+;; weekday-less timestamps in paragraphs when one omits the "%a". But
+;; it is only "semi"-optional since Org cannot process properly
+;; timestamps in CLOCK, DEADLINE, and SCHEDULED lines when one omits
+;; the "%a".
(defvaralias 'org-time-stamp-formats 'org-timestamp-formats)
(defconst org-timestamp-formats '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M")
"Formats for `format-time-string' which are used for time stamps.
@@ -15472,9 +15488,13 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays
like
(looking-at org-ts-regexp3)
(goto-char
(pcase origin-cat
- ;; `day' category ends before `hour' if any, or at the end
- ;; of the day name.
- (`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
+ ;; `day' category ends at the end of the weekday name if
+ ;; any (group 5), or before `hour' if any (group 7), or at
+ ;; the end of the timestamp (group 1).
+ (`day (min (cond ((match-end 5) (1- (match-end 5)))
+ ((match-beginning 7))
+ (t (1- (match-end 1))))
+ origin))
(`hour (min (match-end 7) origin))
(`minute (min (1- (match-end 8)) origin))
((pred integerp) (min (1- (match-end 0)) origin))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index eefc9b6922..af307f70be 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -8993,6 +8993,14 @@ CLOSED: %s
(eq 'day
(org-test-with-temp-text "<2012-03-29 T<point>hu>"
(org-at-timestamp-p))))
+ (should
+ (eq 'hour
+ (org-test-with-temp-text "<2012-03-29 Thu <point>12:34>"
+ (org-at-timestamp-p))))
+ (should
+ (eq 'minute
+ (org-test-with-temp-text "<2012-03-29 Thu 12:<point>34>"
+ (org-at-timestamp-p))))
(should
(wholenump
(org-test-with-temp-text "<2012-03-29 Thu +2<point>y>"
@@ -9005,6 +9013,23 @@ CLOSED: %s
(eq 'after
(org-test-with-temp-text "<2012-03-29 Thu><point>ยป"
(org-at-timestamp-p))))
+ ;; Test optional weekday name.
+ (should
+ (eq 'day
+ (org-test-with-temp-text "<2012-03-2<point>9>"
+ (org-at-timestamp-p))))
+ (should
+ (eq 'day
+ (org-test-with-temp-text "<2012-03-29<point> 12:34>"
+ (org-at-timestamp-p))))
+ (should
+ (eq 'hour
+ (org-test-with-temp-text "<2012-03-29 <point>12:34>"
+ (org-at-timestamp-p))))
+ (should
+ (eq 'minute
+ (org-test-with-temp-text "<2012-03-29 12:<point>34>"
+ (org-at-timestamp-p))))
;; Test `inactive' optional argument.
(should
(org-test-with-temp-text "[2012-03-29 Thu]"
@@ -9067,6 +9092,45 @@ CLOSED: %s
(org-test-with-temp-text "# [2012-03-29 Thu]<point>"
(org-at-timestamp-p 'lax))))
+(ert-deftest test-org/org-timestamp-change ()
+ "Test `org-timestamp-change' specifications."
+ (let ((now (current-time)) now-ts point)
+ (message "Testing with timestamps <%s> and <%s>"
+ (format-time-string (car org-timestamp-formats) now)
+ (format-time-string (cdr org-timestamp-formats) now))
+ ;; loop over regular timestamp formats and weekday-less timestamp
+ ;; formats
+ (dolist (org-timestamp-formats
+ (list org-timestamp-formats
+ (cons (replace-regexp-in-string
+ " %a" "" (car org-timestamp-formats))
+ (replace-regexp-in-string
+ " %a" "" (cdr org-timestamp-formats)))))
+ ;; loop over timestamps that do not and do contain time
+ (dolist (format (list (car org-timestamp-formats)
+ (cdr org-timestamp-formats)))
+ (setq now-ts
+ (concat "<" (format-time-string format now) ">"))
+ (org-test-with-temp-text now-ts
+ (forward-char 1)
+ (while (not (eq (char-after) ?>))
+ (skip-syntax-forward "-")
+ ;; change the timestamp unit at point one down, two up,
+ ;; one down, which should give us the original timestamp
+ ;; again. However, point can move backward during that
+ ;; operation, so take care of that. *Not* using
+ ;; `save-excursion', which fails to restore point since
+ ;; the timestamp gets completely replaced.
+ (setq point (point))
+ (org-timestamp-change -1 nil nil nil)
+ (org-timestamp-change 2 nil nil nil)
+ (org-timestamp-change -1 nil nil nil)
+ (goto-char point)
+ (should (string=
+ (buffer-substring (point-min) (point-max))
+ now-ts))
+ (forward-char 1)))))))
+
(ert-deftest test-org/timestamp ()
"Test `org-timestamp' specifications."
;; Insert chosen time stamp at point.
