exot/.emacs.d
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Descend into sublists when searching for first open checkbox

Browse Source
This commit is contained in:
Daniel Borchmann 2024-07-11 21:53:56 +02:00
parent 21f5988d6a
commit 4a1509981b
No known key found for this signature in database
GPG Key ID: 784AA8DF0CCDF625
1 changed files with 55 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
site-lisp/db-org.el
View File

@ -1356,7 +1356,7 @@ inserting the checklist."
nil nil
'region)) 'region))
(db/org-goto-first-open-checkbox-in-subtree))))) (db/org-goto-first-open-checkbox-in-headline)))))
(define-obsolete-function-alias 'db/org-copy-template (define-obsolete-function-alias 'db/org-copy-template
'db/org-insert-checklist 'db/org-insert-checklist
@ -1429,45 +1429,75 @@ inserted template."
(looking-at (rx bol (* space) eol))) (looking-at (rx bol (* space) eol)))
(insert "\n")))) (insert "\n"))))
(defun db/org-goto-first-open-checkbox-in-subtree (&optional silent) (defun db/org-goto-first-open-checkbox-in-headline (&optional silent)
"Jump to first open checkbox in the current subtree. "Go to first open checkbox in the current subtree.
First search for started checkboxes, i.e. [-], and if those are First search for started checkboxes, i.e. [-], and if those are
not found, go to the first open checkbox, i.e. [ ]. not found, go to the first open checkbox, i.e. [ ]. If the item
thus found contains a sublist of checkbox items on it's own,
recursively repeat the search, until no more sublists exist that
contain open checkboxes.
If there's no such open checkbox, emit a message (unless SILENT If there's no such open checkbox, emit a message (unless SILENT
is non-nil) and stay put. is non-nil) and stay put.
Note: when lists are nested, those are not (yet) descended into Do not search through branches, i.e., stop the search when the
to find the logically first open checkbox. This should be fixed first sub-headline is found."
somewhen, though."
(unless (derived-mode-p 'org-mode) (unless (derived-mode-p 'org-mode)
(user-error "Not in Org buffer, exiting")) (user-error "Not in Org buffer, exiting"))
(save-restriction (save-restriction
(let ((original-point (point)))
(widen) (widen)
(org-back-to-heading 'invisible-ok) (org-back-to-heading 'invisible-ok)
(org-narrow-to-subtree) (org-narrow-to-subtree)
(unless ;; XXX: this needs a description of how the below algorithm works
;; Yes, those `progn's are not strictly necessary, but it feels (let ((ast (org-element-parse-buffer))
;; cleaner this way. checkbox-pos
(or (progn checkbox-node
(goto-char (point-min)) checkbox-pos-1)
(re-search-forward " \\[-\\] " nil 'no-error))
(progn (while ast
(goto-char (point-min))
(re-search-forward " \\[ \\] " nil 'no-error))) (when checkbox-pos
(unless silent ;; `checkbox-pos' might be nil when the found checkbox item is empty; in this case, `ast'
(message "No open checkbox in subtree")) ;; is not empty, and the following assignment will potentially delete the last known
(goto-char original-point))))) ;; position of a proper checkbox.
(setq checkbox-pos-1 checkbox-pos))
(setq checkbox-pos nil
checkbox-node nil)
(org-element-map ast '(item headline)
(lambda (node)
(unless (eq node ast)
(if (eq 'headline (org-element-type node))
nil ; Abort search to ignore headlines and everything that follows.
(when (and (null checkbox-pos)
(not (memq (org-element-property :checkbox node)
'(nil on))))
(setq checkbox-pos (org-element-contents-begin node)
checkbox-node node))
;; Having this `when' separately and at the end of this function results in
;; `org-element-map' terminating the search as soon as a “[-]” is found.
(when (eq 'trans (org-element-property :checkbox node))
(setq checkbox-pos (org-element-contents-begin node)
checkbox-node node)))))
nil t)
(setq ast checkbox-node))
(cond
(checkbox-pos (goto-char checkbox-pos))
(checkbox-pos-1 (goto-char checkbox-pos-1))
(t (unless silent
(message "No open checkbox in subtree")))))))
(defun db/org-clock-goto-first-open-checkbox (&optional select) (defun db/org-clock-goto-first-open-checkbox (&optional select)
"Go to the currently clocked-in item or most recently clocked item. "Go to the currently clocked-in item or most recently clocked item.
Move point to first open checkbox there, if there's one. See Move point to first open checkbox there, if there's one. See
`db/org-goto-first-open-checkbox-in-subtree' for details. `db/org-goto-first-open-checkbox-in-headline' for details.
If SELECT is non-nil, offer a choice of the most recently If SELECT is non-nil, offer a choice of the most recently
clocked-in tasks to jump to." clocked-in tasks to jump to."
@ -1494,7 +1524,7 @@ clocked-in tasks to jump to."
(goto-char m) (goto-char m)
(org-fold-show-entry) (org-fold-show-entry)
(org-fold-hide-drawer-all) (org-fold-hide-drawer-all)
(db/org-goto-first-open-checkbox-in-subtree :silent) (db/org-goto-first-open-checkbox-in-headline :silent)
(org-reveal) (org-reveal)
(if recent (if recent
(message "No running clock, this is the most recently clocked task")) (message "No running clock, this is the most recently clocked task"))