388 lines
15 KiB
EmacsLisp
388 lines
15 KiB
EmacsLisp
;;; orb-utils.el --- Org Roam BibTeX: utility macros and functions -*- lexical-binding: t -*-
|
||
|
||
;; Copyright © 2020-2022 Mykhailo Shevchuk
|
||
;; Copyright © 2020 Leo Vivier
|
||
|
||
;; Author: Mykhailo Shevchuk <mail@mshevchuk.com>
|
||
;; Leo Vivier <leo.vivier+dev@gmail.com>
|
||
;; URL: https://github.com/org-roam/org-roam-bibtex
|
||
|
||
;; 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
|
||
;; this program; see the file LICENSE. If not, visit
|
||
;; <https://www.gnu.org/licenses/>.
|
||
|
||
;; N.B. This file contains code snippets adopted from other
|
||
;; open-source projects. These snippets are explicitly marked as such
|
||
;; in place. They are not subject to the above copyright and
|
||
;; authorship claims.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; This file contains utility macros and helper functions used accross
|
||
;; different org-mode-bibtex modules. This library may be required
|
||
;; directly or through orb-core.el. Definitions in this file should
|
||
;; only depend on built-in Emacs libraries.
|
||
|
||
;;; Code:
|
||
|
||
;; ============================================================================
|
||
;;;; Dependencies
|
||
;; ============================================================================
|
||
;;
|
||
;; org-roam requires org,org-element, dash, f, s, emacsql, emacsql-sqlite,
|
||
;; so all these libraries are always at our disposal
|
||
|
||
(require 'org-roam)
|
||
(require 'bibtex-completion)
|
||
|
||
(require 'warnings)
|
||
|
||
(eval-when-compile
|
||
(require 'subr-x))
|
||
|
||
(defvar org-ref-cite-types)
|
||
|
||
;; Adopted from `org-roam-version'
|
||
(defun orb-version (&optional message)
|
||
"Return `orb-roam' version.
|
||
Interactively, or when MESSAGE is non-nil, show in the echo area."
|
||
(interactive)
|
||
(let* ((toplib (or load-file-name buffer-file-name))
|
||
gitdir topdir version)
|
||
(unless (and toplib (equal (file-name-nondirectory toplib) "orb-utils.el"))
|
||
(setq toplib (locate-library "orb-utils.el")))
|
||
(setq toplib (and toplib (org-roam--straight-chase-links toplib)))
|
||
(when toplib
|
||
(setq topdir (file-name-directory toplib)
|
||
gitdir (expand-file-name ".git" topdir)))
|
||
(when (file-exists-p gitdir)
|
||
(setq version
|
||
(let ((default-directory topdir))
|
||
(shell-command-to-string
|
||
"git describe --tags --dirty --always"))))
|
||
(unless version
|
||
(setq version (with-temp-buffer
|
||
(insert-file-contents-literally
|
||
(locate-library "org-roam-bibtex.el"))
|
||
(goto-char (point-min))
|
||
(save-match-data
|
||
(if (re-search-forward
|
||
"\\(?:;; Version: \\([^z-a]*?$\\)\\)" nil nil)
|
||
(substring-no-properties (match-string 1))
|
||
"N/A")))))
|
||
(if (or message (called-interactively-p 'interactive))
|
||
(message "%s" version)
|
||
version)))
|
||
|
||
;; ============================================================================
|
||
;;;; Macros
|
||
;; ============================================================================
|
||
|
||
(defmacro orb--with-message! (message &rest body)
|
||
"Put MESSAGE before and after BODY.
|
||
Append \"...\" to the first message and \"...done\" to the second.
|
||
Return result of evaluating the BODY."
|
||
(declare (indent 1) (debug (stringp &rest form)))
|
||
(let ((reporter (gensym "orb")))
|
||
`(let ((,reporter (make-progress-reporter ,message)))
|
||
,@body
|
||
(progress-reporter-done ,reporter))))
|
||
|
||
(defmacro orb-note-actions-defun (interface &rest body)
|
||
"Return a function definition for INTERFACE.
|
||
Function name takes a form of orb-note-actions--INTERFACE. A
|
||
simple docstring is constructed and BODY is injected into a `let'
|
||
form, which has two variables bound, NAME and CANDIDATES. NAME
|
||
is a string formatted with `orb-format-entry' and CANDIDATES
|
||
is a cons cell alist constructed from `orb-note-actions-default',
|
||
`orb-note-actions-extra', and `orb-note-actions-user'."
|
||
(declare (indent 1) (debug (symbolp &rest form)))
|
||
(let* ((interface-name (symbol-name interface))
|
||
(fun-name (intern (concat "orb-note-actions-" interface-name))))
|
||
`(defun ,fun-name (citekey)
|
||
,(format "Provide note actions using %s interface.
|
||
CITEKEY is the citekey." (capitalize interface-name))
|
||
(let ((name (orb-format-entry citekey)) ;; TODO: make a native format function
|
||
(candidates
|
||
,(unless (eq interface 'hydra)
|
||
'(append orb-note-actions-default
|
||
orb-note-actions-extra
|
||
orb-note-actions-user))))
|
||
,@body))))
|
||
|
||
;; ============================================================================
|
||
;;;; General utilities
|
||
;; ============================================================================
|
||
|
||
(defun orb-warning (warning &optional citekey)
|
||
"Display a WARNING message. Return nil.
|
||
Include CITEKEY if it is non-nil."
|
||
(display-warning
|
||
:warning (concat "ORB: " (when citekey (format "%s :" citekey)) warning))
|
||
nil)
|
||
|
||
(defun orb-buffer-string (&optional start end)
|
||
"Retun buffer (sub)string with no text porperties.
|
||
Like `buffer-substring-no-properties' but START and END are
|
||
optional and equal to (`point-min') and (`point-max'),
|
||
respectively, if nil."
|
||
(buffer-substring-no-properties (or start (point-min))
|
||
(or end (point-max))))
|
||
|
||
(defun orb-format (&rest args)
|
||
"Format ARGS conditionally and return a string.
|
||
ARGS must be a plist, whose keys are `format' control strings and
|
||
values are `format' objects. Thus only one object per control
|
||
string is allowed. The result will be concatenated into a single
|
||
string.
|
||
|
||
In the simplest case, it behaves as a sort of interleaved `format':
|
||
==========
|
||
|
||
\(orb-format \"A: %s\" 'hello
|
||
\" B: %s\" 'world
|
||
\" C: %s\" \"!\")
|
||
|
||
=> 'A: hello B: world C: !'
|
||
|
||
If format object is nil, it will be formatted as empty string:
|
||
==========
|
||
|
||
\(orb-format \"A: %s\" 'hello
|
||
\" B: %s\" nil
|
||
\" C: %s\" \"!\")
|
||
=> 'A: hello C: !'
|
||
|
||
Object can also be a cons cell. If its car is nil then its cdr
|
||
will be treated as default value and formatted as \"%s\":
|
||
==========
|
||
|
||
\(orb-format \"A: %s\" 'hello
|
||
\" B: %s\" '(nil . dworl)
|
||
\" C: %s\" \"!\")
|
||
=> 'A: hellodworl C: !'
|
||
|
||
Finally, if the control string is nil, the object will be formatted as \"%s\":
|
||
==========
|
||
|
||
\(orb-format \"A: %s\" 'hello
|
||
\" B: %s\" '(nil . \" world\")
|
||
nil \"!\")
|
||
=> 'A: hello world!'."
|
||
(let ((res ""))
|
||
(while args
|
||
(let ((str (pop args))
|
||
(obj (pop args)))
|
||
(unless (consp obj)
|
||
(setq obj (cons obj nil)))
|
||
(setq res
|
||
(concat res
|
||
(format (or (and (car obj) str) "%s")
|
||
(or (car obj) (cdr obj) ""))))))
|
||
res))
|
||
|
||
;; ============================================================================
|
||
;;;; Temporary files
|
||
;; ============================================================================
|
||
|
||
;;;;; Code in this section was adopted from ob-core.el
|
||
;;
|
||
;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
|
||
;;
|
||
;; Authors: Eric Schulte
|
||
;; Dan Davison
|
||
|
||
(defvar orb--temp-dir)
|
||
(unless (or noninteractive (boundp 'orb--temp-dir))
|
||
(defvar orb--temp-dir
|
||
(or (and (boundp 'orb--temp-dir)
|
||
(file-exists-p orb--temp-dir)
|
||
orb--temp-dir)
|
||
(make-temp-file "orb-" t))
|
||
"Directory to hold temporary files created during reference parsing.
|
||
Used by `orb-temp-file'. This directory will be removed on Emacs
|
||
shutdown."))
|
||
|
||
(defun orb-temp-file (prefix &optional suffix)
|
||
"Create a temporary file in the `orb--temp-dir'.
|
||
Passes PREFIX and SUFFIX directly to `make-temp-file' with the
|
||
value of variable `temporary-file-directory' temporarily set to
|
||
the value of `orb--temp-dir'."
|
||
(let ((temporary-file-directory
|
||
(or (and (boundp 'orb--temp-dir)
|
||
(file-exists-p orb--temp-dir)
|
||
orb--temp-dir)
|
||
temporary-file-directory)))
|
||
(make-temp-file prefix nil suffix)))
|
||
|
||
(defun orb--remove-temp-dir ()
|
||
"Remove `orb--temp-dir' on Emacs shutdown."
|
||
(when (and (boundp 'orb--temp-dir)
|
||
(file-exists-p orb--temp-dir))
|
||
;; taken from `delete-directory' in files.el
|
||
(condition-case nil
|
||
(progn
|
||
(mapc (lambda (file)
|
||
;; This test is equivalent to
|
||
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
|
||
;; but more efficient
|
||
(if (eq t (car (file-attributes file)))
|
||
(delete-directory file)
|
||
(delete-file file)))
|
||
(directory-files orb--temp-dir 'full
|
||
directory-files-no-dot-files-regexp))
|
||
(delete-directory orb--temp-dir))
|
||
(error
|
||
(message "Failed to remove temporary Org-roam-bibtex directory %s"
|
||
(if (boundp 'orb--temp-dir)
|
||
orb--temp-dir
|
||
"[directory not defined]"))))))
|
||
|
||
(add-hook 'kill-emacs-hook 'orb--remove-temp-dir)
|
||
|
||
;;;;; End of code adopted from ob-core.el
|
||
|
||
;; ============================================================================
|
||
;;;; Document properties
|
||
;; ============================================================================
|
||
|
||
(defvar orb-utils-citekey-re
|
||
;; NOTE: Not tested thoroughly
|
||
(rx
|
||
(or
|
||
(seq (group-n 2 (regexp
|
||
;; If Org-ref is available, use its types
|
||
;; default to "cite"
|
||
(if (boundp 'org-ref-cite-types)
|
||
(regexp-opt
|
||
(mapcar
|
||
(lambda (el)
|
||
;; Org-ref v3 cite type is a list of strings
|
||
;; Org-ref v2 cite type is a plain string
|
||
(or (car-safe el) el))
|
||
org-ref-cite-types))
|
||
"cite")))
|
||
":"
|
||
(or
|
||
;; Org-ref v2 style `cite:links'
|
||
(group-n 1 (+ (any "a-zA-Z0-9_:.-")))
|
||
;; Org-ref v3 style `cite:Some&key'
|
||
(seq (*? (not "&")) "&"
|
||
(group-n 1 (+ (any "!#-+./:<>-@^-`{-~-" word))))))
|
||
;; Org-cite [cite/@citations]
|
||
(seq "@" (group-n 1 (+ (any "!#-+./:<>-@^-`{-~-" word))))))
|
||
"Universal regexp to match citations in `ROAM_REFS'.
|
||
Supports Org-ref v2 and v3 and Org-cite.")
|
||
|
||
(defun orb-get-db-cite-refs ()
|
||
"Get a list of `cite` refs from Org Roam database."
|
||
(let* ((types "cite")
|
||
(refs (org-roam-db-query
|
||
[:select [ref nodes:file id pos title type]
|
||
:from refs
|
||
:left-join nodes
|
||
:on (= refs:node-id nodes:id)
|
||
:where (= type $s1)]
|
||
types))
|
||
result)
|
||
(dolist (ref refs result)
|
||
(push (-interleave '(:ref :file :id :pos :title :type) ref) result))))
|
||
|
||
(defvar orb-notes-cache nil
|
||
"Cache of ORB notes.")
|
||
|
||
(defun orb-make-notes-cache ()
|
||
"Update ORB notes hash table `orb-notes-cache'."
|
||
(let* ((db-entries (orb-get-db-cite-refs))
|
||
(size (round (/ (length db-entries) 0.8125))) ;; ht oversize
|
||
(ht (make-hash-table :test #'equal :size size)))
|
||
(dolist (entry db-entries)
|
||
(puthash (plist-get entry :ref)
|
||
(org-roam-node-create
|
||
:id (plist-get entry :id)
|
||
:file (plist-get entry :file)
|
||
:title (plist-get entry :title)
|
||
:point (plist-get entry :pos))
|
||
ht))
|
||
(setq orb-notes-cache ht)))
|
||
|
||
(defun orb-find-note-file (citekey)
|
||
"Find note file associated with CITEKEY.
|
||
Returns the path to the note file, or nil if it doesn’t exist."
|
||
(when-let ((node (gethash citekey (or orb-notes-cache
|
||
(orb-make-notes-cache)))))
|
||
(org-roam-node-file node)))
|
||
|
||
(defun orb-get-buffer-keyword (keyword &optional buffer)
|
||
"Return the value of Org KEYWORD in-buffer directive.
|
||
The KEYWORD should be given as a string without \"#+\", e.g. \"title\".
|
||
|
||
If optional BUFFER is non-nil, return the value from that buffer
|
||
instead of `current-buffer'."
|
||
;; NOTE: does not work with `org-element-multiple-keywords' keywords
|
||
;; if that will somewhen be required, `org-element' should be used.
|
||
(with-current-buffer (or buffer (current-buffer))
|
||
(let ((case-fold-search t))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(re-search-forward
|
||
(format "^[ ]*#\\+%s:[ ]*\\(.*\\)$" keyword) nil t)
|
||
(match-string-no-properties 1)))))
|
||
|
||
(defun orb-note-exists-p (citekey)
|
||
"Check if a note exists whose citekey is CITEKEY.
|
||
Return Org Roam node or nil."
|
||
;; NOTE: This function can be made more general.
|
||
(gethash citekey (or orb-notes-cache
|
||
(orb-make-notes-cache))))
|
||
|
||
(defun orb-get-node-citekey (&optional node assert)
|
||
"Return citation key associated with NODE.
|
||
If optional NODE is nil, return the citekey for node at point.
|
||
ASSERT will be passed to `org-roam-node-at-point'. If it is
|
||
non-nil, an error will be thrown if there is no node at point."
|
||
(when-let ((node (or node
|
||
;; try to get node at point only in Org mode;
|
||
;; can brake other things if not in Org mode, see e.g.
|
||
;; https://github.com/org-roam/org-roam-bibtex/issues/268
|
||
(and (derived-mode-p 'org-mode)
|
||
(org-roam-node-at-point assert))))
|
||
(node-refs (cdr (assoc-string
|
||
"ROAM_REFS"
|
||
(org-roam-node-properties node) t))))
|
||
(let* ((ref-list (split-string-and-unquote node-refs)))
|
||
(catch 'found
|
||
(dolist (ref ref-list)
|
||
(when (string-match orb-utils-citekey-re ref)
|
||
(throw 'found (match-string 1 ref))))))))
|
||
|
||
(defun orb-format-entry (citekey)
|
||
"Format a BibTeX entry for display, whose citation key is CITEKEY.
|
||
Uses `bibtex-completion-format-entry' internally and so the
|
||
display can be tweaked in the `bibtex-completion-display-formats'
|
||
variable."
|
||
;; NOTE: A drop-in replacement for `org-ref-format-entry' which was removed
|
||
;; in Org-ref v3. Still waiting for a native solution.
|
||
(bibtex-completion-init)
|
||
(bibtex-completion-format-entry
|
||
(bibtex-completion-get-entry citekey) (1- (frame-width))))
|
||
|
||
(provide 'orb-utils)
|
||
;;; orb-utils.el ends here
|
||
;; Local Variables:
|
||
;; coding: utf-8
|
||
;; fill-column: 79
|
||
;; End:
|