[PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[fernseed]

From: Kierin Bell <fernseed@fernseed.me>

* lisp/org-id.el (org-id-ts-relative, org-id-ts-relative-method):
(org-id-ts-effective-format):
(org-id-ts-elapsed-format): New custom variables controlling the
relative timestamp feature for the `ts' `org-id-method'.
(org-id-ts-format-strip-redundant): New function for `org-id-ts-effective-format'.
(org-id-ts-effective-from-keyword):
(org-id-ts-format-relative): New helper functions for generating
relative timestamps.
(org-id-new): Use the new variables to optionally generate IDs in the
new relative timestamp format.

* etc/ORG-NEWS (New relative timestamp feature now available for the
~ts~ ~org-id-method~): Document the new feature.
---
This patch introduces a new feature for the `ts` method specified by
`org-id-method' that allows for the creation IDs with relative
timestamps. This is my first patch for Emacs/Org mode. I have just
started the FSF copyright assignment process.

 etc/ORG-NEWS   |  40 +++++++++++
 lisp/org-id.el | 178 +++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 213 insertions(+), 5 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index b6acafc3d..58d61fa43 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -201,6 +201,46 @@ Running shell blocks with the ~:session~ header freezes Emacs until
 execution completes.  The new ~:async~ header allows users to continue
 editing with Emacs while a ~:session~ block executes.
 
+*** New relative timestamp feature now available for the ~ts~ ~org-id-method~
+
+The new ~org-id-ts-relative~, ~org-id-ts-relative-method~,
+~org-id-ts-effective-format~, and ~org-id-ts-elapsed-format~ options
+allow the user to modify the behavior of the ~ts~ ID method specified
+by ~org-id-method~.
+
+When ~org-id-ts-relative~ is non-nil, the new relative timestamp
+feature is enabled.  Before a ~ts~ timestamp ID is created, an attempt
+is made to determine an effective time for the current file according
+to ~org-id-ts-relative-method~, which can either be a regular
+expression matching a keyword name that contains an Org timestamp
+value or a function that is called in the current buffer and should
+return the effective date.
+
+If an effective time can be determined, then this is used to generate
+relative timestamps for IDs within the file.  Otherwise, timestamps
+for IDs are generated as normal using the current system time.
+
+Relative timestamps have the format:
+EFFECTIVE[+ELAPSED]
+
+...Where EFFECTIVE is generated by formatting the effective time
+according to ~org-id-ts-effective-format~, and ELAPSED is generated by
+calculating the elapsed time, in seconds, since the effective time and
+formatting that according to ~org-id-ts-elapsed-format~.  The latter
+can optionally be set to nil to omit the ELAPSED component.
+
+Assuming that a suitable keyword in the current file contains the
+timestamp [2023-04-16 Sun], an ID in the new relative timestamp
+format, created at exactly 12:00 on that same day using the default
+settings, would look like this:
+20230416T000000+720.000000
+
+Users of Protesilaos Stavrou's Denote package
+(https://protesilaos.com/emacs/denote), which provides a convenient
+mechanism for adding headings with a ~date~ keyword to Org files, may
+find this new feature particularly helpful, especially when organizing
+Org attachments.
+
 ** Miscellaneous
 *** Blank lines after removed objects are not retained during export
 
diff --git a/lisp/org-id.el b/lisp/org-id.el
index aa9610f16..e22635199 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -142,6 +142,109 @@ timezone, local time and precision down to 1e-6 seconds."
   :type 'string
   :package-version '(Org . "9.5"))
 
+(defcustom org-id-ts-relative nil
+  "Non-nil means to use relative timestamps where applicable.
+
+When this variable is non-nil and an ID is created using the `ts'
+method specified by `org-id-method', the relative timestamp
+format will be used if an effective time can be determined for
+the current Org file.
+
+The variable `org-id-ts-relative-method' specifies how the
+effective time is determined.  By default, if the first
+occurrence of a keyword with the name \\=\"date\\=\" contains a
+valid timestamp value, then this is used as the effective time,
+and otherwise, the ID is created as a normal timestamp using the
+current system time, as if this variable were nil.
+
+A relative timestamp has the format:
+EFFECTIVE[+ELAPSED]
+
+EFFECTIVE is generated by formatting the effective time according
+to the variable `org-id-ts-effective-format'.
+
+ELAPSED is generated by calculating the number of seconds that has
+elapsed since the effective time and formatting it according to
+`org-id-ts-elapsed-format', which can be set to nil to omit both the
+ELAPSED component and the \\='+\\=' separator."
+  :group 'org-id
+  :type 'boolean
+  :package-version '(Org . "9.6"))
+
+(defcustom org-id-ts-relative-method "date"
+  "Method to use for determining effective times for relative timestamps.
+
+If this variable is a string, then it is a regular expression
+matching the name of the keyword specifying the effective time as
+an Org timestamp.
+
+Note that only the first occurrence of such a keyword in each
+file is checked for a valid timestamp value, even if subsequent
+occurrences of the keyword contain valid timestamps.
+
+This variable can also be a function, in which case it is called
+in the current buffer with no arguments and should return a Lisp
+timestamp to be used as the effective time.
+
+Setting this variable to nil has the same effect as setting
+`org-id-ts-relative' to nil."
+  :group 'org-id
+  :type '(choice
+          (string :tag "Regular expression matching a keyword name")
+          (function :tag "Function called to determine effective time")
+          (const :tag "Disable relative timestamps" nil))
+  :package-version '(Org . "9.6"))
+
+(defcustom org-id-ts-effective-format 'org-id-ts-format-strip-redundant
+  "Timestamp format for effective component of relative timestamps.
+
+If this variable is a string, then it should be suitable to pass
+as an argument to `format-time-string', which will be used to
+format the effective time when generating relative timestamps.
+
+If this variable is nil, then `org-id-ts-format' is used to
+format the effective time.
+
+This variable can also be a function, in which case it will be
+called with a single argument, the effective time as a Lisp
+timestamp , and should return a string to be used as the EFFECTIVE
+component of a relative timestamp.  This is useful for modifying
+`org-id-ts-format' dynamically.
+
+See `org-id-ts-relative' for a description of EFFECTIVE."
+  :group 'org-id
+  :type '(choice
+          (string :tag "Timestamp format for effective time")
+          (function :tag "Function called to format effective time")
+          (const :tag "Use `org-id-ts-format'" nil))
+  :package-version '(Org . "9.6"))
+
+
+(defcustom org-id-ts-elapsed-format "%.6f"
+  "Format for elapsed component of relative timestamps.
+
+If this variable is a string, then it should be a suitable format
+control string for `format' containing at most a single
+%-sequence.  Since `format' is called with the elapsed time as a
+floating-point argument, the %-sequence must be valid for
+floating-point arguments; that is, it cannot be \\='%c\\='.
+
+If this variable is nil, the ELAPSED component of relative
+timestamps is omitted, along with the \\='+\\=' separator.
+
+This variable can also be a function, in which case it will be
+called with a single argument, the elapsed time as a
+floating-point number, and should return a string to be used the
+ELAPSED component of a relative timestamp.
+
+See `org-id-ts-relative' for a description of ELAPSED."
+  :group 'org-id
+  :type '(choice
+          (string :tag "Format string for elapsed time")
+          (function :tag "Function called to format elapsed time")
+          (const :tag "Omit elapsed time"))
+  :package-version '(Org . "9.6"))
+
 (defcustom org-id-method 'uuid
   "The method that should be used to create new IDs.
 
@@ -158,7 +261,8 @@ uuid       Create random (version 4) UUIDs.  If the program defined in
            `org-id-uuid-program' is available it is used to create the ID.
            Otherwise an internal functions is used.
 
-ts         Create ID's based on timestamps as specified in `org-id-ts-format'."
+ts         Create ID's based on timestamps as specified by
+           `org-id-ts-format' and `org-id-ts-relative'."
   :group 'org-id
   :type '(choice
 	  (const :tag "Org's internal method" org)
@@ -357,10 +461,65 @@ With optional argument MARKERP, return the position as a new marker."
 	(setq where (org-id-find-id-in-file id file markerp))))
     where))
 
