From: Kierin Bell <ferns...@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