REF make properties DRY

This commit is contained in:
Nathan Dwarshuis 2021-04-17 00:21:33 -04:00
parent 0703e6f067
commit 0a8b7be598
2 changed files with 79 additions and 49 deletions

View File

@ -2227,39 +2227,24 @@ 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).
#+BEGIN_SRC emacs-lisp
(mapc (lambda (i) (add-to-list 'org-default-properties i))
(list
;; defines a repeater group
"PARENT_TYPE"
(setq org-default-properties (->> (list org-x-prop-parent-type
org-x-prop-time-shift
org-x-prop-thread
org-x-prop-routine
org-x-prop-created
org-x-prop-expire
org-x-prop-days-to-live)
(-union org-default-properties))
;; defines the time shift for repeater groups
"TIME_SHIFT"
org-use-property-inheritance (list org-x-prop-parent-type
org-x-prop-time-shift))
;; defines an email thread
"THREAD"
;; defines a goal
"GOAL"
;; for sorting routines in the agenda
"X-ROUTINE"
;; date of header creation
"CREATED"
;; date of header expiration
"X-EXPIRE"
;; days before a header expires
"X-DAYS_TO_LIVE"))
(setq org-global-properties
'(("PARENT_TYPE_ALL" . "periodical iterator")
("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00 :ETC")
("X-ROUTINE" . "morning evening"))
org-use-property-inheritance
'("PARENT_TYPE" "TIME_SHIFT"))
(let ((effort-choices (list "0:05" "0:15" "0:30" "1:00" "1:30" "2:00" "3:00"
"4:00" "5:00" "6:00")))
(setq org-global-properties
(list org-x-prop-parent-type-choices
(org-x-define-prop-choices org-effort-property effort-choices t)
org-x-prop-routine-choices)))
#+END_SRC
*** capture
**** templates

View File

@ -23,7 +23,10 @@
;;; Commentary:
;; XXX
;; Extra org-mode glue code I use to run my life. These are generally bits and
;; pieces that I deem useful enough to put in their own file separate from my
;; 'main' config to a) keep me sane b) test things and c) fork off into a
;; separate package if I think it is worthy (mostly (a)).
;;; Code:
@ -33,7 +36,49 @@
(require 'org)
(require 'org-x-agg)
;; constants
;;; PROPERTIES
(eval-and-compile
(defun org-x-define-prop-choices (prop options &optional allow-other)
(let ((options* (if allow-other (-snoc options ":ETC") options)))
(cons (format "%s_ALL" prop) (s-join " " options*)))))
(eval-and-compile
(defconst org-x-prop-parent-type "PARENT_TYPE"
"Property denoting iterator/periodical headline."))
(eval-and-compile
(defconst org-x-prop-parent-type-choices
(org-x-define-prop-choices org-x-prop-parent-type '("periodical" "iterator"))
"Choices for `org-x-prop-parent-type'."))
(defconst org-x-prop-time-shift "TIME_SHIFT"
"Property denoting time shift when cloning iterator/periodical headlines.")
;; TODO this is a WIP
(defconst org-x-prop-thread "THREAD"
"Property denoting an email thread to track.")
(eval-and-compile
(defconst org-x-prop-routine "X-ROUTINE"
"Property denoting a routine group."))
(eval-and-compile
(defconst org-x-prop-routine-choices
(org-x-define-prop-choices org-x-prop-routine '("morning" "evening"))
"Choices for `org-x-prop-routine'."))
(defconst org-x-prop-created "CREATED"
"Property denoting when a headline was created.")
(defconst org-x-prop-expire "X-EXPIRE"
"Property denoting when a headline will expire.")
(defconst org-x-prop-days-to-live "X-DAYS_TO_LIVE"
"Property denoting after how many days a headline will expire.")
;;; CONSTANTS
(defconst org-x-iter-future-time (* 7 24 60 60)
"Iterators must have at least one task greater into the future to be active.")
@ -142,7 +187,7 @@ compared to REF-TIME. Returns nil if no timestamp is found."
(defun org-x-is-created-heading-p ()
"Get scheduled timestamp of current heading."
(org-x-get-date-property "CREATED"))
(org-x-get-date-property org-x-prop-created))
(defun org-x-is-closed-heading-p ()
"Get closed timestamp of current heading."
@ -155,16 +200,16 @@ compared to REF-TIME. Returns nil if no timestamp is found."
(when (and ts (not (cl-find ?+ ts))) (org-2ft ts))))))
(defun org-x-is-expired-date-headline-p ()
"Return timestamp if current headline is expired via \"X-EXPIRE\"."
"Return timestamp if current headline is expired via `org-x-prop-expire'."
(org-x-heading-compare-timestamp
(lambda () (-some-> (org-entry-get nil "X-EXPIRE")
(lambda () (-some-> (org-entry-get nil org-x-prop-expire)
(org-2ft)))))
(defun org-x-is-expired-dtl-headline-p ()
"Return timestamp if current headline is expired via \"X-DAYS_TO_LIVE\"."
"Return timestamp if current headline is expired via `org-x-prop-days-to-live'."
(org-x-heading-compare-timestamp
(lambda () (let ((dtl (org-entry-get nil "X-DAYS_TO_LIVE"))
(created (org-entry-get nil "CREATED")))
(lambda () (let ((dtl (org-entry-get nil org-x-prop-days-to-live))
(created (org-entry-get nil org-x-prop-created)))
(when (and dtl (s-matches-p "[0-9]+" dtl) created)
(+ (org-2ft created)
(* (string-to-number dtl) 24 60 60)))))))
@ -200,7 +245,7 @@ compared to REF-TIME. Returns nil if no timestamp is found."
(org-ml-get-property :deadline)
(org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime)))
(created-ut (-some->> (org-ml-headline-get-node-property "CREATED" hl)
(created-ut (-some->> (org-ml-headline-get-node-property org-x-prop-created hl)
(org-2ft))))
;; not inert if headline is scheduled or deadlined in the future
(unless (or (-some->> scheduled-ut (- now) (> 0))
@ -253,11 +298,11 @@ compared to REF-TIME. Returns nil if no timestamp is found."
(defun org-x-is-periodical-heading-p ()
"Return t if heading is a periodical."
(equal "periodical" (org-entry-get nil "PARENT_TYPE" t)))
(equal "periodical" (org-entry-get nil org-x-prop-parent-type t)))
(defun org-x-is-iterator-heading-p ()
"Return t if heading is an iterator."
(equal "iterator" (org-entry-get nil "PARENT_TYPE" t)))
(equal "iterator" (org-entry-get nil org-x-prop-parent-type t)))
(defun org-x-is-habit-heading-p ()
"Return t if heading is an iterator."
@ -265,7 +310,7 @@ compared to REF-TIME. Returns nil if no timestamp is found."
(defun org-x-headline-has-effort-p ()
"Return t if heading has an effort."
(org-entry-get nil "Effort"))
(org-entry-get nil org-effort-property))
(defun org-x-headline-has-context-p ()
"Return t if heading has a context."
@ -622,7 +667,7 @@ This includes unchecking all checkboxes, marking keywords as
headline)
(org-ml-headline-map-supercontents* config
(org-ml-supercontents-set-logbook nil it))
(org-ml-headline-set-node-property "CREATED" created-ts)
(org-ml-headline-set-node-property org-x-prop-created created-ts)
(org-ml-headline-map-planning*
(if (not it) it
(org-ml-planning-set-timestamp! :closed nil it)))
@ -688,7 +733,7 @@ N is the number of clones to produce."
(interactive "nNumber of clones to produce: ")
(let* ((st (org-ml-parse-this-subtree))
(shift
(or (org-entry-get nil "TIME_SHIFT" 'selective)
(or (org-entry-get nil org-x-prop-time-shift 'selective)
(read-from-minibuffer
"Date shift per clone (e.g. +1w, empty to copy unchanged): ")))
(ins (->> (org-x--reset-headline st)
@ -706,7 +751,7 @@ N is the number of clones to produce."
((get-shift
(subtree)
(or
(org-ml-headline-get-node-property "TIME_SHIFT" subtree)
(org-ml-headline-get-node-property org-x-prop-time-shift subtree)
(read-from-minibuffer
"Shift per clone (e.g. +1w, empty to copy unchanged): "))))
(org-ml-update-this-subtree*
@ -1092,7 +1137,7 @@ original function being advised and ARGS are the arguments."
(org-ml-unixtime-to-time-long)
(org-ml-build-timestamp!)
(org-ml-to-string)
(org-ml-build-node-property "CREATED"))))
(org-ml-build-node-property org-x-prop-created))))
(org-ml-update-this-headline*
(org-ml-headline-map-node-properties* (cons np it) it))))
@ -1107,7 +1152,7 @@ If ARG is non-nil use long timestamp format."
(org-ml-unixtime-to-time-short ut))
(org-ml-build-timestamp!)
(org-ml-to-string)
(org-ml-build-node-property "X-EXPIRE"))))
(org-ml-build-node-property org-x-prop-expire))))
(org-ml-update-this-headline*
(org-ml-headline-map-node-properties* (cons np it) it)))))
@ -1117,7 +1162,7 @@ If ARG is non-nil use long timestamp format."
(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)))
(let ((np (org-ml-build-node-property org-x-prop-days-to-live n)))
(org-ml-update-this-headline*
(org-ml-headline-map-node-properties* (cons np it) it))))))