org-roam-utils.el (18786B)
1 ;;; org-roam-utils.el --- Utilities for Org-roam -*- 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") (dash "2.13") (org "9.4")) 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 library provides definitions for utilities that used throughout the 31 ;; whole package. 32 ;; 33 ;;; Code: 34 35 (require 'org-roam) 36 37 (defun org-roam-require (libs) 38 "Require LIBS." 39 (dolist (lib libs) 40 (require lib nil 'noerror))) 41 42 ;;; String utilities 43 ;; TODO Refactor this. 44 (defun org-roam-replace-string (old new s) 45 "Replace OLD with NEW in S." 46 (declare (pure t) (side-effect-free t)) 47 (replace-regexp-in-string (regexp-quote old) new s t t)) 48 49 (defun org-roam-quote-string (s) 50 "Quotes string S." 51 (->> s 52 (org-roam-replace-string "\\" "\\\\") 53 (org-roam-replace-string "\"" "\\\""))) 54 55 (defun org-roam-word-wrap (len s) 56 "If S is longer than LEN, wrap the words with newlines." 57 (declare (side-effect-free t)) 58 (save-match-data 59 (with-temp-buffer 60 (insert s) 61 (let ((fill-column len)) 62 (fill-region (point-min) (point-max))) 63 (buffer-substring (point-min) (point-max))))) 64 65 (defun org-roam-string-equal (s1 s2) 66 "Return t if S1 and S2 are equal. 67 Like `string-equal', but case-insensitive." 68 (and (= (length s1) (length s2)) 69 (or (string-equal s1 s2) 70 (string-equal (downcase s1) (downcase s2))))) 71 72 (defun org-roam-whitespace-content (s) 73 "Return the whitespace content at the end of S." 74 (with-temp-buffer 75 (let ((c 0)) 76 (insert s) 77 (skip-chars-backward " \t\n") 78 (buffer-substring-no-properties 79 (point) (point-max))))) 80 81 (defun org-roam-strip-comments (s) 82 "Strip Org comments from string S." 83 (with-temp-buffer 84 (insert s) 85 (goto-char (point-min)) 86 (while (not (eobp)) 87 (if (org-at-comment-p) 88 (delete-region (point-at-bol) (progn (forward-line) (point))) 89 (forward-line))) 90 (buffer-string))) 91 92 ;;; List utilities 93 (defun org-roam-plist-map! (fn plist) 94 "Map FN over PLIST, modifying it in-place and returning it. 95 FN must take two arguments: the key and the value." 96 (let ((plist-index plist)) 97 (while plist-index 98 (let ((key (pop plist-index))) 99 (setf (car plist-index) (funcall fn key (car plist-index)) 100 plist-index (cdr plist-index))))) 101 plist) 102 103 (defmacro org-roam-dolist-with-progress (spec msg &rest body) 104 "Loop over a list and report progress in the echo area. 105 Like `dolist-with-progress-reporter', but falls back to `dolist' 106 if the function does not yet exist. 107 108 Evaluate BODY with VAR bound to each car from LIST, in turn. 109 Then evaluate RESULT to get return value, default nil. 110 111 MSG is a progress reporter object or a string. In the latter 112 case, use this string to create a progress reporter. 113 114 SPEC is a list, as per `dolist'." 115 (declare (indent 2)) 116 (if (fboundp 'dolist-with-progress-reporter) 117 `(dolist-with-progress-reporter ,spec ,msg ,@body) 118 `(dolist ,spec ,@body))) 119 120 ;;; File utilities 121 (defun org-roam-descendant-of-p (a b) 122 "Return t if A is descendant of B." 123 (unless (equal (file-truename a) (file-truename b)) 124 (string-prefix-p (replace-regexp-in-string "^\\([A-Za-z]\\):" 'downcase (expand-file-name b) t t) 125 (replace-regexp-in-string "^\\([A-Za-z]\\):" 'downcase (expand-file-name a) t t)))) 126 127 (defmacro org-roam-with-file (file keep-buf-p &rest body) 128 "Execute BODY within FILE. 129 If FILE is nil, execute BODY in the current buffer. 130 Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited." 131 (declare (indent 2) (debug t)) 132 `(let* (new-buf 133 (auto-mode-alist nil) 134 (find-file-hook nil) 135 (buf (or (and (not ,file) 136 (current-buffer)) ;If FILE is nil, use current buffer 137 (find-buffer-visiting ,file) ; If FILE is already visited, find buffer 138 (progn 139 (setq new-buf t) 140 (find-file-noselect ,file)))) ; Else, visit FILE and return buffer 141 res) 142 (with-current-buffer buf 143 (unless (derived-mode-p 'org-mode) 144 (delay-mode-hooks 145 (let ((org-inhibit-startup t) 146 (org-agenda-files nil)) 147 (org-mode) 148 (hack-local-variables)))) 149 (setq res (progn ,@body)) 150 (unless (and new-buf (not ,keep-buf-p)) 151 (save-buffer))) 152 (if (and new-buf (not ,keep-buf-p)) 153 (when (find-buffer-visiting ,file) 154 (kill-buffer (find-buffer-visiting ,file)))) 155 res)) 156 157 ;;; Buffer utilities 158 (defmacro org-roam-with-temp-buffer (file &rest body) 159 "Execute BODY within a temp buffer. 160 Like `with-temp-buffer', but propagates `org-roam-directory'. 161 If FILE, set `default-directory' to FILE's directory and insert its contents." 162 (declare (indent 1) (debug t)) 163 (let ((current-org-roam-directory (make-symbol "current-org-roam-directory"))) 164 `(let ((,current-org-roam-directory org-roam-directory)) 165 (with-temp-buffer 166 (let ((org-roam-directory ,current-org-roam-directory)) 167 (delay-mode-hooks (org-mode)) 168 (when ,file 169 (insert-file-contents ,file) 170 (setq-local default-directory (file-name-directory ,file))) 171 ,@body))))) 172 173 ;;; Formatting 174 (defun org-roam-format-template (template replacer) 175 "Format TEMPLATE with the function REPLACER. 176 The templates are of form ${foo} for variable foo, and 177 ${foo=default} for variable foo with default value \"default\". 178 REPLACER takes an argument of the format variable and the default 179 value (possibly nil). Adapted from `s-format'." 180 (let ((saved-match-data (match-data))) 181 (unwind-protect 182 (replace-regexp-in-string 183 "\\${\\([^}]+\\)}" 184 (lambda (md) 185 (let ((var (match-string 1 md)) 186 (replacer-match-data (match-data)) 187 default-val) 188 (when (string-match "\\(.+\\)=\\(.+\\)" var) 189 (setq default-val (match-string 2 var) 190 var (match-string 1 var))) 191 (unwind-protect 192 (let ((v (progn 193 (set-match-data saved-match-data) 194 (funcall replacer var default-val)))) 195 (if v 196 (format (apply #'propertize "%s" (text-properties-at 0 var)) v) 197 (signal 'org-roam-format-resolve md))) 198 (set-match-data replacer-match-data)))) 199 (if (functionp template) 200 (funcall template) 201 template) 202 ;; Need literal to make sure it works 203 t t) 204 (set-match-data saved-match-data)))) 205 206 ;;; Fontification 207 (defvar org-ref-buffer-hacked) 208 209 (defun org-roam-fontify-like-in-org-mode (s) 210 "Fontify string S like in Org mode. 211 Like `org-fontify-like-in-org-mode', but supports `org-ref'." 212 ;; NOTE: pretend that the temporary buffer created by `org-fontify-like-in-org-mode' to 213 ;; fontify a `cite:' reference has been hacked by org-ref, whatever that means; 214 ;; 215 ;; `org-ref-cite-link-face-fn', which is used to supply a face for `cite:' links, calls 216 ;; `hack-dir-local-variables' rationalizing that `bibtex-completion' would throw some warnings 217 ;; otherwise. This doesn't seem to be the case and calling this function just before 218 ;; `org-font-lock-ensure' (alias of `font-lock-ensure') actually instead of fixing the alleged 219 ;; warnings messes the things so badly that `font-lock-ensure' crashes with error and doesn't let 220 ;; org-roam to proceed further. I don't know what's happening there exactly but disabling this hackery 221 ;; fixes the crashing. Fortunately, org-ref provides the `org-ref-buffer-hacked' switch, which we use 222 ;; here to make it believe that the buffer was hacked. 223 ;; 224 ;; This is a workaround for `cite:' links and does not have any effect on other ref types. 225 ;; 226 ;; `org-ref-buffer-hacked' is a buffer-local variable, therefore we inline 227 ;; `org-fontify-like-in-org-mode' here 228 (with-temp-buffer 229 (insert s) 230 (let ((org-ref-buffer-hacked t) 231 (org-fold-core-style 'overlays)) 232 (org-mode) 233 (font-lock-ensure) 234 (buffer-string)))) 235 236 ;;;; Shielding regions 237 (defface org-roam-shielded 238 '((t :inherit (warning))) 239 "Face for regions that are shielded (marked as read-only). 240 This face is used on the region target by org-roam-insertion 241 during an `org-roam-capture'." 242 :group 'org-roam-faces) 243 244 (defun org-roam-shield-region (beg end) 245 "Shield region against modifications. 246 BEG and END are markers for the beginning and end regions. 247 REGION must be a cons-cell containing the marker to the region 248 beginning and maximum values." 249 (add-text-properties beg end 250 '(font-lock-face org-roam-shielded 251 read-only t) 252 (marker-buffer beg))) 253 254 (defun org-roam-unshield-region (beg end) 255 "Unshield the shielded REGION. 256 BEG and END are markers for the beginning and end regions." 257 (let ((inhibit-read-only t)) 258 (remove-text-properties beg end 259 '(font-lock-face org-roam-shielded 260 read-only t) 261 (marker-buffer beg)))) 262 263 ;;; Org-mode utilities 264 ;;;; Motions 265 (defun org-roam-up-heading-or-point-min () 266 "Fixed version of Org's `org-up-heading-or-point-min'." 267 (ignore-errors (org-back-to-heading t)) 268 (let ((p (point))) 269 (if (< 1 (funcall outline-level)) 270 (progn 271 (org-up-heading-safe) 272 (when (= (point) p) 273 (goto-char (point-min)))) 274 (unless (bobp) (goto-char (point-min)))))) 275 276 ;;;; Keywords 277 (defun org-roam-get-keyword (name &optional file bound) 278 "Return keyword property NAME from an org FILE. 279 FILE defaults to current file. 280 Only scans up to BOUND bytes of the document." 281 (unless bound 282 (setq bound 1024)) 283 (if file 284 (with-temp-buffer 285 (insert-file-contents file nil 0 bound) 286 (org-roam--get-keyword name)) 287 (org-roam--get-keyword name bound))) 288 289 (defun org-roam--get-keyword (name &optional bound) 290 "Return keyword property NAME in current buffer. 291 If BOUND, scan up to BOUND bytes of the buffer." 292 (save-excursion 293 (let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name)))) 294 (goto-char (point-min)) 295 (when (re-search-forward re bound t) 296 (buffer-substring-no-properties (match-beginning 1) (match-end 1)))))) 297 298 (defun org-roam-end-of-meta-data (&optional full) 299 "Like `org-end-of-meta-data', but supports file-level metadata. 300 301 When FULL is non-nil but not t, skip planning information, 302 properties, clocking lines and logbook drawers. 303 304 When optional argument FULL is t, skip everything above, and also 305 skip keywords." 306 (org-back-to-heading-or-point-min t) 307 (when (org-at-heading-p) (forward-line)) 308 ;; Skip planning information. 309 (when (looking-at-p org-planning-line-re) (forward-line)) 310 ;; Skip property drawer. 311 (when (looking-at org-property-drawer-re) 312 (goto-char (match-end 0)) 313 (forward-line)) 314 ;; When FULL is not nil, skip more. 315 (when (and full (not (org-at-heading-p))) 316 (catch 'exit 317 (let ((end (save-excursion (outline-next-heading) (point))) 318 (re (concat "[ \t]*$" "\\|" org-clock-line-re))) 319 (while (not (eobp)) 320 (cond ;; Skip clock lines. 321 ((looking-at-p re) (forward-line)) 322 ;; Skip logbook drawer. 323 ((looking-at-p org-logbook-drawer-re) 324 (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) 325 (forward-line) 326 (throw 'exit t))) 327 ((looking-at-p org-drawer-regexp) 328 (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) 329 (forward-line) 330 (throw 'exit t))) 331 ;; When FULL is t, skip keywords too. 332 ((and (eq full t) 333 (looking-at-p org-keyword-regexp)) 334 (forward-line)) 335 (t (throw 'exit t)))))))) 336 337 (defun org-roam-set-keyword (key value) 338 "Set keyword KEY to VALUE. 339 If the property is already set, it's value is replaced." 340 (org-with-point-at 1 341 (let ((case-fold-search t)) 342 (if (re-search-forward (concat "^#\\+" key ":\\(.*\\)") (point-max) t) 343 (if (string-blank-p value) 344 (kill-whole-line) 345 (replace-match (concat " " value) 'fixedcase nil nil 1)) 346 (org-roam-end-of-meta-data 'drawers) 347 (if (save-excursion (end-of-line) (eobp)) 348 (progn 349 (end-of-line) 350 (insert "\n")) 351 (forward-line) 352 (beginning-of-line)) 353 (insert "#+" key ": " value "\n"))))) 354 355 (defun org-roam-erase-keyword (keyword) 356 "Erase the line where the KEYWORD is, setting line from the top of the file." 357 (let ((case-fold-search t)) 358 (org-with-point-at 1 359 (when (re-search-forward (concat "^#\\+" keyword ":") nil t) 360 (beginning-of-line) 361 (delete-region (point) (line-end-position)) 362 (delete-char 1))))) 363 364 ;;;; Properties 365 (defun org-roam-add-property (val prop) 366 "Add VAL value to PROP property for the node at point. 367 Both, VAL and PROP are strings." 368 (org-roam-property-add prop val)) 369 370 (defun org-roam-remove-property (prop &optional val) 371 "Remove VAL value from PROP property for the node at point. 372 Both VAL and PROP are strings. 373 374 If VAL is not specified, user is prompted to select a value." 375 (org-roam-property-remove prop val)) 376 377 (defun org-roam-property-add (prop val) 378 "Add VAL value to PROP property for the node at point. 379 Both, VAL and PROP are strings." 380 (let* ((p (org-entry-get (point) prop)) 381 (lst (when p (split-string-and-unquote p))) 382 (lst (if (memq val lst) lst (cons val lst))) 383 (lst (seq-uniq lst))) 384 (org-set-property prop (combine-and-quote-strings lst)) 385 val)) 386 387 (defun org-roam-property-remove (prop &optional val) 388 "Remove VAL value from PROP property for the node at point. 389 Both VAL and PROP are strings. 390 391 If VAL is not specified, user is prompted to select a value." 392 (let* ((p (org-entry-get (point) prop)) 393 (lst (when p (split-string-and-unquote p))) 394 (prop-to-remove (or val (completing-read "Remove: " lst))) 395 (lst (delete prop-to-remove lst))) 396 (if lst 397 (org-set-property prop (combine-and-quote-strings lst)) 398 (org-delete-property prop)) 399 prop-to-remove)) 400 401 ;;; Refs 402 (defun org-roam-org-ref-path-to-keys (path) 403 "Return a list of keys given an org-ref cite: PATH. 404 Accounts for both v2 and v3." 405 (cond ((fboundp 'org-ref-parse-cite-path) 406 (mapcar (lambda (cite) (plist-get cite :key)) 407 (plist-get (org-ref-parse-cite-path path) :references))) 408 ((fboundp 'org-ref-split-and-strip-string) 409 (org-ref-split-and-strip-string path)))) 410 411 ;;; Logs 412 (defvar org-roam-verbose) 413 (defun org-roam-message (format-string &rest args) 414 "Pass FORMAT-STRING and ARGS to `message' when `org-roam-verbose' is t." 415 (when org-roam-verbose 416 (apply #'message `(,(concat "(org-roam) " format-string) ,@args)))) 417 418 ;;; Diagnostics 419 ;; TODO Update this to also get commit hash 420 ;;;###autoload 421 (defun org-roam-version (&optional message) 422 "Return `org-roam' version. 423 Interactively, or when MESSAGE is non-nil, show in the echo area." 424 (interactive) 425 (let* ((toplib (or load-file-name buffer-file-name)) 426 gitdir topdir version) 427 (unless (and toplib (equal (file-name-nondirectory toplib) "org-roam-utils.el")) 428 (setq toplib (locate-library "org-roam-utils.el"))) 429 (setq toplib (and toplib (org-roam--straight-chase-links toplib))) 430 (when toplib 431 (setq topdir (file-name-directory toplib) 432 gitdir (expand-file-name ".git" topdir))) 433 (when (file-exists-p gitdir) 434 (setq version 435 (let ((default-directory topdir)) 436 (shell-command-to-string "git describe --tags --dirty --always")))) 437 (unless version 438 (setq version (with-temp-buffer 439 (insert-file-contents-literally (locate-library "org-roam.el")) 440 (goto-char (point-min)) 441 (save-match-data 442 (if (re-search-forward "\\(?:;; Version: \\([^z-a]*?$\\)\\)" nil nil) 443 (substring-no-properties (match-string 1)) 444 "N/A"))))) 445 (if (or message (called-interactively-p 'interactive)) 446 (message "%s" version) 447 version))) 448 449 (defun org-roam--straight-chase-links (filename) 450 "Chase links in FILENAME until a name that is not a link. 451 452 This is the same as `file-chase-links', except that it also 453 handles fake symlinks that are created by the package manager 454 straight.el on Windows. 455 456 See <https://github.com/raxod502/straight.el/issues/520>." 457 (when (and (bound-and-true-p straight-symlink-emulation-mode) 458 (fboundp 'straight-chase-emulated-symlink)) 459 (when-let ((target (straight-chase-emulated-symlink filename))) 460 (unless (eq target 'broken) 461 (setq filename target)))) 462 (file-chase-links filename)) 463 464 ;;;###autoload 465 (defun org-roam-diagnostics () 466 "Collect and print info for `org-roam' issues." 467 (interactive) 468 (with-current-buffer (switch-to-buffer-other-window (get-buffer-create "*org-roam diagnostics*")) 469 (erase-buffer) 470 (insert (propertize "Copy info below this line into issue:\n" 'face '(:weight bold))) 471 (insert (format "- Emacs: %s\n" (emacs-version))) 472 (insert (format "- Framework: %s\n" 473 (condition-case _ 474 (completing-read "I'm using the following Emacs framework:" 475 '("Doom" "Spacemacs" "N/A" "I don't know")) 476 (quit "N/A")))) 477 (insert (format "- Org: %s\n" (org-version nil 'full))) 478 (insert (format "- Org-roam: %s" (org-roam-version))) 479 (insert (format "- sqlite-connector: %s" org-roam-database-connector)))) 480 481 482 (provide 'org-roam-utils) 483 ;;; org-roam-utils.el ends here