diff options
| -rw-r--r-- | flycheck_org-roam-ui.el | 494 |
1 files changed, 0 insertions, 494 deletions
diff --git a/flycheck_org-roam-ui.el b/flycheck_org-roam-ui.el deleted file mode 100644 index 02c88a8..0000000 --- a/flycheck_org-roam-ui.el +++ /dev/null @@ -1,494 +0,0 @@ -;;; org-roam-ui.el --- User Interface for Org-roam -*- coding: utf-8; lexical-binding: t; -*- - -;; Copyright © 2021 Kirill Rogovoy, Thomas F. K. Jorna - -;; author: Kirill Rogovoy, Thomas Jorna -;; URL: https://github.com/org-roam/org-roam-ui -;; Keywords: org-mode, roam -;; Version: 0 -;; Package-Requires: ((emacs "27.1") (f "0.17.2") (org-roam "2.0.0") (simple-httpd "20191103.1446") (websocket "20210110.17") (json "1.2")) - -;; 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: -;; -;; Org-roam-ui provides a web interface for navigating around notes created -;; within Org-roam. -;; -;;; Code: -;;;; Dependencies -(require 'f) -(require 'json) -(require 'simple-httpd) -(require 'org-roam) -(require 'websocket) - -(defgroup org-roam-ui nil - "UI in Org-roam." - :group 'org-roam - :prefix "org-roam-ui-" - :link '(url-link :tag "Github" "https://github.com/org-roam/org-roam-ui")) - -(defvar org-roam-ui/root-dir - (concat (file-name-directory - (f-full (or - load-file-name - buffer-file-name))) - ".") - "Root directory of the org-roam-ui project.") - -(defvar org-roam-ui/app-build-dir (expand-file-name "./out/" org-roam-ui/root-dir) - "Directory containing org-roam-ui's web build.") - -;; TODO: make into defcustom -(defvar org-roam-ui-port - 35901 - "Port to serve the org-roam-ui interface.") - -(defcustom org-roam-ui-sync-theme t - "If true, sync your current Emacs theme with org-roam-ui. -Works best with doom-themes. -Ignored if a custom theme is provied for 'org-roam-ui-custom-theme'." - :group 'org-roam-ui - :type 'boolean) - -(defcustom org-roam-ui-custom-theme nil - "Custom theme for org-roam-ui. Blocks 'org-roam-ui-sync-theme. -Provide a list of cons with the following values: -bg, bg-alt, fg, fg-alt, red, orange, yellow, green, cyan, blue, violet, magenta. -E.g. '((bg . \"#1E2029\") -\(bg-alt . \"#282a36\") -\(fg . \"#f8f8f2\") -\(fg-alt . \"#6272a\") -\(red . \"#ff5555\") -\(orange . \"#f1fa8c\") -\(yellow .\"#ffb86c\") -\(green . \"#50fa7b\") -\(cyan . \"#8be9fd\") -\(blue . \"#ff79c6\") -\(violet . \"#8be9fd\") -\(magenta . \"#bd93f9\"))." - :group 'org-roam-ui - :type 'list) - -(defcustom org-roam-ui-follow t - "If true, org-roam-ui will follow you around in the graph." - :group 'org-roam-ui - :type 'boolean) - -(defcustom org-roam-ui-update-on-save t - "If true, org-roam-ui will send new data when you save an org-roam-buffer. -This can lead to some jank." - :group 'org-roam-ui - :type 'boolean) - -(defcustom org-roam-ui-open-on-start t - "Whether to open your default browser when org-roam-ui-mode launces." - :group 'org-roam-ui - :type 'boolean) - -(defcustom org-roam-ui-find-ref-title t - "Should org-roam-ui use `org-roam-bibtex' to try to find the title of a reference in the bibliography?" - :group 'org-roam-ui - :type 'boolean) - -(defcustom org-roam-ui-retitle-ref-nodes t - "Should org-roam-ui use `org-roam-bibtex' try to retitle reference nodes?" - :group 'org-roam-ui - :type 'boolean) - -(defcustom org-roam-ui-ref-title-template "%^{author-abbrev} (%^{year}) %^{title}" - "A template for title creation, used for references without associated nodes. - -This uses `orb--pre-expand-template' under the hood and therefore only org-style -capture `%^{...}' are supported." - :group 'org-roam-ui - :type 'string) - -(defcustom org-roam-ui-browser-function #'browse-url - "When non-nil launch org-roam-ui with a different browser function. -Takes a function name, such as #'browse-url-chromium. -Defaults to #'browse-url." - :group 'org-roam-ui - :type 'function) - -(defvar org-roam-ui--ws-current-node nil - "Var to keep track of which node you are looking at.") - -(defvar oru-ws nil - "The websocket for org-roam-ui.") - -(defvar org-roam-ui--window nil - "The window for displaying nodes opened from within ORUI. -This is mostly to prevent issues with EXWM and the Webkit browser.") - -;; (defvar org-roam-ui-ws nil -;; "The websocket server for org-roam-ui.") - -;;;###autoload -(define-minor-mode - org-roam-ui-mode - "Enable org-roam-ui. -This serves the web-build and API over HTTP." - :lighter " org-roam-ui" - :global t - :group 'org-roam-ui - :init-value nil - (if (fboundp #'org-roam-version) - (when (eq (seq-first (org-roam-version)) 49) - (message "You are running org-roam %s. Org-roam-ui is only compatible with v2, please upgrade." (org-roam-version)) - (setq org-roam-ui-mode -1)) - (message "Org-roam is either not installed or not running. Please fix this.") - (setq org-roam-ui-mode -1)) - (cond - (org-roam-ui-mode - ;;; check if the default keywords actually exist on `orb-preformat-keywords' - ;;; else add them - (setq-local httpd-port org-roam-ui-port) - (setq httpd-root org-roam-ui/app-build-dir) - (httpd-start) - (setq org-roam-ui-ws - (websocket-server - 35903 - :host 'local - :on-open (lambda (ws) (progn - (setq oru-ws ws) - (org-roam-ui--send-graphdata) - (when org-roam-ui-update-on-save - (add-hook 'after-save-hook #'org-roam-ui--on-save)) - (message "Connection established with org-roam-ui") - (when org-roam-ui-follow - (org-roam-ui-follow-mode 1)))) - :on-message (lambda (_websocket frame) - (let* ((msg (json-parse-string (websocket-frame-text frame) :object-type 'alist)) - (command (alist-get 'command msg)) - (data (alist-get 'data msg))) - (cond ((string= command "open") - (let* ((node (org-roam-populate (org-roam-node-create - :id (alist-get 'id data)))) - (pos (org-roam-node-point node)) - (buf (org-roam-node-find-noselect node))) - (unless (window-live-p org-roam-ui--window) - (if-let ((windows (window-list)) - (or-windows (seq-filter (lambda (window) (org-roam-buffer-p (window-buffer window))) windows)) - (newest-window (car (seq-sort-by #'window-use-time #'v or-windows)))) - (setq org-roam-ui--window newest-window) - (split-window-vertically) - (setq org-roam-ui--window (frame-selected-window)))) - (set-window-buffer org-roam-ui--window buf) - (select-window org-roam-ui--window) - (goto-char pos))) - ((string= command "delete") - (progn - (message "Deleted %s" (alist-get 'file data)) - (delete-file (alist-get 'file data)) - (org-roam-db-sync) - (org-roam-ui--send-graphdata))) - ((string= command "create") - (progn - (if (and (fboundp #'orb-edit-note) (alist-get 'ROAM_REFS data)) - (orb-edit-note (alist-get 'id data))) - (org-roam-capture- - :node (org-roam-node-create :title (alist-get 'title data)) - :props '(:finalize find-file)))) - (t (message "Something went wrong when receiving a message from Org-Roam-UI"))))) - :on-close (lambda (_websocket) - (remove-hook 'after-save-hook #'org-roam-ui--on-save) - (org-roam-ui-follow-mode -1) - (message "Connection with org-roam-ui closed.")))) - (when org-roam-ui-open-on-start (orui-open))) - (t - (progn - (websocket-server-close org-roam-ui-ws) - (httpd-stop) - (remove-hook 'after-save-hook #'org-roam-ui--on-save) - (org-roam-ui-follow-mode -1))))) - -(defun org-roam-ui--on-save () - "Send graphdata on saving an org-roam buffer." - (when (org-roam-buffer-p) - (org-roam-ui--send-graphdata))) - - -(defun org-roam-ui--check-orb-keywords () - "Check if the default keywords are in `orb-preformat-keywords', if not, add them." - (when (and org-roam-ui-retitle-ref-nodes (boundp 'orb-preformat-keywords)) - (dolist (keyword '("author-abbrev" "year" "title")) - (unless (seq-contains-p orb-preformat-keywords keyword) - (setq orb-preformat-keywords (append orb-preformat-keywords (list keyword))))))) - -(defun org-roam-ui--find-ref-title (ref) - "Find the title of the bibtex entry keyed by `REF'. - -Requires `org-roam-bibtex' and `bibtex-completion' (a dependency of `orb') to be -loaded. Returns `ref' if an entry could not be found." - (if (and org-roam-ui-find-ref-title - (fboundp 'bibtex-completion-get-entry) - (fboundp 'orb--pre-expand-template) - (boundp 'orb-preformat-keywords)) - (if-let ((entry (bibtex-completion-get-entry ref)) - (orb-preformat-keywords (append orb-preformat-keywords '("author-abbrev" "year" "title")))) - ;; Create a fake capture template list, only the actual capture at 3 - ;; matters. Interpolate the bibtex entries, and extract the filled - ;; template from the return value. - (nth 3 (orb--pre-expand-template `("" "" plain ,org-roam-ui-ref-title-template) entry)) - ref) - ref)) - -(defun org-roam-ui--replace-nth (el n lst) - "Non-destructively replace the `N'th element of `LST' with `EL'." - (let ((head (butlast lst (- (length lst) n))) - (tail (nthcdr (+ n 1) lst))) - (append head (list el) tail))) - -(defun org-roam-ui--citekey-to-ref (citekey) - "Convert a CITEKEY property (most likely with a `cite:' prefix) to just a key. - -This method is mostly taken from `org-roam-bibtex' -see https://github.com/org-roam/org-roam-bibtex/blob/919ec8d837a7a3bd25232bdba17a0208efaefb2a/orb-utils.el#L289 -but is has been adapted to operate on a sting instead of a node. Requires -`org-ref' to be loaded. Returns the `key' or nil if the format does not match -the `org-ref-cite-re'" - (if-let ((boundp 'org-ref-cite-re) - (citekey-list (split-string-and-unquote citekey))) - (catch 'found - (dolist (c citekey-list) - (when (string-match org-ref-cite-re c) - (throw 'found (match-string 2 c))))))) - -(defun org-roam-ui--retitle-node (node) - "Replace the title of citation NODE with associated notes. - -A new title is created using information from the bibliography and formatted -according to `org-roam-ui-ref-title-template', just like the citation nodes with -a note are. It requires `org-roam-bibtex' and it's dependencies -\(`bibtex-completion' and `org-ref'\) to be loaded. - -Returns the node with an updated title if the current node is a reference node -and the key was found in the bibliography, otherwise the node is returned -unchanged." - (if-let* (org-roam-ui-retitle-ref-nodes - ;; set a fake var because if-let(((boundp 'fake-var))) returns true - (orcr (boundp 'org-ref-cite-re)) - (citekey (cdr (assoc "ROAM_REFS" (nth 5 node)))) - (ref (org-roam-ui--citekey-to-ref citekey)) - (title (org-roam-ui--find-ref-title ref))) - (org-roam-ui--replace-nth title 2 node) - node)) - -(defun org-roam-ui--create-fake-node (ref) - "Create a fake node for REF without a source note." - (list ref ref (org-roam-ui--find-ref-title ref) 0 0 'nil `(("ROAM_REFS" . ,(format "cite:%s" ref)) ("FILELESS" . t)) 'nil)) - -(defun org-roam-ui--send-graphdata () - "Get roam data, make JSON, send through websocket to org-roam-ui." - (let* ((nodes-columns [id file title level pos olp properties ,(funcall group-concat tag (emacsql-escape-raw \, ))]) - (nodes-names [id file title level pos olp properties tags]) - (links-columns [links:source links:dest links:type]) - (cites-columns [citations:node-id citations:cite-key refs:node-id]) - (nodes-db-rows (org-roam-db-query `[:select ,nodes-columns :as tags - :from nodes - :left-join tags - :on (= id node_id) - :group :by id])) - links-db-rows - cites-db-rows - links-with-empty-refs) - ;; Put this check in until Doom upgrades to the latest org-roam - (if (fboundp 'org-roam-db-map-citations) - (setq links-db-rows (org-roam-db-query `[:select ,links-columns - :from links - :where (= links:type "id")]) - ;; Left outer join on refs means any id link (or cite link without a - ;; corresponding node) will have 'nil for the `refs:node-id' value. Any - ;; cite link where a node has that `:ROAM_REFS:' will have a value. - cites-db-rows (org-roam-db-query `[:select ,cites-columns - :from citations - :left :outer :join refs :on (= citations:cite-key refs:ref)]) - ;; Convert any cite links that have nodes with associated refs to an - ;; id based link of type `ref' while removing the 'nil `refs:node-id' - ;; from all other links - cites-db-rows (seq-map (lambda (l) - (pcase-let ((`(,source ,dest ,node-id) l)) - (if node-id - (list source node-id "ref") - (list source dest "cite")))) cites-db-rows) - links-db-rows (append links-db-rows cites-db-rows) - links-with-empty-refs (seq-filter (lambda (link) (string-match-p "cite" (nth 2 link))) cites-db-rows)) - (setq links-db-rows (org-roam-db-query `[:select [links:source links:dest links:type refs:node-id] - :from links - :left :outer :join refs :on (= links:dest refs:ref) - :where (or (= links:type "id") (like links:type "%cite%"))]) - links-db-rows (seq-map (lambda (l) - (pcase-let ((`(,source ,dest ,type ,node-id) l)) - (if node-id - (list source node-id "ref") - (list source dest type)))) links-db-rows) - links-with-empty-refs (seq-filter (lambda (link) (string-match-p "cite" (nth 2 link))) links-db-rows))) - (let* ((empty-refs (delete-dups (seq-map (lambda (link) (nth 1 link)) links-with-empty-refs))) - (fake-nodes (seq-map 'org-roam-ui--create-fake-node empty-refs)) - ;; Try to update real nodes that are reference with a title build from - ;; their bibliography entry. Check configuration here for avoid unneeded - ;; iteration though nodes. - (nodes-db-rows (if org-roam-ui-retitle-ref-nodes (seq-map 'org-roam-ui--retitle-node nodes-db-rows) nodes-db-rows)) - (nodes-db-rows (append nodes-db-rows fake-nodes)) - (response `((nodes . ,(mapcar (apply-partially #'org-roam-ui-sql-to-alist (append nodes-names nil)) nodes-db-rows)) - (links . ,(mapcar (apply-partially #'org-roam-ui-sql-to-alist '(source target type)) links-db-rows)) - (tags . ,(seq-mapcat #'seq-reverse (org-roam-db-query [:select :distinct tag :from tags])))))) - (websocket-send-text oru-ws (json-encode `((type . "graphdata") (data . ,response))))))) - - - -(defun org-roam-ui--update-current-node () - "Send the current node data to the web-socket." - (when (and (websocket-openp oru-ws) (org-roam-buffer-p) (buffer-file-name)) - (let* ((node (org-roam-id-at-point))) - (unless (string= org-roam-ui--ws-current-node node) - (setq org-roam-ui--ws-current-node node) - (websocket-send-text oru-ws (json-encode `((type . "command") (data . ((commandName . "follow") (id . ,node)))))))))) - - -(defun org-roam-ui--update-theme () - "Send the current theme data to the websocket." - (let ((ui-theme (list nil))) - (if org-roam-ui-sync-theme - (if (boundp 'doom-themes--colors) - (let* - ((colors (butlast doom-themes--colors (- (length doom-themes--colors) 25))) doom-theme (list-nil)) - (progn - (dolist (color colors) (push (cons (car color) (car (cdr color))) doom-theme))) - (setq ui-theme doom-theme)) - (setq ui-theme (org-roam-ui-get-theme))) - (when org-roam-ui-custom-theme - org-roam-ui-custom-theme)) - ui-theme)) - -(defun org-roam-ui-sql-to-alist (column-names rows) - "Convert sql result to alist for json encoding. -ROWS is the sql result, while COLUMN-NAMES is the columns to use." - (let (res) - (while rows - ;; emacsql does not want to give us the tags as a list, so we post process it - (if (not (string= (car column-names) "tags")) - (push (cons (pop column-names) (pop rows)) res) - (push (cons (pop column-names) - (seq-remove - (lambda (elt) (string= elt ",")) - rows)) - res) - (setq rows nil))) - res)) - -;; (defservlet* id/:id text/html () -;; (let ((node (org-roam-populate (org-roam-node-create :id id))) -;; html-string) -;; (org-roam-with-temp-buffer (org-roam-node-file node) -;; (progn -;; (setq-local org-export-with-toc nil) -;; (setq-local org-export-with-broken-links t) -;; (setq-local org-export-with-sub-superscripts nil) -;; (replace-string "[[id:" "[[./") -;; (let* ((file-string (buffer-string)) -;; (matches (s-match-strings-all "\\[\\[\\(file:\\|\\.\\/\\)\\(.*\\.\\(png\\|jpg\\|jpeg\\|gif\\|svg\\)\\)\\]\\(\\[.*\\]\\)?\\]" file-string))) -;; (dolist (match matches) -;; (let ((path (elt match 2)) -;; (link (elt match 0))) -;; (unless (file-name-absolute-p path) -;; (setq path (concat (file-name-directory (org-roam-node-file-node)) path))) -;; (setq path (f-full path)) -;; (if (file-exists-p path) -;; (setq file-string -;; (s-replace link (format "[[image:%s]]" path) file-string))))) -;; (erase-buffer) -;; (insert file-string)) -;; (setq html-string (org-export-as 'html)))) -;; (insert html-string) -;; (httpd-send-header t "text/html" 200 :Access-Control-Allow-Origin "*"))) - -(defun org-roam-ui-get-theme () - "Attempt to bring the current theme into a standardized format." -(list `(bg . ,(face-background hl-line-face)) - `(bg-alt . ,(face-background 'default)) - `(fg . ,(face-foreground 'default)) - `(fg-alt . ,(face-foreground font-lock-comment-face)) - `(red . ,(face-foreground 'error)) - `(orange . ,(face-foreground 'warning)) - `(yellow . ,(face-foreground font-lock-builtin-face)) - `(green . ,(face-foreground 'success)) - `(cyan . ,(face-foreground font-lock-constant-face)) - `(blue . ,(face-foreground font-lock-keyword-face)) - `(violet . ,(face-foreground font-lock-constant-face)) - `(magenta . ,(face-foreground font-lock-preprocessor-face)))) - - -;;;; commands -;;;###autoload -(defun orui-open () - "Ensure `org-roam-ui-mode' is enabled, then open the `org-roam-ui' webpage." - (interactive) - (or org-roam-ui-mode (org-roam-ui-mode)) - (funcall org-roam-ui-browser-function (format "http://localhost:%d" org-roam-ui-port))) - -;;;###autoload -(defun orui-node-zoom (&optional id speed padding) - "Move the view of the graph to current node. -or optionally a node of your choosing. -Optionally takes three arguments: -The ID of the node you want to travel to. -The SPEED in ms it takes to make the transition. -The PADDING around the nodes in the viewport." - (interactive) - (if-let ((node (or id (org-roam-id-at-point)))) - (websocket-send-text oru-ws (json-encode `((type . "command") (data . - ((commandName . "zoom") (id . ,node) (speed . ,speed) (padding . ,padding))))))) - (message "No node found.")) - - -;;;###autoload -(defun orui-node-local (&optional id speed padding) - "Open the local graph view of the current node. -Optionally with ID (string), SPEED (number, ms) and PADDING (number, px)." - (interactive) - (if-let ((node (or id (org-roam-id-at-point)))) - (websocket-send-text oru-ws (json-encode `((type . "command") (data . - ((commandName . "local") (id . ,node) (speed . ,speed) (padding . ,padding))))))) - (message "No node found.")) - - -;;;###autoload -(define-minor-mode org-roam-ui-follow-mode - "Set whether ORUI should follow your every move in Emacs." - :lighter " org-roam-ui" - :global t - :group 'org-roam-ui - :init-value nil - (if org-roam-ui-follow-mode - (progn - (add-hook 'post-command-hook #'org-roam-ui--update-current-node) - (message "Org-Roam-UI will now follow you around.")) - (remove-hook 'post-command-hook #'org-roam-ui--update-current-node) - (message "Org-Roam-UI will now leave you alone."))) - - -(defun orui-sync-theme () - "Sync your current Emacs theme with org-roam-ui." - (interactive) - (websocket-send-text oru-ws (json-encode `((type . "theme") (data . ,(org-roam-ui--update-theme)))))) - -(provide 'org-roam-ui) -;;; org-roam-ui.el ends here |