2020-05-12 19:06:19 +00:00
|
|
|
;;; org-roam-graph.el --- Graphing API -*- coding: utf-8; lexical-binding: t; -*-
|
2020-03-28 13:16:28 +00:00
|
|
|
|
|
|
|
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
|
|
|
|
|
|
|
|
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
|
2020-05-10 05:48:16 +00:00
|
|
|
;; URL: https://github.com/org-roam/org-roam
|
2020-03-28 13:16:28 +00:00
|
|
|
;; Keywords: org-mode, roam, convenience
|
2020-07-26 17:03:35 +00:00
|
|
|
;; Version: 1.2.1
|
2020-05-27 05:20:06 +00:00
|
|
|
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.0"))
|
2020-03-28 13:16:28 +00:00
|
|
|
|
|
|
|
;; 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 library provides graphing functionality for org-roam.
|
|
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(require 'xml) ;xml-escape-string
|
|
|
|
(require 's) ;s-truncate, s-replace
|
|
|
|
(require 'org-roam-macs)
|
2020-04-19 07:04:24 +00:00
|
|
|
(require 'org-roam-db)
|
2020-03-28 13:16:28 +00:00
|
|
|
|
|
|
|
;;;; Declarations
|
|
|
|
(defvar org-roam-directory)
|
2020-05-28 04:25:19 +00:00
|
|
|
(defvar org-roam-mode)
|
2020-04-08 02:52:40 +00:00
|
|
|
(declare-function org-roam--org-roam-file-p "org-roam")
|
2020-03-28 13:16:28 +00:00
|
|
|
(declare-function org-roam--path-to-slug "org-roam")
|
2020-05-28 04:25:19 +00:00
|
|
|
(declare-function org-roam-mode "org-roam")
|
2020-03-28 13:16:28 +00:00
|
|
|
|
|
|
|
;;;; Options
|
|
|
|
(defcustom org-roam-graph-viewer (executable-find "firefox")
|
2020-04-19 11:00:33 +00:00
|
|
|
"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"))
|
2020-03-28 13:16:28 +00:00
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-05-07 17:44:28 +00:00
|
|
|
(defcustom org-roam-graph-executable "dot"
|
|
|
|
"Path to graphing executable, or its name."
|
2020-03-28 13:16:28 +00:00
|
|
|
:type 'string
|
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-03-31 08:56:15 +00:00
|
|
|
(defcustom org-roam-graph-extra-config nil
|
2020-04-01 03:36:24 +00:00
|
|
|
"Extra options passed to graphviz.
|
2020-03-28 13:16:28 +00:00
|
|
|
Example:
|
|
|
|
'((\"rankdir\" . \"LR\"))"
|
|
|
|
:type '(alist)
|
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-04-30 05:56:54 +00:00
|
|
|
(defcustom org-roam-graph-node-extra-config
|
|
|
|
'(("shape" . "underline")
|
|
|
|
("style" . "rounded,filled")
|
|
|
|
("fillcolor" . "#EEEEEE")
|
|
|
|
("color" . "#C9C9C9")
|
|
|
|
("fontcolor" . "#111111"))
|
2020-04-01 03:36:24 +00:00
|
|
|
"Extra options for graphviz nodes.
|
|
|
|
Example:
|
|
|
|
'((\"color\" . \"skyblue\"))"
|
|
|
|
:type '(alist)
|
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-04-30 05:56:54 +00:00
|
|
|
(defcustom org-roam-graph-edge-extra-config
|
|
|
|
'(("color" . "#333333"))
|
2020-04-11 05:41:21 +00:00
|
|
|
"Extra options for graphviz edges.
|
|
|
|
Example:
|
|
|
|
'((\"dir\" . \"back\"))"
|
|
|
|
:type '(alist)
|
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-04-12 06:38:58 +00:00
|
|
|
(defcustom org-roam-graph-edge-cites-extra-config '(("color" . "red"))
|
|
|
|
"Extra options for graphviz edges for citation links.
|
|
|
|
Example:
|
|
|
|
'((\"dir\" . \"back\"))"
|
|
|
|
:type '(alist)
|
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-03-28 13:16:28 +00:00
|
|
|
(defcustom org-roam-graph-max-title-length 100
|
|
|
|
"Maximum length of titles in graph nodes."
|
|
|
|
:type 'number
|
|
|
|
:group 'org-roam)
|
|
|
|
|
2020-05-01 11:49:46 +00:00
|
|
|
(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)
|
|
|
|
|
2020-03-28 13:16:28 +00:00
|
|
|
(defcustom org-roam-graph-exclude-matcher nil
|
|
|
|
"Matcher for excluding nodes from the generated graph.
|
|
|
|
Any nodes and links for file paths matching this string is
|
|
|
|
excluded from the graph.
|
|
|
|
|
|
|
|
If value is a string, the string is the only matcher.
|
|
|
|
|
|
|
|
If value is a list, all file paths matching any of the strings
|
|
|
|
are excluded."
|
|
|
|
:type '(choice
|
|
|
|
(string :tag "Matcher")
|
|
|
|
(list :tag "Matchers"))
|
|
|
|
:group 'org-roam)
|
|
|
|
|
|
|
|
;;;; Functions
|
|
|
|
(defun org-roam-graph--expand-matcher (col &optional negate where)
|
|
|
|
"Return the exclusion regexp from `org-roam-graph-exclude-matcher'.
|
|
|
|
COL is the symbol to be matched against. if NEGATE, add :not to sql query.
|
|
|
|
set WHERE to true if WHERE query already exists."
|
2020-04-19 07:04:24 +00:00
|
|
|
(let ((matchers (pcase org-roam-graph-exclude-matcher
|
|
|
|
('nil nil)
|
|
|
|
((pred stringp) `(,(concat "%" org-roam-graph-exclude-matcher "%")))
|
|
|
|
((pred listp) (mapcar (lambda (m)
|
|
|
|
(concat "%" m "%"))
|
|
|
|
org-roam-graph-exclude-matcher))
|
|
|
|
(_ (error "Invalid org-roam-graph-exclude-matcher"))))
|
2020-03-28 13:16:28 +00:00
|
|
|
res)
|
|
|
|
(dolist (match matchers)
|
|
|
|
(if where
|
|
|
|
(push :and res)
|
|
|
|
(push :where res)
|
|
|
|
(setq where t))
|
|
|
|
(push col res)
|
|
|
|
(when negate
|
|
|
|
(push :not res))
|
|
|
|
(push :like res)
|
|
|
|
(push match res))
|
|
|
|
(nreverse res)))
|
|
|
|
|
2020-04-19 07:04:24 +00:00
|
|
|
(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--dot (node-query)
|
|
|
|
"Build the graphviz dot string for NODE-QUERY.
|
2020-04-08 02:52:40 +00:00
|
|
|
The Org-roam database titles table is read, to obtain the list of titles.
|
|
|
|
The links table is then read to obtain all directed links, and formatted
|
|
|
|
into a digraph."
|
2020-03-28 13:16:28 +00:00
|
|
|
(org-roam-db--ensure-built)
|
2020-06-06 08:48:42 +00:00
|
|
|
(org-roam--with-temp-buffer nil
|
2020-04-08 02:52:40 +00:00
|
|
|
(let* ((nodes (org-roam-db-query node-query))
|
|
|
|
(edges-query
|
|
|
|
`[:with selected :as [:select [file] :from ,node-query]
|
2020-04-10 20:20:43 +00:00
|
|
|
:select :distinct [to from] :from links
|
2020-04-08 02:52:40 +00:00
|
|
|
:where (and (in to selected) (in from selected))])
|
2020-04-12 06:38:58 +00:00
|
|
|
(edges-cites-query
|
|
|
|
`[:with selected :as [:select [file] :from ,node-query]
|
|
|
|
:select :distinct [file from]
|
2020-04-19 07:04:24 +00:00
|
|
|
:from links :inner :join refs :on (and (= links:to refs:ref)
|
2020-05-04 12:44:15 +00:00
|
|
|
(= links:type "cite")
|
|
|
|
(= refs:type "cite"))
|
2020-04-12 06:38:58 +00:00
|
|
|
:where (and (in file selected) (in from selected))])
|
2020-04-19 07:04:24 +00:00
|
|
|
(edges (org-roam-db-query edges-query))
|
2020-04-12 06:38:58 +00:00
|
|
|
(edges-cites (org-roam-db-query edges-cites-query)))
|
2020-03-28 13:16:28 +00:00
|
|
|
(insert "digraph \"org-roam\" {\n")
|
2020-03-31 08:56:15 +00:00
|
|
|
(dolist (option org-roam-graph-extra-config)
|
2020-04-19 07:04:24 +00:00
|
|
|
(insert (org-roam-graph--dot-option option) ";\n"))
|
|
|
|
(dolist (attribute '("node" "edge"))
|
|
|
|
(insert (format " %s [%s];\n" attribute
|
2020-04-29 03:30:39 +00:00
|
|
|
(mapconcat (lambda (var)
|
|
|
|
(org-roam-graph--dot-option var nil "\""))
|
2020-04-19 07:04:24 +00:00
|
|
|
(symbol-value
|
|
|
|
(intern (concat "org-roam-graph-" attribute "-extra-config")))
|
|
|
|
","))))
|
2020-03-28 13:16:28 +00:00
|
|
|
(dolist (node nodes)
|
|
|
|
(let* ((file (xml-escape-string (car node)))
|
2020-07-10 11:23:38 +00:00
|
|
|
(title (or (cadr node)
|
2020-03-28 13:16:28 +00:00
|
|
|
(org-roam--path-to-slug file)))
|
2020-05-01 11:49:46 +00:00
|
|
|
(shortened-title (pcase org-roam-graph-shorten-titles
|
|
|
|
(`truncate (s-truncate org-roam-graph-max-title-length title))
|
|
|
|
(`wrap (s-word-wrap org-roam-graph-max-title-length title))
|
|
|
|
(_ title)))
|
2020-07-07 05:07:10 +00:00
|
|
|
(shortened-title (org-roam-string-quote shortened-title))
|
|
|
|
(title (org-roam-string-quote title))
|
2020-04-19 07:04:24 +00:00
|
|
|
(node-properties
|
2020-07-07 05:07:10 +00:00
|
|
|
`(("label" . ,shortened-title)
|
2020-04-19 07:04:24 +00:00
|
|
|
("URL" . ,(concat "org-protocol://roam-file?file=" (url-hexify-string file)))
|
|
|
|
("tooltip" . ,(xml-escape-string title)))))
|
2020-03-28 13:16:28 +00:00
|
|
|
(insert
|
2020-04-19 07:04:24 +00:00
|
|
|
(format " \"%s\" [%s];\n" file
|
|
|
|
(mapconcat (lambda (n)
|
|
|
|
(org-roam-graph--dot-option n nil "\""))
|
|
|
|
node-properties ",")))))
|
2020-03-28 13:16:28 +00:00
|
|
|
(dolist (edge edges)
|
2020-04-19 07:04:24 +00:00
|
|
|
(insert (apply #'format `(" \"%s\" -> \"%s\";\n"
|
|
|
|
,@(mapcar #'xml-escape-string edge)))))
|
2020-04-12 06:38:58 +00:00
|
|
|
(insert (format " edge [%s];\n"
|
2020-04-19 07:04:24 +00:00
|
|
|
(mapconcat #'org-roam-graph--dot-option
|
|
|
|
org-roam-graph-edge-cites-extra-config ",")))
|
2020-04-12 06:38:58 +00:00
|
|
|
(dolist (edge edges-cites)
|
2020-04-19 07:04:24 +00:00
|
|
|
(insert (apply #'format `(" \"%s\" -> \"%s\";\n"
|
|
|
|
,@(mapcar #'xml-escape-string edge)))))
|
2020-03-28 13:16:28 +00:00
|
|
|
(insert "}")
|
|
|
|
(buffer-string))))
|
|
|
|
|
2020-05-21 17:03:16 +00:00
|
|
|
(defun org-roam-graph--build (&optional node-query callback)
|
|
|
|
"Generate a graph showing the relations between nodes in NODE-QUERY.
|
|
|
|
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* ((node-query (or node-query
|
2020-07-10 11:23:38 +00:00
|
|
|
`[:select [file title] :from titles
|
|
|
|
,@(org-roam-graph--expand-matcher 'file t)
|
|
|
|
:group :by file]))
|
2020-05-21 17:03:16 +00:00
|
|
|
(graph (org-roam-graph--dot node-query))
|
|
|
|
(temp-dot (make-temp-file "graph." nil ".dot" graph))
|
|
|
|
(temp-graph (make-temp-file "graph." nil ".svg")))
|
2020-05-22 02:19:27 +00:00
|
|
|
(org-roam-message "building graph")
|
2020-05-21 17:03:16 +00:00
|
|
|
(make-process
|
|
|
|
:name "*org-roam-graph--build-process*"
|
|
|
|
:buffer "*org-roam-graph--build-process*"
|
|
|
|
:command `(,org-roam-graph-executable ,temp-dot "-Tsvg" "-o" ,temp-graph)
|
|
|
|
:sentinel (when callback
|
|
|
|
(lambda (process _event)
|
|
|
|
(when (= 0 (process-exit-status process))
|
|
|
|
(funcall callback temp-graph)))))))
|
2020-04-11 08:41:49 +00:00
|
|
|
|
2020-04-19 11:00:33 +00:00
|
|
|
(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)
|
2020-04-25 10:53:09 +00:00
|
|
|
(error (user-error "Failed to open org-roam graph: %s" err)))
|
2020-04-19 11:00:33 +00:00
|
|
|
(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)))))
|
|
|
|
|
2020-05-21 17:03:16 +00:00
|
|
|
(defun org-roam-graph--build-connected-component (file &optional max-distance callback)
|
2020-04-19 07:04:24 +00:00
|
|
|
"Build a graph of nodes connected to FILE.
|
2020-05-21 17:03:16 +00:00
|
|
|
If MAX-DISTANCE is non-nil, limit nodes to MAX-DISTANCE steps.
|
|
|
|
CALLBACK is passed to `org-roam-graph--build'."
|
2020-04-19 07:04:24 +00:00
|
|
|
(let* ((file (file-truename file))
|
|
|
|
(files (or (if (and max-distance (>= max-distance 0))
|
2020-04-10 20:20:43 +00:00
|
|
|
(org-roam-db--links-with-max-distance file max-distance)
|
|
|
|
(org-roam-db--connected-component file))
|
|
|
|
(list file)))
|
2020-07-10 11:23:38 +00:00
|
|
|
(query `[:select [file title]
|
2020-04-08 02:52:40 +00:00
|
|
|
:from titles
|
|
|
|
:where (in file [,@files])]))
|
2020-05-21 17:03:16 +00:00
|
|
|
(org-roam-graph--build query callback)))
|
2020-04-19 07:04:24 +00:00
|
|
|
|
|
|
|
;;;; Commands
|
|
|
|
;;;###autoload
|
|
|
|
(defun org-roam-graph (&optional arg file node-query)
|
|
|
|
"Build and possibly display a graph for FILE from NODE-QUERY.
|
|
|
|
If FILE is nil, default to current buffer's file name.
|
|
|
|
ARG may be any of the following values:
|
|
|
|
- nil show the graph.
|
|
|
|
- `\\[universal-argument]' show the graph for FILE.
|
|
|
|
- `\\[universal-argument]' N show the graph for FILE limiting nodes to N steps.
|
|
|
|
- `\\[universal-argument] \\[universal-argument]' build the graph.
|
|
|
|
- `\\[universal-argument]' - build the graph for FILE.
|
|
|
|
- `\\[universal-argument]' -N build the graph for FILE limiting nodes to N steps."
|
2020-04-11 08:41:49 +00:00
|
|
|
(interactive "P")
|
2020-05-28 04:25:19 +00:00
|
|
|
(unless org-roam-mode (org-roam-mode))
|
2020-05-03 22:03:02 +00:00
|
|
|
(let ((file (or file (buffer-file-name (buffer-base-buffer)))))
|
|
|
|
(unless (or (not arg) (equal arg '(16)))
|
|
|
|
(unless file
|
|
|
|
(user-error "Cannot build graph for nil file. Is current buffer visiting a file?"))
|
|
|
|
(unless (org-roam--org-roam-file-p file)
|
|
|
|
(user-error "\"%s\" is not an org-roam file" file)))
|
2020-04-19 07:04:24 +00:00
|
|
|
(pcase arg
|
2020-05-21 17:03:16 +00:00
|
|
|
('nil (org-roam-graph--build node-query #'org-roam-graph--open))
|
|
|
|
('(4) (org-roam-graph--build-connected-component file nil #'org-roam-graph--open))
|
|
|
|
((pred integerp) (org-roam-graph--build-connected-component file (abs arg) (when (>= arg 0) #'org-roam-graph--open)))
|
2020-04-19 07:04:24 +00:00
|
|
|
('(16) (org-roam-graph--build node-query))
|
|
|
|
('- (org-roam-graph--build-connected-component file))
|
|
|
|
(_ (user-error "Unrecognized ARG: %s" arg)))))
|
2020-03-28 13:16:28 +00:00
|
|
|
|
|
|
|
(provide 'org-roam-graph)
|
|
|
|
|
|
|
|
;;; org-roam-graph.el ends here
|