awesome-emacs/nursery
1
0
Fork 0
mirror of https://github.com/chrisbarrett/nursery synced 2025-08-19 13:43:32 -05:00
Code Issues Packages Projects Releases Wiki Activity

Teach org-roam-review actions to work on a selection of nodes

Browse Source
This commit is contained in:
Chris Barrett
2023-02-17 11:21:48 +13:00
parent 12cabfa706
commit 13bedff0ff
1 changed files with 83 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

132
lisp/org-roam-review.el
View File

@@ -661,34 +661,59 @@ them as reviewed with `org-roam-review-accept',
(when (oref section node) (when (oref section node)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(put-text-property (line-beginning-position) (line-end-position) 'face 'font-lock-comment-face)) (put-text-property (line-beginning-position) (line-end-position) 'face 'font-lock-comment-face))
(magit-section-hide section)) (magit-section-hide section))))))))
(org-roam-review--forward-to-uncommented-sibling)))))))
(defmacro org-roam-review--transform-selected-sections (&rest body)
"Execute BODY, possibly over multiple sections.
Return the affected sections."
(declare (indent 0))
`(progn
(if-let* ((sections (-list (or (magit-region-sections) (magit-section-at)))))
(dolist (section sections)
(goto-char (oref section start))
(let ((buf (current-buffer))
(result (progn ,@body)))
(when (buffer-live-p buf)
(with-current-buffer buf
(deactivate-mark)
(magit-section-deactivate-mark)
(magit-section-update-highlight)))
result))
,@body)
(org-roam-review--forward-to-uncommented-sibling)))
;;;###autoload ;;;###autoload
(defun org-roam-review-accept () (defun org-roam-review-accept ()
"Confirm review of the current node." "Confirm review of the current node."
(interactive) (interactive)
(org-roam-review--update-review-buffer-entry (let ((count 0))
(org-roam-review--visiting-node-at-point (org-roam-review--transform-selected-sections
(when-let* ((maturity (org-entry-get-with-inheritance "MATURITY"))) (cl-incf count)
(org-roam-review--update-node-srs-properties maturity org-roam-review--maturity-score-ok)) (org-roam-review--update-review-buffer-entry
(org-roam-review--update-workspace-for-completed-review) (org-roam-review--visiting-node-at-point
(run-hooks 'org-roam-review-node-accepted-hook) (when-let* ((maturity (org-entry-get-with-inheritance "MATURITY")))
(run-hooks 'org-roam-review-node-processed-hook) (org-roam-review--update-node-srs-properties maturity org-roam-review--maturity-score-ok))
(message "Node scheduled for future review")))) (org-roam-review--update-workspace-for-completed-review)
(run-hooks 'org-roam-review-node-accepted-hook)
(run-hooks 'org-roam-review-node-processed-hook))))
(message "Node%s scheduled for future review" (if (= 1 count) "" "s"))))
;;;###autoload ;;;###autoload
(defun org-roam-review-bury () (defun org-roam-review-bury ()
"Confirm review of the current node and bury it." "Confirm review of the current node and bury it."
(interactive) (interactive)
(org-roam-review--update-review-buffer-entry (let ((count 0))
(org-roam-review--visiting-node-at-point (org-roam-review--transform-selected-sections
(when-let* ((maturity (org-entry-get-with-inheritance "MATURITY"))) (cl-incf count)
(org-roam-review--update-node-srs-properties maturity org-roam-review--maturity-score-bury)) (org-roam-review--update-review-buffer-entry
(org-roam-review--update-workspace-for-completed-review) (org-roam-review--visiting-node-at-point
(run-hooks 'org-roam-review-node-buried-hook) (when-let* ((maturity (org-entry-get-with-inheritance "MATURITY")))
(run-hooks 'org-roam-review-node-processed-hook) (org-roam-review--update-node-srs-properties maturity org-roam-review--maturity-score-bury))
(message "Node buried")))) (org-roam-review--update-workspace-for-completed-review)
(run-hooks 'org-roam-review-node-buried-hook)
(run-hooks 'org-roam-review-node-processed-hook))))
(message "Node%s buried" (if (= 1 count) "" "s"))))
(defun org-roam-review--skip-node-for-maturity-assignment-p () (defun org-roam-review--skip-node-for-maturity-assignment-p ()
(org-with-wide-buffer (org-with-wide-buffer
@@ -702,13 +727,14 @@ them as reviewed with `org-roam-review-accept',
With prefix arg BURY, the node is less likely to be surfaced in With prefix arg BURY, the node is less likely to be surfaced in
the future." the future."
(interactive "P") (interactive "P")
(let ((score (if bury (org-roam-review--transform-selected-sections
org-roam-review--maturity-score-bury (let ((score (if bury
org-roam-review--maturity-score-ok))) org-roam-review--maturity-score-bury
(org-roam-review--update-review-buffer-entry org-roam-review--maturity-score-ok)))
(org-roam-review--visiting-node-at-point (org-roam-review--update-review-buffer-entry
(unless (org-roam-review--skip-node-for-maturity-assignment-p) (org-roam-review--visiting-node-at-point
(org-roam-review--update-node-srs-properties "budding" score)))))) (unless (org-roam-review--skip-node-for-maturity-assignment-p)
(org-roam-review--update-node-srs-properties "budding" score)))))))
;;;###autoload ;;;###autoload
(defun org-roam-review-set-seedling (&optional bury) (defun org-roam-review-set-seedling (&optional bury)
@@ -717,13 +743,14 @@ the future."
With prefix arg BURY, the node is less likely to be surfaced in With prefix arg BURY, the node is less likely to be surfaced in
the future." the future."
(interactive "P") (interactive "P")
(let ((score (if bury (org-roam-review--transform-selected-sections
org-roam-review--maturity-score-bury (let ((score (if bury
org-roam-review--maturity-score-revisit))) org-roam-review--maturity-score-bury
(org-roam-review--update-review-buffer-entry org-roam-review--maturity-score-revisit)))
(org-roam-review--visiting-node-at-point (org-roam-review--update-review-buffer-entry
(unless (org-roam-review--skip-node-for-maturity-assignment-p) (org-roam-review--visiting-node-at-point
(org-roam-review--update-node-srs-properties "seedling" score)))))) (unless (org-roam-review--skip-node-for-maturity-assignment-p)
(org-roam-review--update-node-srs-properties "seedling" score)))))))
;;;###autoload ;;;###autoload
(defun org-roam-review-set-evergreen (&optional bury) (defun org-roam-review-set-evergreen (&optional bury)
@@ -732,13 +759,14 @@ the future."
With prefix arg BURY, the node is less likely to be surfaced in With prefix arg BURY, the node is less likely to be surfaced in
the future." the future."
(interactive "P") (interactive "P")
(let ((score (if bury (org-roam-review--transform-selected-sections
org-roam-review--maturity-score-bury (let ((score (if bury
org-roam-review--maturity-score-ok))) org-roam-review--maturity-score-bury
(org-roam-review--update-review-buffer-entry org-roam-review--maturity-score-ok)))
(org-roam-review--visiting-node-at-point (org-roam-review--update-review-buffer-entry
(unless (org-roam-review--skip-node-for-maturity-assignment-p) (org-roam-review--visiting-node-at-point
(org-roam-review--update-node-srs-properties "evergreen" score)))))) (unless (org-roam-review--skip-node-for-maturity-assignment-p)
(org-roam-review--update-node-srs-properties "evergreen" score)))))))
(defun org-roam-review--delete-tags-and-properties (node-id) (defun org-roam-review--delete-tags-and-properties (node-id)
(let ((message-log-max)) (let ((message-log-max))
@@ -756,16 +784,22 @@ the future."
This deletes all the properties and tags managed by this This deletes all the properties and tags managed by this
package." package."
(interactive) (interactive)
(org-roam-review--update-review-buffer-entry (let ((titles))
(org-roam-review--visiting-node-at-point (org-roam-review--transform-selected-sections
(let ((id (org-entry-get (point-min) "ID"))) (org-roam-review--update-review-buffer-entry
(unless id (org-roam-review--visiting-node-at-point
(error "No ID in buffer")) (let ((id (org-entry-get (point-min) "ID")))
(org-with-point-at (org-find-property "ID" id) (unless id
(org-roam-review--delete-tags-and-properties id) (error "No ID in buffer"))
(save-buffer)) (org-with-point-at (org-find-property "ID" id)
(let ((title (org-roam-node-title (org-roam-node-from-id id)))) (org-roam-review--delete-tags-and-properties id)
(message "Excluded node `%s' from reviews" title)))))) (save-buffer))
(let ((title (org-roam-node-title (org-roam-node-from-id id))))
(push title titles))))))
(if (equal 1 (length titles))
(message "Excluded node `%s' from reviews" (car titles))
(message "Excluded %s nodes from reviews" (length titles)))))
(provide 'org-roam-review) (provide 'org-roam-review)