From: fernseed@fernseed.me
To: emacs-orgmode@gnu.org
Cc: Kierin Bell <fernseed@fernseed.me>
Subject: [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method'
Date: Sun, 16 Apr 2023 12:48:41 -0400 [thread overview]
Message-ID: <20230416164841.18665-1-fernseed@fernseed.me> (raw)
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
next reply other threads:[~2023-04-16 16:50 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-04-16 16:48 fernseed [this message]
2023-04-17 11:29 ` [PATCH] lisp/org-id.el: Add new relative timestamp feature for `ts' `org-id-method' 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
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=20230416164841.18665-1-fernseed@fernseed.me \
--to=fernseed@fernseed.me \
--cc=emacs-orgmode@gnu.org \
/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).