emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Ilya Chernyshov <ichernyshovvv@gmail.com>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: emacs-orgmode <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] org-element-timestamp-interpreter: Return daterange anyway, if DATERANGE is non-nil
Date: Sat, 1 Jul 2023 19:47:53 +0000	[thread overview]
Message-ID: <CAGEwbGU9bmg=jAAX5OTrcrjV0q67Nd2yR3aVM4Z-yOUv1Pz1sQ@mail.gmail.com> (raw)
In-Reply-To: <87a616c5do.fsf@localhost>


[-- Attachment #1.1: Type: text/plain, Size: 399 bytes --]

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 <yantar92@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.
>

[-- Attachment #1.2: Type: text/html, Size: 783 bytes --]

[-- Attachment #2: 0001-New-timestamp-property-range-type.patch --]
[-- Type: text/x-patch, Size: 16460 bytes --]

From d95418110897bdde85a74734bb5b5fa7a3c77b92 Mon Sep 17 00:00:00 2001
From: Ilya Chernyshov <ichernyshovvv@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


  reply	other threads:[~2023-07-01 19:49 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-02-19 12:25 [PATCH] org-element-timestamp-interpreter: Return daterange anyway, if DATERANGE is non-nil Ilya Chernyshov
2023-02-19 14:11 ` Ilya Chernyshov
2023-02-20 11:07 ` Ihor Radchenko
2023-02-20 16:36   ` Ilya Chernyshov
2023-02-22 11:21     ` Ihor Radchenko
2023-07-01 19:47       ` Ilya Chernyshov [this message]
2023-07-02  8:46         ` Ihor Radchenko
2023-07-07  7:24           ` Ilya Chernyshov
2023-07-08  8:35             ` Ihor Radchenko
2023-07-10 18:19               ` Ilya Chernyshov
2023-07-11  9:02                 ` Ihor Radchenko
2023-07-11 13:16                   ` Ilya Chernyshov
2023-07-12  8:16                     ` Ihor Radchenko

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='CAGEwbGU9bmg=jAAX5OTrcrjV0q67Nd2yR3aVM4Z-yOUv1Pz1sQ@mail.gmail.com' \
    --to=ichernyshovvv@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    --cc=yantar92@posteo.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).