ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

REF remove unused functions and clean up docstrings

This commit is contained in:
Nathan Dwarshuis 2021-04-03 22:33:20 -04:00
parent 7e7dde8f05
commit 485c2e376b
2 changed files with 89 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/conf.org
View File

@ -3102,7 +3102,7 @@ earlier ones."
((max-ts
(lambda ()
(-some-->
(org-x-element-parse-headline)
(org-ml-parse-this-headline)
(org-element-map it 'timestamp #'identity)
(--filter
(memq (org-element-property :type it) '(active active-range))

225
local/lib/org-x/org-x.el
View File

@ -69,21 +69,8 @@ entire subtrees to save time and ignore tasks")
;; org-element
(defun org-x-element-parse-headline (&optional granularity subtree)
"Like `org-element-parse-buffer' but on only one headline. Assumes
that point is currently on the starting line of the headline in
question. if SUBTREE is t, return all the subheadings under this
heading."
;; (line-beginning-position)
(let ((start (point))
(end (if subtree
(save-excursion (org-end-of-subtree))
(save-excursion (outline-next-heading) (point)))))
(-> (org-element--parse-elements
start end 'first-section nil granularity nil nil)
car)))
(defun org-x-element-first-lb-entry (headline)
"Return epoch time of most recent logbook item or clock from HEADLINE."
(let* ((config (list :log-into-drawer org-log-into-drawer
:clock-into-drawer org-clock-into-drawer
:clock-out-notes org-log-note-clock-out))
@ -114,13 +101,16 @@ If it does not have a date, it will return nil."
(let ((ts (org-entry-get nil timestamp-property)))
(when ts (org-2ft ts))))
(defun org-x-heading-compare-timestamp (timestamp-fun
&optional ref-time future)
"Returns the timestamp (from TIMESTAMP-FUN on the current heading)
if timestamp is futher back in time compared to a REF-TIME (default to
0 which is now, where negative is past and positive is future). If the
FUTURE flag is t, returns timestamp if it is in the future compared
to REF-TIME. Returns nil if no timestamp is found."
;; TODO I don't like this function...it perplexes me
(defun org-x-heading-compare-timestamp (timestamp-fun &optional ref-time future)
"Compare timestamp to some reference time.
TIMESTAMP-FUN is a function that returns a timestamp when called
on the headline in question. Return t if the returned timestamp
is further back in time compared to REF-TIME (default to 0 which
is now, where negative is past and positive is future). If the
FUTURE flag is t, returns timestamp if it is in the future
compared to REF-TIME. Returns nil if no timestamp is found."
(let* ((timestamp (funcall timestamp-fun))
(ref-time (or ref-time 0)))
(if (and timestamp
@ -156,11 +146,13 @@ 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\"."
(org-x-heading-compare-timestamp
(lambda () (-some-> (org-entry-get nil "X-EXPIRE")
(org-2ft)))))
(defun org-x-is-expired-dtl-headline-p ()
"Return timestamp if current headline is expired via \"X-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")))
@ -169,9 +161,11 @@ to REF-TIME. Returns nil if no timestamp is found."
(* (string-to-number dtl) 24 60 60)))))))
(defun org-x-is-expired-headline-p ()
"Return t if current headline is expired."
;; 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)))
(and (or (org-x-is-expired-dtl-headline-p)
(org-x-is-expired-date-headline-p))
t))
(defun org-x-is-fresh-heading-p ()
"Return timestamp if current heading is fresh."
@ -324,8 +318,10 @@ to REF-TIME. Returns nil if no timestamp is found."
"Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP."
`(,op (cl-position ,sc1 ,sc-list) (cl-position ,sc2 ,sc-list)))
(defun org-x-descend-into-project
(allowed-statuscodes trans-tbl get-task-status callback-fun)
;; TODO there is likely a better way to handle this
(defun org-x-descend-into-project (allowed-statuscodes trans-tbl
get-task-status
callback-fun)
"Loop through (sub)project and return overall statuscode.
The returned statuscode is chosen from list ALLOWED-STATUSCODES where
@ -340,7 +336,10 @@ cons cells where the first member is the subproject statuscode and the
statuscode will be translated.
When a task is encountered, function GET-TASK-STATUS will be applied to
obtain a statuscode-equivalent of the status of the tasks."
obtain a statuscode-equivalent of the status of the tasks.
CALLBACK-FUN is a function to call once this is finished (which
should be this function again)."
;; define "breaker-status" as the last of the allowed-statuscodes
;; when this is encountered the loop is broken because we are done
;; (the last entry trumps all others)
@ -473,92 +472,17 @@ function will simply return the point of the next headline."
(not (cl-intersection neg-tags-list heading-tags :test 'equal)))
(org-x-skip-heading)))))
;; sorting and filtering
(defun org-x-agenda-filter-prop (a-line filter prop-fun
&optional prop-key)
"Filter for `org-agenda-before-sorting-filter-function' where
A-LINE is a line from the agenda view, FILTER is an ordered list
of property values to be filtered/sorted, and PROP-FUN is a function
that determines a property value based on the org content of the
original buffer. If PROP-KEY is supplied, assign the return value of
PROP-FUN to PROP-KEY in A-LINE's text properties. Returns either nil
if return value of PROP-FUN not in FILTER or A-LINE (modified or not)."
(let* ((m (get-text-property 1 'org-marker a-line))
(s (with-current-buffer (marker-buffer m)
(goto-char m)
(funcall prop-fun))))
(when (cl-find s filter)
(if (not prop-key) a-line
(org-add-props a-line nil prop-key s)))))
(defun org-x-agenda-regexp-replace-props (props)
(letrec
((replace-prop
(lambda (p)
(let ((prop-val (->> (thing-at-point 'line)
(get-text-property 1 (cdr p))
symbol-name))
(re (format "$%s$" (car p))))
(when prop-val
(save-excursion
(when (search-forward re (line-end-position) t 1)
(replace-match prop-val))))))))
(save-excursion
(goto-char (point-min))
(while (< (point) (point-max))
(--each props (funcall replace-prop it))
(forward-line)))))
(defun org-x-agenda-sort-prop (prop order a b)
"Sort a block agenda view by text property PROP given a list ORDER
of said text properties in the desired order and lines A and B as
inputs. To be used with `org-agenda-cmp-user-defined'."
(let* ((ta (get-text-property 1 prop a))
(tb (get-text-property 1 prop b))
(pa (cl-position ta order :test (if (stringp ta) #'equal)))
(pb (cl-position tb order :test (if (stringp tb) #'equal))))
(cond ((or (null pa) (null pb)) nil)
((< pa pb) +1)
((> pa pb) -1))))
(defun org-x-agenda-sort-multi (a b &rest funs)
"Sort lines A and B from block agenda view given functions FUNS.
Functions in FUNS must take either A or B as their arguments and
should return a positive integer indicating their rank. The FUNS
list is traversed in order, where the front is the outermost sorting
order."
(let* ((fun (car funs))
(pa (funcall fun a))
(pb (funcall fun b)))
(cond
((< pa pb) +1)
((> pa pb) -1)
(t (-some->> funs cdr (apply #'org-x-agenda-sort-multi a b))))))
(defun org-x-agenda-sort-task-todo (line)
(or
(-some-> (get-text-property 1 'todo-state line)
(cl-position org-x-agenda-todo-sort-order :test #'equal))
(length org-x-agenda-todo-sort-order)))
(defun org-x-agenda-sort-status (line order)
(or
(-some-> (get-text-property 1 'statuscode line) (cl-position order))
(length order)))
(defun org-x-agenda-sort-task-atomic (line)
(if (eq '-!- (get-text-property 1 'atomic line)) 1 0))
;; interactive functions
(defun org-x-mark-subtree-keyword (new-keyword &optional exclude no-log)
"Mark all tasks in a subtree with NEW-KEYWORD unless original
keyword is in the optional argument EXCLUDE."
"Change the todo keyword of all tasks in a subtree to NEW-KEYWORD.
If EXCLUDE is given, it should be a list of todo keywords; any headline
matching a keyword in this list will not be changed. If NO-LOG is t,
don't log changes in the logbook."
(let ((subtree-end (save-excursion (org-end-of-subtree t)))
(org-todo-log-states (unless no-log org-todo-log-states)))
(if (not (listp exclude))
(error "exlude must be a list if provided"))
(error "Exclude must be a list if provided"))
(save-excursion
(while (< (point) subtree-end)
(let ((keyword (org-x-is-todoitem-p)))
@ -572,6 +496,9 @@ keyword is in the optional argument EXCLUDE."
(org-x-mark-subtree-keyword "DONE" '("CANC")))
(defun org-x--reset-headline (headline)
"Reset HEADLINE node to incomplete state.
This includes unchecking all checkboxes, marking keywords as
\"TODO\", clearing any unique IDs, etc."
(cl-flet*
((reset
(config created-ts headline)
@ -602,6 +529,9 @@ keyword is in the optional argument EXCLUDE."
(reset config created-ts it))))))
(defun org-x--headline-repeat-shifted (n shift headline)
"Return HEADLINE repeated and shifted N times.
SHIFT is a string specifier denoting the amount to shift, eg
\"+2d\"."
(cl-flet
((convert-shift
(shift)
@ -653,11 +583,6 @@ N is the number of clones to produce."
(s-join "")))
(end (org-ml-get-property :end st)))
(org-ml-insert end ins)))
;; (save-excursion
;; (when (org-up-heading-safe)
;; (-> (org-ml-parse-this-subtree)
;; (org-ml-headline-get-subheadlines)
;; (-each #'org-ml-fold))))))
(defun org-x-clone-subtree-with-time-shift-toplevel (n)
"Like `org-clone-subtree-with-time-shift' except reset items and todos.
@ -705,8 +630,8 @@ N is the number of clones to produce."
(defun org-x-clock-range (&optional arg)
"Add a completed clock entry to the current heading.
Does not touch the running clock. When called with one C-u prefix
argument, ask for a range in minutes in place of the second date."
Does not touch the running clock. When called with one prefix
ARG, ask for a range in minutes in place of the second date."
(interactive "P")
(let* ((t1 (-> (org-read-date t t) (float-time)))
(t2 (if (equal arg '(4))
@ -731,28 +656,30 @@ argument, ask for a range in minutes in place of the second date."
(insert))))))))
(defmacro org-x-agenda-cmd-wrapper (get-head &rest body)
"Wraps commands in BODY in necessary code to allow commands to be
called from the agenda buffer. Particularly, this wrapper will
navigate to the original header, execute BODY, then update the agenda
buffer."
'(org-agenda-check-no-diary)
`(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
newhead)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-show-context 'agenda)
,@body
(when ,get-head (setq newhead (org-get-heading))))
(if ,get-head
(org-agenda-change-all-lines newhead hdmarker)
(org-agenda-redo))
(beginning-of-line 1))))
"Execute BODY in context of agenda buffer.
Specifically, navigate to the original header, execute BODY, then
update the agenda buffer. If GET-HEAD is true, get the headline
string and use it to update the agenda (this is only needed when
the headline changes obviously)."
`(progn
(org-agenda-check-no-diary)
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer hdmarker))
(pos (marker-position hdmarker))
(inhibit-read-only t)
newhead)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-show-context 'agenda)
,@body
(when ,get-head (setq newhead (org-get-heading))))
(if ,get-head
(org-agenda-change-all-lines newhead hdmarker)
(org-agenda-redo))
(beginning-of-line 1)))))
(defun org-x-agenda-toggle-checkbox ()
"Toggle checkboxes in org agenda view using `org-toggle-checkbox'."
@ -777,7 +704,7 @@ It will clone the last entry in the selected subtree."
(call-interactively #'org-x-delete-subtree)))
(defun org-x-agenda-clock-range ()
"Apply `org-x-clock-range' to an agenda entry"
"Apply `org-x-clock-range' to an agenda entry."
(interactive)
(org-x-agenda-cmd-wrapper
nil
@ -890,12 +817,13 @@ If BACK is t seek backward, else forward. Ignore blank lines."
;; to different filter types). Note this does not give a shiny indicator at the
;; bottom of spaceline like the built-in filter does...oh well.
(defun org-x-agenda-filter-make-matcher-prop
(filter type &rest _args)
"Return matching matcher form for FILTER and TYPE where TYPE is not
in the regular `org-agenda-filter-make-matcher' function. This is
intended to be uses as :before-until advice and will return nil if
the type is not valid (which is currently 'prop')"
(defun org-x-agenda-filter-make-matcher-prop (filter type &rest _args)
"Override the standard match filter.
This will return matching matcher form for FILTER and TYPE
where TYPE is not in the regular `org-agenda-filter-make-matcher'
function. This is intended to be uses as :before-until advice and
will return nil if the type is not valid (which is currently
'prop')"
(let (f)
;; has property
(cond
@ -905,7 +833,7 @@ the type is not valid (which is currently 'prop')"
(if f (cons 'and (nreverse f)))))
(defun org-x-agenda-filter-make-matcher-hasprop-exp (h)
"Returns form to test the presence or absence of properties H.
"Return form to test the presence or absence of properties H.
H is a string like +prop or -prop"
(let* ((op (string-to-char h))
(h (substring h 1))
@ -917,7 +845,8 @@ H is a string like +prop or -prop"
(org-entry-get nil ,h))))))
(if (eq op ?-) (list 'not f) f)))
(defun org-x-agenda-filter-show-all-hasprop nil
(defun org-x-agenda-filter-show-all-hasprop ()
"Remove the 'hasprop filter."
(org-agenda-remove-filter 'hasprop))
(advice-add #'org-agenda-filter-make-matcher :before-until
@ -942,14 +871,16 @@ H is a string like +prop or -prop"
;; 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)
"Advice to include done states in `org-tags-view' for tags-todo agenda types."
(defun org-x-tags-view-advice (orig-fn &rest args)
"Include done states in `org-tags-view' for tags-todo agenda types.
This is meant to be used as :around advice, where ORIG-FN is the
original function being advised and ARGS are the arguments."
(nd/with-advice
((#'org-make-tags-matcher
:around (lambda (f m)
(let ((org--matcher-tags-todo-only nil))
(funcall f m)))))
(funcall orig-fn todo-only match)))
(apply orig-fn args)))
(advice-add #'org-tags-view :around #'org-x-tags-view-advice)