Mercurial > core / emacs/lib/org-expiry.el
changeset 698: |
96958d3eb5b0 |
parent: |
74a55d5decce
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Fri, 04 Oct 2024 22:04:59 -0400 |
permissions: |
-rw-r--r-- |
description: |
fixes |
1 ;;; org-expiry.el --- expiry mechanism for Org entries -*- lexical-binding: t; -*- 3 ;; Copyright 2007-2021 Free Software Foundation, Inc. 5 ;; Author: Bastien Guerry <bzg@gnu.org> 7 ;; Keywords: org, expiry 8 ;; Homepage: https://git.sr.ht/~bzg/org-contrib 10 ;; This file is not part of GNU Emacs. 12 ;; This program is free software; you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation; either version 3, or (at your option) 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 27 ;; This gives you a chance to get rid of old entries in your Org files 30 ;; By default, entries that have no EXPIRY property are considered to be 31 ;; new (i.e. 0 day old) and only entries older than one year go to the 32 ;; expiry process, which consist in adding the ARCHIVE tag. None of 33 ;; your tasks will be deleted with the default settings. 35 ;; When does an entry expires? 37 ;; Consider this entry: 41 ;; :CREATED: <2008-01-07 lun 08:01> 42 ;; :EXPIRY: <2008-01-09 08:01> 45 ;; This entry will expire on the 9th, january 2008. 49 ;; :CREATED: <2008-01-07 lun 08:01> 53 ;; This entry will expire on the 14th, january 2008, one week after its 56 ;; What happen when an entry is expired? Nothing until you explicitly 57 ;; M-x org-expiry-process-entries When doing this, org-expiry will check 58 ;; for expired entries and request permission to process them. 60 ;; Processing an expired entries means calling the function associated 61 ;; with `org-expiry-handler-function'; the default is to add the tag 62 ;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive 65 ;; Is this useful? Well, when you're in a brainstorming session, it 66 ;; might be useful to know about the creation date of an entry, and be 67 ;; able to archive those entries that are more than xxx days/weeks old. 69 ;; When you're in such a session, you can insinuate org-expiry like 70 ;; this: M-x org-expiry-insinuate 72 ;; Then, each time you're pressing M-RET to insert an item, the CREATION 73 ;; property will be automatically added. Same when you're scheduling or 74 ;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate 82 (defgroup org-expiry nil 87 (defcustom org-expiry-inactive-timestamps nil 88 "Insert inactive timestamps for created/expired properties." 92 (defcustom org-expiry-created-property-name "CREATED" 93 "The name of the property for setting the creation date." 97 (defcustom org-expiry-expiry-property-name "EXPIRY" 98 "The name of the property for setting the expiry date/delay." 102 (defcustom org-expiry-keyword "EXPIRED" 103 "The default keyword for `org-expiry-add-keyword'." 107 (defcustom org-expiry-wait "+1y" 108 "Time span between the creation date and the expiry. 109 The default value for this variable (\"+1y\") means that entries 110 will expire if there are at least one year old. 112 If the expiry delay cannot be retrieved from the entry or the 113 subtree above, the expiry process compares the expiry delay with 114 `org-expiry-wait'. This can be either an ISO date or a relative 115 time specification. See `org-read-date' for details." 119 (defcustom org-expiry-created-date "+0d" 120 "The default creation date. 121 The default value of this variable (\"+0d\") means that entries 122 without a creation date will be handled as if they were created 125 If the creation date cannot be retrieved from the entry or the 126 subtree above, the expiry process will compare the expiry delay 127 with this date. This can be either an ISO date or a relative 128 time specification. See `org-read-date' for details on relative 129 time specifications." 133 (defcustom org-expiry-handler-function 'org-toggle-archive-tag 134 "Function to process expired entries. 135 Possible candidates for this function are: 137 `org-toggle-archive-tag' 138 `org-expiry-add-keyword' 139 `org-expiry-archive-subtree'" 143 (defcustom org-expiry-confirm-flag t 144 "Non-nil means confirm expiration process." 146 (const :tag "Always require confirmation" t) 147 (const :tag "Do not require confirmation" nil) 148 (const :tag "Require confirmation in interactive expiry process" 152 (defcustom org-expiry-advised-functions 153 '(org-scheduled org-deadline org-time-stamp) 154 "A list of advised functions. 155 `org-expiry-insinuate' will activate the expiry advice for these 156 functions. `org-expiry-deinsinuate' will deactivate them." 160 ;;; Advices and insinuation: 162 (define-advice org-schedule (:after (&rest _) org-schedule-update-created) 163 "Update the creation-date property when calling `org-schedule'." 164 (org-expiry-insert-created)) 166 (define-advice org-deadline (:after (&rest _) org-deadline-update-created) 167 "Update the creation-date property when calling `org-deadline'." 168 (org-expiry-insert-created)) 170 (define-advice org-time-stamp (:after (&rest _) org-time-stamp-update-created) 171 "Update the creation-date property when calling `org-time-stamp'." 172 (org-expiry-insert-created)) 174 (defun org-expiry-insinuate (&optional arg) 175 "Add hooks and activate advices for org-expiry. 176 If ARG, also add a hook to `before-save-hook' in `org-mode' and 177 restart `org-mode' if necessary." 179 (ad-activate 'org-schedule) 180 (ad-activate 'org-time-stamp) 181 (ad-activate 'org-deadline) 182 (add-hook 'org-insert-heading-hook 'org-expiry-insert-created) 183 (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created) 184 (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created) 186 (add-hook 'org-mode-hook 187 (lambda() (add-hook 'before-save-hook 188 'org-expiry-process-entries t t))) 189 ;; need this to refresh org-mode hooks 190 (when (eq major-mode 'org-mode) 192 (if (called-interactively-p 'any) 193 (message "Org-expiry insinuated, `org-mode' restarted."))))) 195 (defun org-expiry-deinsinuate (&optional arg) 196 "Remove hooks and deactivate advices for org-expiry. 197 If ARG, also remove org-expiry hook in Org's `before-save-hook' 198 and restart `org-mode' if necessary." 200 (advice-remove 'org-schedule #'org-schedule@org-schedule-update-created) 201 (advice-remove 'org-time-stamp #'org-time-stamp@org-time-stamp-update-created) 202 (advice-remove 'org-deadline #'org-deadline@org-deadline-update-created) 203 (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created) 204 (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created) 205 (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created) 206 (remove-hook 'org-mode-hook 207 (lambda() (add-hook 'before-save-hook 208 'org-expiry-process-entries t t))) 210 ;; need this to refresh org-mode hooks 211 (when (eq major-mode 'org-mode) 213 (if (called-interactively-p 'any) 214 (message "Org-expiry de-insinuated, `org-mode' restarted."))))) 216 ;;; org-expiry-expired-p: 218 (defun org-expiry-expired-p () 219 "Check if the entry at point is expired. 220 Return nil if the entry is not expired. Otherwise return the 221 amount of time between today and the expiry date. 223 If there is no creation date, use `org-expiry-created-date'. 224 If there is no expiry date, use `org-expiry-wait'." 225 (let* ((ex-prop org-expiry-expiry-property-name) 226 (cr-prop org-expiry-created-property-name) 228 (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) 229 org-expiry-created-date))) 230 (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait)) 231 (ex (if (string-match "^[ \t]?[+-]" ex-field) 232 (time-add cr (time-subtract (org-read-date nil t ex-field) ct)) 233 (org-read-date nil t ex-field)))) 234 (if (time-less-p ex ct) 235 (time-subtract ct ex)))) 237 ;;; Expire an entry or a region/buffer: 239 (defun org-expiry-process-entry (&optional force) 240 "Call `org-expiry-handler-function' on entry. 241 If FORCE is non-nil, don't require confirmation from the user. 242 Otherwise rely on `org-expiry-confirm-flag' to decide." 245 (when (called-interactively-p 'interactive) (org-reveal)) 246 (when (org-expiry-expired-p) 247 (org-back-to-heading) 248 (looking-at org-complex-heading-regexp) 249 (let* ((ov (make-overlay (point) (match-end 0))) 250 (e (org-expiry-expired-p)) 251 (d (time-to-number-of-days e))) 252 (overlay-put ov 'face 'secondary-selection) 254 (null org-expiry-confirm-flag) 255 (and (eq org-expiry-confirm-flag 'interactive) 256 (not (called-interactively-p 'interactive))) 257 (and org-expiry-confirm-flag 258 (y-or-n-p (format "Entry expired by %d days. Process? " d)))) 259 (funcall org-expiry-handler-function)) 260 (delete-overlay ov))))) 262 (defun org-expiry-process-entries (_ _) 263 "Process all expired entries between BEG and END. 264 The expiry process will run the function defined by 265 `org-expiry-handler-functions'." 268 (let ((beg (if (org-region-active-p) 269 (region-beginning) (point-min))) 270 (end (if (org-region-active-p) 271 (region-end) (point-max)))) 273 (let ((expired 0) (processed 0)) 274 (while (and (outline-next-heading) (< (point) end)) 275 (when (org-expiry-expired-p) 276 (setq expired (1+ expired)) 277 (if (if (called-interactively-p 'any) 278 (call-interactively 'org-expiry-process-entry) 279 (org-expiry-process-entry)) 280 (setq processed (1+ processed))))) 281 (if (equal expired 0) 282 (message "No expired entry") 283 (message "Processed %d on %d expired entries" 284 processed expired)))))) 286 ;;; Insert created/expiry property: 287 (defun org-expiry-format-timestamp (timestr inactive) 288 "Properly format TIMESTR into an org (in)active timestamp" 289 (format (if inactive "[%s]" "<%s>") timestr)) 291 (defun org-expiry-insert-created (&optional arg) 292 "Insert or update a property with the creation date. 293 If ARG, always update it. With one `C-u' prefix, silently update 294 to today's date. With two `C-u' prefixes, prompt the user for to 297 (let* ((d (org-entry-get (point) org-expiry-created-property-name)) 298 d-time d-hour timestr) 299 (when (or (null d) arg) 300 ;; update if no date or non-nil prefix argument 301 ;; FIXME Use `org-time-string-to-time' 302 (setq d-time (if d (org-time-string-to-time d) 304 (setq d-hour (format-time-string "%H:%M" d-time)) 306 ;; two C-u prefixes will call org-read-date 307 (org-expiry-format-timestamp 308 (if (equal arg '(16)) 309 (org-read-date nil nil nil nil d-time d-hour) 311 (replace-regexp-in-string "\\(^<\\|>$\\)" "" 312 (cdr org-time-stamp-formats)))) 313 org-expiry-inactive-timestamps)) 316 (point) org-expiry-created-property-name timestr))))) 318 (defun org-expiry-insert-expiry (&optional today) 319 "Insert a property with the expiry date. 320 With one `C-u' prefix, don't prompt interactively for the date 321 and insert today's date." 323 (let* ((d (org-entry-get (point) org-expiry-expiry-property-name)) 324 d-time d-hour timestr) 325 (setq d-time (if d (org-time-string-to-time d) 327 (setq d-hour (format-time-string "%H:%M" d-time)) 328 (setq timestr (org-expiry-format-timestamp 331 (replace-regexp-in-string "\\(^<\\|>$\\)" "" 332 (cdr org-time-stamp-formats))) 333 (org-read-date nil nil nil nil d-time d-hour)) 334 org-expiry-inactive-timestamps)) 335 ;; maybe transform to inactive timestamp 336 (if org-expiry-inactive-timestamps 337 (setq timestr (concat "[" (substring timestr 1 -1) "]"))) 341 (point) org-expiry-expiry-property-name timestr)))) 343 ;;; Functions to process expired entries: 345 (defun org-expiry-archive-subtree () 346 "Archive the entry at point if it is expired." 349 (if (org-expiry-expired-p) 350 (org-archive-subtree) 351 (if (called-interactively-p 'any) 352 (message "Entry at point is not expired."))))) 354 (defun org-expiry-add-keyword (&optional keyword) 355 "Add KEYWORD to the entry at point if it is expired." 356 (interactive "sKeyword: ") 357 (if (or (member keyword org-todo-keywords-1) 358 (setq keyword org-expiry-keyword)) 360 (if (org-expiry-expired-p) 362 (if (called-interactively-p 'any) 363 (message "Entry at point is not expired.")))) 364 (error "\"%s\" is not a to-do keyword in this buffer" keyword))) 366 ;; FIXME what about using org-refile ? 368 (provide 'org-expiry) 370 ;;; org-expiry.el ends here