ADD expire and days-to-live properties

This commit is contained in:
Nathan Dwarshuis 2021-04-02 00:29:17 -04:00
parent 4d44d2833d
commit 776c88de7a
2 changed files with 78 additions and 16 deletions

View File

@ -2226,8 +2226,9 @@ The built-in =effort= is used as the fourth and final homonymous GTD context (th
Also here are the properties for repeated tasks and a few others (see comments in code). Also here are the properties for repeated tasks and a few others (see comments in code).
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(mapc (lambda (i) (add-to-list 'org-default-properties i)) (mapc (lambda (i) (add-to-list 'org-default-properties i))
; defines a repeater group (list
'("PARENT_TYPE" ;; defines a repeater group
"PARENT_TYPE"
;; defines the time shift for repeater groups ;; defines the time shift for repeater groups
"TIME_SHIFT" "TIME_SHIFT"
@ -2238,11 +2239,17 @@ Also here are the properties for repeated tasks and a few others (see comments i
;; defines a goal ;; defines a goal
"GOAL" "GOAL"
"X-ROUTINE"
;; for sorting routines in the agenda ;; for sorting routines in the agenda
"X-ROUTINE"
;; date of header creation ;; date of header creation
"CREATED")) "CREATED"
;; date of header expiration
"X-EXPIRE"
;; days before a header expires
"X-DAYS_TO_LIVE"))
(setq org-global-properties (setq org-global-properties
'(("PARENT_TYPE_ALL" . "periodical iterator") '(("PARENT_TYPE_ALL" . "periodical iterator")
@ -3201,6 +3208,7 @@ original org entry before executing BODY."
(defconst nd/org-x-task-status-priorities (defconst nd/org-x-task-status-priorities
'((:archivable . -1) '((:archivable . -1)
(:complete . -1) (:complete . -1)
(:expired . 0)
(:done-unclosed . 0) (:done-unclosed . 0)
(:undone-closed . 0) (:undone-closed . 0)
(:active . 1) (:active . 1)

View File

@ -5,7 +5,7 @@
;; Author: Nathan Dwarshuis <natedwarshuis@gmail.com> ;; Author: Nathan Dwarshuis <natedwarshuis@gmail.com>
;; Keywords: org-mode, outlines ;; Keywords: org-mode, outlines
;; Homepage: https://github.com/ndwarshuis/org-x ;; Homepage: https://github.com/ndwarshuis/org-x
;; Package-Requires: ((emacs "25") (dash "2.15")) ;; Package-Requires: ((emacs "27.2") (dash "2.18"))
;; Version: 0.0.1 ;; Version: 0.0.1
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
@ -192,6 +192,24 @@ to REF-TIME. Returns nil if no timestamp is found."
(lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP")))) (lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP"))))
(when (and ts (not (cl-find ?+ ts))) (org-2ft ts)))))) (when (and ts (not (cl-find ?+ ts))) (org-2ft ts))))))
(defun org-x-is-expired-date-headline-p ()
(org-x-heading-compare-timestamp
(lambda () (-some-> (org-entry-get nil "X-EXPIRE")
(org-2ft ts)))))
(defun org-x-is-expired-dtl-headline-p ()
(org-x-heading-compare-timestamp
(lambda () (let ((dtl (org-entry-get nil "X-DAYS_TO_LIVE"))
(created (org-entry-get nil "CREATED")))
(when (and dtl (s-matches-p "[0-9]+" dtl) created)
(+ (org-2ft created)
(* (string-to-number dtl) 24 60 60)))))))
(defun org-x-is-expired-headline-p ()
;; NOTE: this will return the dtl ft even if the date ft is less
(or (org-x-is-expired-dtl-headline-p)
(org-x-is-expired-date-headline-p)))
(defun org-x-is-fresh-heading-p () (defun org-x-is-fresh-heading-p ()
"Return timestamp if current heading is fresh." "Return timestamp if current heading is fresh."
(org-x-heading-compare-timestamp 'org-x-is-timestamped-heading-p nil t)) (org-x-heading-compare-timestamp 'org-x-is-timestamped-heading-p nil t))
@ -255,6 +273,8 @@ to REF-TIME. Returns nil if no timestamp is found."
(cond (cond
((org-x-is-archivable-heading-p) ((org-x-is-archivable-heading-p)
:archivable) :archivable)
((and (not (member kw org-done-keywords)) (org-x-is-expired-headline-p))
:expired)
((org-x-is-inert-p) ((org-x-is-inert-p)
:inert) :inert)
((and (member kw org-done-keywords) (not (org-x-is-closed-heading-p))) ((and (member kw org-done-keywords) (not (org-x-is-closed-heading-p)))
@ -1210,9 +1230,18 @@ H is a string like +prop or -prop"
;; advice ;; advice
;; The =org-tags-view= can filter tags for only headings with TODO keywords (with type tags-todo), but this automatically excludes keywords in =org-done-keywords=. Therefore, if I want to include these in any custom agenda blocks, I need to use type tags instead and skip the unwanted TODO keywords with a skip function. This is far slower as it applies the skip function to EVERY heading. ;; The =org-tags-view= can filter tags for only headings with TODO keywords
;; Fix that here by nullifying =org--matcher-tags-todo-only= which controls how the matcher is created for tags and tags-todo. Now I can select done keywords using a match string like "+tag/DONE|CANC" (also much clearer in my opinion). ;; (with type tags-todo), but this automatically excludes keywords in
;; While this is usually more efficient, it may be counterproductive in cases where skip functions can be used to ignore huge sections of an org file (which is rarely for me; most only skip ahead to the next heading). ;; =org-done-keywords=. Therefore, if I want to include these in any custom
;; agenda blocks, I need to use type tags instead and skip the unwanted TODO
;; keywords with a skip function. This is far slower as it applies the skip
;; function to EVERY heading. Fix that here by nullifying
;; =org--matcher-tags-todo-only= which controls how the matcher is created for
;; tags and tags-todo. Now I can select done keywords using a match string like
;; "+tag/DONE|CANC" (also much clearer in my opinion). While this is usually
;; more efficient, it may be counterproductive in cases where skip functions can
;; be used to ignore huge sections of an org file (which is rarely for me; most
;; only skip ahead to the next heading).
(defun org-x-tags-view-advice (orig-fn &optional todo-only match) (defun org-x-tags-view-advice (orig-fn &optional todo-only match)
"Advice to include done states in `org-tags-view' for tags-todo agenda types." "Advice to include done states in `org-tags-view' for tags-todo agenda types."
@ -1236,6 +1265,31 @@ Applies only to todo entries unless ALWAYS is t."
(org-ml-update-this-headline* (org-ml-update-this-headline*
(org-ml-headline-map-node-properties* (cons np it) it)))) (org-ml-headline-map-node-properties* (cons np it) it))))
(defun org-x-set-expired-time (&optional arg)
"Set the expired time of the current headline.
If ARG is non-nil use long timestamp format."
(interactive "P")
(-when-let (ut (-some->> (org-read-date nil t)
(float-time)
(round)))
(let ((np (->> (if arg (org-ml-unixtime-to-time-long ut)
(org-ml-unixtime-to-time-short ut))
(org-ml-build-timestamp!)
(org-ml-to-string)
(org-ml-build-node-property "X-EXPIRE"))))
(org-ml-update-this-headline*
(org-ml-headline-map-node-properties* (cons np it) it)))))
(defun org-x-set-dtl ()
"Set days-to-live of the current headline."
(interactive)
(let ((n (read-string "Days to live: ")))
(if (not (s-matches-p "[0-9]+" n))
(message "Enter a number")
(let ((np (org-ml-build-node-property "X-DAYS_TO_LIVE" n)))
(org-ml-update-this-headline*
(org-ml-headline-map-node-properties* (cons np it) it))))))
(advice-add 'org-insert-heading :after #'org-x-set-creation-time) (advice-add 'org-insert-heading :after #'org-x-set-creation-time)
(add-hook 'org-capture-before-finalize-hook #'org-x-set-creation-time) (add-hook 'org-capture-before-finalize-hook #'org-x-set-creation-time)