diff options
Diffstat (limited to 'contrib/lisp/org-expiry.el')
| -rw-r--r-- | contrib/lisp/org-expiry.el | 361 |
1 files changed, 361 insertions, 0 deletions
diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el new file mode 100644 index 0000000..9f4517d --- /dev/null +++ b/contrib/lisp/org-expiry.el @@ -0,0 +1,361 @@ +;;; org-expiry.el --- expiry mechanism for Org entries +;; +;; Copyright 2007-2012 Free Software Foundation, Inc. +;; +;; Author: bzg AT gnu DOT org +;; Version: 0.2 +;; Keywords: org expiry + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; +;; This gives you a chance to get rid of old entries in your Org files +;; by expiring them. +;; +;; By default, entries that have no EXPIRY property are considered to be +;; new (i.e. 0 day old) and only entries older than one year go to the +;; expiry process, which consist in adding the ARCHIVE tag. None of +;; your tasks will be deleted with the default settings. +;; +;; When does an entry expires? +;; +;; Consider this entry: +;; +;; * Stop watching TV +;; :PROPERTIES: +;; :CREATED: <2008-01-07 lun 08:01> +;; :EXPIRY: <2008-01-09 08:01> +;; :END: +;; +;; This entry will expire on the 9th, january 2008. + +;; * Stop watching TV +;; :PROPERTIES: +;; :CREATED: <2008-01-07 lun 08:01> +;; :EXPIRY: +1w +;; :END: +;; +;; This entry will expire on the 14th, january 2008, one week after its +;; creation date. +;; +;; What happen when an entry is expired? Nothing until you explicitely +;; M-x org-expiry-process-entries When doing this, org-expiry will check +;; for expired entries and request permission to process them. +;; +;; Processing an expired entries means calling the function associated +;; with `org-expiry-handler-function'; the default is to add the tag +;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive +;; the subtree. +;; +;; Is this useful? Well, when you're in a brainstorming session, it +;; might be useful to know about the creation date of an entry, and be +;; able to archive those entries that are more than xxx days/weeks old. +;; +;; When you're in such a session, you can insinuate org-expiry like +;; this: M-x org-expiry-insinuate +;; +;; Then, each time you're pressing M-RET to insert an item, the CREATION +;; property will be automatically added. Same when you're scheduling or +;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate + +;;; Code: + +;;; User variables: + +(defgroup org-expiry nil + "Org expiry process." + :tag "Org Expiry" + :group 'org) + +(defcustom org-expiry-inactive-timestamps nil + "Insert inactive timestamps for the created and expired time properties" + :type 'boolean + :group 'org-expiry) + +(defcustom org-expiry-created-property-name "CREATED" + "The name of the property for setting the creation date." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-expiry-property-name "EXPIRY" + "The name of the property for setting the expiry date/delay." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-keyword "EXPIRED" + "The default keyword for `org-expiry-add-keyword'." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-wait "+1y" + "Time span between the creation date and the expiry. +The default value for this variable (\"+1y\") means that entries +will expire if there are at least one year old. + +If the expiry delay cannot be retrieved from the entry or the +subtree above, the expiry process compares the expiry delay with +`org-expiry-wait'. This can be either an ISO date or a relative +time specification. See `org-read-date' for details." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-created-date "+0d" + "The default creation date. +The default value of this variable (\"+0d\") means that entries +without a creation date will be handled as if they were created +today. + +If the creation date cannot be retrieved from the entry or the +subtree above, the expiry process will compare the expiry delay +with this date. This can be either an ISO date or a relative +time specification. See `org-read-date' for details on relative +time specifications." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-handler-function 'org-toggle-archive-tag + "Function to process expired entries. +Possible candidates for this function are: + +`org-toggle-archive-tag' +`org-expiry-add-keyword' +`org-expiry-archive-subtree'" + :type 'function + :group 'org-expiry) + +(defcustom org-expiry-confirm-flag t + "Non-nil means confirm expiration process." + :type '(choice + (const :tag "Always require confirmation" t) + (const :tag "Do not require confirmation" nil) + (const :tag "Require confirmation in interactive expiry process" + interactive)) + :group 'org-expiry) + +(defcustom org-expiry-advised-functions + '(org-scheduled org-deadline org-time-stamp) + "A list of advised functions. +`org-expiry-insinuate' will activate the expiry advice for these +functions. `org-expiry-deinsinuate' will deactivate them." + :type 'boolean + :group 'list) + +;;; Advices and insinuation: + +(defadvice org-schedule (after org-schedule-update-created) + "Update the creation-date property when calling `org-schedule'." + (org-expiry-insert-created)) + +(defadvice org-deadline (after org-deadline-update-created) + "Update the creation-date property when calling `org-deadline'." + (org-expiry-insert-created)) + +(defadvice org-time-stamp (after org-time-stamp-update-created) + "Update the creation-date property when calling `org-time-stamp'." + (org-expiry-insert-created)) + +(defun org-expiry-insinuate (&optional arg) + "Add hooks and activate advices for org-expiry. +If ARG, also add a hook to `before-save-hook' in `org-mode' and +restart `org-mode' if necessary." + (interactive "P") + (ad-activate 'org-schedule) + (ad-activate 'org-time-stamp) + (ad-activate 'org-deadline) + (add-hook 'org-insert-heading-hook 'org-expiry-insert-created) + (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created) + (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created) + (when arg + (add-hook 'org-mode-hook + (lambda() (add-hook 'before-save-hook + 'org-expiry-process-entries t t))) + ;; need this to refresh org-mode hooks + (when (eq major-mode 'org-mode) + (org-mode) + (if (org-called-interactively-p) + (message "Org-expiry insinuated, `org-mode' restarted."))))) + +(defun org-expiry-deinsinuate (&optional arg) + "Remove hooks and deactivate advices for org-expiry. +If ARG, also remove org-expiry hook in Org's `before-save-hook' +and restart `org-mode' if necessary." + (interactive "P") + (ad-deactivate 'org-schedule) + (ad-deactivate 'org-time-stamp) + (ad-deactivate 'org-deadline) + (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created) + (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created) + (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created) + (remove-hook 'org-mode-hook + (lambda() (add-hook 'before-save-hook + 'org-expiry-process-entries t t))) + (when arg + ;; need this to refresh org-mode hooks + (when (eq major-mode 'org-mode) + (org-mode) + (if (org-called-interactively-p) + (message "Org-expiry de-insinuated, `org-mode' restarted."))))) + +;;; org-expiry-expired-p: + +(defun org-expiry-expired-p () + "Check if the entry at point is expired. +Return nil if the entry is not expired. Otherwise return the +amount of time between today and the expiry date. + +If there is no creation date, use `org-expiry-created-date'. +If there is no expiry date, use `org-expiry-expiry-date'." + (let* ((ex-prop org-expiry-expiry-property-name) + (cr-prop org-expiry-created-property-name) + (ct (current-time)) + (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d"))) + (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait)) + (ex (if (string-match "^[ \t]?[+-]" ex-field) + (time-add cr (time-subtract (org-read-date nil t ex-field) ct)) + (org-read-date nil t ex-field)))) + (if (time-less-p ex ct) + (time-subtract ct ex)))) + +;;; Expire an entry or a region/buffer: + +(defun org-expiry-process-entry (&optional force) + "Call `org-expiry-handler-function' on entry. +If FORCE is non-nil, don't require confirmation from the user. +Otherwise rely on `org-expiry-confirm-flag' to decide." + (interactive "P") + (save-excursion + (when (org-called-interactively-p) (org-reveal)) + (when (org-expiry-expired-p) + (org-back-to-heading) + (looking-at org-complex-heading-regexp) + (let* ((ov (make-overlay (point) (match-end 0))) + (e (org-expiry-expired-p)) + (d (time-to-number-of-days e))) + (overlay-put ov 'face 'secondary-selection) + (if (or force + (null org-expiry-confirm-flag) + (and (eq org-expiry-confirm-flag 'interactive) + (not (interactive))) + (and org-expiry-confirm-flag + (y-or-n-p (format "Entry expired by %d days. Process? " d)))) + (funcall 'org-expiry-handler-function)) + (delete-overlay ov))))) + +(defun org-expiry-process-entries (beg end) + "Process all expired entries between BEG and END. +The expiry process will run the function defined by +`org-expiry-handler-functions'." + (interactive "r") + (save-excursion + (let ((beg (if (org-region-active-p) + (region-beginning) (point-min))) + (end (if (org-region-active-p) + (region-end) (point-max)))) + (goto-char beg) + (let ((expired 0) (processed 0)) + (while (and (outline-next-heading) (< (point) end)) + (when (org-expiry-expired-p) + (setq expired (1+ expired)) + (if (if (org-called-interactively-p) + (call-interactively 'org-expiry-process-entry) + (org-expiry-process-entry)) + (setq processed (1+ processed))))) + (if (equal expired 0) + (message "No expired entry") + (message "Processed %d on %d expired entries" + processed expired)))))) + +;;; Insert created/expiry property: + +(defun org-expiry-insert-created (&optional arg) + "Insert or update a property with the creation date. +If ARG, always update it. With one `C-u' prefix, silently update +to today's date. With two `C-u' prefixes, prompt the user for to +update the date." + (interactive "P") + (let* ((d (org-entry-get (point) org-expiry-created-property-name)) + d-time d-hour timestr) + (when (or (null d) arg) + ;; update if no date or non-nil prefix argument + ;; FIXME Use `org-time-string-to-time' + (setq d-time (if d (org-time-string-to-time d) + (current-time))) + (setq d-hour (format-time-string "%H:%M" d-time)) + (setq timestr + ;; two C-u prefixes will call org-read-date + (if (equal arg '(16)) + (concat "<" (org-read-date + nil nil nil nil d-time d-hour) ">") + (format-time-string (cdr org-time-stamp-formats)))) + ;; maybe transform to inactive timestamp + (if org-expiry-inactive-timestamps + (setq timestr (concat "[" (substring timestr 1 -1) "]"))) + (save-excursion + (org-entry-put + (point) org-expiry-created-property-name timestr))))) + +(defun org-expiry-insert-expiry (&optional today) + "Insert a property with the expiry date. +With one `C-u' prefix, don't prompt interactively for the date +and insert today's date." + (interactive "P") + (let* ((d (org-entry-get (point) org-expiry-expiry-property-name)) + d-time d-hour) + (setq d-time (if d (org-time-string-to-time d) + (current-time))) + (setq d-hour (format-time-string "%H:%M" d-time)) + (setq timestr (if today + (format-time-string (cdr org-time-stamp-formats)) + (concat "<" (org-read-date + nil nil nil nil d-time d-hour) ">"))) + ;; maybe transform to inactive timestamp + (if org-expiry-inactive-timestamps + (setq timestr (concat "[" (substring timestr 1 -1) "]"))) + + (save-excursion + (org-entry-put + (point) org-expiry-expiry-property-name timestr)))) + +;;; Functions to process expired entries: + +(defun org-expiry-archive-subtree () + "Archive the entry at point if it is expired." + (interactive) + (save-excursion + (if (org-expiry-expired-p) + (org-archive-subtree) + (if (org-called-interactively-p) + (message "Entry at point is not expired."))))) + +(defun org-expiry-add-keyword (&optional keyword) + "Add KEYWORD to the entry at point if it is expired." + (interactive "sKeyword: ") + (if (or (member keyword org-todo-keywords-1) + (setq keyword org-expiry-keyword)) + (save-excursion + (if (org-expiry-expired-p) + (org-todo keyword) + (if (org-called-interactively-p) + (message "Entry at point is not expired.")))) + (error "\"%s\" is not a to-do keyword in this buffer" keyword))) + +;; FIXME what about using org-refile ? + +(provide 'org-expiry) + +;;; org-expiry.el ends here |