From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms9.migadu.com with LMTPS id 8NN+JlUnPGQbDQAASxT56A (envelope-from ) for ; Sun, 16 Apr 2023 18:50:29 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id cDuNJlUnPGQbqQAA9RJhRA (envelope-from ) for ; Sun, 16 Apr 2023 18:50:29 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 1E9DB15FDE for ; Sun, 16 Apr 2023 18:50:29 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1po5ZK-0004Vd-1X; Sun, 16 Apr 2023 12:49:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1po5ZA-0004Px-4D for emacs-orgmode@gnu.org; Sun, 16 Apr 2023 12:49:30 -0400 Received: from relay11.mail.gandi.net ([217.70.178.231]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1po5Z7-0001lY-Eh for emacs-orgmode@gnu.org; Sun, 16 Apr 2023 12:49:27 -0400 Received: (Authenticated sender: fernseed@fernseed.me) by mail.gandi.net (Postfix) with ESMTPSA id 1CF2E100003; Sun, 16 Apr 2023 16:49:21 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fernseed.me; s=gm1; t=1681663762; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding; bh=xaiYyvawwDDF52xDfEXsHUToJQ07xG4OQf5CKhzGdas=; b=jdebozSCr3O+pfzJ2fhy7ldm6MYYlJSBkBG6QrVHqltGzqvBiTnDH1Ag0c+7ZfMlAJqJLJ l0z3IoAlwvqweh57fFw/AiA7lgdREohBEilIbRYmdtevp2rQTZRQumeE0U36e1GYcYvd6w 8qhJ2ee9W23FHyzdE7egH/vCIFVY7hTc6e7ykaRz0t1Ai5KxQTSgflWFK1Tzb0TPP8PFv5 /6KAZTjgVtK0E1HoX4xBdNREpw9bdO7wAiKRsRfWR7+GZbpiD/oyqy6B8q/3wPR6Ov89kj 0dhPNj21AT8LBk2KxYmBLoNoijtFfNM0OhZg90t6KjVouXJPGEC8QsXHsiejXg== From: fernseed@fernseed.me To: emacs-orgmode@gnu.org Cc: Kierin Bell 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 Message-Id: <20230416164841.18665-1-fernseed@fernseed.me> X-Mailer: git-send-email 2.39.2 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=217.70.178.231; envelope-from=fernseed@fernseed.me; helo=relay11.mail.gandi.net X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: emacs-orgmode-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN ARC-Seal: i=1; s=key1; d=yhetil.org; t=1681663829; a=rsa-sha256; cv=none; b=Euw0GvBWaAYYEHwOE4FWKLtrOe/BxY3HtH/XHe22bNG9XXr+huq+wA+7OUd9WA/dUE2cJj LWyeqmuxW9sUHKZlTxIuWjRCTLzVtTzJy5NA9j4RMMzIEuHH1jpKuCih3YZ2sSAZaoYXXO +qZgQM7e7ioDbTL0f3ZcXvt+bE87jHEZjeuLnQ0EpfKRYv8fZwgbFZQvNX4zEIJa5AIZBN r+kCPQzlk1h0cLwJowiEXwXt02R/Vhe3/HsIeDSbKQrii7Ye8InmxlJAxBw+ofak/wEnun DjzcnjRMwMf0pEwYlpBmxOtcproLWcg38ffrIxOmInC1Jm+zMsoYKinBeWbYbw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=fernseed.me header.s=gm1 header.b=jdebozSC; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=fernseed.me ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1681663829; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=xaiYyvawwDDF52xDfEXsHUToJQ07xG4OQf5CKhzGdas=; b=cRQ2vczt3JfF5OHqm+NqQLmWM7RKM3AqyZkabHCpO60DR1TCltg2nMUdcw6eGMcw9kwWKM rXoEOJKekrXEsY2XSyfoe42gY/Q0tfKQHusFdqisapTwZCp27Ckqj6gBxf/G0QOxtwjO3v NteUXbEIVs9IVm0QC8JcJN2vtq4o3zXe+dGbN01zs42DBLuv6ck/s5qHP70XkKUyFryAHQ dkvg4ZbZQQhXPWHB51KMXnQhPqIeXPnMQmKL43xvAJY1/cXre37rel4cViYuKE+GFCFYou oonrLCSr0bIBoU+WJ6pZxYUUNL/gywXuZxU0dlQy5PhhRscsD5A2sA2knwVOGg== X-Migadu-Scanner: scn1.migadu.com X-Migadu-Spam-Score: -2.81 X-Spam-Score: -2.81 X-Migadu-Queue-Id: 1E9DB15FDE Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=fernseed.me header.s=gm1 header.b=jdebozSC; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=fernseed.me X-TUID: zFk68e/hpLUu From: Kierin Bell * 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