1.1--- a/emacs/lib/graph.el Fri Sep 13 20:30:55 2024 -0400
1.2+++ b/emacs/lib/graph.el Sat Sep 14 22:13:06 2024 -0400
1.3@@ -107,5 +107,413 @@
1.4 (defun org-dblock-write:graph ()
1.5 "Generate a 'graph' block for the designated set of nodes.")
1.6
1.7+;;; Links
1.8+;; See https://github.com/toshism/org-super-links/blob/develop/org-super-links.el
1.9+(declare-function org-make-link-description-function "ext:org-mode")
1.10+
1.11+(defvar org-graph-edge-backlink-into-drawer "LINKS"
1.12+ "Controls how/where to insert the backlinks.
1.13+If non-nil a drawer will be created and backlinks inserted there. The
1.14+default is BACKLINKS. If this is set to a string a drawer will be
1.15+created using that string. For example LINKS. If nil backlinks will
1.16+just be inserted under the heading.")
1.17+
1.18+(defvar org-graph-edge-backlink-prefix 'org-graph-edge-backlink-prefix-timestamp
1.19+ "Prefix to insert before the backlink.
1.20+This can be a string, nil, or a function that takes no arguments and
1.21+returns a string.
1.22+
1.23+Default is the function `org-graph-edge-backlink-prefix-timestamp'
1.24+which returns an inactive timestamp formatted according to the variable
1.25+`org-time-stamp-formats' and a separator ' <- '.")
1.26+
1.27+(defvar org-graph-edge-backlink-postfix nil
1.28+ "Postfix to insert after the backlink.
1.29+This can be a string, nil, or a function that takes no arguments and
1.30+returns a string")
1.31+
1.32+(defvar org-graph-edge-related-into-drawer nil
1.33+ "Controls how/where to insert links.
1.34+If non-nil a drawer will be created and links inserted there. The
1.35+default is `org-graph-edge-related-drawer-default-name'. If this is set to a
1.36+string a drawer will be created using that string. For example LINKS.
1.37+If nil links will just be inserted at point.")
1.38+
1.39+(defvar org-graph-edge-related-drawer-default-name "RELATED"
1.40+ "Default name to use for link drawer.
1.41+If variable `org-graph-edge-related-into-drawer' is 't' use this
1.42+name for the drawer. See variable `org-graph-edge-related-into-drawer' for more info.")
1.43+
1.44+(defvar org-graph-edge-link-prefix nil
1.45+ "Prefix to insert before the link.
1.46+This can be a string, nil, or a function that takes no arguments and
1.47+returns a string")
1.48+
1.49+(defvar org-graph-edge-link-postfix nil
1.50+ "Postfix to insert after the link.
1.51+This can be a string, nil, or a function that takes no arguments and
1.52+returns a string")
1.53+
1.54+(defvar org-graph-edge-default-description-formatter org-make-link-description-function
1.55+ "What to use if no description is provided.
1.56+This can be a string, nil or a function that accepts two arguments
1.57+LINK and DESC and returns a string.
1.58+
1.59+nil will return the default desciption or the link.
1.60+string will be used only as a default fall back if set.
1.61+function will be called for every link.
1.62+
1.63+Default is the variable `org-make-link-desciption-function'.")
1.64+
1.65+(defvar org-graph-edge-search-function
1.66+ (cond ((require 'helm-org-ql nil 'no-error) "helm-org-ql")
1.67+ ((require 'helm-org-rifle nil 'no-error) "helm-org-rifle")
1.68+ (t 'org-graph-edge-get-location))
1.69+ "The interface to use for finding target links.
1.70+This can be a string with one of the values 'helm-org-ql',
1.71+'helm-org-rifle', or a function. If you provide a custom
1.72+function it will be called with the `point` at the location the link
1.73+should be inserted. The only other requirement is that it should call
1.74+the function `org-graph-edge--insert-link' with a marker to the target link.
1.75+AKA the place you want the backlink.
1.76+
1.77+Using 'helm-org-ql' or 'helm-org-rifle' will also add a new
1.78+action to the respective action menu.
1.79+
1.80+See the function `org-graph-edge-link-search-interface-ql' or for an example.
1.81+
1.82+Default is set based on currently installed packages. In order of priority:
1.83+- 'helm-org-ql'
1.84+- 'helm-org-rifle'
1.85+- `org-graph-edge-get-location'
1.86+
1.87+`org-graph-edge-get-location' internally uses `org-refile-get-location'.")
1.88+
1.89+(defvar org-graph-edge-pre-link-hook nil
1.90+ "Hook called before storing the link on the link side.
1.91+This is called with point at the location where it was called.")
1.92+
1.93+(defvar org-graph-edge-pre-backlink-hook nil
1.94+ "Hook called before storing the link on the backlink side.
1.95+This is called with point in the heading of the backlink.")
1.96+
1.97+(declare-function org-graph-edge-org-ql-link-search-interface "ext:org-graph-edge-org-ql")
1.98+(declare-function org-graph-edge-org-rifle-link-search-interface "ext:org-graph-edge-org-rifle")
1.99+
1.100+(defun org-graph-edge-get-location ()
1.101+ "Default for function `org-graph-edge-search-function' that reuses the `org-refile' machinery."
1.102+ (let ((target (org-refile-get-location "Super Link")))
1.103+ (org-graph-edge--insert-link (set-marker (make-marker) (car (cdddr target))
1.104+ (get-file-buffer (car (cdr target)))))))
1.105+
1.106+(defun org-graph-edge-search-function ()
1.107+ "Call the search interface specified in variable `org-graph-edge-search-function'."
1.108+ (cond ((string= org-graph-edge-search-function "helm-org-ql")
1.109+ (require 'org-graph-edge-org-ql)
1.110+ (org-graph-edge-org-ql-link-search-interface))
1.111+ ((string= org-graph-edge-search-function "helm-org-rifle")
1.112+ (require 'org-graph-edge-org-rifle)
1.113+ (org-graph-edge-org-rifle-link-search-interface))
1.114+ (t (funcall org-graph-edge-search-function))))
1.115+
1.116+(defun org-graph-edge-backlink-prefix ()
1.117+ "Return an appropriate string based on variable `org-graph-edge-backlink-prefix'."
1.118+ (cond ((equal org-graph-edge-backlink-prefix nil) "")
1.119+ ((stringp org-graph-edge-backlink-prefix) org-graph-edge-backlink-prefix)
1.120+ (t (funcall org-graph-edge-backlink-prefix))))
1.121+
1.122+(defun org-graph-edge-backlink-postfix ()
1.123+ "Return an appropriate string based on variable `org-graph-edge-backlink-postfix'."
1.124+ (cond ((equal org-graph-edge-backlink-postfix nil) "\n")
1.125+ ((stringp org-graph-edge-backlink-postfix) org-graph-edge-backlink-postfix)
1.126+ (t (funcall org-graph-edge-backlink-postfix))))
1.127+
1.128+(defun org-graph-edge-link-prefix ()
1.129+ "Return an appropriate string based on variable `org-graph-edge-link-prefix'."
1.130+ (cond ((equal org-graph-edge-link-prefix nil) "")
1.131+ ((stringp org-graph-edge-link-prefix) org-graph-edge-link-prefix)
1.132+ (t (funcall org-graph-edge-link-prefix))))
1.133+
1.134+(defun org-graph-edge-link-postfix ()
1.135+ "Return an appropriate string based on variable `org-graph-edge-link-postfix'."
1.136+ (cond ((equal org-graph-edge-link-postfix nil) "")
1.137+ ((stringp org-graph-edge-link-postfix) org-graph-edge-link-postfix)
1.138+ (t (funcall org-graph-edge-link-postfix))))
1.139+
1.140+(defun org-graph-edge-backlink-prefix-timestamp ()
1.141+ "Return the default prefix string for a backlink.
1.142+Inactive timestamp formatted according to `org-time-stamp-formats' and
1.143+a separator ' <- '."
1.144+ (concat (format-time-string (org-time-stamp-format t t) (current-time))
1.145+ " <- "))
1.146+
1.147+(defun org-graph-edge-default-description-formatter (link desc)
1.148+ "Return a string to use as the link desciption.
1.149+LINK is the link target. DESC is the provided desc."
1.150+ (let ((p org-graph-edge-default-description-formatter))
1.151+ (cond ((equal p nil) (or desc link))
1.152+ ((stringp p) (or desc p))
1.153+ ((fboundp p) (funcall p link desc))
1.154+ (t desc))))
1.155+
1.156+(defun org-graph-edge-backlink-into-drawer ()
1.157+ "Name of the backlink drawer, as a string, or nil.
1.158+This is the value of variable
1.159+`org-graph-edge-backlink-into-drawer'. However, if the current
1.160+entry has or inherits a BACKLINK_INTO_DRAWER property, it will be
1.161+used instead of the default value."
1.162+ (let ((p (org-entry-get nil "BACKLINK_INTO_DRAWER" 'inherit t)))
1.163+ (cond ((equal p "nil") nil)
1.164+ ((equal p "t") "BACKLINKS")
1.165+ ((stringp p) p)
1.166+ (p "BACKLINKS")
1.167+ ((stringp org-graph-edge-backlink-into-drawer) org-graph-edge-backlink-into-drawer)
1.168+ (org-graph-edge-backlink-into-drawer "BACKLINKS"))))
1.169+
1.170+;; delete related functions
1.171+(defun org-graph-edge--find-link (id)
1.172+ "Return link element for ID."
1.173+ (save-restriction
1.174+ (org-graph-edge--org-narrow-to-here)
1.175+ (let ((link
1.176+ (org-element-map (org-element-parse-buffer) 'link
1.177+ (lambda (link)
1.178+ (when (string= (org-element-property :path link) id)
1.179+ link)))))
1.180+ (widen)
1.181+ (if (> (length link) 1)
1.182+ (error "Multiple links found. Canceling delete")
1.183+ (car link)))))
1.184+
1.185+(defun org-graph-edge--org-narrow-to-here ()
1.186+ "Narrow to current heading, excluding subheadings."
1.187+ (org-narrow-to-subtree)
1.188+ (save-excursion
1.189+ (org-next-visible-heading 1)
1.190+ (narrow-to-region (point-min) (point))))
1.191+
1.192+
1.193+(defun org-graph-edge--in-drawer ()
1.194+ "Return nil if point is not in a drawer.
1.195+Return element at point is in a drawer."
1.196+ (let ((element (org-element-at-point)))
1.197+ (while (and element
1.198+ (not (memq (org-element-type element) '(drawer property-drawer))))
1.199+ (setq element (org-element-property :parent element)))
1.200+ element))
1.201+
1.202+
1.203+(defun org-graph-edge--delete-link (link)
1.204+ "Delete the LINK.
1.205+If point is in drawer, delete the entire line."
1.206+ (save-excursion
1.207+ (goto-char (org-element-property :begin link))
1.208+ (if (org-graph-edge--in-drawer)
1.209+ (progn
1.210+ (kill-whole-line 1)
1.211+ (org-remove-empty-drawer-at (point)))
1.212+ (delete-region (org-element-property :begin link) (org-element-property :end link)))))
1.213+
1.214+
1.215+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1.216+;; EXPERIMENTAL related into drawer
1.217+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1.218+
1.219+(defun org-graph-edge-related-into-drawer ()
1.220+ "Name of the related drawer, as a string, or nil.
1.221+This is the value of variable
1.222+`org-graph-edge-related-into-drawer'. However, if the current
1.223+entry has or inherits a RELATED_INTO_DRAWER property, it will be
1.224+used instead of the default value."
1.225+ (let ((p (org-entry-get nil "RELATED_INTO_DRAWER" 'inherit t)))
1.226+ (cond ((equal p "nil") nil)
1.227+ ((equal p "t") org-graph-edge-related-drawer-default-name)
1.228+ ((stringp p) p)
1.229+ (p org-graph-edge-related-drawer-default-name)
1.230+ ((stringp org-graph-edge-related-into-drawer) org-graph-edge-related-into-drawer)
1.231+ (org-graph-edge-related-into-drawer org-graph-edge-related-drawer-default-name))))
1.232+
1.233+(defun org-graph-edge-insert-relatedlink (link desc)
1.234+ "LINK DESC related experiment."
1.235+ (if (org-graph-edge-related-into-drawer)
1.236+ (let* ((org-log-into-drawer (org-graph-edge-related-into-drawer))
1.237+ (beg (org-log-beginning t)))
1.238+ (goto-char beg)
1.239+ (insert (org-graph-edge-link-prefix))
1.240+ (org-insert-link nil link desc)
1.241+ (insert (org-graph-edge-link-postfix) "\n")
1.242+ (org-indent-region beg (point)))
1.243+ (insert (org-graph-edge-link-prefix))
1.244+ (org-insert-link nil link desc)
1.245+ (insert (org-graph-edge-link-postfix))))
1.246+
1.247+(defun org-graph-edge-link-prefix-timestamp ()
1.248+ "Return the default prefix string for a backlink.
1.249+Inactive timestamp formatted according to `org-time-stamp-formats' and
1.250+a separator ' -> '."
1.251+ (concat (format-time-string (org-time-stamp-format t t) (current-time))
1.252+ " -> "))
1.253+
1.254+(defun org-graph-edge-quick-insert-drawer-link ()
1.255+ "Insert link into drawer regardless of variable `org-graph-edge-related-into-drawer' value."
1.256+ (interactive)
1.257+ ;; how to handle prefix here?
1.258+ (let ((org-graph-edge-related-into-drawer (or org-graph-edge-related-into-drawer t))
1.259+ (org-graph-edge-link-prefix 'org-graph-edge-link-prefix-timestamp))
1.260+ (org-graph-edge-link)))
1.261+
1.262+(defun org-graph-edge-quick-insert-inline-link ()
1.263+ "Insert inline link regardless of variable `org-graph-edge-related-into-drawer' value."
1.264+ (interactive)
1.265+ ;; how to handle prefix here?
1.266+ (let ((org-graph-edge-related-into-drawer nil)
1.267+ (org-graph-edge-link-prefix nil))
1.268+ (org-graph-edge-link)))
1.269+
1.270+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1.271+;; /EXPERIMENTAL related into drawer
1.272+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1.273+
1.274+(defun org-graph-edge-insert-backlink (link desc)
1.275+ "Insert backlink to LINK with DESC.
1.276+Where the backlink is placed is determined by the variable `org-graph-edge-backlink-into-drawer'."
1.277+ (let* ((org-log-into-drawer (org-graph-edge-backlink-into-drawer))
1.278+ (description (org-graph-edge-default-description-formatter link desc))
1.279+ (beg (org-log-beginning t)))
1.280+ (goto-char beg)
1.281+ (insert (org-graph-edge-backlink-prefix))
1.282+ (insert (org-link-make-string link description))
1.283+ (insert (org-graph-edge-backlink-postfix))
1.284+ (org-indent-region beg (point))))
1.285+
1.286+(defun org-graph-edge-links-action (marker hooks)
1.287+ "Go to MARKER, run HOOKS and store a link."
1.288+ (with-current-buffer (marker-buffer marker)
1.289+ (save-excursion
1.290+ (save-restriction
1.291+ (widen) ;; buffer could be narrowed
1.292+ (goto-char (marker-position marker))
1.293+ (run-hooks hooks)
1.294+ (call-interactively #'org-store-link)
1.295+ (pop org-stored-links)))))
1.296+
1.297+(defun org-graph-edge-link-builder (link)
1.298+ "Format link description for LINK."
1.299+ (let* ((link-ref (car link))
1.300+ (pre-desc (cadr link))
1.301+ (description (org-graph-edge-default-description-formatter link-ref pre-desc)))
1.302+ (cons link-ref description)))
1.303+
1.304+(defun org-graph-edge--insert-link (target &optional no-forward)
1.305+ "Insert link to marker TARGET at current `point`, and create backlink to here.
1.306+Only create backlinks in files in `org-mode' or a derived mode, otherwise just
1.307+act like a normal link.
1.308+
1.309+If NO-FORWARD is non-nil skip creating the forward link. Currently
1.310+only used when converting a link."
1.311+ (let* ((source (point-marker))
1.312+ (source-link (org-graph-edge-links-action source 'org-graph-edge-pre-link-hook))
1.313+ (target-link (org-graph-edge-links-action target 'org-graph-edge-pre-backlink-hook))
1.314+ (source-formatted-link (org-graph-edge-link-builder source-link))
1.315+ (target-formatted-link (org-graph-edge-link-builder target-link)))
1.316+ (with-current-buffer (marker-buffer target)
1.317+ (save-excursion
1.318+ (save-restriction
1.319+ (widen) ;; buffer could be narrowed
1.320+ (goto-char (marker-position target))
1.321+ (when (derived-mode-p 'org-mode)
1.322+ (org-graph-edge-insert-backlink (car source-formatted-link) (cdr source-formatted-link))))))
1.323+ (unless no-forward
1.324+ (with-current-buffer (marker-buffer source)
1.325+ (save-excursion
1.326+ (goto-char (marker-position source))
1.327+ (org-graph-edge-insert-relatedlink (car target-formatted-link) (cdr target-formatted-link)))))))
1.328+
1.329+
1.330+;;;###autoload
1.331+(defun org-graph-edge-convert-link-to-edge (arg)
1.332+ "Convert a normal `org-mode' link at `point' to a graph link, ARG prefix.
1.333+If variable `org-graph-edge-related-into-drawer' is non-nil move
1.334+the link into drawer.
1.335+
1.336+When called interactively with a `C-u' prefix argument ignore
1.337+variable `org-graph-edge-related-into-drawer' configuration and
1.338+do not modify existing link."
1.339+ (interactive "P")
1.340+ (let ((from-m (point-marker))
1.341+ (target (save-window-excursion
1.342+ (with-current-buffer (current-buffer)
1.343+ (save-excursion
1.344+ (org-open-at-point)
1.345+ (point-marker))))))
1.346+ (org-graph-edge--insert-link target (or arg (not org-graph-edge-related-into-drawer)))
1.347+ (goto-char (marker-position from-m)))
1.348+
1.349+ (when (and (not arg) (org-graph-edge-related-into-drawer))
1.350+ (let ((begin (org-element-property :begin (org-element-context)))
1.351+ (end (org-element-property :end (org-element-context))))
1.352+ (delete-region begin end))))
1.353+
1.354+;;;###autoload
1.355+(defun org-graph-edge-delete-link ()
1.356+ "Delete the link at point, and the corresponding reverse link.
1.357+If no reverse link exists, just delete link at point.
1.358+This works from either side, and deletes both sides of a link."
1.359+ (interactive)
1.360+ (save-window-excursion
1.361+ (with-current-buffer (current-buffer)
1.362+ (save-excursion
1.363+ (let ((id (org-id-get (point))))
1.364+ (org-open-at-point)
1.365+ (let ((link-element (org-graph-edge--find-link id)))
1.366+ (if link-element
1.367+ (org-graph-edge--delete-link link-element)
1.368+ (message "No backlink found. Deleting active only.")))))))
1.369+ (org-graph-edge--delete-link (org-element-context)))
1.370+
1.371+;;;###autoload
1.372+(defun org-graph-edge-store-link (&optional GOTO KEYS)
1.373+ "Store a point to register for use in function `org-graph-edge-insert-link'.
1.374+This is primarily intended to be called before `org-capture', but
1.375+could possibly even be used to replace `org-store-link' IF
1.376+function `org-graph-edge-insert-link' is used to replace
1.377+`org-insert-link'. This has not been thoroughly tested outside
1.378+of links to/form org files. GOTO and KEYS are unused."
1.379+ (interactive "P")
1.380+ (ignore GOTO)
1.381+ (ignore KEYS)
1.382+ (save-excursion
1.383+ ;; this is a hack. if the point is at the first char of a heading
1.384+ ;; the marker is not updated as expected when text is inserted
1.385+ ;; above the heading. for example a capture template inserted
1.386+ ;; above. that results in the link being to the heading above the
1.387+ ;; expected heading.
1.388+ (goto-char (line-end-position))
1.389+ (let ((c1 (make-marker)))
1.390+ (set-marker c1 (point) (current-buffer))
1.391+ (set-register ?^ c1)
1.392+ (message "Link copied"))))
1.393+
1.394+;; not sure if this should be autoloaded or left to config?
1.395+;;;###autoload
1.396+(advice-add 'org-capture :before #'org-graph-edge-store-link)
1.397+
1.398+;;;###autoload
1.399+(defun org-graph-edge-insert-link ()
1.400+ "Insert a super link from the register."
1.401+ (interactive)
1.402+ (let* ((target (get-register ?^)))
1.403+ (if target
1.404+ (progn
1.405+ (org-graph-edge--insert-link target)
1.406+ (set-register ?^ nil))
1.407+ (message "No link to insert!"))))
1.408+
1.409+;;;###autoload
1.410+(defun org-graph-edge-link ()
1.411+ "Insert a link and add a backlink to the target heading."
1.412+ (interactive)
1.413+ (org-graph-edge-search-function))
1.414+
1.415 (provide 'graph)
1.416 ;; graph.el ends here
