;;; org-roam-graph.el --- Graphing API -*- coding: utf-8; lexical-binding: t; -*- ;; Copyright © 2020 Jethro Kuan ;; Author: Jethro Kuan ;; URL: https://github.com/org-roam/org-roam ;; Keywords: org-mode, roam, convenience ;; Version: 1.1.1 ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite "1.0.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 library provides graphing functionality for org-roam. ;; ;;; Code: (require 'xml) ;xml-escape-string (require 's) ;s-truncate, s-replace (require 'org-roam-macs) (require 'org-roam-db) ;;;; Declarations (defvar org-roam-directory) (declare-function org-roam--org-roam-file-p "org-roam") (declare-function org-roam--path-to-slug "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-extra-config nil "Extra options passed to graphviz. Example: '((\"rankdir\" . \"LR\"))" :type '(alist) :group 'org-roam) (defcustom org-roam-graph-node-extra-config '(("shape" . "underline") ("style" . "rounded,filled") ("fillcolor" . "#EEEEEE") ("color" . "#C9C9C9") ("fontcolor" . "#111111")) "Extra options for graphviz nodes. Example: '((\"color\" . \"skyblue\"))" :type '(alist) :group 'org-roam) (defcustom org-roam-graph-edge-extra-config '(("color" . "#333333")) "Extra options for graphviz edges. Example: '((\"dir\" . \"back\"))" :type '(alist) :group 'org-roam) (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) (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) (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." (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")))) 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))) (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. 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." (org-roam-db--ensure-built) (org-roam--with-temp-buffer (let* ((nodes (org-roam-db-query node-query)) (edges-query `[:with selected :as [:select [file] :from ,node-query] :select :distinct [to from] :from links :where (and (in to selected) (in from selected))]) (edges-cites-query `[:with selected :as [:select [file] :from ,node-query] :select :distinct [file from] :from links :inner :join refs :on (and (= links:to refs:ref) (= links:type "cite") (= refs:type "cite")) :where (and (in file selected) (in from selected))]) (edges (org-roam-db-query edges-query)) (edges-cites (org-roam-db-query edges-cites-query))) (insert "digraph \"org-roam\" {\n") (dolist (option org-roam-graph-extra-config) (insert (org-roam-graph--dot-option option) ";\n")) (dolist (attribute '("node" "edge")) (insert (format " %s [%s];\n" attribute (mapconcat (lambda (var) (org-roam-graph--dot-option var nil "\"")) (symbol-value (intern (concat "org-roam-graph-" attribute "-extra-config"))) ",")))) (dolist (node nodes) (let* ((file (xml-escape-string (car node))) (title (or (caadr node) (org-roam--path-to-slug file))) (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))) (node-properties `(("label" . ,(s-replace "\"" "\\\"" shortened-title)) ("URL" . ,(concat "org-protocol://roam-file?file=" (url-hexify-string file))) ("tooltip" . ,(xml-escape-string title))))) (insert (format " \"%s\" [%s];\n" file (mapconcat (lambda (n) (org-roam-graph--dot-option n nil "\"")) node-properties ","))))) (dolist (edge edges) (insert (apply #'format `(" \"%s\" -> \"%s\";\n" ,@(mapcar #'xml-escape-string edge))))) (insert (format " edge [%s];\n" (mapconcat #'org-roam-graph--dot-option org-roam-graph-edge-cites-extra-config ","))) (dolist (edge edges-cites) (insert (apply #'format `(" \"%s\" -> \"%s\";\n" ,@(mapcar #'xml-escape-string edge))))) (insert "}") (buffer-string)))) (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 `[:select [file titles] :from titles ,@(org-roam-graph--expand-matcher 'file t)])) (graph (org-roam-graph--dot node-query)) (temp-dot (make-temp-file "graph." nil ".dot" graph)) (temp-graph (make-temp-file "graph." nil ".svg"))) (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))))))) (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))))) (defun org-roam-graph--build-connected-component (file &optional max-distance callback) "Build a graph of nodes connected to FILE. If MAX-DISTANCE is non-nil, limit nodes to MAX-DISTANCE steps. CALLBACK is passed to `org-roam-graph--build'." (let* ((file (file-truename file)) (files (or (if (and max-distance (>= max-distance 0)) (org-roam-db--links-with-max-distance file max-distance) (org-roam-db--connected-component file)) (list file))) (query `[:select [file titles] :from titles :where (in file [,@files])])) (org-roam-graph--build query callback))) ;;;; 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." (interactive "P") (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))) (pcase arg ('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))) ('(16) (org-roam-graph--build node-query)) ('- (org-roam-graph--build-connected-component file)) (_ (user-error "Unrecognized ARG: %s" arg))))) (provide 'org-roam-graph) ;;; org-roam-graph.el ends here