all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'
@ 2023-04-16 16:48 fernseed
  2023-04-17 11:29 ` Ihor Radchenko
  0 siblings, 1 reply; 6+ messages in thread
From: fernseed @ 2023-04-16 16:48 UTC (permalink / raw)
  To: emacs-orgmode; +Cc: Kierin Bell

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



^ permalink raw reply related	[flat|nested] 6+ messages in thread
end of thread, other threads:[~2023-07-03 14:37 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-04-16 16:48 [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method' fernseed
2023-04-17 11:29 ` Ihor Radchenko
     [not found]   ` <87v8gac9uy.fsf@localhost>
     [not found]     ` <87r0qxo8z5.fsf@fernseed.me>
     [not found]       ` <87a5xkoq6p.fsf@localhost>
2023-05-31 20:04         ` Kierin Bell
2023-06-01  8:50           ` Ihor Radchenko
2023-07-02 11:00             ` Ihor Radchenko
2023-07-03 14:36               ` Kierin Bell

Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.