+(defun org-id-ts-format-strip-redundant (effective-time)
+  "Return EFFECTIVE-TIME formatted without redundant precision.
+
+This function uses `org-id-ts-format' to format EFFECTIVE-TIME,
+stripping a trailing subseconds component, if present."
+  (let ((time-fmt (substring org-id-ts-format 0
+                             (string-match "\\.?%[[:digit:]]N\\'"
+                                           org-id-ts-format))))
+    (format-time-string time-fmt effective-time)))
+
 ;;; Internal functions
 
 ;; Creating new IDs
 
+(defun org-id-ts-effective-from-keyword (keyword &optional pom)
+  "Get a Lisp timestamp from the current buffer's first KEYWORD.
+
+If the first keyword matching KEYWORD that occurs after position
+POM in the current buffer contains a valid Org timestamp, return
+it as a Lisp timestamp.  Otherwise, return nil."
+  (let ((date-re (concat "^[\t]*#\\+" keyword ":")))
+    (save-excursion
+      (goto-char (or pom (point-min)))
+      (when (and (re-search-forward date-re nil t)
+                 (not (org-in-commented-heading-p)))
+        (let* ((element (save-match-data (org-element-at-point)))
+               (value (and (eq (org-element-type element) 'keyword)
+                           (org-element-property :value element)))
+               (timestamp (and value
+                               (org-timestamp-from-string value))))
+          (when timestamp
+            (org-timestamp-to-time timestamp)))))))
+
+(defun org-id-ts-format-relative (effective)
+  "Format a relative timestamp from EFFECTIVE Lisp timestamp."
+  (let* ((elapsed (- (float-time (current-time))
+                     (float-time effective)))
+         (elapsed-str (cond
+                       ((stringp org-id-ts-elapsed-format)
+                        (format org-id-ts-elapsed-format elapsed))
+                       ((functionp org-id-ts-elapsed-format)
+                        (funcall org-id-ts-elapsed-format elapsed))
+                       ((not org-id-ts-elapsed-format)
+                        nil)
+                       (t
+                        (error "Invalid `org-id-ts-elapsed-format'"))))
+         (effective-str (cond
+                         ((string-or-null-p org-id-ts-effective-format)
+                          (format-time-string (or org-id-ts-effective-format
+                                                  org-id-ts-format)
+                                              effective))
+                         ((functionp org-id-ts-effective-format)
+                          (funcall org-id-ts-effective-format effective))
+                         (t
+                          (error
+                           "Invalid `org-id-ts-effective-format'")))))
+    (concat effective-str (and elapsed-str
+                               (concat "+" elapsed-str)))))
+
 ;;;###autoload
 (defun org-id-new (&optional prefix)
   "Create a new globally unique ID.
@@ -391,10 +550,19 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
 			(concat "@" (message-make-fqdn)))))
 	(setq unique (concat etime postfix))))
      ((eq org-id-method 'ts)
-      (let ((ts (format-time-string org-id-ts-format))
-	    (postfix (when org-id-include-domain
-		       (require 'message)
-		       (concat "@" (message-make-fqdn)))))
+      (let* ((effective (and org-id-ts-relative
+                             (cond
+                              ((stringp org-id-ts-relative-method)
+                               (org-id-ts-effective-from-keyword
+                                org-id-ts-relative-method))
+                              ((functionp org-id-ts-relative-method)
+                               (funcall org-id-ts-relative-method)))))
+             (ts (if effective
+                     (org-id-ts-format-relative effective)
+                   (format-time-string org-id-ts-format)))
+	     (postfix (when org-id-include-domain
+		        (require 'message)
+		        (concat "@" (message-make-fqdn)))))
 	(setq unique (concat ts postfix))))
      (t (error "Invalid `org-id-method'")))
     (concat prefix unique)))
-- 
2.39.2

Re: [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[Ihor Radchenko]

fernseed@fernseed.me writes:

> * etc/ORG-NEWS (New relative timestamp feature now available for the
> ~ts~ ~org-id-method~): Document the new feature.
> ---
> This patch introduces a new feature for the `ts` method specified by
> `org-id-method' that allows for the creation IDs with relative
> timestamps. This is my first patch for Emacs/Org mode. I have just
> started the FSF copyright assignment process.

Thanks for the patch!

Several high-level comments:
1. Instead of manually searching for keywords, please use `org-collect-keywords'
2. It will make sense to allow properties, not just keywords, to be the
   source of time.
3. Currently, `org-id-new' can be called outside Org mode buffers.
   With your new ID method, `org-id-new' may fail with error in non-Org
   buffers.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[Kierin Bell]

Ihor Radchenko <yantar92@posteo.net> writes:

> Kierin Bell <fernseed@fernseed.me> writes:
>
>> 3. I have implemented a check to verify that `org-id-ts-relative-function' is
>> only called in Org mode buffers. But since I am uncertain about all of
>> the possible contexts in which `org-id-new' can be called, I am not
>> completely sure if it is adequate:
>>
>> --8<---------------cut here---------------start------------->8---
>> (defun org-id-ts-relative-get-effective ()
>>   "Get an effective time using `org-id-ts-relative-function'.
>>
>> Ensure that `org-id-ts-relative-function' is only called in the
>> proper environment (an Org buffer), and return nil otherwise."
>>   (when (and (derived-mode-p 'org-mode)
>>              (functionp org-id-ts-relative-function))
>>     (funcall org-id-ts-relative-function)))
>> --8<---------------cut here---------------end--------------->8---
>
> I do not like this approach too much.
> I think that more reliable approach would be adding a new optional
> argument CONTEXT to `org-id-new'. Then, `org-id-get' can pass the
> context (buffer marker) letting `org-id-new' know the aimed location of
> the newly created ID.

I think that your suggestion is a better idea.

It might also be a good idea to refactor `org-id-new' so that the
different ID methods are more composable.

One nice way to do this would be to create a new option that supersedes
(but does not override) `org-id-method' and takes a list of functions
that are tried in order, so that:

(setopt org-id-method 'ts
        org-id-ts-relative t
        org-id-ts-relative-function
	#'org-id-ts-relative-from-keyword-or-property)
        
... would be equivalent to:

(setopt org-id-function-list '(org-id-relative-ts-keyword
			       org-id-relative-ts-property
			       org-id-ts))

It would then be easy, for example, to instead set the variable so that
a timestamp value is searched for in properties first *and then* in
keywords if that fails.

Or, perhaps someone will want to implement an `org-id-semantic-ts' ID
method that takes a file with the keywords:

#+title:      Title of File
#+date:       [2023-06-01 Thu 00:00]

...And creates an ID that looks like:

20230601T000000--title-of-file+0.000000

Users could abuse my new `org-id-ts-effective-format' option to achieve
this, or we could add an `org-id-ts-infix' option, and so on. But it
would be better to have ID methods that are each narrowly focused in
purpose, with an easy extension mechanism so that we won't have any
qualms about the focus being too narrow.

I do understand that ID methods may be intentionally difficult to
extend, because IDs should be stable and consistent. But I don't think
that extensibility, human-friendliness and consistency are necessarily
mutually exclusive.

So, what do you think about the `org-id-function-list' option?

Either way, I'll work on refactoring the patch to make things as modular
as possible.

-- 
Kierin Bell
GPG Key: FCF2 5F08 EA4F 2E3D C7C3  0D41 D14A 8CD3 2D97 0B36

Re: [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[Ihor Radchenko]

Kierin Bell <fernseed@fernseed.me> writes:

> It might also be a good idea to refactor `org-id-new' so that the
> different ID methods are more composable.
>
> One nice way to do this would be to create a new option that supersedes
> (but does not override) `org-id-method' and takes a list of functions
> that are tried in order, so that:
>
> (setopt org-id-method 'ts
>         org-id-ts-relative t
>         org-id-ts-relative-function
> 	#'org-id-ts-relative-from-keyword-or-property)
>         
> ... would be equivalent to:
>
> (setopt org-id-function-list '(org-id-relative-ts-keyword
> 			       org-id-relative-ts-property
> 			       org-id-ts))

This will be breaking.
We can do it slightly differently:

1. Allow `org-id-method' to be a list of methods/functions to try in
   addition to being a symbol.
2. Add new customization `org-id-methods' that will link method names to
   functions: '((ts . org-id-ts) (uuid . ...) (uuidgen . ...) (org . ...)).

That way, old configurations will continue working.

> I do understand that ID methods may be intentionally difficult to
> extend, because IDs should be stable and consistent.

Just by default. We do not constrain users from using arbitrary IDs,
including manually typed.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[Ihor Radchenko]

Hi Kierin,

It has been over one month since the last email in this thread.
May I know if you had a chance to work on your patch any further?

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'

[Kierin Bell]

Ihor Radchenko <yantar92@posteo.net> writes:

> It has been over one month since the last email in this thread.
> May I know if you had a chance to work on your patch any further?

Hello,
I have made some progress, and I should have some time soon to finalize
and submit version 2.

Thanks!

-- 
Kierin Bell
GPG Key: FCF2 5F08 EA4F 2E3D C7C3  0D41 D14A 8CD3 2D97 0B36