awesome-emacs/org-roam
1
0
Fork 0
mirror of https://github.com/org-roam/org-roam synced 2025-08-01 12:17:21 -05:00
Code Issues Packages Projects Releases Wiki Activity
Files
2d8dc8e31b8f542b9baa9e58d1d427a315203912
org-roam/extensions/org-roam-graph.el
Wetlize 2d8dc8e31b (feat): globally restructure and refactor the codebase (#1724) 
Detangle the codebase and change how dependencies are resolved to
allow the package to better modularize and load itself without
introducing circular dependencies, especially when autoloads involved.
2021-08-08 13:53:35 +08:00

283 lines
12 KiB
EmacsLisp
Raw Blame History

;;; org-roam-graph.el --- Basic graphing functionality for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.0"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This extension implements capability to build and generate graphs in Org-roam
;; with the help of Graphviz.
;;
;;; Code:
(require 'xml) ;xml-escape-string
(require 'org-roam)
;;; Options
(defcustom org-roam-graph-viewer (executable-find "firefox")
"Method to view the org-roam graph.
It may be one of the following:
- a string representing the path to the executable for viewing the graph.
- a function accepting a single argument: the graph file path.
- nil uses `view-file' to view the graph."
:type '(choice
(string :tag "Path to executable")
(function :tag "Function to display graph" eww-open-file)
(const :tag "view-file"))
:group 'org-roam)
(defcustom org-roam-graph-executable "dot"
"Path to graphing executable, or its name."
:type 'string
:group 'org-roam)
(defcustom org-roam-graph-filetype "svg"
"File type to generate when producing graphs."
:type 'string
:group 'org-roam)
(defcustom org-roam-graph-extra-config nil
"Extra options passed to graphviz.
Example:
'((\"rankdir\" . \"LR\"))"
:type '(alist)
:group 'org-roam)
(defcustom org-roam-graph-edge-extra-config nil
"Extra edge options passed to graphviz.
Example:
'((\"dir\" . \"back\"))"
:type '(alist)
:group 'org-roam)
(defcustom org-roam-graph-node-extra-config
'(("id" . (("style" . "bold,rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#111111")))
("http" . (("style" . "rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#0A97A6")))
("https" . (("shape" . "rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#0A97A6"))))
"Extra options for graphviz nodes."
:type '(alist)
:group 'org-roam)
(defcustom org-roam-graph-link-hidden-types
'("file")
"What sort of links to hide from the Org-roam graph."
:type '(repeat string)
:group 'org-roam)
(defcustom org-roam-graph-max-title-length 100
"Maximum length of titles in graph nodes."
:type 'number
:group 'org-roam)
(defcustom org-roam-graph-shorten-titles 'truncate
"Determines how long titles appear in graph nodes.
Recognized values are the symbols `truncate' and `wrap', in which
cases the title will be truncated or wrapped, respectively, if it
is longer than `org-roam-graph-max-title-length'.
All other values including nil will have no effect."
:type '(choice
(const :tag "truncate" truncate)
(const :tag "wrap" wrap)
(const :tag "no" nil))
:group 'org-roam)
;;; Interactive command
;;;###autoload
(defun org-roam-graph (&optional arg node)
"Build and possibly display a graph for NODE.
ARG may be any of the following values:
- nil show the graph.
- `\\[universal-argument]' show the graph for NODE.
- `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps."
(interactive
(list current-prefix-arg
(and current-prefix-arg
(org-roam-node-at-point 'assert))))
(let ((graph (cl-typecase arg
(null (org-roam-graph--dot nil 'all-nodes))
(cons (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) 0)))
(integer (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) (abs arg)))))))
(org-roam-graph--build graph #'org-roam-graph--open)))
;;; Generation and Build process
(defun org-roam-graph--build (graph &optional callback)
"Generate the GRAPH, and execute CALLBACK when process exits successfully.
CALLBACK is passed the graph file as its sole argument."
(unless (stringp org-roam-graph-executable)
(user-error "`org-roam-graph-executable' is not a string"))
(unless (executable-find org-roam-graph-executable)
(user-error (concat "Cannot find executable \"%s\" to generate the graph. "
"Please adjust `org-roam-graph-executable'")
org-roam-graph-executable))
(let* ((temp-dot (make-temp-file "graph." nil ".dot" graph))
(temp-graph (make-temp-file "graph." nil (concat "." org-roam-graph-filetype))))
(org-roam-message "building graph")
(make-process
:name "*org-roam-graph--build-process*"
:buffer "*org-roam-graph--build-process*"
:command `(,org-roam-graph-executable ,temp-dot "-T" ,org-roam-graph-filetype "-o" ,temp-graph)
:sentinel (when callback
(lambda (process _event)
(when (= 0 (process-exit-status process))
(funcall callback temp-graph)))))))
(defun org-roam-graph--dot (&optional edges all-nodes)
"Build the graphviz given the EDGES of the graph.
If ALL-NODES, include also nodes without edges."
(let ((org-roam-directory-temp org-roam-directory)
(nodes-table (make-hash-table :test #'equal))
(seen-nodes (list))
(edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links]))))
(pcase-dolist (`(,id ,file ,title)
(org-roam-db-query [:select [id file title] :from nodes]))
(puthash id (org-roam-node-create :file file :id id :title title) nodes-table))
(with-temp-buffer
(setq-local org-roam-directory org-roam-directory-temp)
(insert "digraph \"org-roam\" {\n")
(dolist (option org-roam-graph-extra-config)
(insert (org-roam-graph--dot-option option) ";\n"))
(insert (format " edge [%s];\n"
(mapconcat (lambda (var)
(org-roam-graph--dot-option var nil "\""))
org-roam-graph-edge-extra-config
",")))
(pcase-dolist (`(,source ,dest ,type) edges)
(unless (member type org-roam-graph-link-hidden-types)
(pcase-dolist (`(,node ,node-type) `((,source "id")
(,dest ,type)))
(unless (member node seen-nodes)
(insert (org-roam-graph--format-node
(or (gethash node nodes-table) node) node-type))
(push node seen-nodes)))
(insert (format " \"%s\" -> \"%s\";\n"
(xml-escape-string source)
(xml-escape-string dest)))))
(when all-nodes
(maphash (lambda (id node)
(unless (member id seen-nodes)
(insert (org-roam-graph--format-node node "id"))))
nodes-table))
(insert "}")
(buffer-string))))
(defun org-roam-graph--connected-component (id distance)
"Return the edges for all nodes reachable from/connected to ID.
DISTANCE is the maximum distance away from the root node."
(let* ((query
(if (= distance 0)
"
WITH RECURSIVE
links_of(source, dest) AS
(SELECT source, dest FROM links UNION
SELECT dest, source FROM links),
connected_component(source) AS
(SELECT dest FROM links_of WHERE source = $s1 UNION
SELECT dest FROM links_of JOIN connected_component USING(source))
SELECT source, dest, type FROM links WHERE source IN connected_component OR dest IN connected_component;"
"
WITH RECURSIVE
links_of(source, dest) AS
(SELECT source, dest FROM links UNION
SELECT dest, source FROM links),
connected_component(source, trace) AS
(VALUES ($s1 , json_array($s1)) UNION
SELECT lo.dest, json_insert(cc.trace, '$[' || json_array_length(cc.trace) || ']', lo.dest) FROM
connected_component AS cc JOIN links_of AS lo USING(source)
WHERE (
-- Avoid cycles by only visiting each node once.
(SELECT count(*) FROM json_each(cc.trace) WHERE json_each.value == lo.dest) == 0
-- Note: BFS is cut off early here.
AND json_array_length(cc.trace) < $s2)),
nodes(source) as (SELECT DISTINCT source
FROM connected_component GROUP BY source ORDER BY min(json_array_length(trace)))
SELECT source, dest, type FROM links WHERE source IN nodes OR dest IN nodes;")))
(org-roam-db-query query id distance)))
(defun org-roam-graph--dot-option (option &optional wrap-key wrap-val)
"Return dot string of form KEY=VAL for OPTION cons.
If WRAP-KEY is non-nil it wraps the KEY.
If WRAP-VAL is non-nil it wraps the VAL."
(concat wrap-key (car option) wrap-key
"="
wrap-val (cdr option) wrap-val))
(defun org-roam-graph--format-node (node type)
"Return a graphviz NODE with TYPE.
Handles both Org-roam nodes, and string nodes (e.g. urls)."
(let (node-id node-properties)
(if (org-roam-node-p node)
(let* ((title (org-roam-quote-string (org-roam-node-title node)))
(shortened-title
(org-roam-quote-string
(pcase org-roam-graph-shorten-titles
(`truncate (truncate-string-to-width title org-roam-graph-max-title-length nil nil "..."))
(`wrap (s-word-wrap org-roam-graph-max-title-length title))
(_ title)))))
(setq node-id (org-roam-node-id node)
node-properties `(("label" . ,shortened-title)
("URL" . ,(concat "org-protocol://roam-node?node="
(url-hexify-string (org-roam-node-id node))))
("tooltip" . ,(xml-escape-string title)))))
(setq node-id node
node-properties (append `(("label" . ,(concat type ":" node)))
(when (member type (list "http" "https"))
`(("URL" . ,(xml-escape-string (concat type ":" node))))))))
(format "\"%s\" [%s];\n"
node-id
(mapconcat (lambda (n)
(org-roam-graph--dot-option n nil "\""))
(append (cdr (assoc type org-roam-graph-node-extra-config))
node-properties) ","))))
(defun org-roam-graph--open (file)
"Open FILE using `org-roam-graph-viewer' with `view-file' as a fallback."
(pcase org-roam-graph-viewer
((pred stringp)
(if (executable-find org-roam-graph-viewer)
(condition-case err
(call-process org-roam-graph-viewer nil 0 nil file)
(error (user-error "Failed to open org-roam graph: %s" err)))
(user-error "Executable not found: \"%s\"" org-roam-graph-viewer)))
((pred functionp) (funcall org-roam-graph-viewer file))
('nil (view-file file))
(_ (signal 'wrong-type-argument `((functionp stringp null) ,org-roam-graph-viewer)))))
(provide 'org-roam-graph)
;;; org-roam-graph.el ends here
Reference in New Issue View Git Blame Copy Permalink