ADD agenda linking functions

This commit is contained in:
Nathan Dwarshuis 2022-04-12 22:39:25 -04:00
parent 9fa38bee29
commit 909d1f7148
4 changed files with 93 additions and 47 deletions

View File

@ -31,6 +31,9 @@
(require 'org-x-files) (require 'org-x-files)
(require 'org-x-const) (require 'org-x-const)
(eval-when-compile
(require 'org-x-macs))
;;; DATE/TIME FUNCTIONS ;;; DATE/TIME FUNCTIONS
;; current state ;; current state
@ -3678,6 +3681,11 @@ review phase)"
(t (t
(message "Cannot link child from parent in current file")))))) (message "Cannot link child from parent in current file"))))))
(defun org-x-dag-agenda-link-parent-to-child ()
(interactive)
(org-x-agenda-cmd-wrapper nil
(org-x-dag-link-parent-to-child)))
;; child -> parent linkers ;; child -> parent linkers
;; ;;
;; functions to retrieve a parent headline id and add it to the current ;; functions to retrieve a parent headline id and add it to the current
@ -3830,6 +3838,11 @@ review phase)"
(t (t
(message "Cannot link parent from child in current file")))))) (message "Cannot link parent from child in current file"))))))
(defun org-x-dag-agenda-link-child-to-parent ()
(interactive)
(org-x-agenda-cmd-wrapper nil
(org-x-dag-link-child-to-parent)))
;; add nodes ;; add nodes
(defun org-x-dag-read-string-until (prompt pred msg) (defun org-x-dag-read-string-until (prompt pred msg)

View File

@ -144,12 +144,5 @@ PATH must be relative to `org-directory' and end in '.org'."
(append (org-x-get-action-files) (append (org-x-get-action-files)
(org-x-get-incubator-files))) (org-x-get-incubator-files)))
(defmacro org-x-with-file (path &rest body)
"Open PATH and execute BODY."
(declare (indent 1))
`(with-current-buffer (find-file-noselect ,path)
(save-excursion
,@body)))
(provide 'org-x-files) (provide 'org-x-files)
;;; org-x-files.el ends here ;;; org-x-files.el ends here

View File

@ -0,0 +1,76 @@
;;; org-x-macs.el --- Org for Apple Devs ;) -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Nathan Dwarshuis
;; Author: Nathan Dwarshuis <natedwarshuis@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'org-agenda)
(require 'dash)
(defmacro org-x-with-file (path &rest body)
"Open PATH and execute BODY."
(declare (indent 1))
`(with-current-buffer (find-file-noselect ,path)
(save-excursion
,@body)))
;; lift buffer commands into agenda context
;; TODO body prints a message and update is 'update-all' then the
;; message will be overwritten
(defmacro org-x-agenda-cmd-wrapper (update &rest body)
"Execute BODY in context of agenda buffer.
Specifically, navigate to the original header, execute BODY, then
update the agenda buffer. If UPDATE is 'update-headline', get the
headline string and use it to update the agenda (this is only
needed when the headline changes obviously). When update is
'update-all', reload the entire buffer. When UPDATE is nil, do
nothing."
(declare (indent 1))
(-let* ((newhead (make-symbol "newhead"))
(hdmarker (make-symbol "hdmarker"))
((update-form get-head-form)
(cond
((eq update 'update-headline)
(list `((org-agenda-change-all-lines ,newhead ,hdmarker))
`((setq ,newhead (org-get-heading)))))
((eq update 'update-all)
(list '((org-agenda-redo))
nil)))))
`(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
,@get-head-form)
,@update-form
(beginning-of-line 1))))))
(provide 'org-x-macs)
;;; org-x-macs.el ends here

View File

@ -39,6 +39,9 @@
(require 'org-x-agg) (require 'org-x-agg)
(require 'org-x-dag) (require 'org-x-dag)
(eval-when-compile
(require 'org-x-macs))
;;; INTERNAL CONSTANTS ;;; INTERNAL CONSTANTS
;; TODO ;unscheduled should trump all ;; TODO ;unscheduled should trump all
@ -1986,46 +1989,7 @@ If ARG is non-nil use long timestamp format."
(org-ml-headline-map-node-properties* (cons np it) it)))) (org-ml-headline-map-node-properties* (cons np it) it))))
;;; INTERACTIVE AGENDA FUNCTIONS ;;; INTERACTIVE AGENDA FUNCTIONS
;; lift buffer commands into agenda context
(defmacro org-x-agenda-cmd-wrapper (update &rest body)
"Execute BODY in context of agenda buffer.
Specifically, navigate to the original header, execute BODY, then
update the agenda buffer. If UPDATE is 'update-headline', get the
headline string and use it to update the agenda (this is only
needed when the headline changes obviously). When update is
'update-all', reload the entire buffer. When UPDATE is nil, do
nothing."
(declare (indent 1))
(-let* ((newhead (make-symbol "newhead"))
(hdmarker (make-symbol "hdmarker"))
((update-form get-head-form)
(cond
((eq update 'update-headline)
(list `((org-agenda-change-all-lines ,newhead ,hdmarker))
`((setq ,newhead (org-get-heading)))))
((eq update 'update-all)
(list '((org-agenda-redo))
nil)))))
`(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
,@get-head-form)
,@update-form
(beginning-of-line 1))))))
(defun org-x-agenda-toggle-checkbox () (defun org-x-agenda-toggle-checkbox ()
"Toggle checkboxes in org agenda view using `org-toggle-checkbox'." "Toggle checkboxes in org agenda view using `org-toggle-checkbox'."
(interactive) (interactive)