org-roam-graph.el (12787B)
1 ;;; org-roam-graph.el --- Basic graphing functionality for Org-roam -*- coding: utf-8; lexical-binding: t; -*- 2 3 ;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com> 4 5 ;; Author: Jethro Kuan <jethrokuan95@gmail.com> 6 ;; URL: https://github.com/org-roam/org-roam 7 ;; Keywords: org-mode, roam, convenience 8 ;; Version: 2.2.2 9 ;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.1")) 10 11 ;; This file is NOT part of GNU Emacs. 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation; either version 3, or (at your option) 16 ;; any later version. 17 ;; 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26 ;; Boston, MA 02110-1301, USA. 27 28 ;;; Commentary: 29 ;; 30 ;; This extension implements capability to build and generate graphs in Org-roam 31 ;; with the help of Graphviz. 32 ;; 33 ;;; Code: 34 (require 'xml) ;xml-escape-string 35 (require 'org-roam) 36 37 ;;; Options 38 (defcustom org-roam-graph-viewer (executable-find "firefox") 39 "Method to view the org-roam graph. 40 It may be one of the following: 41 - a string representing the path to the executable for viewing the graph. 42 - a function accepting a single argument: the graph file path. 43 - nil uses `view-file' to view the graph." 44 :type '(choice 45 (string :tag "Path to executable") 46 (function :tag "Function to display graph" eww-open-file) 47 (const :tag "view-file")) 48 :group 'org-roam) 49 50 (defcustom org-roam-graph-executable "dot" 51 "Path to graphing executable, or its name." 52 :type 'string 53 :group 'org-roam) 54 55 (defcustom org-roam-graph-filetype "svg" 56 "File type to generate when producing graphs." 57 :type 'string 58 :group 'org-roam) 59 60 61 (defcustom org-roam-graph-extra-config nil 62 "Extra options passed to graphviz. 63 Example: 64 '((\"rankdir\" . \"LR\"))" 65 :type '(alist) 66 :group 'org-roam) 67 68 (defcustom org-roam-graph-edge-extra-config nil 69 "Extra edge options passed to graphviz. 70 Example: 71 '((\"dir\" . \"back\"))" 72 :type '(alist) 73 :group 'org-roam) 74 75 (defcustom org-roam-graph-node-extra-config 76 '(("id" . (("style" . "bold,rounded,filled") 77 ("fillcolor" . "#EEEEEE") 78 ("color" . "#C9C9C9") 79 ("fontcolor" . "#111111"))) 80 ("http" . (("style" . "rounded,filled") 81 ("fillcolor" . "#EEEEEE") 82 ("color" . "#C9C9C9") 83 ("fontcolor" . "#0A97A6"))) 84 ("https" . (("style" . "rounded,filled") 85 ("fillcolor" . "#EEEEEE") 86 ("color" . "#C9C9C9") 87 ("fontcolor" . "#0A97A6")))) 88 "Extra options for graphviz nodes." 89 :type '(alist) 90 :group 'org-roam) 91 92 (defcustom org-roam-graph-link-hidden-types 93 '("file") 94 "What sort of links to hide from the Org-roam graph." 95 :type '(repeat string) 96 :group 'org-roam) 97 98 (defcustom org-roam-graph-max-title-length 100 99 "Maximum length of titles in graph nodes." 100 :type 'number 101 :group 'org-roam) 102 103 (defcustom org-roam-graph-shorten-titles 'truncate 104 "Determines how long titles appear in graph nodes. 105 Recognized values are the symbols `truncate' and `wrap', in which 106 cases the title will be truncated or wrapped, respectively, if it 107 is longer than `org-roam-graph-max-title-length'. 108 109 All other values including nil will have no effect." 110 :type '(choice 111 (const :tag "truncate" truncate) 112 (const :tag "wrap" wrap) 113 (const :tag "no" nil)) 114 :group 'org-roam) 115 116 (defcustom org-roam-graph-link-builder 'org-roam-org-protocol-link-builder 117 "Function used to build the Org-roam graph links. 118 Given a node name, return a string to be used for the link fed to 119 the graph generation utility." 120 :type 'function 121 :group 'org-roam) 122 123 (defcustom org-roam-graph-generation-hook nil 124 "Functions to run after the graph has been generated. 125 Each function is called with two arguments: the filename 126 containing the graph generation tool, and the generated graph." 127 :type 'hook 128 :group 'org-roam) 129 130 (defun org-roam-org-protocol-link-builder (node) 131 "Default org-roam link builder. Generate an org-protocol link using NODE." 132 (concat "org-protocol://roam-node?node=" 133 (url-hexify-string (org-roam-node-id node)))) 134 135 ;;; Interactive command 136 ;;;###autoload 137 (defun org-roam-graph (&optional arg node) 138 "Build and possibly display a graph for NODE. 139 ARG may be any of the following values: 140 - nil show the graph. 141 - `\\[universal-argument]' show the graph for NODE. 142 - `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps." 143 (interactive 144 (list current-prefix-arg 145 (and current-prefix-arg 146 (org-roam-node-at-point 'assert)))) 147 (let ((graph (cl-typecase arg 148 (null (org-roam-graph--dot nil 'all-nodes)) 149 (cons (org-roam-graph--dot (org-roam-graph--connected-component 150 (org-roam-node-id node) 0))) 151 (integer (org-roam-graph--dot (org-roam-graph--connected-component 152 (org-roam-node-id node) (abs arg))))))) 153 (org-roam-graph--build graph #'org-roam-graph--open))) 154 155 ;;; Generation and Build process 156 (defun org-roam-graph--build (graph &optional callback) 157 "Generate the GRAPH, and execute CALLBACK when process exits successfully. 158 CALLBACK is passed the graph file as its sole argument." 159 (unless (stringp org-roam-graph-executable) 160 (user-error "`org-roam-graph-executable' is not a string")) 161 (unless (executable-find org-roam-graph-executable) 162 (user-error (concat "Cannot find executable \"%s\" to generate the graph. " 163 "Please adjust `org-roam-graph-executable'") 164 org-roam-graph-executable)) 165 (let* ((temp-dot (make-temp-file "graph." nil ".dot" graph)) 166 (temp-graph (make-temp-file "graph." nil (concat "." org-roam-graph-filetype)))) 167 (org-roam-message "building graph") 168 (make-process 169 :name "*org-roam-graph*" 170 :buffer " *org-roam-graph*" 171 :command `(,org-roam-graph-executable ,temp-dot "-T" ,org-roam-graph-filetype "-o" ,temp-graph) 172 :sentinel (when callback 173 (lambda (process _event) 174 (when (= 0 (process-exit-status process)) 175 (progn (funcall callback temp-graph) 176 (run-hook-with-args 'org-roam-graph-generation-hook temp-dot temp-graph)))))))) 177 178 (defun org-roam-graph--dot (&optional edges all-nodes) 179 "Build the graphviz given the EDGES of the graph. 180 If ALL-NODES, include also nodes without edges." 181 (let ((org-roam-directory-temp org-roam-directory) 182 (nodes-table (make-hash-table :test #'equal)) 183 (seen-nodes (list)) 184 (edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links])))) 185 (pcase-dolist (`(,id ,file ,title) 186 (org-roam-db-query [:select [id file title] :from nodes])) 187 (puthash id (org-roam-node-create :file file :id id :title title) nodes-table)) 188 (with-temp-buffer 189 (setq-local org-roam-directory org-roam-directory-temp) 190 (insert "digraph \"org-roam\" {\n") 191 (dolist (option org-roam-graph-extra-config) 192 (insert (org-roam-graph--dot-option option) ";\n")) 193 (insert (format " edge [%s];\n" 194 (mapconcat (lambda (var) 195 (org-roam-graph--dot-option var nil "\"")) 196 org-roam-graph-edge-extra-config 197 ","))) 198 (pcase-dolist (`(,source ,dest ,type) edges) 199 (unless (member type org-roam-graph-link-hidden-types) 200 (pcase-dolist (`(,node ,node-type) `((,source "id") 201 (,dest ,type))) 202 (unless (member node seen-nodes) 203 (insert (org-roam-graph--format-node 204 (or (gethash node nodes-table) node) node-type)) 205 (push node seen-nodes))) 206 (insert (format " \"%s\" -> \"%s\";\n" 207 (xml-escape-string source) 208 (xml-escape-string dest))))) 209 (when all-nodes 210 (maphash (lambda (id node) 211 (unless (member id seen-nodes) 212 (insert (org-roam-graph--format-node node "id")))) 213 nodes-table)) 214 (insert "}") 215 (buffer-string)))) 216 217 (defun org-roam-graph--connected-component (id distance) 218 "Return the edges for all nodes reachable from/connected to ID. 219 DISTANCE is the maximum distance away from the root node." 220 (let* ((query 221 (if (= distance 0) 222 " 223 WITH RECURSIVE 224 links_of(source, dest) AS 225 (SELECT source, dest FROM links UNION 226 SELECT dest, source FROM links), 227 connected_component(source) AS 228 (SELECT dest FROM links_of WHERE source = $s1 UNION 229 SELECT dest FROM links_of JOIN connected_component USING(source)) 230 SELECT DISTINCT source, dest, type FROM links 231 WHERE source IN connected_component OR dest IN connected_component;" 232 " 233 WITH RECURSIVE 234 links_of(source, dest) AS 235 (SELECT source, dest FROM links UNION 236 SELECT dest, source FROM links), 237 connected_component(source, trace) AS 238 (VALUES ($s1 , json_array($s1)) UNION 239 SELECT lo.dest, json_insert(cc.trace, '$[' || json_array_length(cc.trace) || ']', lo.dest) FROM 240 connected_component AS cc JOIN links_of AS lo USING(source) 241 WHERE ( 242 -- Avoid cycles by only visiting each node once. 243 (SELECT count(*) FROM json_each(cc.trace) WHERE json_each.value == lo.dest) == 0 244 -- Note: BFS is cut off early here. 245 AND json_array_length(cc.trace) < $s2)), 246 nodes(source) as (SELECT DISTINCT source 247 FROM connected_component GROUP BY source ORDER BY min(json_array_length(trace))) 248 SELECT DISTINCT source, dest, type FROM links WHERE source IN nodes OR dest IN nodes;"))) 249 (org-roam-db-query query id distance))) 250 251 (defun org-roam-graph--dot-option (option &optional wrap-key wrap-val) 252 "Return dot string of form KEY=VAL for OPTION cons. 253 If WRAP-KEY is non-nil it wraps the KEY. 254 If WRAP-VAL is non-nil it wraps the VAL." 255 (concat wrap-key (car option) wrap-key 256 "=" 257 wrap-val (cdr option) wrap-val)) 258 259 (defun org-roam-graph--format-node (node type) 260 "Return a graphviz NODE with TYPE. 261 Handles both Org-roam nodes, and string nodes (e.g. urls)." 262 (let (node-id node-properties) 263 (if (org-roam-node-p node) 264 (let* ((title (org-roam-quote-string (org-roam-node-title node))) 265 (shortened-title 266 (org-roam-quote-string 267 (pcase org-roam-graph-shorten-titles 268 (`truncate (truncate-string-to-width title org-roam-graph-max-title-length nil nil "...")) 269 (`wrap (org-roam-word-wrap org-roam-graph-max-title-length title)) 270 (_ title))))) 271 (setq node-id (org-roam-node-id node) 272 node-properties `(("label" . ,shortened-title) 273 ("URL" . ,(funcall org-roam-graph-link-builder node)) 274 ("tooltip" . ,(xml-escape-string title))))) 275 (setq node-id node 276 node-properties (append `(("label" . ,(concat type ":" node))) 277 (when (member type (list "http" "https")) 278 `(("URL" . ,(xml-escape-string (concat type ":" node)))))))) 279 (format "\"%s\" [%s];\n" 280 node-id 281 (mapconcat (lambda (n) 282 (org-roam-graph--dot-option n nil "\"")) 283 (append (cdr (assoc type org-roam-graph-node-extra-config)) 284 node-properties) ",")))) 285 286 (defun org-roam-graph--open (file) 287 "Open FILE using `org-roam-graph-viewer' with `view-file' as a fallback." 288 (pcase org-roam-graph-viewer 289 ((pred stringp) 290 (if (executable-find org-roam-graph-viewer) 291 (condition-case err 292 (call-process org-roam-graph-viewer nil 0 nil file) 293 (error (user-error "Failed to open org-roam graph: %s" err))) 294 (user-error "Executable not found: \"%s\"" org-roam-graph-viewer))) 295 ((pred functionp) (funcall org-roam-graph-viewer file)) 296 ('nil (view-file file)) 297 (_ (signal 'wrong-type-argument `((functionp stringp null) ,org-roam-graph-viewer))))) 298 299 300 (provide 'org-roam-graph) 301 302 ;;; org-roam-graph.el ends here