emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] lisp/org-element.el: Add repeater-deadline support to org-element
@ 2024-04-03 21:21 Morgan Smith
  2024-04-04 16:51 ` Ihor Radchenko
  0 siblings, 1 reply; 6+ messages in thread
From: Morgan Smith @ 2024-04-03 21:21 UTC (permalink / raw)
  To: emacs-orgmode; +Cc: Morgan Smith

* lisp/org-element.el (org-element-timestamp-parser,
org-element-timestamp-interpreter): Add support for repeater
deadlines.  Adds two new properties: ':repeater-deadline-value' and
':repeater-deadline-unit'.

* testing/lisp/test-org-element.el (test-org-element/timestamp-parser,
test-org-element/timestamp-interpreter): Test support for repeater
deadlines.
---

Hello!

I would like to add some features to org-habit (something I have tried
unsuccessfully in the past).  Before I do that, I would like to switch
org-habit over to the org-element api.  Before I do that, I would like to
extend org-element to support the org-habit syntax.

Let me know what you think!  All the tests pass on my machine.

Thanks,

Morgan

 lisp/org-element.el              | 58 +++++++++++++++++++++-----------
 testing/lisp/test-org-element.el | 38 +++++++++++++++++++--
 2 files changed, 74 insertions(+), 22 deletions(-)

diff --git a/lisp/org-element.el b/lisp/org-element.el
index f4eec1695..8d3b8ce44 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -4288,12 +4288,13 @@ 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', `:range-type', `:raw-value', `:year-start', `:month-start',
-`:day-start', `:hour-start', `:minute-start', `:year-end',
-`:month-end', `:day-end', `:hour-end', `:minute-end',
+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',
-`:warning-type', `:warning-value', `:warning-unit', `:begin', `:end'
-and `:post-blank' properties.  Otherwise, return nil.
+`:repeater-deadline-value', `:repeater-deadline-unit', `:warning-type',
+`:warning-value', `:warning-unit', `:begin', `:end' and `:post-blank'
+properties.  Otherwise, return nil.
 
 Assume point is at the beginning of the timestamp."
   (when (looking-at-p org-element--timestamp-regexp)
@@ -4326,20 +4327,28 @@ Assume point is at the beginning of the timestamp."
                           (date-end 'daterange)
                           (time-range 'timerange)
                           (t nil)))
-	     (repeater-props
-	      (and (not diaryp)
-		   (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
-				 raw-value)
-		   (list
-		    :repeater-type
-		    (let ((type (match-string 1 raw-value)))
-		      (cond ((equal "++" type) 'catch-up)
-			    ((equal ".+" type) 'restart)
-			    (t 'cumulate)))
-		    :repeater-value (string-to-number (match-string 2 raw-value))
-		    :repeater-unit
-		    (pcase (string-to-char (match-string 3 raw-value))
-		      (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
+             (repeater-props
+              (and (not diaryp)
+                   (string-match
+                    "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)/?\\([0-9]+\\)?\\([hdwmy]\\)?"
+                    raw-value)
+                   (nconc
+                    (list
+                     :repeater-type
+                     (let ((type (match-string 1 raw-value)))
+                       (cond ((equal "++" type) 'catch-up)
+                             ((equal ".+" type) 'restart)
+                             (t 'cumulate)))
+                     :repeater-value (string-to-number (match-string 2 raw-value))
+                     :repeater-unit
+                     (pcase (string-to-char (match-string 3 raw-value))
+                       (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))
+                    (when (and (match-string 4 raw-value) (match-string 5 raw-value))
+                      (list
+                       :repeater-deadline-value (string-to-number (match-string 4 raw-value))
+                       :repeater-deadline-unit
+                       (pcase (string-to-char (match-string 5 raw-value))
+                         (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))))
 	     (warning-props
 	      (and (not diaryp)
 		   (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
@@ -4407,7 +4416,16 @@ Assume point is at the beginning of the timestamp."
 	             (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"))))
+	               (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))
+                     (let ((deadline-value (org-element-property :repeater-deadline-value timestamp))
+                           (deadline-unit (org-element-property :repeater-deadline-unit timestamp)))
+                       (if (and deadline-value deadline-unit)
+                           (concat
+                            "/"
+                            (number-to-string deadline-value)
+                            (pcase deadline-unit
+                              (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))
+                         ""))))
                    (range-type (org-element-property :range-type timestamp))
                    (warning-string
 	            (concat
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index c49dc80d1..ddd601690 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -3208,11 +3208,18 @@ Outside list"
      (let ((timestamp (org-element-context)))
        (or (org-element-property :hour-end timestamp)
 	   (org-element-property :minute-end timestamp)))))
-  ;; With repeater, warning delay and both.
+  ;; With repeater, repeater deadline, warning delay and combinations.
   (should
    (eq 'catch-up
        (org-test-with-temp-text "<2012-03-29 Thu ++1y>"
 	 (org-element-property :repeater-type (org-element-context)))))
+  (should
+   (equal '(catch-up 2 year)
+       (org-test-with-temp-text "<2012-03-29 Thu ++1y/2y>"
+         (let ((ts (org-element-context)))
+           (list (org-element-property :repeater-type ts)
+                 (org-element-property :repeater-deadline-value ts)
+                 (org-element-property :repeater-deadline-unit ts))))))
   (should
    (eq 'first
        (org-test-with-temp-text "<2012-03-29 Thu --1y>"
@@ -3223,6 +3230,14 @@ Outside list"
 	    (let ((ts (org-element-context)))
 	      (list (org-element-property :repeater-type ts)
 		    (org-element-property :warning-type ts))))))
+  (should
+   (equal '(cumulate all 2 year)
+          (org-test-with-temp-text "<2012-03-29 Thu +1y/2y -1y>"
+            (let ((ts (org-element-context)))
+              (list (org-element-property :repeater-type ts)
+                    (org-element-property :warning-type ts)
+                    (org-element-property :repeater-deadline-value ts)
+                    (org-element-property :repeater-deadline-unit ts))))))
   ;; :range-type property
   (should
    (eq
@@ -3963,7 +3978,7 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu
   ;; Diary.
   (should (equal (org-test-parse-and-interpret "<%%diary-float t 4 2>")
 		 "<%%diary-float t 4 2>\n"))
-  ;; Timestamp with repeater interval, with delay, with both.
+  ;; Timestamp with repeater interval, repeater deadline, with delay, with combinations.
   (should
    (string-match "<2012-03-29 .* \\+1y>"
 		 (org-test-parse-and-interpret "<2012-03-29 thu. +1y>")))
@@ -3975,6 +3990,15 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu
        (:type active :year-start 2012 :month-start 3 :day-start 29
 	      :repeater-type cumulate :repeater-value 1 :repeater-unit year))
      nil)))
+  (should
+   (string-match
+    "<2012-03-29 .* \\+1y/2y>"
+    (org-element-timestamp-interpreter
+     '(timestamp
+       (:type active :year-start 2012 :month-start 3 :day-start 29
+              :repeater-type cumulate :repeater-value 1 :repeater-unit year
+              :repeater-deadline-value 2 :repeater-deadline-unit year))
+     nil)))
   (should
    (string-match
     "<2012-03-29 .* -1y>"
@@ -3992,6 +4016,16 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu
 	      :warning-type all :warning-value 1 :warning-unit year
 	      :repeater-type cumulate :repeater-value 1 :repeater-unit year))
      nil)))
+  (should
+   (string-match
+    "<2012-03-29 .* \\+1y/2y -1y>"
+    (org-element-timestamp-interpreter
+     '(timestamp
+       (:type active :year-start 2012 :month-start 3 :day-start 29
+              :warning-type all :warning-value 1 :warning-unit year
+              :repeater-type cumulate :repeater-value 1 :repeater-unit year
+              :repeater-deadline-value 2 :repeater-deadline-unit year))
+     nil)))
   ;; Timestamp range with repeater interval
   (should
    (string-match "<2012-03-29 .* \\+1y>--<2012-03-30 .* \\+1y>"
-- 
2.41.0



^ permalink raw reply related	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2024-04-11 13:25 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-04-03 21:21 [PATCH] lisp/org-element.el: Add repeater-deadline support to org-element Morgan Smith
2024-04-04 16:51 ` Ihor Radchenko
2024-04-04 21:08   ` Morgan Smith
2024-04-07 11:33     ` Ihor Radchenko
2024-04-10 21:46       ` Morgan Smith
2024-04-11 13:24         ` Ihor Radchenko

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).