Hello!
In the new patch I added :range-type timestamp property, adjusted
interpreter,
parser functions, added tests for the property.
On Wed, Feb 22, 2023 at 11:21 AM Ihor Radchenko <yanta...@posteo.net> wrote:
> I suggest introducing a new timestamp property :range-type. It can be
> nil, timerange, or daterange.
>
> Changing :type values will not be backwards-compatible.
>
From d95418110897bdde85a74734bb5b5fa7a3c77b92 Mon Sep 17 00:00:00 2001
From: Ilya Chernyshov <ichernysho...@gmail.com>
Date: Sat, 18 Feb 2023 14:55:39 +0700
Subject: [PATCH] New timestamp property :range-type
* lisp/org-element (org-element-timestamp-interpreter): For ranges:
When :range-type is nil or `timerange', return timerange (<YYYY-mm-DD
HH:MM-HH:MM>) if date-start and date-end are equal; return
daterange(<...>--<...>) otherwise. When :range-type is `daterange',
return daterange anyway. Refactor the code.
* lisp/org-element (org-element-timestamp-parser): Add :range-type property
* testing/lisp/test-org-element
(test-org-element/timestamp-interpreter): Add new tests.
(test-org-element/timestamp-parser): Add testing for :range-type
property.
---
lisp/org-element.el | 168 ++++++++++++++-----------------
testing/lisp/test-org-element.el | 86 +++++++++++++---
2 files changed, 149 insertions(+), 105 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index bfb1d206e..13dd41e5d 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -4043,7 +4043,7 @@ Assume point is at the target."
"Parse time stamp at point, if any.
When at a time stamp, return a new syntax node of `timestamp' type
-containing `:type', `:raw-value', `:year-start', `:month-start',
+containing `:type', `:range-type', `:raw-value', `:year-start', `:month-start',
`:day-start', `:hour-start', `:minute-start', `:year-end',
`:month-end', `:day-end', `:hour-end', `:minute-end',
`:repeater-type', `:repeater-value', `:repeater-unit',
@@ -4077,6 +4077,10 @@ Assume point is at the beginning of the timestamp."
(activep 'active)
((or date-end time-range) 'inactive-range)
(t 'inactive)))
+ (range-type (cond
+ (date-end 'daterange)
+ (time-range 'timerange)
+ (t nil)))
(repeater-props
(and (not diaryp)
(string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
@@ -4123,6 +4127,7 @@ Assume point is at the beginning of the timestamp."
(org-element-create
'timestamp
(nconc (list :type type
+ :range-type range-type
:raw-value raw-value
:year-start year-start
:month-start month-start
@@ -4142,98 +4147,75 @@ Assume point is at the beginning of the timestamp."
(defun org-element-timestamp-interpreter (timestamp _)
"Interpret TIMESTAMP object as Org syntax."
- (let* ((repeat-string
- (concat
- (pcase (org-element-property :repeater-type timestamp)
- (`cumulate "+") (`catch-up "++") (`restart ".+"))
- (let ((val (org-element-property :repeater-value timestamp)))
- (and val (number-to-string val)))
- (pcase (org-element-property :repeater-unit timestamp)
- (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
- (warning-string
- (concat
- (pcase (org-element-property :warning-type timestamp)
- (`first "--") (`all "-"))
- (let ((val (org-element-property :warning-value timestamp)))
- (and val (number-to-string val)))
- (pcase (org-element-property :warning-unit timestamp)
- (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
- (build-ts-string
- ;; Build an Org timestamp string from TIME. ACTIVEP is
- ;; non-nil when time stamp is active. If WITH-TIME-P is
- ;; non-nil, add a time part. HOUR-END and MINUTE-END
- ;; specify a time range in the timestamp. REPEAT-STRING is
- ;; the repeater string, if any.
- (lambda (time activep &optional with-time-p hour-end minute-end)
- (let ((ts (format-time-string
- (org-time-stamp-format with-time-p)
- time)))
- (when (and hour-end minute-end)
- (string-match "[012]?[0-9]:[0-5][0-9]" ts)
- (setq ts
- (replace-match
- (format "\\&-%02d:%02d" hour-end minute-end)
- nil nil ts)))
- (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
- (dolist (s (list repeat-string warning-string))
- (when (org-string-nw-p s)
- (setq ts (concat (substring ts 0 -1)
- " "
- s
- (substring ts -1)))))
- ;; Return value.
- ts)))
- (type (org-element-property :type timestamp)))
- (pcase type
- ((or `active `inactive)
- (let* ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp))
- (time-range-p (and hour-start hour-end minute-start minute-end
- (or (/= hour-start hour-end)
- (/= minute-start minute-end)))))
- (funcall
- build-ts-string
- (org-encode-time 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active)
- (and hour-start minute-start)
- (and time-range-p hour-end)
- (and time-range-p minute-end))))
- ((or `active-range `inactive-range)
- (let ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp)))
- (concat
- (funcall
- build-ts-string (org-encode-time
- 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active-range)
- (and hour-start minute-start))
- "--"
- (funcall build-ts-string
- (org-encode-time
- 0
- (or minute-end 0)
- (or hour-end 0)
- (org-element-property :day-end timestamp)
- (org-element-property :month-end timestamp)
- (org-element-property :year-end timestamp))
- (eq type 'active-range)
- (and hour-end minute-end)))))
- (_ (org-element-property :raw-value timestamp)))))
-
+ (if (member
+ (org-element-property :type timestamp)
+ '(active inactive inactive-range active-range))
+ (let((start-date
+ (format-time-string
+ (org-time-stamp-format nil 'no-brackets)
+ (org-encode-time
+ 0 0 0
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp)))))
+ (when start-date
+ (let*((repeat-string
+ (concat
+ (pcase (org-element-property :repeater-type timestamp)
+ (`cumulate "+") (`catch-up "++") (`restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (pcase (org-element-property :repeater-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
+ (range-type (org-element-property :range-type timestamp))
+ (warning-string
+ (concat
+ (pcase (org-element-property :warning-type timestamp)
+ (`first "--") (`all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (pcase (org-element-property :warning-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
+ (hour-start (org-element-property :hour-start timestamp))
+ (minute-start (org-element-property :minute-start timestamp))
+ (start-time
+ (and hour-start minute-start
+ (format "%02d:%02d" hour-start minute-start)))
+ (hour-end (org-element-property :hour-end timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (end-time (and hour-end minute-end
+ (format "%02d:%02d" hour-end minute-end)))
+ (day-end (org-element-property :day-end timestamp))
+ (month-end (org-element-property :month-end timestamp))
+ (year-end (org-element-property :year-end timestamp))
+ (time-range-p (and start-time end-time
+ (not (string= start-time end-time))))
+ (end-date
+ (and year-end month-end day-end
+ (format-time-string
+ (org-time-stamp-format nil 'no-brackets)
+ (org-encode-time
+ 0 0 0 day-end month-end year-end))))
+ (date-range-p (or (eq range-type 'daterange)
+ (and end-date (not (string= end-date start-date)))))
+ (ts
+ (concat
+ "<" start-date (and start-time (concat " " start-time))
+ (if date-range-p
+ (concat ">--<" end-date (and end-time (concat " " end-time)))
+ (if time-range-p (concat "-" end-time)))
+ ">")))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (string-replace ">" (concat " " s ">") ts))))
+ (pcase (org-element-property :type timestamp)
+ ((or `active `active-range)
+ ts)
+ ((or `inactive `inactive-range)
+ (string-replace
+ "<" "["
+ (string-replace ">" "]" ts)))))))
+ (org-element-property :raw-value timestamp)))
;;;; Underline
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 283ade10f..09a20491d 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -3081,27 +3081,31 @@ Outside list"
(should
(org-test-with-temp-text "<2012-03-29 16:40>"
(eq (org-element-property :type (org-element-context)) 'active)))
- (should-not
+ (should
(org-test-with-temp-text "<2012-03-29 Thu>"
(let ((timestamp (org-element-context)))
- (or (org-element-property :hour-start timestamp)
- (org-element-property :minute-start timestamp)))))
+ (and
+ (not
+ (or (org-element-property :hour-start timestamp)
+ (org-element-property :minute-start timestamp)))
+ (null (org-element-property :range-type timestamp))))))
(should
- (equal '(2012 3 29 16 40)
+ (equal '(2012 3 29 16 40 nil)
(org-test-with-temp-text "<2012-03-29 Thu 16:40>"
(let ((object (org-element-context)))
(list (org-element-property :year-start object)
(org-element-property :month-start object)
(org-element-property :day-start object)
(org-element-property :hour-start object)
- (org-element-property :minute-start object))))))
+ (org-element-property :minute-start object)
+ (org-element-property :range-type object))))))
;; Inactive timestamp.
(should
(org-test-with-temp-text "[2012-03-29 Thu 16:40]"
(eq (org-element-property :type (org-element-context)) 'inactive)))
;; Time range.
(should
- (equal '(2012 3 29 16 40 7 30)
+ (equal '(2012 3 29 16 40 7 30 timerange)
(org-test-with-temp-text "<2012-03-29 Thu 7:30-16:40>"
(let ((object (org-element-context)))
(list (org-element-property :year-end object)
@@ -3110,7 +3114,8 @@ Outside list"
(org-element-property :hour-end object)
(org-element-property :minute-end object)
(org-element-property :hour-start object)
- (org-element-property :minute-start object))))))
+ (org-element-property :minute-start object)
+ (org-element-property :range-type object))))))
(should
(eq 'active-range
(org-test-with-temp-text "<2012-03-29 Thu 7:30-16:40>"
@@ -3118,12 +3123,17 @@ Outside list"
;; Date range.
(should
(org-test-with-temp-text "[2012-03-29 Thu 16:40]--[2012-03-29 Thu 16:41]"
- (eq (org-element-property :type (org-element-context)) 'inactive-range)))
- (should-not
+ (let((timestamp (org-element-context)))
+ (and (eq (org-element-property :type timestamp) 'inactive-range)
+ (eq (org-element-property :range-type timestamp) 'daterange)))))
+ (should
(org-test-with-temp-text "[2011-07-14 Thu]--[2012-03-29 Thu]"
(let ((timestamp (org-element-context)))
- (or (org-element-property :hour-end timestamp)
- (org-element-property :minute-end timestamp)))))
+ (and
+ (not
+ (or (org-element-property :hour-end timestamp)
+ (org-element-property :minute-end timestamp)))
+ (eq (org-element-property :range-type timestamp) 'daterange)))))
;; With repeater, warning delay and both.
(should
(eq 'catch-up
@@ -3697,31 +3707,83 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu
(:type inactive :year-start 2012 :month-start 3 :day-start 29
:hour-start 16 :minute-start 40)) nil)))
;; Active range.
+
+ ;; range-type: daterange; parse-and-interpret
(should
(string-match "<2012-03-29 .* 16:40>--<2012-03-29 .* 16:41>"
(org-test-parse-and-interpret
"<2012-03-29 thu. 16:40>--<2012-03-29 thu. 16:41>")))
+
+ ;; range-type: daterange; interpreter
(should
(string-match
"<2012-03-29 .* 16:40>--<2012-03-29 .* 16:41>"
+ (org-element-timestamp-interpreter
+ '(timestamp
+ (:type active-range :range-type daterange :year-start 2012 :month-start 3 :day-start 29
+ :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3
+ :day-end 29 :hour-end 16 :minute-end 41)) nil)))
+
+ ;; range-type: timerange; parse-and-interpret
+ (should
+ (string-match "<2012-03-29 .* 16:40-16:41>"
+ (org-test-parse-and-interpret
+ "<2012-03-29 thu. 16:40-16:41>")))
+
+ ;; range-type: timerange; interpreter
+ (should
+ (string-match
+ "<2012-03-29 .* 16:40-16:41>"
+ (org-element-timestamp-interpreter
+ '(timestamp
+ (:type active-range :range-type timerange :year-start 2012 :month-start 3 :day-start 29
+ :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3
+ :day-end 29 :hour-end 16 :minute-end 41)) nil)))
+
+ ;; range-type: nil; date-start and date-end are equal; interpreter
+ (should
+ (string-match
+ "<2012-03-29 .* 16:40-16:41>"
(org-element-timestamp-interpreter
'(timestamp
(:type active-range :year-start 2012 :month-start 3 :day-start 29
:hour-start 16 :minute-start 40 :year-end 2012 :month-end 3
:day-end 29 :hour-end 16 :minute-end 41)) nil)))
+
+ ;; range-type: nil; date-start and date-end aren't equal; interpreter
+ (should
+ (string-match
+ "<2012-03-29 .* 16:40>--<2012-03-30 .* 16:41>"
+ (org-element-timestamp-interpreter
+ '(timestamp
+ (:type active-range :year-start 2012 :month-start 3 :day-start 29
+ :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3
+ :day-end 30 :hour-end 16 :minute-end 41)) nil)))
+
;; Inactive range.
(should
(string-match "\\[2012-03-29 .* 16:40\\]--\\[2012-03-29 .* 16:41\\]"
(org-test-parse-and-interpret
"[2012-03-29 thu. 16:40]--[2012-03-29 thu. 16:41]")))
+
+ (should
+ (string-match
+ "\\[2012-03-29 .* 16:40-16:41\\]"
+ (org-element-timestamp-interpreter
+ '(timestamp
+ (:type inactive-range :range-type timerange :year-start 2012 :month-start 3 :day-start 29
+ :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3
+ :day-end 29 :hour-end 16 :minute-end 41)) nil)))
+
(should
(string-match
- "\\[2012-03-29 .* 16:40\\]--\\[2012-03-29 .* 16:41\\]"
+ "\\[2012-03-29 .* 16:40-16:41\\]"
(org-element-timestamp-interpreter
'(timestamp
(:type inactive-range :year-start 2012 :month-start 3 :day-start 29
:hour-start 16 :minute-start 40 :year-end 2012 :month-end 3
:day-end 29 :hour-end 16 :minute-end 41)) nil)))
+
;; Diary.
(should (equal (org-test-parse-and-interpret "<%%diary-float t 4 2>")
"<%%diary-float t 4 2>\n"))
--
2.40.1
