daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

pkg update and first config fix

Browse Source 
org-brain not working, add org-roam
This commit is contained in:
Daniel Weschke
2022-12-19 23:02:34 +01:00
parent 02b3e07185
commit 82f05baffe
885 changed files with 356098 additions and 36993 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
lisp/org-roam/dir Normal file
View File

@@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Org-roam: (org-roam). Roam Research for Emacs.

829
lisp/org-roam/org-roam-capture.el Normal file
View File

@@ -0,0 +1,829 @@
;;; org-roam-capture.el --- Capture functionality -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.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 module provides `org-capture' functionality for Org-roam. With this
;; module the user can capture new nodes or capture new content to existing
;; nodes.
;;
;;; Code:
(require 'org-roam)
;;;; Declarations
(defvar org-end-time-was-given)
;;; Options
(defcustom org-roam-capture-templates
'(("d" "default" plain "%?"
:target (file+head "%<%Y%m%d%H%M%S>-${slug}.org"
"#+title: ${title}\n")
:unnarrowed t))
"Templates for the creation of new entries within Org-roam.
Each entry is a list with the following items:
keys The keys that will select the template, as a string, characters only, for
example \"a\" for a template to be selected with a single key, or
\"bt\" for selection with two keys. When using several keys, keys
using the same prefix must be together in the list and preceded by a
2-element entry explaining the prefix key, for example:
(\"b\" \"Templates for marking stuff to buy\")
The \"C\" key is used by default for quick access to the customization of
the template variable. But if you want to use that key for a template,
you can.
description A short string describing the template, which will be shown
during selection.
type The type of entry. Valid types are:
entry an Org node, with a headline. Will be filed
as the child of the target entry or as a
top level entry. Its default template is:
\"* %?\n %a\"
item a plain list item, will be placed in the
first plain list at the target location.
Its default template is:
\"- %?\"
checkitem a checkbox item. This differs from the
plain list item only in so far as it uses a
different default template. Its default
template is:
\"- [ ] %?\"
table-line a new line in the first table at target location.
Its default template is:
\"| %? |\"
plain text to be inserted as it is.
template The template for creating the capture item.
If it is an empty string or nil, a default template based on
the entry type will be used (see the \"type\" section above).
Instead of a string, this may also be one of:
(file \"/path/to/template-file\")
(function function-returning-the-template)
in order to get a template from a file, or dynamically
from a function.
The template contains a compulsory :target property. The :target property
contains a list, where:
- The first element indicates the type of the target.
- The second element indicates the location of the captured node.
- And the rest of the list indicate the prefilled template, that will be
inserted and the position of the point will be adjusted for.
This behavior varies from type to type.
The following options are supported for the :target property:
(file \"path/to/file\")
The file will be created, and prescribed an ID.
(file+head \"path/to/file\" \"head content\")
The file will be created, prescribed an ID, and head content will be
inserted if the node is a newly captured one.
(file+olp \"path/to/file\" (\"h1\" \"h2\"))
The file will be created, prescribed an ID. If the file doesn't contain
the outline path (h1, h2), it will be automatically created. The point
will be adjusted to the last element in the OLP.
(file+head+olp \"path/to/file\" \"head content\" (\"h1\" \"h2\"))
The file will be created, prescribed an ID. Head content will be
inserted at the start of the file if the node is a newly captured one.
If the file doesn't contain the outline path (h1, h2), it will be
automatically created. The point will be adjusted to the last element in
the OLP.
(file+datetree \"path/to/file\" tree-type)
The file will be created, prescribed an ID. A date based outline path
will be created for today's date. The tree-type can be one of the
following symbols: day, week or month. The point will adjusted to the
last element in the tree. To prompt for date instead of using today's,
use the :time-prompt property.
(node \"title or alias or ID of an existing node\")
The point will be placed for an existing node, based on either, its
title, alias or ID.
The rest of the entry is a property list of additional options. Recognized
properties are:
:prepend Normally newly captured information will be appended at
the target location (last child, last table line,
last list item...). Setting this property will
change that.
:immediate-finish When set, do not offer to edit the information, just
file it away immediately. This makes sense if the
template only needs information that can be added
automatically.
:jump-to-captured When set, jump to the captured entry when finished.
:empty-lines Set this to the number of lines that should be inserted
before and after the new item. Default 0, only common
other value is 1.
:empty-lines-before Set this to the number of lines that should be inserted
before the new item. Overrides :empty-lines for the
number lines inserted before.
:empty-lines-after Set this to the number of lines that should be inserted
after the new item. Overrides :empty-lines for the
number of lines inserted after.
:clock-in Start the clock in this item.
:clock-keep Keep the clock running when filing the captured entry.
:clock-resume Start the interrupted clock when finishing the capture.
Note that :clock-keep has precedence over :clock-resume.
When setting both to t, the current clock will run and
the previous one will not be resumed.
:time-prompt Prompt for a date/time to be used for date/week trees
and when filling the template.
:tree-type When `week', make a week tree instead of the month-day
tree. When `month', make a month tree instead of the
month-day tree.
:unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you
only see the new stuff.
:table-line-pos Specification of the location in the table where the
new line should be inserted. It should be a string like
\"II-3\", meaning that the new line should become the
third line before the second horizontal separator line.
:kill-buffer If the target file was not yet visited by a buffer when
capture was invoked, kill the buffer again after capture
is finalized.
:no-save Do not save the target file after finishing the capture.
The template defines the text to be inserted. Often this is an
Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded:
%[pathname] Insert the contents of the file given by
`pathname'. These placeholders are expanded at the very
beginning of the process so they can be used to extend the
current template.
%(sexp) Evaluate elisp `(sexp)' and replace it with the results.
Only placeholders pre-existing within the template, or
introduced with %[pathname] are expanded this way. Since this
happens after expanding non-interactive %-escapes, those can
be used to fill the expression.
%<...> The result of `format-time-string' on the ... format
specification.
%t Time stamp, date only. The time stamp is the current time,
except when called from agendas with `\\[org-agenda-capture]' or
with `org-capture-use-agenda-date' set.
%T Time stamp as above, with date and time.
%u, %U Like the above, but inactive time stamps.
%i Initial content, copied from the active region. If
there is text before %i on the same line, such as
indentation, and %i is not inside a %(sexp), that prefix
will be added before every line in the inserted text.
%a Annotation, normally the link created with `org-store-link'.
%A Like %a, but prompt for the description part.
%l Like %a, but only insert the literal link.
%L Like %l, but without brackets (the link content itself).
%c Current kill ring head.
%x Content of the X clipboard.
%k Title of currently clocked task.
%K Link to currently clocked task.
%n User name (taken from the variable `user-full-name').
%f File visited by current buffer when `org-capture' was called.
%F Full path of the file or directory visited by current buffer.
%:keyword Specific information for certain link types, see below.
%^g Prompt for tags, with completion on tags in target file.
%^G Prompt for tags, with completion on all tags in all agenda files.
%^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like: %^{Please specify birthday}t.
The default date is that of %t, see above.
%^C Interactive selection of which kill or clip to use.
%^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'.
A default value can be specified like this:
%^{prop|default}p.
%^{prompt} Prompt the user for a string and replace this sequence with it.
A default value and a completion table can be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
%\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
is a number, starting from 1.
Apart from these general escapes, you can access information specific to
the link type that is created. For example, calling `org-capture' in emails
or in Gnus will record the author and the subject of the message, which you
can access with \"%:from\" and \"%:subject\", respectively. Here is a
complete list of what is recorded for each link type.
Link type | Available information
------------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, mew, rmail, | %:type %:subject %:message-id
gnus | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
| %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
eww, w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date
When you need to insert a literal percent sign in the template,
you can escape ambiguous cases with a backward slash, e.g., \\%i.
In addition to all of the above, Org-roam supports additional
substitutions within its templates. \"${foo}\" will look for the
foo property in the Org-roam node (see the `org-roam-node'). If
the property does not exist, the user will be prompted to fill in
the string value.
Org-roam templates are NOT compatible with regular Org capture:
they rely on additional hacks and hooks to achieve the
streamlined user experience in Org-roam."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :target)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-roam-capture-new-node-hook nil
"Normal-mode hooks run when a new Org-roam node is created.
The current point is the point of the new node.
The hooks must not move the point."
:group 'org-roam
:type 'hook)
(defvar org-roam-capture-preface-hook nil
"Hook run when Org-roam tries to determine capture location of the node.
If any hook returns a value (which should be an ID), all hooks
after it are ignored.
With this hook you can hijack controls over the location of the
node for which the capture process is currently running for, or
use to just perform an arbitrary side effect, e.g. modify the
state related to the capture process. See `org-roam-protocol' and
`org-roam-dailies' as examples for what and how this hook is used
for.
If you're trying to perform the hijack, it's mandatory for you to:
1. Set the currently active buffer for editing operations using
`org-capture-target-buffer'.
2. Place the point in this buffer from where the location starts
from (e.g. if it's a file based node it should be the BOB,
otherwise it should be the position from where the heading
based node starts from).
3. Return the ID (as a string) of the capturing node.
If you use this hook for any other purpose, but not the hijack,
it's mandatory that you should return nil as the return value; so
the capture process would be able to setup the capture buffer.
If you need to do something when you capture new nodes, use
`org-roam-capture-new-node-hook' instead of this hook.
WARNING: This hook is primarily designed for the usage by the
extensions and packages, and requires understanding of the
internal capture process. If you don't understand it, you should
learn these internals before using this or use it at your own
risk breaking things.")
;;; Variables
(defvar org-roam-capture--node nil
"The node passed during an Org-roam capture.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defvar org-roam-capture--info nil
"A property-list of additional information passed to the Org-roam template.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defconst org-roam-capture--template-keywords (list :target :id :link-description :call-location
:region)
"Keywords used in `org-roam-capture-templates' specific to Org-roam.")
;;; Main entry point
;;;###autoload
(cl-defun org-roam-capture- (&key goto keys node info props templates)
"Main entry point of `org-roam-capture' module.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates."
(let* ((props (plist-put props :call-location (point-marker)))
(org-capture-templates
(mapcar (lambda (template)
(org-roam-capture--convert-template template props))
(or templates org-roam-capture-templates)))
(_ (setf (org-roam-node-id node) (or (org-roam-node-id node)
(org-id-new))))
(org-roam-capture--node node)
(org-roam-capture--info info))
(when (and (not keys)
(= (length org-capture-templates) 1))
(setq keys (caar org-capture-templates)))
(org-capture goto keys)))
;;;###autoload
(cl-defun org-roam-capture (&optional goto keys &key filter-fn templates info)
"Launches an `org-capture' process for a new or existing node.
This uses the templates defined at `org-roam-capture-templates'.
Arguments GOTO and KEYS see `org-capture'.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)
The INFO, if provided, is passed along to the underlying `org-roam-capture-'."
(interactive "P")
(let ((node (org-roam-node-read nil filter-fn)))
(org-roam-capture- :goto goto
:info info
:keys keys
:templates templates
:node node
:props '(:immediate-finish nil))))
;;; Capture process
(defun org-roam-capture-p ()
"Return t if the current capture process is an Org-roam capture.
This function is to only be called when `org-capture-plist' is
valid for the capture (i.e. initialization, and finalization of
the capture)."
(plist-get org-capture-plist :org-roam))
(defun org-roam-capture--get (keyword)
"Get the value for KEYWORD from the `org-roam-capture-template'."
(plist-get (plist-get org-capture-plist :org-roam) keyword))
(defun org-roam-capture--put (prop value)
"Set property PROP to VALUE in the `org-roam-capture-template'."
(let ((p (plist-get org-capture-plist :org-roam)))
(setq org-capture-plist
(plist-put org-capture-plist
:org-roam
(plist-put p prop value)))))
;;;; Capture target
(defun org-roam-capture--prepare-buffer ()
"Prepare the capture buffer for the current Org-roam based capture template.
This function will initialize and setup the capture buffer,
position the point to the current :target (and if necessary,
create it if it doesn't exist), and place the point for further
processing by `org-capture'.
Note: During the capture process this function is run by
`org-capture-set-target-location', as a (function ...) based
capture target."
(let ((id (cond ((run-hook-with-args-until-success 'org-roam-capture-preface-hook))
(t (org-roam-capture--setup-target-location)))))
(org-roam-capture--adjust-point-for-capture-type)
(let ((template (org-capture-get :template)))
(when (stringp template)
(org-capture-put
:template
(org-roam-capture--fill-template template))))
(org-roam-capture--put :id id)
(org-roam-capture--put :finalize (or (org-capture-get :finalize)
(org-roam-capture--get :finalize)))))
(defun org-roam-capture--setup-target-location ()
"Initialize the buffer, and goto the location of the new capture.
Return the ID of the location."
(let (p new-file-p)
(pcase (org-roam-capture--get-target)
(`(file ,path)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(when new-file-p (org-roam-capture--put :new-file path))
(set-buffer (org-capture-target-buffer path))
(widen)
(setq p (goto-char (point-min))))
(`(file+olp ,path ,olp)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(when new-file-p (org-roam-capture--put :new-file path))
(set-buffer (org-capture-target-buffer path))
(setq p (point-min))
(let ((m (org-roam-capture-find-or-create-olp olp)))
(goto-char m))
(widen))
(`(file+head ,path ,head)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(set-buffer (org-capture-target-buffer path))
(when new-file-p
(org-roam-capture--put :new-file path)
(insert (org-roam-capture--fill-template head 'ensure-newline)))
(widen)
(setq p (goto-char (point-min))))
(`(file+head+olp ,path ,head ,olp)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(set-buffer (org-capture-target-buffer path))
(widen)
(when new-file-p
(org-roam-capture--put :new-file path)
(insert (org-roam-capture--fill-template head 'ensure-newline)))
(setq p (point-min))
(let ((m (org-roam-capture-find-or-create-olp olp)))
(goto-char m)))
(`(file+datetree ,path ,tree-type)
(setq path (org-roam-capture--target-truepath path))
(require 'org-datetree)
(widen)
(set-buffer (org-capture-target-buffer path))
(unless (file-exists-p path)
(org-roam-capture--put :new-file path))
(funcall
(pcase tree-type
(`week #'org-datetree-find-iso-week-create)
(`month #'org-datetree-find-month-create)
(_ #'org-datetree-find-date-create))
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
;; Use the overriding default time.
(time-to-days org-overriding-default-time))
((org-capture-get :default-time)
(time-to-days (org-capture-get :default-time)))
((org-capture-get :time-prompt)
;; Prompt for date. Bind `org-end-time-was-given' so
;; that `org-read-date-analyze' handles the time range
;; case and returns `prompt-time' with the start value.
(let* ((org-time-was-given nil)
(org-end-time-was-given nil)
(prompt-time (org-read-date
nil t nil "Date for tree entry:")))
(org-capture-put
:default-time
(if (or org-time-was-given
(= (time-to-days prompt-time) (org-today)))
prompt-time
;; Use 00:00 when no time is given for another
;; date than today?
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time)))))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
;; workers.
(org-today)))))
(setq p (point)))
(`(node ,title-or-id)
;; first try to get ID, then try to get title/alias
(let ((node (or (org-roam-node-from-id title-or-id)
(org-roam-node-from-title-or-alias title-or-id)
(user-error "No node with title or id \"%s\"" title-or-id))))
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(setq p (org-roam-node-point node)))))
;; Setup `org-id' for the current capture target and return it back to the
;; caller.
(save-excursion
(goto-char p)
(if-let ((id (org-entry-get p "ID")))
(setf (org-roam-node-id org-roam-capture--node) id)
(org-entry-put p "ID" (org-roam-node-id org-roam-capture--node)))
(prog1
(org-id-get)
(run-hooks 'org-roam-capture-new-node-hook)))))
(defun org-roam-capture--get-target ()
"Get the current capture :target for the capture template in use."
(or (org-roam-capture--get :target)
(user-error "Template needs to specify `:target'")))
(defun org-roam-capture--target-truepath (path)
"From PATH get the correct path to the current capture target and return it.
PATH is a string that can optionally contain templated text in
it."
(or (org-roam-node-file org-roam-capture--node)
(thread-first
path
(org-roam-capture--fill-template)
(string-trim)
(expand-file-name org-roam-directory))))
(defun org-roam-capture--new-file-p (path)
"Return t if PATH is for a new file with no visiting buffer."
(not (or (file-exists-p path)
(org-find-base-buffer-visiting path))))
(defun org-roam-capture-find-or-create-olp (olp)
"Return a marker pointing to the entry at OLP in the current buffer.
If OLP does not exist, create it. If anything goes wrong, throw
an error, and if you need to do something based on this error,
you can catch it with `condition-case'."
(let* ((level 1)
(lmin 1)
(lmax 1)
(start (point-min))
(end (point-max))
found flevel)
(unless (derived-mode-p 'org-mode)
(error "Buffer %s needs to be in Org mode" (current-buffer)))
(org-with-wide-buffer
(goto-char start)
(dolist (heading olp)
(setq heading (org-roam-capture--fill-template heading))
(let ((re (format org-complex-heading-regexp-format
(regexp-quote heading)))
(cnt 0))
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(when (and (>= level lmin) (<= level lmax))
(setq found (match-beginning 0) flevel level cnt (1+ cnt))))
(when (> cnt 1)
(error "Heading not unique on level %d: %s" lmax heading))
(when (= cnt 0)
;; Create heading if it doesn't exist
(goto-char end)
(unless (bolp) (newline))
(let (org-insert-heading-respect-content)
(org-insert-heading nil nil t))
(unless (= lmax 1)
(dotimes (_ level) (org-do-demote)))
(insert heading)
(setq end (point))
(goto-char start)
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(when (and (>= level lmin) (<= level lmax))
(setq found (match-beginning 0) flevel level cnt (1+ cnt))))))
(goto-char found)
(setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq start found
end (save-excursion (org-end-of-subtree t t))))
(point-marker))))
(defun org-roam-capture--adjust-point-for-capture-type (&optional pos)
"Reposition the point for template insertion dependently on the capture type.
Return the newly adjusted position of `point'.
POS is the current position of point (an integer) inside the
currently active capture buffer, where the adjustment should
start to begin from. If it's nil, then it will default to
the current value of `point'."
(or pos (setq pos (point)))
(goto-char pos)
(let ((location-type (if (= pos 1) 'beginning-of-file 'heading-at-point)))
(and (eq location-type 'heading-at-point)
(cl-assert (org-at-heading-p)))
(pcase (org-capture-get :type)
(`plain
(cl-case location-type
(beginning-of-file
(if (org-capture-get :prepend)
(let ((el (org-element-at-point)))
(while (and (not (eobp))
(memq (org-element-type el)
'(drawer property-drawer keyword comment comment-block horizontal-rule)))
(goto-char (org-element-property :end el))
(setq el (org-element-at-point))))
(goto-char (org-entry-end-position))))
(heading-at-point
(if (org-capture-get :prepend)
(org-end-of-meta-data t)
(goto-char (org-entry-end-position))))))))
(point))
;;; Capture implementation
(add-hook 'org-roam-capture-preface-hook #'org-roam-capture--try-capture-to-ref-h)
(defun org-roam-capture--try-capture-to-ref-h ()
"Try to capture to an existing node that match the ref."
(when-let ((node (and (plist-get org-roam-capture--info :ref)
(org-roam-node-from-ref
(plist-get org-roam-capture--info :ref)))))
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(widen)
(org-roam-node-id node)))
(add-hook 'org-roam-capture-new-node-hook #'org-roam-capture--insert-captured-ref-h)
(defun org-roam-capture--insert-captured-ref-h ()
"Insert the ref if any."
(when-let ((ref (plist-get org-roam-capture--info :ref)))
(org-roam-ref-add ref)))
;;;; Finalizers
(add-hook 'org-capture-prepare-finalize-hook #'org-roam-capture--install-finalize-h)
(defun org-roam-capture--install-finalize-h ()
"Install `org-roam-capture--finalize' if the capture is an Org-roam capture."
(when (org-roam-capture-p)
(add-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize)))
(defun org-roam-capture--finalize ()
"Finalize the `org-roam-capture' process."
(when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region)))
(if org-note-abort
(when-let ((new-file (org-roam-capture--get :new-file))
(_ (yes-or-no-p "Delete file for aborted capture?")))
(when (find-buffer-visiting new-file)
(kill-buffer (find-buffer-visiting new-file)))
(delete-file new-file))
(when-let* ((buffer (plist-get org-capture-plist :buffer))
(file (buffer-file-name buffer)))
(org-id-add-location (org-roam-capture--get :id) file))
(when-let* ((finalize (org-roam-capture--get :finalize))
(org-roam-finalize-fn (intern (concat "org-roam-capture--finalize-"
(symbol-name finalize)))))
(if (functionp org-roam-finalize-fn)
(funcall org-roam-finalize-fn)
(funcall finalize))))
(remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize))
(defun org-roam-capture--finalize-find-file ()
"Visit the buffer after Org-capture is done.
This function is to be called in the Org-capture finalization process.
ID is unused."
(switch-to-buffer (org-capture-get :buffer)))
(defun org-roam-capture--finalize-insert-link ()
"Insert a link to ID into the buffer where Org-capture was called.
ID is the Org id of the newly captured content.
This function is to be called in the Org-capture finalization process."
(when-let* ((mkr (org-roam-capture--get :call-location))
(buf (marker-buffer mkr)))
(with-current-buffer buf
(when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region))
(delete-region (car region) (cdr region))
(set-marker (car region) nil)
(set-marker (cdr region) nil))
(let* ((id (org-roam-capture--get :id))
(description (org-roam-capture--get :link-description))
(link (org-link-make-string (concat "id:" id)
description)))
(if (eq (point) (marker-position mkr))
(insert link)
(org-with-point-at mkr
(insert link)))
(run-hook-with-args 'org-roam-post-node-insert-hook
id
description)))))
;;;; Processing of the capture templates
(defun org-roam-capture--fill-template (template &optional ensure-newline)
"Expand TEMPLATE and return it.
It expands ${var} occurrences in TEMPLATE, and then runs
org-capture's template expansion.
When ENSURE-NEWLINE, always ensure there's a newline behind."
(let* ((template (if (functionp template)
(funcall template)
template))
(template-whitespace-content (org-roam-whitespace-content template)))
(setq template
(org-roam-format-template
template
(lambda (key default-val)
(let ((fn (intern key))
(node-fn (intern (concat "org-roam-node-" key)))
(ksym (intern (concat ":" key))))
(cond
((fboundp fn)
(funcall fn org-roam-capture--node))
((fboundp node-fn)
(funcall node-fn org-roam-capture--node))
((plist-get org-roam-capture--info ksym)
(plist-get org-roam-capture--info ksym))
(t (let ((r (read-from-minibuffer (format "%s: " key) default-val)))
(plist-put org-roam-capture--info ksym r)
r)))))))
;; WARNING:
;; `org-capture-fill-template' fills the template, but post-processes whitespace such that the resultant
;; template does not start with any whitespace, and only ends with a single newline
;;
;; Instead, we restore the whitespace in the original template.
(setq template (replace-regexp-in-string "[\n]*\\'" "" (org-capture-fill-template template)))
(when (and ensure-newline
(string-equal template-whitespace-content ""))
(setq template-whitespace-content "\n"))
(setq template (concat template template-whitespace-content))
template))
(defun org-roam-capture--convert-template (template &optional props)
"Convert TEMPLATE from Org-roam syntax to `org-capture-templates' syntax.
PROPS is a plist containing additional Org-roam specific
properties to be added to the template."
(pcase template
(`(,_key ,_desc)
template)
((or `(,key ,desc ,type ignore ,body . ,rest)
`(,key ,desc ,type (function ignore) ,body . ,rest)
`(,key ,desc ,type ,body . ,rest))
(setq rest (append rest props))
(let (org-roam-plist options)
(while rest
(let* ((key (pop rest))
(val (pop rest))
(custom (member key org-roam-capture--template-keywords)))
(when (and custom
(not val))
(user-error "Invalid capture template format: %s\nkey %s cannot be nil" template key))
(if custom
(setq org-roam-plist (plist-put org-roam-plist key val))
(setq options (plist-put options key val)))))
(append `(,key ,desc ,type #'org-roam-capture--prepare-buffer ,body)
options
(list :org-roam org-roam-plist))))
(_
(signal 'invalid-template template))))
(provide 'org-roam-capture)
;;; org-roam-capture.el ends here

241
lisp/org-roam/org-roam-compat.el Normal file
View File

@@ -0,0 +1,241 @@
;;; org-roam-compat.el --- Backward compatibility code -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1"))
;; 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 file is dedicated to maintain backward compatibility with older older
;; Emacsen and Org-roam versions.
;;
;;; Code:
(require 'org-roam)
;;; Backports
;; REVIEW Remove when 26.x support is dropped. This is exact the same as
;; `directory-files-recursively' from Emacs 26, but with FOLLOW-SYMLINKS
;; parameter from Emacs 27.
(defun org-roam--directory-files-recursively (dir regexp
&optional include-directories predicate
follow-symlinks)
"Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included.
PREDICATE can be either nil (which means that all subdirectories
of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
(when (and (or (not (file-symlink-p full-file))
(and (file-symlink-p full-file)
follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
(condition-case nil
(org-roam--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks)
(file-error nil))
(org-roam--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
;;; Compatibility hacks and patches
(advice-add #'org-id-add-location :around #'org-roam--handle-absent-org-id-locations-file-a)
(defun org-roam--handle-absent-org-id-locations-file-a (fn &rest args)
"Gracefully handle errors related to absence of `org-id-locations-file'.
FN is `org-id-add-location' that comes from advice and ARGS are
passed to it."
(condition-case err
(apply fn args)
;; `org-id' makes the assumption that `org-id-locations-file' will be stored in `user-emacs-directory'
;; which always exist if you have Emacs, so it uses `with-temp-file' to write to the file. However, the
;; users *do* change the path to this file and `with-temp-file' unable to create the file, if the path to
;; it consists of directories that don't exist. We'll have to handle this ourselves.
(error
(advice-remove 'org-id-add-location #'org-roam--handle-absent-org-id-locations-file-a)
(if (file-exists-p (file-truename org-id-locations-file))
(signal (car err) (cdr err))
;; Pre-allocate the hash table to avoid weird access related errors during the regeneration.
(or org-id-locations (setq org-id-locations (make-hash-table :test 'equal)))
;; If permissions allow that, try to create the user specified directory path to
;; `org-id-locations-file' ourselves.
(condition-case _err
(progn (org-roam-message (concat "`org-id-locations-file' (%s) doesn't exist. "
"Trying to regenerate it (this may take a while)...")
org-id-locations-file)
(make-directory (file-name-directory (file-truename org-id-locations-file)))
(org-roam-update-org-id-locations)
(apply fn args))
;; In case of failure (lack of permissions), we'll patch it to at least handle the current session
;; without errors.
(file-error (org-roam-message "Failed to regenerate `org-id-locations-file'")
(lwarn 'org-roam :error "
--------
WARNING: `org-id-locations-file' (%s) doesn't exist!
Org-roam is unable to create it for you.
--------
This happens when Emacs doesn't have permissions to create the
path to your `org-id-locations-file'. Org-roam will now fallback
storing the file in your current `org-roam-directory', but the
warning will keep popup with each new session.
To stop this warning from popping up, set `org-id-locations-file'
to the location you want and ensure that the path exists on your
filesystem, then run M-x `org-roam-update-org-id-locations'.
Note: While Org-roam doesn't depend on `org-id-locations-file' to
lookup IDs for the nodes that are stored in the database, it
still tries to keep it updated so IDs work across other files in
Org-mode, so the IDs used in your `org-roam-directory' would be
able to cross-reference outside of `org-roam-directory'. It also
allows to keep linking with \"id:\" links within the current
`org-roam-directory' to headings and files that are excluded from
identification (e.g. with \"ROAM_EXCLUDE\" property) as Org-roam
nodes." org-id-locations-file)
(setq org-id-locations-file
(expand-file-name ".orgids" (file-truename org-roam-directory)))
(apply fn args)))))))
;;;; Deprecated :if-new capture template keyword
(with-eval-after-load 'org-roam-capture
(add-to-list 'org-roam-capture--template-keywords :if-new)
(let ((inhibit-warning-p t)) ; REVIEW Set this to nil close to next major release
(advice-add 'org-roam-capture--get-target :around #'org-roam-capture--get-if-new-target-a)
(defun org-roam-capture--get-if-new-target-a (fn &rest args)
"Get the current capture target using deprecated :if-new property."
(if-let ((target (org-roam-capture--get :if-new)))
(prog1 target
(unless inhibit-warning-p
(lwarn 'org-roam-capture :warning
(mapconcat
#'identity
["`:if-new' property is deprecated in favor of `:target'."
"This warning will popup once per each session. In order to get"
"rid of it, rename all the references to the `:if-new' property"
"in your capture templates to `:target'."]
"\n"))
;; Don't irritate the user too much. Displaying the warning once per session should be enough.
(setq inhibit-warning-p t)))
(apply fn args)))))
;;; Obsolete aliases (remove after next major release)
(define-obsolete-function-alias
'org-roam-setup
'org-roam-db-autosync-enable "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-teardown
'org-roam-db-autosync-disable "org-roam 2.0")
(define-obsolete-variable-alias
'org-roam-current-node
'org-roam-buffer-current-node "org-roam 2.0")
(define-obsolete-variable-alias
'org-roam-current-directory
'org-roam-buffer-current-directory "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-buffer-render
'org-roam-buffer-render-contents "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-buffer
'org-roam-buffer-display-dedicated "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-visit-thing
'org-roam-buffer-visit-thing "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-today
'org-roam-dailies-goto-today "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-yesterday
'org-roam-dailies-goto-yesterday "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-tomorrow
'org-roam-dailies-goto-tomorrow "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-next-note
'org-roam-dailies-goto-next-note "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-previous-note
'org-roam-dailies-goto-previous-note "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-date
'org-roam-dailies-goto-date "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-add-property
'org-roam-property-add "org-roam 2.1")
(define-obsolete-function-alias
'org-roam-remove-property
'org-roam-property-remove "org-roam 2.1")
(define-obsolete-variable-alias
'org-roam-mode-section-functions
'org-roam-mode-sections "org-roam 2.2.0")
;;; Obsolete functions
(make-obsolete 'org-roam-get-keyword 'org-collect-keywords "org-roam 2.0")
(provide 'org-roam-compat)
;;; org-roam-compat.el ends here

366
lisp/org-roam/org-roam-dailies.el Normal file
View File

@@ -0,0 +1,366 @@
;;; org-roam-dailies.el --- Daily-notes for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;;;
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020 Leo Vivier <leo.vivier+dev@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; Leo Vivier <leo.vivier+dev@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org-roam "2.1"))
;; 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 extension provides functionality for creating daily-notes, or shortly
;; "dailies". Dailies implemented here as a unique node per unique file, where
;; each file named after certain date and stored in `org-roam-dailies-directory'.
;;
;; One can use dailies for various purposes, e.g. journaling, fleeting notes,
;; scratch notes or whatever else you can think of.
;;
;;; Code:
(require 'dash)
(require 'org-roam)
;;; Faces
(defface org-roam-dailies-calendar-note
'((t :inherit (org-link) :underline nil))
"Face for dates with a daily-note in the calendar."
:group 'org-roam-faces)
;;; Options
(defcustom org-roam-dailies-directory "daily/"
"Path to daily-notes.
This path is relative to `org-roam-directory'."
:group 'org-roam
:type 'string)
(defcustom org-roam-dailies-find-file-hook nil
"Hook that is run right after navigating to a daily-note."
:group 'org-roam
:type 'hook)
(defcustom org-roam-dailies-capture-templates
`(("d" "default" entry
"* %?"
:target (file+head "%<%Y-%m-%d>.org"
"#+title: %<%Y-%m-%d>\n")))
"Capture templates for daily-notes in Org-roam.
Note that for daily files to show up in the calendar, they have to be of format
\"org-time-string.org\".
See `org-roam-capture-templates' for the template documentation."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :target)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
;;; Commands
;;;; Today
;;;###autoload
(defun org-roam-dailies-capture-today (&optional goto keys)
"Create an entry in the daily-note for today.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "P")
(org-roam-dailies--capture (current-time) goto keys))
;;;###autoload
(defun org-roam-dailies-goto-today (&optional keys)
"Find the daily-note for today, creating it if necessary.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive)
(org-roam-dailies-capture-today t keys))
;;;; Tomorrow
;;;###autoload
(defun org-roam-dailies-capture-tomorrow (n &optional goto keys)
"Create an entry in the daily-note for tomorrow.
With numeric argument N, use the daily-note N days in the future.
With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies--capture (time-add (* n 86400) (current-time)) goto keys))
;;;###autoload
(defun org-roam-dailies-goto-tomorrow (n &optional keys)
"Find the daily-note for tomorrow, creating it if necessary.
With numeric argument N, use the daily-note N days in the
future.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies-capture-tomorrow n t keys))
;;;; Yesterday
;;;###autoload
(defun org-roam-dailies-capture-yesterday (n &optional goto keys)
"Create an entry in the daily-note for yesteday.
With numeric argument N, use the daily-note N days in the past.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies-capture-tomorrow (- n) goto keys))
;;;###autoload
(defun org-roam-dailies-goto-yesterday (n &optional keys)
"Find the daily-note for yesterday, creating it if necessary.
With numeric argument N, use the daily-note N days in the
future.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies-capture-tomorrow (- n) t keys))
;;;; Date
;;;###autoload
(defun org-roam-dailies-capture-date (&optional goto prefer-future keys)
"Create an entry in the daily-note for a date using the calendar.
Prefer past dates, unless PREFER-FUTURE is non-nil.
With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "P")
(let ((time (let ((org-read-date-prefer-future prefer-future))
(org-read-date nil t nil (if goto
"Find daily-note: "
"Capture to daily-note: ")))))
(org-roam-dailies--capture time goto keys)))
;;;###autoload
(defun org-roam-dailies-goto-date (&optional prefer-future keys)
"Find the daily-note for a date using the calendar, creating it if necessary.
Prefer past dates, unless PREFER-FUTURE is non-nil.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive)
(org-roam-dailies-capture-date t prefer-future keys))
;;;; Navigation
(defun org-roam-dailies-goto-next-note (&optional n)
"Find next daily-note.
With numeric argument N, find note N days in the future. If N is
negative, find note N days in the past."
(interactive "p")
(unless (org-roam-dailies--daily-note-p)
(user-error "Not in a daily-note"))
(setq n (or n 1))
(let* ((dailies (org-roam-dailies--list-files))
(position
(cl-position-if (lambda (candidate)
(string= (buffer-file-name (buffer-base-buffer)) candidate))
dailies))
note)
(unless position
(user-error "Can't find current note file - have you saved it yet?"))
(pcase n
((pred (natnump))
(when (eq position (- (length dailies) 1))
(user-error "Already at newest note")))
((pred (integerp))
(when (eq position 0)
(user-error "Already at oldest note"))))
(setq note (nth (+ position n) dailies))
(find-file note)
(run-hooks 'org-roam-dailies-find-file-hook)))
(defun org-roam-dailies-goto-previous-note (&optional n)
"Find previous daily-note.
With numeric argument N, find note N days in the past. If N is
negative, find note N days in the future."
(interactive "p")
(let ((n (if n (- n) -1)))
(org-roam-dailies-goto-next-note n)))
(defun org-roam-dailies--list-files (&rest extra-files)
"List all files in `org-roam-dailies-directory'.
EXTRA-FILES can be used to append extra files to the list."
(let ((dir (expand-file-name org-roam-dailies-directory org-roam-directory))
(regexp (rx-to-string `(and "." (or ,@org-roam-file-extensions)))))
(append (--remove (let ((file (file-name-nondirectory it)))
(when (or (auto-save-file-name-p file)
(backup-file-name-p file)
(string-match "^\\." file))
it))
(directory-files-recursively dir regexp))
extra-files)))
(defun org-roam-dailies--daily-note-p (&optional file)
"Return t if FILE is an Org-roam daily-note, nil otherwise.
If FILE is not specified, use the current buffer's file-path."
(when-let ((path (expand-file-name
(or file
(buffer-file-name (buffer-base-buffer)))))
(directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(setq path (expand-file-name path))
(save-match-data
(and
(org-roam-file-p path)
(org-roam-descendant-of-p path directory)))))
;;;###autoload
(defun org-roam-dailies-find-directory ()
"Find and open `org-roam-dailies-directory'."
(interactive)
(find-file (expand-file-name org-roam-dailies-directory org-roam-directory)))
;;; Calendar integration
(defun org-roam-dailies-calendar--file-to-date (file)
"Convert FILE to date.
Return (MONTH DAY YEAR) or nil if not an Org time-string."
(ignore-errors
(cl-destructuring-bind (_ _ _ d m y _ _ _)
(org-parse-time-string
(file-name-sans-extension
(file-name-nondirectory file)))
(list m d y))))
(defun org-roam-dailies-calendar-mark-entries ()
"Mark days in the calendar for which a daily-note is present."
(when (file-exists-p (expand-file-name org-roam-dailies-directory org-roam-directory))
(dolist (date (remove nil
(mapcar #'org-roam-dailies-calendar--file-to-date
(org-roam-dailies--list-files))))
(when (calendar-date-is-visible-p date)
(calendar-mark-visible-date date 'org-roam-dailies-calendar-note)))))
(add-hook 'calendar-today-visible-hook #'org-roam-dailies-calendar-mark-entries)
(add-hook 'calendar-today-invisible-hook #'org-roam-dailies-calendar-mark-entries)
;;; Capture implementation
(add-to-list 'org-roam-capture--template-keywords :override-default-time)
(defun org-roam-dailies--capture (time &optional goto keys)
"Capture an entry in a daily-note for TIME, creating it if necessary.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(let ((org-roam-directory (expand-file-name org-roam-dailies-directory org-roam-directory))
(org-roam-dailies-directory "./"))
(org-roam-capture- :goto (when goto '(4))
:keys keys
:node (org-roam-node-create)
:templates org-roam-dailies-capture-templates
:props (list :override-default-time time)))
(when goto (run-hooks 'org-roam-dailies-find-file-hook)))
(add-hook 'org-roam-capture-preface-hook #'org-roam-dailies--override-capture-time-h)
(defun org-roam-dailies--override-capture-time-h ()
"Override the `:default-time' with the time from `:override-default-time'."
(prog1 nil
(when (org-roam-capture--get :override-default-time)
(org-capture-put :default-time (org-roam-capture--get :override-default-time)))))
;;; Bindings
(defvar org-roam-dailies-map (make-sparse-keymap)
"Keymap for `org-roam-dailies'.")
(define-prefix-command 'org-roam-dailies-map)
(define-key org-roam-dailies-map (kbd "d") #'org-roam-dailies-goto-today)
(define-key org-roam-dailies-map (kbd "y") #'org-roam-dailies-goto-yesterday)
(define-key org-roam-dailies-map (kbd "t") #'org-roam-dailies-goto-tomorrow)
(define-key org-roam-dailies-map (kbd "n") #'org-roam-dailies-capture-today)
(define-key org-roam-dailies-map (kbd "f") #'org-roam-dailies-goto-next-note)
(define-key org-roam-dailies-map (kbd "b") #'org-roam-dailies-goto-previous-note)
(define-key org-roam-dailies-map (kbd "c") #'org-roam-dailies-goto-date)
(define-key org-roam-dailies-map (kbd "v") #'org-roam-dailies-capture-date)
(define-key org-roam-dailies-map (kbd ".") #'org-roam-dailies-find-directory)
(provide 'org-roam-dailies)
;;; org-roam-dailies.el ends here

787
lisp/org-roam/org-roam-db.el Normal file
View File

@@ -0,0 +1,787 @@
;;; org-roam-db.el --- Org-roam database API -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.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 module provides the underlying database API to Org-roam.
;;
;;; Code:
(require 'org-roam)
(require 'url-parse)
(require 'ol)
(defvar org-outline-path-cache)
;;; Options
(defcustom org-roam-database-connector 'sqlite
"The database connector used by Org-roam.
This must be set before `org-roam' is loaded. To use an alternative
connector you must install the respective package explicitly.
The default is `sqlite', which uses the `emacsql-sqlite' library
that is being maintained in the same repository as `emacsql'
itself.
If you are using Emacs 29, then the recommended connector is
`sqlite-builtin', which uses the new builtin support for SQLite.
You need to install the `emacsql-sqlite-builtin' package to use
this connector.
If you are using an older Emacs release, then the recommended
connector is `sqlite-module', which uses the module provided by
the `sqlite3' package. This is very similar to the previous
connector and the built-in support in Emacs 29 derives from this
module. You need to install the `emacsql-sqlite-module' package
to use this connector.
For the time being `libsqlite3' is still supported. Do not use
this, it is an older version of the `sqlite-module' connector
from before the connector and the package were renamed.
For the time being `sqlite3' is also supported. Do not use this.
This uses the third-party `emacsql-sqlite3' package, which uses
the official `sqlite3' cli tool, which is not intended
to be used like this. See https://nullprogram.com/blog/2014/02/06/."
:package-version '(forge . "0.3.0")
:group 'org-roam
:type '(choice (const sqlite)
(const sqlite-builtin)
(const sqlite-module)
(const :tag "libsqlite3 (OBSOLETE)" libsqlite3)
(const :tag "sqlite3 (BROKEN)" sqlite3)))
(defcustom org-roam-db-location (locate-user-emacs-file "org-roam.db")
"The path to file where the Org-roam database is stored.
It is the user's responsibility to set this correctly, especially
when used with multiple Org-roam instances."
:type 'string
:group 'org-roam)
(defcustom org-roam-db-gc-threshold gc-cons-threshold
"The value to temporarily set the `gc-cons-threshold' threshold to.
During `org-roam-db-sync', Emacs can pause multiple times to
perform garbage collection because of the large number of
temporary structures generated (e.g. parsed ASTs).
`gc-cons-threshold' is temporarily set to
`org-roam-db-gc-threshold' during this operation, and increasing
`gc-cons-threshold' will help reduce the number of GC operations,
at the cost of memory usage. Tweaking this value may lead to
better overall performance.
For example, to reduce the number of GCs to the minimum, on
machines with large memory one may set it to
`most-positive-fixnum'."
:type 'int
:group 'org-roam)
(defcustom org-roam-db-node-include-function (lambda () t)
"A custom function to check if the point contains a valid node.
This function is called each time a node (both file and headline)
is about to be saved into the Org-roam database.
If the function returns nil, Org-roam will skip the node. This
function is useful for excluding certain nodes from the Org-roam
database."
:type 'function
:group 'org-roam)
(defcustom org-roam-db-update-on-save t
"If t, update the Org-roam database upon saving the file.
Disable this if your files are large and updating the database is
slow."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-db-extra-links-elements '(node-property keyword)
"The list of Org element types to include for parsing by Org-roam.
By default, when parsing Org's AST, links within keywords and
property drawers are not parsed as links. Sometimes however, it
is desirable to parse and cache these links (e.g. hiding links in
a property drawer)."
:package-version '(org-roam . "2.2.0")
:group 'org-roam
:type '(set (const :tag "keywords" keyword)
(const :tag "property drawers" node-property)))
(defcustom org-roam-db-extra-links-exclude-keys '((node-property . ("ROAM_REFS"))
(keyword . ("transclude")))
"Keys to ignore when mapping over links.
The car of the association list is the Org element type (e.g.
keyword). The cdr is a list of case-insensitive strings to
exclude from being treated as links.
For example, we use this to prevent self-referential links in
ROAM_REFS."
:package-version '(org-roam . "2.2.0")
:group 'org-roam
:type '(alist))
;;; Variables
(defconst org-roam-db-version 18)
(defvar org-roam-db--connection (make-hash-table :test #'equal)
"Database connection to Org-roam database.")
;;; Core Functions
(defun org-roam-db--get-connection ()
"Return the database connection, if any."
(gethash (expand-file-name (file-name-as-directory org-roam-directory))
org-roam-db--connection))
(declare-function emacsql-sqlite "ext:emacsql-sqlite")
(declare-function emacsql-sqlite3 "ext:emacsql-sqlite3")
(declare-function emacsql-libsqlite3 "ext:emacsql-libsqlite3")
(declare-function emacsql-sqlite-builtin "ext:emacsql-sqlite-builtin")
(declare-function emacsql-sqlite-module "ext:emacsql-sqlite-module")
(defun org-roam-db--conn-fn ()
"Return the function for creating the database connection."
(cl-case org-roam-database-connector
(sqlite
(progn
(require 'emacsql-sqlite)
#'emacsql-sqlite))
(sqlite-builtin
(progn
(require 'emacsql-sqlite-builtin)
#'emacsql-sqlite-builtin))
(sqlite-module
(progn
(require 'emacsql-sqlite-module)
#'emacsql-sqlite-module))
(libsqlite3
(progn
(require 'emacsql-libsqlite3)
#'emacsql-libsqlite3))
(sqlite3
(progn
(require 'emacsql-sqlite3)
#'emacsql-sqlite3))))
(defun org-roam-db ()
"Entrypoint to the Org-roam sqlite database.
Initializes and stores the database, and the database connection.
Performs a database upgrade when required."
(unless (and (org-roam-db--get-connection)
(emacsql-live-p (org-roam-db--get-connection)))
(let ((init-db (not (file-exists-p org-roam-db-location))))
(make-directory (file-name-directory org-roam-db-location) t)
(let ((conn (funcall (org-roam-db--conn-fn) org-roam-db-location)))
(emacsql conn [:pragma (= foreign_keys ON)])
(when-let* ((process (emacsql-process conn))
(_ (processp process)))
(set-process-query-on-exit-flag process nil))
(puthash (expand-file-name (file-name-as-directory org-roam-directory))
conn
org-roam-db--connection)
(when init-db
(org-roam-db--init conn))
(let* ((version (caar (emacsql conn "PRAGMA user_version")))
(version (org-roam-db--upgrade-maybe conn version)))
(cond
((> version org-roam-db-version)
(emacsql-close conn)
(user-error
"The Org-roam database was created with a newer Org-roam version. "
"You need to update the Org-roam package"))
((< version org-roam-db-version)
(emacsql-close conn)
(error "BUG: The Org-roam database scheme changed %s"
"and there is no upgrade path")))))))
(org-roam-db--get-connection))
;;; Entrypoint: (org-roam-db-query)
(define-error 'emacsql-constraint "SQL constraint violation")
(defun org-roam-db-query (sql &rest args)
"Run SQL query on Org-roam database with ARGS.
SQL can be either the emacsql vector representation, or a string."
(apply #'emacsql (org-roam-db) sql args))
(defun org-roam-db-query! (handler sql &rest args)
"Run SQL query on Org-roam database with ARGS.
SQL can be either the emacsql vector representation, or a string.
The query is expected to be able to fail, in this situation, run HANDLER."
(condition-case err
(org-roam-db-query sql args)
(emacsql-constraint
(funcall handler err))))
;;; Schemata
(defconst org-roam-db--table-schemata
'((files
[(file :unique :primary-key)
title
(hash :not-null)
(atime :not-null)
(mtime :not-null)])
(nodes
([(id :not-null :primary-key)
(file :not-null)
(level :not-null)
(pos :not-null)
todo
priority
(scheduled text)
(deadline text)
title
properties
olp]
(:foreign-key [file] :references files [file] :on-delete :cascade)))
(aliases
([(node-id :not-null)
alias]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(citations
([(node-id :not-null)
(cite-key :not-null)
(pos :not-null)
properties]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(refs
([(node-id :not-null)
(ref :not-null)
(type :not-null)]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(tags
([(node-id :not-null)
tag]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(links
([(pos :not-null)
(source :not-null)
(dest :not-null)
(type :not-null)
(properties :not-null)]
(:foreign-key [source] :references nodes [id] :on-delete :cascade)))))
(defconst org-roam-db--table-indices
'((alias-node-id aliases [node-id])
(refs-node-id refs [node-id])
(tags-node-id tags [node-id])))
(defun org-roam-db--init (db)
"Initialize database DB with the correct schema and user version."
(emacsql-with-transaction db
(pcase-dolist (`(,table ,schema) org-roam-db--table-schemata)
(emacsql db [:create-table $i1 $S2] table schema))
(pcase-dolist (`(,index-name ,table ,columns) org-roam-db--table-indices)
(emacsql db [:create-index $i1 :on $i2 $S3] index-name table columns))
(emacsql db (format "PRAGMA user_version = %s" org-roam-db-version))))
(defun org-roam-db--upgrade-maybe (db version)
"Upgrades the database schema for DB, if VERSION is old."
(emacsql-with-transaction db
'ignore
(if (< version org-roam-db-version)
(progn
(org-roam-message (format "Upgrading the Org-roam database from version %d to version %d"
version org-roam-db-version))
(org-roam-db-sync t))))
version)
(defun org-roam-db--close (&optional db)
"Closes the database connection for database DB.
If DB is nil, closes the database connection for the database in
the current `org-roam-directory'."
(unless db
(setq db (org-roam-db--get-connection)))
(when (and db (emacsql-live-p db))
(emacsql-close db)))
(defun org-roam-db--close-all ()
"Closes all database connections made by Org-roam."
(dolist (conn (hash-table-values org-roam-db--connection))
(org-roam-db--close conn)))
;;; Database API
;;;; Clearing
(defun org-roam-db-clear-all ()
"Clears all entries in the Org-roam cache."
(interactive)
(when (file-exists-p org-roam-db-location)
(dolist (table (mapcar #'car org-roam-db--table-schemata))
(org-roam-db-query `[:delete :from ,table]))))
(defun org-roam-db-clear-file (&optional file)
"Remove any related links to the FILE.
This is equivalent to removing the node from the graph.
If FILE is nil, clear the current buffer."
(setq file (or file (buffer-file-name (buffer-base-buffer))))
(org-roam-db-query [:delete :from files
:where (= file $s1)]
file))
;;;; Updating tables
(defun org-roam-db--file-title ()
"In current Org buffer, get the title.
If there is no title, return the file name relative to
`org-roam-directory'."
(org-link-display-format
(or (string-join (cdr (assoc "TITLE" (org-collect-keywords '("title")))) " ")
(file-name-sans-extension (file-relative-name
(buffer-file-name (buffer-base-buffer))
org-roam-directory)))))
(defun org-roam-db-insert-file (&optional hash)
"Update the files table for the current buffer.
If UPDATE-P is non-nil, first remove the file in the database.
If HASH is non-nil, use that as the file's hash without recalculating it."
(let* ((file (buffer-file-name))
(file-title (org-roam-db--file-title))
(attr (file-attributes file))
(atime (file-attribute-access-time attr))
(mtime (file-attribute-modification-time attr))
(hash (or hash (org-roam-db--file-hash file))))
(org-roam-db-query
[:insert :into files
:values $v1]
(list (vector file file-title hash atime mtime)))))
(defun org-roam-db-get-scheduled-time ()
"Return the scheduled time at point in ISO8601 format."
(when-let ((time (org-get-scheduled-time (point))))
(org-format-time-string "%FT%T%z" time)))
(defun org-roam-db-get-deadline-time ()
"Return the deadline time at point in ISO8601 format."
(when-let ((time (org-get-deadline-time (point))))
(org-format-time-string "%FT%T%z" time)))
(defun org-roam-db-node-p ()
"Return t if headline at point is an Org-roam node, else return nil."
(and (org-id-get)
(not (org-entry-get (point) "ROAM_EXCLUDE"))
(funcall org-roam-db-node-include-function)))
(defun org-roam-db-map-nodes (fns)
"Run FNS over all nodes in the current buffer."
(org-with-wide-buffer
(org-map-region
(lambda ()
(when (org-roam-db-node-p)
(dolist (fn fns)
(funcall fn))))
(point-min) (point-max))))
(defun org-roam-db-map-links (fns)
"Run FNS over all links in the current buffer."
(org-with-point-at 1
(while (re-search-forward org-link-any-re nil :no-error)
;; `re-search-forward' let the cursor one character after the link, we need to go backward one char to
;; make the point be on the link.
(backward-char)
(let* ((begin (match-beginning 0))
(element (org-element-context))
(type (org-element-type element))
link bounds)
(cond
;; Links correctly recognized by Org Mode
((eq type 'link)
(setq link element))
;; Links in property drawers and lines starting with #+. Recall that, as for Org Mode v9.4.4, the
;; org-element-type of links within properties drawers is "node-property" and for lines starting with
;; #+ is "keyword".
((and (member type org-roam-db-extra-links-elements)
(not (member-ignore-case (org-element-property :key element)
(cdr (assoc type org-roam-db-extra-links-exclude-keys))))
(setq link (save-excursion
(goto-char begin)
(save-match-data (org-element-link-parser)))))))
(when link
(dolist (fn fns)
(funcall fn link)))))))
(defun org-roam-db-map-citations (info fns)
"Run FNS over all citations in the current buffer.
INFO is the org-element parsed buffer."
(org-element-map info 'citation-reference
(lambda (cite)
(dolist (fn fns)
(funcall fn cite)))))
(defun org-roam-db-insert-file-node ()
"Insert the file-level node into the Org-roam cache."
(org-with-point-at 1
(when (and (= (org-outline-level) 0)
(org-roam-db-node-p))
(when-let ((id (org-id-get)))
(let* ((file (buffer-file-name (buffer-base-buffer)))
(title (org-roam-db--file-title))
(pos (point))
(todo nil)
(priority nil)
(scheduled nil)
(deadline nil)
(level 0)
(tags org-file-tags)
(properties (org-entry-properties))
(olp nil))
(org-roam-db-query!
(lambda (err)
(lwarn 'org-roam :warning "%s for %s (%s) in %s"
(error-message-string err)
title id file))
[:insert :into nodes
:values $v1]
(vector id file level pos todo priority
scheduled deadline title properties olp))
(when tags
(org-roam-db-query
[:insert :into tags
:values $v1]
(mapcar (lambda (tag)
(vector id (substring-no-properties tag)))
tags)))
(org-roam-db-insert-aliases)
(org-roam-db-insert-refs))))))
(cl-defun org-roam-db-insert-node-data ()
"Insert node data for headline at point into the Org-roam cache."
(when-let ((id (org-id-get)))
(let* ((file (buffer-file-name (buffer-base-buffer)))
(heading-components (org-heading-components))
(pos (point))
(todo (nth 2 heading-components))
(priority (nth 3 heading-components))
(level (nth 1 heading-components))
(scheduled (org-roam-db-get-scheduled-time))
(deadline (org-roam-db-get-deadline-time))
(title (or (nth 4 heading-components)
(progn (lwarn 'org-roam :warning "Node in %s:%s:%s has no title, skipping..."
file
(line-number-at-pos)
(1+ (- (point) (line-beginning-position))))
(cl-return-from org-roam-db-insert-node-data))))
(properties (org-entry-properties))
(olp (org-get-outline-path nil 'use-cache))
(title (org-link-display-format title)))
(org-roam-db-query!
(lambda (err)
(lwarn 'org-roam :warning "%s for %s (%s) in %s"
(error-message-string err)
title id file))
[:insert :into nodes
:values $v1]
(vector id file level pos todo priority
scheduled deadline title properties olp)))))
(defun org-roam-db-insert-aliases ()
"Insert aliases for node at point into Org-roam cache."
(when-let* ((node-id (org-id-get))
(aliases (org-entry-get (point) "ROAM_ALIASES"))
(aliases (split-string-and-unquote aliases)))
(org-roam-db-query [:insert :into aliases
:values $v1]
(mapcar (lambda (alias)
(vector node-id alias))
aliases))))
(defun org-roam-db-insert-tags ()
"Insert tags for node at point into Org-roam cache."
(when-let ((node-id (org-id-get))
(tags (org-get-tags)))
(org-roam-db-query [:insert :into tags
:values $v1]
(mapcar (lambda (tag)
(vector node-id (substring-no-properties tag))) tags))))
(defun org-roam-db-insert-refs ()
"Insert refs for node at point into Org-roam cache."
(when-let* ((node-id (org-id-get))
(refs (org-entry-get (point) "ROAM_REFS"))
(refs (split-string-and-unquote refs)))
(let (rows)
(dolist (ref refs)
(save-match-data
(cond (;; @citeKey
(string-prefix-p "@" ref)
(push (vector node-id (substring ref 1) "cite") rows))
(;; [cite:@citeKey]
(string-prefix-p "[cite:" ref)
(condition-case nil
(let ((cite-obj (org-cite-parse-objects ref)))
(org-element-map cite-obj 'citation-reference
(lambda (cite)
(let ((key (org-element-property :key cite)))
(push (vector node-id key "cite") rows)))))
(error
(lwarn '(org-roam) :warning
"%s:%s\tInvalid cite %s, skipping..." (buffer-file-name) (point) ref))))
(;; https://google.com, cite:citeKey
;; Note: we use string-match here because it matches any link: e.g. [[cite:abc][abc]]
;; But this form of matching is loose, and can accept invalid links e.g. [[cite:abc]
(string-match org-link-any-re (org-link-encode ref '(#x20)))
(setq ref (org-link-encode ref '(#x20)))
(let ((ref-url (url-generic-parse-url (or (match-string 2 ref) (match-string 0 ref))))
(link-type ()) ;; clear url-type for backward compatible.
(path ()))
(setq link-type (url-type ref-url))
(setf (url-type ref-url) nil)
(setq path (org-link-decode (url-recreate-url ref-url)))
(if (and (boundp 'org-ref-cite-types)
(or (assoc link-type org-ref-cite-types)
(member link-type org-ref-cite-types)))
(dolist (key (org-roam-org-ref-path-to-keys path))
(push (vector node-id key link-type) rows))
(push (vector node-id path link-type) rows))))
(t
(lwarn '(org-roam) :warning
"%s:%s\tInvalid ref %s, skipping..." (buffer-file-name) (point) ref)))))
(when rows
(org-roam-db-query [:insert :into refs
:values $v1]
rows)))))
(defun org-roam-db-insert-link (link)
"Insert link data for LINK at current point into the Org-roam cache."
(save-excursion
(goto-char (org-element-property :begin link))
(let ((type (org-element-property :type link))
(path (org-element-property :path link))
(source (org-roam-id-at-point))
(properties (list :outline (ignore-errors
;; This can error if link is not under any headline
(org-get-outline-path 'with-self 'use-cache)))))
;; For Org-ref links, we need to split the path into the cite keys
(when (and source path)
(if (and (boundp 'org-ref-cite-types)
(or (assoc type org-ref-cite-types)
(member type org-ref-cite-types)))
(org-roam-db-query
[:insert :into citations
:values $v1]
(mapcar (lambda (k) (vector source k (point) properties))
(org-roam-org-ref-path-to-keys path)))
(org-roam-db-query
[:insert :into links
:values $v1]
(vector (point) source path type properties)))))))
(defun org-roam-db-insert-citation (citation)
"Insert data for CITATION at current point into the Org-roam cache."
(save-excursion
(goto-char (org-element-property :begin citation))
(let ((key (org-element-property :key citation))
(source (org-roam-id-at-point))
(properties (list :outline (ignore-errors
;; This can error if link is not under any headline
(org-get-outline-path 'with-self 'use-cache)))))
(when (and source key)
(org-roam-db-query
[:insert :into citations
:values $v1]
(vector source key (point) properties))))))
;;;; Fetching
(defun org-roam-db--get-current-files ()
"Return a hash-table of file to the hash of its file contents."
(let ((current-files (org-roam-db-query [:select [file hash] :from files]))
(ht (make-hash-table :test #'equal)))
(dolist (row current-files)
(puthash (car row) (cadr row) ht))
ht))
(defun org-roam-db--file-hash (file-path)
"Compute the hash of FILE-PATH."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file-path)
(secure-hash 'sha1 (current-buffer))))
;;;; Synchronization
(defun org-roam-db-update-file (&optional file-path no-require)
"Update Org-roam cache for FILE-PATH.
If the file does not exist anymore, remove it from the cache.
If the file exists, update the cache with information.
If NO-REQUIRE, don't require optional libraries. Set NO-REQUIRE
when the libraries are already required at some toplevel, e.g.
in `org-roam-db-sync'."
(setq file-path (or file-path (buffer-file-name (buffer-base-buffer))))
(let ((content-hash (org-roam-db--file-hash file-path))
(db-hash (caar (org-roam-db-query [:select hash :from files
:where (= file $s1)] file-path)))
info)
(unless (string= content-hash db-hash)
(unless no-require
(org-roam-require '(org-ref oc)))
(org-roam-with-file file-path nil
(emacsql-with-transaction (org-roam-db)
(org-with-wide-buffer
(org-set-regexps-and-options 'tags-only)
(org-refresh-category-properties)
(org-roam-db-clear-file)
(org-roam-db-insert-file content-hash)
(org-roam-db-insert-file-node)
(setq org-outline-path-cache nil)
(org-roam-db-map-nodes
(list #'org-roam-db-insert-node-data
#'org-roam-db-insert-aliases
#'org-roam-db-insert-tags
#'org-roam-db-insert-refs))
(setq org-outline-path-cache nil)
(setq info (org-element-parse-buffer))
(org-roam-db-map-links
(list #'org-roam-db-insert-link))
(when (fboundp 'org-cite-insert)
(require 'oc) ;ensure feature is loaded
(org-roam-db-map-citations
info
(list #'org-roam-db-insert-citation)))))))))
;;;###autoload
(defun org-roam-db-sync (&optional force)
"Synchronize the cache state with the current Org files on-disk.
If FORCE, force a rebuild of the cache from scratch."
(interactive "P")
(org-roam-db--close) ;; Force a reconnect
(when force (delete-file org-roam-db-location))
(org-roam-db) ;; To initialize the database, no-op if already initialized
(org-roam-require '(org-ref oc))
(let* ((gc-cons-threshold org-roam-db-gc-threshold)
(org-agenda-files nil)
(org-roam-files (org-roam-list-files))
(current-files (org-roam-db--get-current-files))
(modified-files nil))
(dolist (file org-roam-files)
(let ((contents-hash (org-roam-db--file-hash file)))
(unless (string= (gethash file current-files)
contents-hash)
(push file modified-files)))
(remhash file current-files))
(emacsql-with-transaction (org-roam-db)
(org-roam-dolist-with-progress (file (hash-table-keys current-files))
"Clearing removed files..."
(org-roam-db-clear-file file))
(org-roam-dolist-with-progress (file modified-files)
"Processing modified files..."
(condition-case err
(org-roam-db-update-file file 'no-require)
(error
(org-roam-db-clear-file file)
(lwarn 'org-roam :error "Failed to process %s with error %s, skipping..."
file (error-message-string err))))))))
;;;###autoload
(define-minor-mode org-roam-db-autosync-mode
"Global minor mode to keep your Org-roam session automatically synchronized.
Through the session this will continue to setup your
buffers (that are Org-roam file visiting), keep track of the
related changes, maintain cache consistency and incrementally
update the currently active database.
If you need to manually trigger resync of the currently active
database, see `org-roam-db-sync' command."
:group 'org-roam
:global t
:init-value nil
(let ((enabled org-roam-db-autosync-mode))
(cond
(enabled
(add-hook 'find-file-hook #'org-roam-db-autosync--setup-file-h)
(add-hook 'kill-emacs-hook #'org-roam-db--close-all)
(advice-add #'rename-file :after #'org-roam-db-autosync--rename-file-a)
(advice-add #'delete-file :before #'org-roam-db-autosync--delete-file-a)
(org-roam-db-sync))
(t
(remove-hook 'find-file-hook #'org-roam-db-autosync--setup-file-h)
(remove-hook 'kill-emacs-hook #'org-roam-db--close-all)
(advice-remove #'rename-file #'org-roam-db-autosync--rename-file-a)
(advice-remove #'delete-file #'org-roam-db-autosync--delete-file-a)
(org-roam-db--close-all)
;; Disable local hooks for all org-roam buffers
(dolist (buf (org-roam-buffer-list))
(with-current-buffer buf
(remove-hook 'after-save-hook #'org-roam-db-autosync--try-update-on-save-h t)))))))
;;;###autoload
(defun org-roam-db-autosync-enable ()
"Activate `org-roam-db-autosync-mode'."
(org-roam-db-autosync-mode +1))
(defun org-roam-db-autosync-disable ()
"Deactivate `org-roam-db-autosync-mode'."
(org-roam-db-autosync-mode -1))
(defun org-roam-db-autosync-toggle ()
"Toggle `org-roam-db-autosync-mode' enabled/disabled."
(org-roam-db-autosync-mode 'toggle))
(defun org-roam-db-autosync--delete-file-a (file &optional _trash)
"Maintain cache consistency when file deletes.
FILE is removed from the database."
(when (and (not (auto-save-file-name-p file))
(not (backup-file-name-p file))
(org-roam-file-p file))
(org-roam-db-clear-file (expand-file-name file))))
(defun org-roam-db-autosync--rename-file-a (old-file new-file-or-dir &rest _args)
"Maintain cache consistency of file rename.
OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
(let ((new-file (if (directory-name-p new-file-or-dir)
(expand-file-name (file-name-nondirectory old-file) new-file-or-dir)
new-file-or-dir)))
(setq new-file (expand-file-name new-file))
(setq old-file (expand-file-name old-file))
(when (and (not (auto-save-file-name-p old-file))
(not (auto-save-file-name-p new-file))
(not (backup-file-name-p old-file))
(not (backup-file-name-p new-file))
(org-roam-file-p old-file))
(org-roam-db-clear-file old-file))
(when (org-roam-file-p new-file)
(org-roam-db-update-file new-file))))
(defun org-roam-db-autosync--setup-file-h ()
"Setup the current buffer if it visits an Org-roam file."
(when (org-roam-file-p) (run-hooks 'org-roam-find-file-hook)))
(add-hook 'org-roam-find-file-hook #'org-roam-db-autosync--setup-update-on-save-h)
(defun org-roam-db-autosync--setup-update-on-save-h ()
"Setup the current buffer to update the DB after saving the current file."
(add-hook 'after-save-hook #'org-roam-db-autosync--try-update-on-save-h nil t))
(defun org-roam-db-autosync--try-update-on-save-h ()
"If appropriate, update the database for the current file after saving buffer."
(when org-roam-db-update-on-save (org-roam-db-update-file)))
;;; Diagnostics
(defun org-roam-db-diagnose-node ()
"Print information about node at point."
(interactive)
(prin1 (org-roam-node-at-point)))
(provide 'org-roam-db)
;;; org-roam-db.el ends here

75
lisp/org-roam/org-roam-export.el Normal file
View File

@@ -0,0 +1,75 @@
;;; org-roam-export.el --- Org-roam org-export tweaks -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.1"))
;; 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 package provides the necessary changes required to make org-export work out-of-the-box.
;;
;; To enable it, run:
;;
;; (require 'org-roam-export)
;;
;; The key issue Org's export-to-html functionality has is that it does not respect the ID property, which
;; Org-roam relies heavily on. This patches the necessary function in ox-html to export ID links correctly,
;; pointing to the correct place.
;;
;;; Code:
(require 'ox-html)
(defun org-roam-export--org-html--reference (datum info &optional named-only)
"Org-roam's patch for `org-html--reference' to support ID link export.
See `org-html--reference' for DATUM, INFO and NAMED-ONLY."
(let* ((type (org-element-type datum))
(user-label
(org-element-property
(pcase type
((or `headline `inlinetask) :CUSTOM_ID)
((or `radio-target `target) :value)
(_ :name))
datum))
(user-label
(or user-label
(when-let ((path (org-element-property :ID datum)))
;; see `org-html-link' for why we use "ID-"
;; (search for "ID-" in ox-html.el)
(concat "ID-" path)))))
(cond
((and user-label
(or (plist-get info :html-prefer-user-labels)
(memq type '(headline inlinetask))))
user-label)
((and named-only
(not (memq type '(headline inlinetask radio-target target)))
(not user-label))
nil)
(t
(org-export-get-reference datum info)))))
(advice-add 'org-html--reference :override #'org-roam-export--org-html--reference)
(provide 'org-roam-export)
;;; org-roam-export.el ends here

302
lisp/org-roam/org-roam-graph.el Normal file
View File

@@ -0,0 +1,302 @@
;;; org-roam-graph.el --- Basic graphing functionality for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.1"))
;; 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 extension implements capability to build and generate graphs in Org-roam
;; with the help of Graphviz.
;;
;;; Code:
(require 'xml) ;xml-escape-string
(require '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-filetype "svg"
"File type to generate when producing graphs."
: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-edge-extra-config nil
"Extra edge options passed to graphviz.
Example:
'((\"dir\" . \"back\"))"
:type '(alist)
:group 'org-roam)
(defcustom org-roam-graph-node-extra-config
'(("id" . (("style" . "bold,rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#111111")))
("http" . (("style" . "rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#0A97A6")))
("https" . (("style" . "rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#0A97A6"))))
"Extra options for graphviz nodes."
:type '(alist)
:group 'org-roam)
(defcustom org-roam-graph-link-hidden-types
'("file")
"What sort of links to hide from the Org-roam graph."
:type '(repeat string)
: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-link-builder 'org-roam-org-protocol-link-builder
"Function used to build the Org-roam graph links.
Given a node name, return a string to be used for the link fed to
the graph generation utility."
:type 'function
:group 'org-roam)
(defcustom org-roam-graph-generation-hook nil
"Functions to run after the graph has been generated.
Each function is called with two arguments: the filename
containing the graph generation tool, and the generated graph."
:type 'hook
:group 'org-roam)
(defun org-roam-org-protocol-link-builder (node)
"Default org-roam link builder. Generate an org-protocol link using NODE."
(concat "org-protocol://roam-node?node="
(url-hexify-string (org-roam-node-id node))))
;;; Interactive command
;;;###autoload
(defun org-roam-graph (&optional arg node)
"Build and possibly display a graph for NODE.
ARG may be any of the following values:
- nil show the graph.
- `\\[universal-argument]' show the graph for NODE.
- `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps."
(interactive
(list current-prefix-arg
(and current-prefix-arg
(org-roam-node-at-point 'assert))))
(let ((graph (cl-typecase arg
(null (org-roam-graph--dot nil 'all-nodes))
(cons (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) 0)))
(integer (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) (abs arg)))))))
(org-roam-graph--build graph #'org-roam-graph--open)))
;;; Generation and Build process
(defun org-roam-graph--build (graph &optional callback)
"Generate the GRAPH, and 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* ((temp-dot (make-temp-file "graph." nil ".dot" graph))
(temp-graph (make-temp-file "graph." nil (concat "." org-roam-graph-filetype))))
(org-roam-message "building graph")
(make-process
:name "*org-roam-graph*"
:buffer " *org-roam-graph*"
:command `(,org-roam-graph-executable ,temp-dot "-T" ,org-roam-graph-filetype "-o" ,temp-graph)
:sentinel (when callback
(lambda (process _event)
(when (= 0 (process-exit-status process))
(progn (funcall callback temp-graph)
(run-hook-with-args 'org-roam-graph-generation-hook temp-dot temp-graph))))))))
(defun org-roam-graph--dot (&optional edges all-nodes)
"Build the graphviz given the EDGES of the graph.
If ALL-NODES, include also nodes without edges."
(let ((org-roam-directory-temp org-roam-directory)
(nodes-table (make-hash-table :test #'equal))
(seen-nodes (list))
(edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links]))))
(pcase-dolist (`(,id ,file ,title)
(org-roam-db-query [:select [id file title] :from nodes]))
(puthash id (org-roam-node-create :file file :id id :title title) nodes-table))
(with-temp-buffer
(setq-local org-roam-directory org-roam-directory-temp)
(insert "digraph \"org-roam\" {\n")
(dolist (option org-roam-graph-extra-config)
(insert (org-roam-graph--dot-option option) ";\n"))
(insert (format " edge [%s];\n"
(mapconcat (lambda (var)
(org-roam-graph--dot-option var nil "\""))
org-roam-graph-edge-extra-config
",")))
(pcase-dolist (`(,source ,dest ,type) edges)
(unless (member type org-roam-graph-link-hidden-types)
(pcase-dolist (`(,node ,node-type) `((,source "id")
(,dest ,type)))
(unless (member node seen-nodes)
(insert (org-roam-graph--format-node
(or (gethash node nodes-table) node) node-type))
(push node seen-nodes)))
(insert (format " \"%s\" -> \"%s\";\n"
(xml-escape-string source)
(xml-escape-string dest)))))
(when all-nodes
(maphash (lambda (id node)
(unless (member id seen-nodes)
(insert (org-roam-graph--format-node node "id"))))
nodes-table))
(insert "}")
(buffer-string))))
(defun org-roam-graph--connected-component (id distance)
"Return the edges for all nodes reachable from/connected to ID.
DISTANCE is the maximum distance away from the root node."
(let* ((query
(if (= distance 0)
"
WITH RECURSIVE
links_of(source, dest) AS
(SELECT source, dest FROM links UNION
SELECT dest, source FROM links),
connected_component(source) AS
(SELECT dest FROM links_of WHERE source = $s1 UNION
SELECT dest FROM links_of JOIN connected_component USING(source))
SELECT DISTINCT source, dest, type FROM links
WHERE source IN connected_component OR dest IN connected_component;"
"
WITH RECURSIVE
links_of(source, dest) AS
(SELECT source, dest FROM links UNION
SELECT dest, source FROM links),
connected_component(source, trace) AS
(VALUES ($s1 , json_array($s1)) UNION
SELECT lo.dest, json_insert(cc.trace, '$[' || json_array_length(cc.trace) || ']', lo.dest) FROM
connected_component AS cc JOIN links_of AS lo USING(source)
WHERE (
-- Avoid cycles by only visiting each node once.
(SELECT count(*) FROM json_each(cc.trace) WHERE json_each.value == lo.dest) == 0
-- Note: BFS is cut off early here.
AND json_array_length(cc.trace) < $s2)),
nodes(source) as (SELECT DISTINCT source
FROM connected_component GROUP BY source ORDER BY min(json_array_length(trace)))
SELECT DISTINCT source, dest, type FROM links WHERE source IN nodes OR dest IN nodes;")))
(org-roam-db-query query id distance)))
(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--format-node (node type)
"Return a graphviz NODE with TYPE.
Handles both Org-roam nodes, and string nodes (e.g. urls)."
(let (node-id node-properties)
(if (org-roam-node-p node)
(let* ((title (org-roam-quote-string (org-roam-node-title node)))
(shortened-title
(org-roam-quote-string
(pcase org-roam-graph-shorten-titles
(`truncate (truncate-string-to-width title org-roam-graph-max-title-length nil nil "..."))
(`wrap (org-roam-word-wrap org-roam-graph-max-title-length title))
(_ title)))))
(setq node-id (org-roam-node-id node)
node-properties `(("label" . ,shortened-title)
("URL" . ,(funcall org-roam-graph-link-builder node))
("tooltip" . ,(xml-escape-string title)))))
(setq node-id node
node-properties (append `(("label" . ,(concat type ":" node)))
(when (member type (list "http" "https"))
`(("URL" . ,(xml-escape-string (concat type ":" node))))))))
(format "\"%s\" [%s];\n"
node-id
(mapconcat (lambda (n)
(org-roam-graph--dot-option n nil "\""))
(append (cdr (assoc type org-roam-graph-node-extra-config))
node-properties) ","))))
(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)))))
(provide 'org-roam-graph)
;;; org-roam-graph.el ends here

117
lisp/org-roam/org-roam-id.el Normal file
View File

@@ -0,0 +1,117 @@
;;; org-roam-id.el --- ID-related utilities for Org-roam -*- lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (magit-section "3.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 module provides ID-related facilities using the Org-roam database.
;;
;;; Code:
(require 'org-id)
(defun org-roam-id-at-point ()
"Return the ID at point, if any.
Recursively traverses up the headline tree to find the
first encapsulating ID."
(org-with-wide-buffer
(org-back-to-heading-or-point-min t)
(while (and (not (org-roam-db-node-p))
(not (bobp)))
(org-roam-up-heading-or-point-min))
(when (org-roam-db-node-p)
(org-id-get))))
(defun org-roam-id-find (id &optional markerp)
"Return the location of the entry with the id ID using the Org-roam db.
The return value is a cons cell (file-name . position), or nil
if there is no entry with that ID.
With optional argument MARKERP, return the position as a new marker."
(cond
((symbolp id) (setq id (symbol-name id)))
((numberp id) (setq id (number-to-string id))))
(let ((node (org-roam-populate (org-roam-node-create :id id))))
(when-let ((file (org-roam-node-file node)))
(if markerp
(unwind-protect
(let ((buffer (or (find-buffer-visiting file)
(find-file-noselect file))))
(with-current-buffer buffer
(move-marker (make-marker) (org-roam-node-point node) buffer))))
(cons (org-roam-node-file node)
(org-roam-node-point node))))))
(defun org-roam-id-open (id _)
"Go to the entry with id ID.
Like `org-id-open', but additionally uses the Org-roam database."
(org-mark-ring-push)
(let ((m (or (org-roam-id-find id 'marker)
(org-id-find id 'marker)))
cmd)
(unless m
(error "Cannot find entry with ID \"%s\"" id))
;; Use a buffer-switching command in analogy to finding files
(setq cmd
(or
(cdr
(assq
(cdr (assq 'file org-link-frame-setup))
'((find-file . switch-to-buffer)
(find-file-other-window . switch-to-buffer-other-window)
(find-file-other-frame . switch-to-buffer-other-frame))))
'switch-to-buffer-other-window))
(if (not (equal (current-buffer) (marker-buffer m)))
(funcall cmd (marker-buffer m)))
(goto-char m)
(move-marker m nil)
(org-show-context)))
(org-link-set-parameters "id" :follow #'org-roam-id-open)
;;;###autoload
(defun org-roam-update-org-id-locations (&rest directories)
"Scan Org-roam files to update `org-id' related state.
This is like `org-id-update-id-locations', but will automatically
use the currently bound `org-directory' and `org-roam-directory'
along with DIRECTORIES (if any), where the lookup for files in
these directories will be always recursive.
Note: Org-roam doesn't have hard dependency on
`org-id-locations-file' to lookup IDs for nodes that are stored
in the database, but it still tries to properly integrates with
`org-id'. This allows the user to cross-reference IDs outside of
the current `org-roam-directory', and also link with \"id:\"
links to headings/files within the current `org-roam-directory'
that are excluded from identification in Org-roam as
`org-roam-node's, e.g. with \"ROAM_EXCLUDE\" property."
(interactive)
(cl-loop for dir in (cons org-roam-directory directories)
for org-roam-directory = dir
nconc (org-roam-list-files) into files
finally (org-id-update-id-locations files org-roam-verbose)))
(provide 'org-roam-id)
;;; org-roam-id.el ends here

53
lisp/org-roam/org-roam-log.el Normal file
View File

@@ -0,0 +1,53 @@
;;; org-roam-log.el --- Integrations with Org-log -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2022-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.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 module provides integrations with Org-log.
;;
;;; Code:
(require 'org-roam)
(defcustom org-roam-log-setup-hook nil
"Hook run when a log for an Org-roam file is setup."
:group 'org-roam
:type 'hook)
(defun org-roam-log-p ()
"Return t if the log buffer is for an Org-roam file, nil otherwise."
(and org-log-note-marker
(org-roam-file-p (buffer-file-name (marker-buffer org-log-note-marker)))))
(defun org-roam-log--setup ()
"Run hooks in `org-roam-log-setup-hook'."
(run-hooks 'org-roam-log-setup-hook))
(add-hook 'org-roam-log-setup-hook #'org-roam--register-completion-functions-h)
(add-hook 'org-log-buffer-setup-hook #'org-roam-log--setup)
(provide 'org-roam-log)
;;; org-roam-log.el ends here

168
lisp/org-roam/org-roam-migrate.el Normal file
View File

@@ -0,0 +1,168 @@
;;; org-roam-migrate.el --- Migration utilities from v1 to v2 -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.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 is a special library provided for the v1 users of this package. It's
;; purpose is to ease the transition from v1 to v2, by providing migration
;; utilities to convert from v1 notes to v2 nodes.
;;
;;; Code:
(require 'org-roam)
;;; Migration wizard (v1 -> v2)
;;;###autoload
(defun org-roam-migrate-wizard ()
"Migrate all notes from to be compatible with Org-roam v2.
1. Convert all notes from v1 format to v2.
2. Rebuild the cache.
3. Replace all file links with ID links."
(interactive)
(when (yes-or-no-p "Org-roam will now convert all your notes from v1 to v2.
This will take a while. Are you sure you want to do this?")
;; Back up notes
(let ((backup-dir (expand-file-name "org-roam.bak"
(file-name-directory (directory-file-name org-roam-directory)))))
(message "Backing up files to %s" backup-dir)
(copy-directory org-roam-directory backup-dir))
;; Upgrade database to v2
(org-roam-db-sync 'force)
;; Convert v1 to v2
(dolist (f (org-roam-list-files))
(org-roam-with-file f nil
(org-roam-migrate-v1-to-v2)))
;; Rebuild cache
(org-roam-db-sync 'force)
;;Replace all file links with ID links
(dolist (f (org-roam-list-files))
(org-roam-with-file f nil
(org-roam-migrate-replace-file-links-with-id)
(save-buffer)))))
(defun org-roam-migrate-v1-to-v2 ()
"Convert the current buffer to v2 format."
;; Create file level ID
(org-with-point-at 1
(org-id-get-create))
;; Replace roam_key into properties drawer roam_ref
(when-let* ((refs (mapcan #'split-string-and-unquote
(cdar (org-collect-keywords '("roam_key"))))))
(let ((case-fold-search t))
(org-with-point-at 1
(dolist (ref refs)
(org-roam-ref-add ref))
(while (re-search-forward "^#\\+roam_key:" (point-max) t)
(beginning-of-line)
(kill-line 1)))))
;; Replace roam_alias into properties drawer roam_aliases
(when-let* ((aliases (mapcan #'split-string-and-unquote
(cdar (org-collect-keywords '("roam_alias"))))))
(dolist (alias aliases)
(org-roam-alias-add alias)))
(let ((case-fold-search t))
(org-with-point-at 1
(while (re-search-forward "^#\\+roam_alias:" (point-max) t)
(beginning-of-line)
(kill-line 1))))
;; Replace #+roam_tags into #+filetags
(org-with-point-at 1
(let* ((roam-tags (org-roam-migrate-get-prop-list "ROAM_TAGS"))
(file-tags (cl-mapcan (lambda (value)
(cl-mapcan
(lambda (k) (org-split-string k ":"))
(split-string value)))
(org-roam-migrate-get-prop-list "FILETAGS")))
(tags (append roam-tags file-tags))
(tags (seq-map (lambda (tag)
(replace-regexp-in-string
"[^[:alnum:]_@#%]"
"_"
tag)) tags))
(tags (seq-uniq tags)))
(when tags
(org-roam-migrate-prop-set "filetags" (org-make-tag-string tags))))
(let ((case-fold-search t))
(org-with-point-at 1
(while (re-search-forward "^#\\+roam_tags:" (point-max) t)
(beginning-of-line)
(kill-line 1)))))
(save-buffer))
(defun org-roam-migrate-get-prop-list (keyword)
"Return prop list for KEYWORD."
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase keyword)))
lst)
(goto-char (point-min))
(while (re-search-forward re 2048 t)
(setq lst (append lst (split-string-and-unquote
(buffer-substring-no-properties
(match-beginning 1) (match-end 1))))))
lst))
(defun org-roam-migrate-prop-set (name value)
"Set a file property called NAME to VALUE in buffer file.
If the property is already set, replace its value."
(setq name (downcase name))
(org-with-point-at 1
(let ((case-fold-search t))
(if (re-search-forward (concat "^#\\+" name ":\\(.*\\)")
(point-max) t)
(replace-match (concat "#+" name ": " value) 'fixedcase)
(while (and (not (eobp))
(looking-at "^[#:]"))
(if (save-excursion (end-of-line) (eobp))
(progn
(end-of-line)
(insert "\n"))
(forward-line)
(beginning-of-line)))
(insert "#+" name ": " value "\n")))))
(defun org-roam-migrate-replace-file-links-with-id ()
"Replace all file: links with ID links in current buffer."
(org-with-point-at 1
(while (re-search-forward org-link-bracket-re nil t)
(let* ((mdata (match-data))
(path (match-string 1))
(desc (match-string 2)))
(when (string-prefix-p "file:" path)
(setq path (expand-file-name (substring path 5)))
(when-let ((node-id (caar (org-roam-db-query [:select [id] :from nodes
:where (= file $s1)
:and (= level 0)] path))))
(set-match-data mdata)
(replace-match (org-link-make-string (concat "id:" node-id)
desc) nil t)))))))
(provide 'org-roam-migrate)
;;; org-roam-migrate.el ends here

704
lisp/org-roam/org-roam-mode.el Normal file
View File

@@ -0,0 +1,704 @@
;;; org-roam-mode.el --- Major mode for special Org-roam buffers -*- lexical-binding: t -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.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 module implements `org-roam-mode', which is a major mode that used by
;; special Org-roam buffers to display various content in a section-like manner
;; about the nodes and relevant to them information (e.g. backlinks) with which
;; the user can interact with.
;;
;;; Code:
(require 'org-roam)
;;;; Declarations
(defvar org-ref-buffer-hacked)
;;; Options
(defcustom org-roam-mode-sections (list #'org-roam-backlinks-section
#'org-roam-reflinks-section)
"A list of sections for the `org-roam-mode' based buffers.
Each section is a function that is passed the an `org-roam-node'
for which the section will be constructed for as the first
argument. Normally this node is `org-roam-buffer-current-node'.
The function may also accept other optional arguments. Each item
in the list is either:
1. A function, which is called only with the `org-roam-node' as the argument
2. A list, containing the function and the optional arguments.
For example, one can add
(org-roam-backlinks-section :unique t)
to the list to pass :unique t to the section-rendering function."
:group 'org-roam
:type `(repeat (choice (symbol :tag "Function")
(list :tag "Function with arguments"
(symbol :tag "Function")
(repeat :tag "Arguments" :inline t (sexp :tag "Arg"))))))
(defcustom org-roam-buffer-postrender-functions (list)
"Functions to run after the Org-roam buffer is rendered.
Each function accepts no arguments, and is run with the Org-roam
buffer as the current buffer."
:group 'org-roam
:type 'hook)
(defcustom org-roam-preview-function #'org-roam-preview-default-function
"The preview function to use to populate the Org-roam buffer.
The function takes no arguments, but the point is temporarily set
to the exact location of the backlink."
:group 'org-roam
:type 'function)
(defcustom org-roam-preview-postprocess-functions (list #'org-roam-strip-comments)
"A list of functions to postprocess the preview content.
Each function takes a single argument, the string for the preview
content, and returns the post-processed string. The functions are
applied in order of appearance in the list."
:group 'org-roam
:type 'hook)
;;; Faces
(defface org-roam-header-line
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DarkGoldenrod4"
:weight bold)
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "LightGoldenrod2"
:weight bold))
"Face for the `header-line' in some Org-roam modes."
:group 'org-roam-faces)
(defface org-roam-title
'((t :weight bold))
"Face for Org-roam titles."
:group 'org-roam-faces)
(defface org-roam-olp
'((((class color) (background light)) :foreground "grey60")
(((class color) (background dark)) :foreground "grey40"))
"Face for the OLP of the node."
:group 'org-roam-faces)
(defface org-roam-preview-heading
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey80"
:foreground "grey30")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey25"
:foreground "grey70"))
"Face for preview headings."
:group 'org-roam-faces)
(defface org-roam-preview-heading-highlight
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey75"
:foreground "grey30")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey35"
:foreground "grey70"))
"Face for current preview headings."
:group 'org-roam-faces)
(defface org-roam-preview-heading-selection
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:inherit org-roam-preview-heading-highlight
:foreground "salmon4")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:inherit org-roam-preview-heading-highlight
:foreground "LightSalmon3"))
"Face for selected preview headings."
:group 'org-roam-faces)
(defface org-roam-preview-region
`((t :inherit bold
,@(and (>= emacs-major-version 27)
(list :extend (ignore-errors (face-attribute 'region :extend))))))
"Face used by `org-roam-highlight-preview-region-using-face'.
This face is overlaid over text that uses other hunk faces,
and those normally set the foreground and background colors.
The `:foreground' and especially the `:background' properties
should be avoided here. Setting the latter would cause the
loss of information. Good properties to set here are `:weight'
and `:slant'."
:group 'org-roam-faces)
(defface org-roam-dim
'((((class color) (background light)) :foreground "grey60")
(((class color) (background dark)) :foreground "grey40"))
"Face for the dimmer part of the widgets."
:group 'org-roam-faces)
;;; Major mode
(defvar org-roam-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-section-mode-map)
(define-key map [C-return] 'org-roam-buffer-visit-thing)
(define-key map (kbd "C-m") 'org-roam-buffer-visit-thing)
(define-key map [remap revert-buffer] 'org-roam-buffer-refresh)
map)
"Parent keymap for all keymaps of modes derived from `org-roam-mode'.")
(define-derived-mode org-roam-mode magit-section-mode "Org-roam"
"Major mode for displaying relevant information about Org-roam nodes.
This mode is used by special Org-roam buffers, such as persistent
`org-roam-buffer' and dedicated Org-roam buffers
\(`org-roam-buffer-display-dedicated'), which render the
information in a section-like manner (see
`org-roam-mode-sections'), with which the user can
interact with."
:group 'org-roam
(face-remap-add-relative 'header-line 'org-roam-header-line))
;;; Buffers
(defvar org-roam-buffer-current-node nil
"The node for which an `org-roam-mode' based buffer displays its contents.
This set both, locally and globally. Normally the local value is
only set in the `org-roam-mode' based buffers, while the global
value shows the current node in the persistent `org-roam-buffer'.")
(put 'org-roam-buffer-current-node 'permanent-local t)
(defvar org-roam-buffer-current-directory nil
"The `org-roam-directory' value of `org-roam-buffer-current-node'.
Set both, locally and globally in the same way as
`org-roam-buffer-current-node'.")
(put 'org-roam-buffer-current-directory 'permanent-local t)
;;;; Library
(defun org-roam-buffer-visit-thing ()
"This is a placeholder command.
Where applicable, section-specific keymaps bind another command
which visits the thing at point."
(interactive)
(user-error "There is no thing at point that could be visited"))
(defun org-roam-buffer-file-at-point (&optional assert)
"Return the file at point in the current `org-roam-mode' based buffer.
If ASSERT, throw an error."
(if-let ((file (magit-section-case
(org-roam-node-section (org-roam-node-file (oref it node)))
(org-roam-grep-section (oref it file))
(org-roam-preview-section (oref it file))
(t (cl-assert (derived-mode-p 'org-roam-mode))))))
file
(when assert
(user-error "No file at point"))))
(defun org-roam-buffer-refresh ()
"Refresh the contents of the currently selected Org-roam buffer."
(interactive)
(cl-assert (derived-mode-p 'org-roam-mode))
(save-excursion (org-roam-buffer-render-contents)))
(defun org-roam-buffer-render-contents ()
"Recompute and render the contents of an Org-roam buffer.
Assumes that the current buffer is an `org-roam-mode' based
buffer."
(let ((inhibit-read-only t))
(erase-buffer)
(org-roam-mode)
(setq-local default-directory org-roam-buffer-current-directory)
(setq-local org-roam-directory org-roam-buffer-current-directory)
(org-roam-buffer-set-header-line-format
(org-roam-node-title org-roam-buffer-current-node))
(magit-insert-section (org-roam)
(magit-insert-heading)
(dolist (section org-roam-mode-sections)
(pcase section
((pred functionp)
(funcall section org-roam-buffer-current-node))
(`(,fn . ,args)
(apply fn (cons org-roam-buffer-current-node args)))
(_
(user-error "Invalid `org-roam-mode-sections' specification")))))
(run-hooks 'org-roam-buffer-postrender-functions)
(goto-char 0)))
(defun org-roam-buffer-set-header-line-format (string)
"Set the header-line using STRING.
If the `face' property of any part of STRING is already set, then
that takes precedence. Also pad the left side of STRING so that
it aligns with the text area."
(setq-local header-line-format
(concat (propertize " " 'display '(space :align-to 0))
string)))
;;;; Dedicated buffer
;;;###autoload
(defun org-roam-buffer-display-dedicated (node)
"Launch NODE dedicated Org-roam buffer.
Unlike the persistent `org-roam-buffer', the contents of this
buffer won't be automatically changed and will be held in place.
In interactive calls prompt to select NODE, unless called with
`universal-argument', in which case NODE will be set to
`org-roam-node-at-point'."
(interactive
(list (if current-prefix-arg
(org-roam-node-at-point 'assert)
(org-roam-node-read nil nil nil 'require-match))))
(let ((buffer (get-buffer-create (org-roam-buffer--dedicated-name node))))
(with-current-buffer buffer
(setq-local org-roam-buffer-current-node node)
(setq-local org-roam-buffer-current-directory org-roam-directory)
(org-roam-buffer-render-contents))
(display-buffer buffer)))
(defun org-roam-buffer--dedicated-name (node)
"Construct buffer name for NODE dedicated Org-roam buffer."
(let ((title (org-roam-node-title node))
(filename (file-relative-name (org-roam-node-file node) org-roam-directory)))
(format "*org-roam: %s<%s>*" title filename)))
(defun org-roam-buffer-dedicated-p (&optional buffer)
"Return t if an Org-roam BUFFER is a node dedicated one.
See `org-roam-buffer-display-dedicated' for more details.
If BUFFER is nil, default it to `current-buffer'."
(or buffer (setq buffer (current-buffer)))
(string-match-p (concat "^" (regexp-quote "*org-roam: "))
(buffer-name buffer)))
;;;; Persistent buffer
(defvar org-roam-buffer "*org-roam*"
"The persistent Org-roam buffer name. Must be surround with \"*\".
The content inside of this buffer will be automatically updated
to the nearest node at point that comes from the current buffer.
To toggle its display use `org-roam-buffer-toggle' command.")
(defun org-roam-buffer-toggle ()
"Toggle display of the persistent `org-roam-buffer'."
(interactive)
(pcase (org-roam-buffer--visibility)
('visible
(progn
(quit-window nil (get-buffer-window org-roam-buffer))
(remove-hook 'post-command-hook #'org-roam-buffer--redisplay-h)))
((or 'exists 'none)
(progn
(display-buffer (get-buffer-create org-roam-buffer))
(org-roam-buffer-persistent-redisplay)))))
(define-inline org-roam-buffer--visibility ()
"Return the current visibility state of the persistent `org-roam-buffer'.
Valid states are 'visible, 'exists and 'none."
(declare (side-effect-free t))
(inline-quote
(cond
((get-buffer-window org-roam-buffer) 'visible)
((get-buffer org-roam-buffer) 'exists)
(t 'none))))
(defun org-roam-buffer-persistent-redisplay ()
"Recompute contents of the persistent `org-roam-buffer'.
Has no effect when there's no `org-roam-node-at-point'."
(when-let ((node (org-roam-node-at-point)))
(unless (equal node org-roam-buffer-current-node)
(setq org-roam-buffer-current-node node
org-roam-buffer-current-directory org-roam-directory)
(with-current-buffer (get-buffer-create org-roam-buffer)
(org-roam-buffer-render-contents)
(add-hook 'kill-buffer-hook #'org-roam-buffer--persistent-cleanup-h nil t)))))
(defun org-roam-buffer--persistent-cleanup-h ()
"Clean-up global state that's dedicated for the persistent `org-roam-buffer'."
(setq-default org-roam-buffer-current-node nil
org-roam-buffer-current-directory nil))
(add-hook 'org-roam-find-file-hook #'org-roam-buffer--setup-redisplay-h)
(defun org-roam-buffer--setup-redisplay-h ()
"Setup automatic redisplay of the persistent `org-roam-buffer'."
(add-hook 'post-command-hook #'org-roam-buffer--redisplay-h nil t))
(defun org-roam-buffer--redisplay-h ()
"Reconstruct the persistent `org-roam-buffer'.
This needs to be quick or infrequent, because this designed to
run at `post-command-hook'."
(and (get-buffer-window org-roam-buffer)
(org-roam-buffer-persistent-redisplay)))
;;; Sections
;;;; Node
(defvar org-roam-node-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-node-visit)
map)
"Keymap for `org-roam-node-section's.")
(defclass org-roam-node-section (magit-section)
((keymap :initform 'org-roam-node-map)
(node :initform nil))
"A `magit-section' used by `org-roam-mode' to outline NODE in its own heading.")
(cl-defun org-roam-node-insert-section (&key source-node point properties)
"Insert section for a link from SOURCE-NODE to some other node.
The other node is normally `org-roam-buffer-current-node'.
SOURCE-NODE is an `org-roam-node' that links or references with
the other node.
POINT is a character position where the link is located in
SOURCE-NODE's file.
PROPERTIES (a plist) contains additional information about the
link.
Despite the name, this function actually inserts 2 sections at
the same time:
1. `org-roam-node-section' for a heading that describes
SOURCE-NODE. Acts as a parent section of the following one.
2. `org-roam-preview-section' for a preview content that comes
from SOURCE-NODE's file for the link (that references the
other node) at POINT. Acts a child section of the previous
one."
(magit-insert-section section (org-roam-node-section)
(let ((outline (if-let ((outline (plist-get properties :outline)))
(mapconcat #'org-link-display-format outline " > ")
"Top")))
(insert (concat (propertize (org-roam-node-title source-node)
'font-lock-face 'org-roam-title)
(format " (%s)"
(propertize outline 'font-lock-face 'org-roam-olp)))))
(magit-insert-heading)
(oset section node source-node)
(magit-insert-section section (org-roam-preview-section)
(insert (org-roam-fontify-like-in-org-mode
(org-roam-preview-get-contents (org-roam-node-file source-node) point))
"\n")
(oset section file (org-roam-node-file source-node))
(oset section point point)
(insert ?\n))))
;;;; Preview
(defvar org-roam-preview-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-preview-visit)
map)
"Keymap for `org-roam-preview-section's.")
(defclass org-roam-preview-section (magit-section)
((keymap :initform 'org-roam-preview-map)
(file :initform nil)
(point :initform nil))
"A `magit-section' used by `org-roam-mode' to contain preview content.
The preview content comes from FILE, and the link as at POINT.")
(defun org-roam-preview-visit (file point &optional other-window)
"Visit FILE at POINT and return the visited buffer.
With OTHER-WINDOW non-nil do so in another window.
In interactive calls OTHER-WINDOW is set with
`universal-argument'."
(interactive (list (org-roam-buffer-file-at-point 'assert)
(oref (magit-current-section) point)
current-prefix-arg))
(let ((buf (find-file-noselect file))
(display-buffer-fn (if other-window
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window)))
(funcall display-buffer-fn buf)
(with-current-buffer buf
(widen)
(goto-char point))
(when (org-invisible-p) (org-show-context))
buf))
(defun org-roam-preview-default-function ()
"Return the preview content at point.
This function returns the all contents under the current
headline, up to the next headline."
(let ((beg (save-excursion
(org-roam-end-of-meta-data t)
(point)))
(end (save-excursion
(org-next-visible-heading 1)
(point))))
(string-trim (buffer-substring-no-properties beg end))))
(defun org-roam-preview-get-contents (file pt)
"Get preview content for FILE at PT."
(save-excursion
(org-roam-with-temp-buffer file
(org-with-wide-buffer
(goto-char pt)
(let ((s (funcall org-roam-preview-function)))
(dolist (fn org-roam-preview-postprocess-functions)
(setq s (funcall fn s)))
s)))))
;;;; Backlinks
(cl-defstruct (org-roam-backlink (:constructor org-roam-backlink-create)
(:copier nil))
source-node target-node
point properties)
(cl-defmethod org-roam-populate ((backlink org-roam-backlink))
"Populate BACKLINK from database."
(setf (org-roam-backlink-source-node backlink)
(org-roam-populate (org-roam-backlink-source-node backlink))
(org-roam-backlink-target-node backlink)
(org-roam-populate (org-roam-backlink-target-node backlink)))
backlink)
(cl-defun org-roam-backlinks-get (node &key unique)
"Return the backlinks for NODE.
When UNIQUE is nil, show all positions where references are found.
When UNIQUE is t, limit to unique sources."
(let* ((sql (if unique
[:select :distinct [source dest pos properties]
:from links
:where (= dest $s1)
:and (= type "id")
:group :by source
:having (funcall min pos)]
[:select [source dest pos properties]
:from links
:where (= dest $s1)
:and (= type "id")]))
(backlinks (org-roam-db-query sql (org-roam-node-id node))))
(cl-loop for backlink in backlinks
collect (pcase-let ((`(,source-id ,dest-id ,pos ,properties) backlink))
(org-roam-populate
(org-roam-backlink-create
:source-node (org-roam-node-create :id source-id)
:target-node (org-roam-node-create :id dest-id)
:point pos
:properties properties))))))
(defun org-roam-backlinks-sort (a b)
"Default sorting function for backlinks A and B.
Sorts by title."
(string< (org-roam-node-title (org-roam-backlink-source-node a))
(org-roam-node-title (org-roam-backlink-source-node b))))
(cl-defun org-roam-backlinks-section (node &key (unique nil) (show-backlink-p nil))
"The backlinks section for NODE.
When UNIQUE is nil, show all positions where references are found.
When UNIQUE is t, limit to unique sources.
When SHOW-BACKLINK-P is not null, only show backlinks for which
this predicate is not nil."
(when-let ((backlinks (seq-sort #'org-roam-backlinks-sort (org-roam-backlinks-get node :unique unique))))
(magit-insert-section (org-roam-backlinks)
(magit-insert-heading "Backlinks:")
(dolist (backlink backlinks)
(when (or (null show-backlink-p)
(and (not (null show-backlink-p))
(funcall show-backlink-p backlink)))
(org-roam-node-insert-section
:source-node (org-roam-backlink-source-node backlink)
:point (org-roam-backlink-point backlink)
:properties (org-roam-backlink-properties backlink))))
(insert ?\n))))
;;;; Reflinks
(cl-defstruct (org-roam-reflink (:constructor org-roam-reflink-create)
(:copier nil))
source-node ref
point properties)
(cl-defmethod org-roam-populate ((reflink org-roam-reflink))
"Populate REFLINK from database."
(setf (org-roam-reflink-source-node reflink)
(org-roam-populate (org-roam-reflink-source-node reflink)))
reflink)
(defun org-roam-reflinks-get (node)
"Return the reflinks for NODE."
(let ((refs (org-roam-db-query [:select :distinct [refs:ref links:source links:pos links:properties]
:from refs
:left-join links
:where (= refs:node-id $s1)
:and (= links:dest refs:ref)
:union
:select :distinct [refs:ref citations:node-id
citations:pos citations:properties]
:from refs
:left-join citations
:where (= refs:node-id $s1)
:and (= citations:cite-key refs:ref)]
(org-roam-node-id node)))
links)
(pcase-dolist (`(,ref ,source-id ,pos ,properties) refs)
(push (org-roam-populate
(org-roam-reflink-create
:source-node (org-roam-node-create :id source-id)
:ref ref
:point pos
:properties properties)) links))
links))
(defun org-roam-reflinks-sort (a b)
"Default sorting function for reflinks A and B.
Sorts by title."
(string< (org-roam-node-title (org-roam-reflink-source-node a))
(org-roam-node-title (org-roam-reflink-source-node b))))
(defun org-roam-reflinks-section (node)
"The reflinks section for NODE."
(when-let ((refs (org-roam-node-refs node))
(reflinks (seq-sort #'org-roam-reflinks-sort (org-roam-reflinks-get node))))
(magit-insert-section (org-roam-reflinks)
(magit-insert-heading "Reflinks:")
(dolist (reflink reflinks)
(org-roam-node-insert-section
:source-node (org-roam-reflink-source-node reflink)
:point (org-roam-reflink-point reflink)
:properties (org-roam-reflink-properties reflink)))
(insert ?\n))))
;;;; Grep
(defvar org-roam-grep-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-grep-visit)
map)
"Keymap for Org-roam grep result sections.")
(defclass org-roam-grep-section (magit-section)
((keymap :initform 'org-roam-grep-map)
(file :initform nil)
(row :initform nil)
(col :initform nil))
"A `magit-section' used by `org-roam-mode' to contain grep output.")
(defun org-roam-grep-visit (file &optional other-window row col)
"Visit FILE at row ROW (if any) and column COL (if any). Return the buffer.
With OTHER-WINDOW non-nil (in interactive calls set with
`universal-argument') display the buffer in another window
instead."
(interactive (list (org-roam-buffer-file-at-point t)
current-prefix-arg
(oref (magit-current-section) row)
(oref (magit-current-section) col)))
(let ((buf (find-file-noselect file))
(display-buffer-fn (if other-window
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window)))
(funcall display-buffer-fn buf)
(with-current-buffer buf
(widen)
(goto-char (point-min))
(when row
(forward-line (1- row)))
(when col
(forward-char (1- col))))
(when (org-invisible-p) (org-show-context))
buf))
;;;; Unlinked references
(defvar org-roam-unlinked-references-result-re
(rx (group (one-or-more anything))
":"
(group (one-or-more digit))
":"
(group (one-or-more digit))
":"
(group (zero-or-more anything)))
"Regex for the return result of a ripgrep query.")
(defun org-roam-unlinked-references-preview-line (file row)
"Return the preview line from FILE.
This is the ROW within FILE."
(with-temp-buffer
(insert-file-contents file)
(forward-line (1- row))
(buffer-substring-no-properties
(save-excursion
(beginning-of-line)
(point))
(save-excursion
(end-of-line)
(point)))))
(defun org-roam-unlinked-references-section (node)
"The unlinked references section for NODE.
References from FILE are excluded."
(when (and (executable-find "rg")
(org-roam-node-title node)
(not (string-match "PCRE2 is not available"
(shell-command-to-string "rg --pcre2-version"))))
(let* ((titles (cons (org-roam-node-title node)
(org-roam-node-aliases node)))
(rg-command (concat "rg -L -o --vimgrep -P -i "
(mapconcat (lambda (glob) (concat "-g " glob))
(org-roam--list-files-search-globs org-roam-file-extensions)
" ")
(format " '\\[([^[]]++|(?R))*\\]%s' "
(mapconcat (lambda (title)
(format "|(\\b%s\\b)" (shell-quote-argument title)))
titles ""))
org-roam-directory))
(results (split-string (shell-command-to-string rg-command) "\n"))
f row col match)
(magit-insert-section (unlinked-references)
(magit-insert-heading "Unlinked References:")
(dolist (line results)
(save-match-data
(when (string-match org-roam-unlinked-references-result-re line)
(setq f (match-string 1 line)
row (string-to-number (match-string 2 line))
col (string-to-number (match-string 3 line))
match (match-string 4 line))
(when (and match
(not (file-equal-p (org-roam-node-file node) f))
(member (downcase match) (mapcar #'downcase titles)))
(magit-insert-section section (org-roam-grep-section)
(oset section file f)
(oset section row row)
(oset section col col)
(insert (propertize (format "%s:%s:%s"
(truncate-string-to-width (file-name-base f) 15 nil nil t)
row col) 'font-lock-face 'org-roam-dim)
" "
(org-roam-fontify-like-in-org-mode
(org-roam-unlinked-references-preview-line f row))
"\n"))))))
(insert ?\n)))))
(provide 'org-roam-mode)
;;; org-roam-mode.el ends here

1129
lisp/org-roam/org-roam-node.el Normal file
View File

File diff suppressed because it is too large Load Diff

96
lisp/org-roam/org-roam-overlay.el Normal file
View File

@@ -0,0 +1,96 @@
;;; org-roam-overlay.el --- Link overlay for [id:] links to Org-roam nodes -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.1"))
;; 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 extension allows to render [[id:]] links that don't have an associated
;; descriptor with an overlay that displays the node's current title.
;;
;;; Code:
(require 'org-roam)
(defface org-roam-overlay
'((((class color) (background light))
:background "grey90" :box (:line-width -1 :color "black"))
(((class color) (background dark))
:background "grey10" :box (:line-width -1 :color "white")))
"Face for the Org-roam overlay."
:group 'org-roam-faces)
(defun org-roam-overlay--make (l r &rest props)
"Make an overlay from L to R with PROPS."
(let ((o (make-overlay l (or r l))))
(overlay-put o 'category 'org-roam)
(while props (overlay-put o (pop props) (pop props)))
o))
(defun org-roam-overlay-make-link-overlay (link)
"Create overlay for LINK."
(save-excursion
(save-match-data
(let* ((type (org-element-property :type link))
(id (org-element-property :path link))
(pos (org-element-property :end link))
(desc-p (org-element-property :contents-begin link))
node)
(when (and (string-equal type "id")
(setq node (org-roam-node-from-id id))
(not desc-p))
(org-roam-overlay--make
pos pos
'after-string (format "%s "
(propertize (org-roam-node-title node)
'face 'org-roam-overlay))))))))
(defun org-roam-overlay-enable ()
"Enable Org-roam overlays."
(org-roam-db-map-links
(list #'org-roam-overlay-make-link-overlay)))
(defun org-roam-overlay-disable ()
"Disable Org-roam overlays."
(remove-overlays nil nil 'category 'org-roam))
(defun org-roam-overlay-redisplay ()
"Redisplay Org-roam overlays."
(org-roam-overlay-disable)
(org-roam-overlay-enable))
(define-minor-mode org-roam-overlay-mode
"Overlays for Org-roam ID links.
Org-roam overlay mode is a minor mode. When enabled,
overlay displaying the node's title is displayed."
:lighter " org-roam-overlay"
(if org-roam-overlay-mode
(progn
(org-roam-overlay-enable)
(add-hook 'after-save-hook #'org-roam-overlay-redisplay nil t))
(org-roam-overlay-disable)
(remove-hook 'after-save-hook #'org-roam-overlay-redisplay t)))
(provide 'org-roam-overlay)
;;; org-roam-overlay.el ends here

17
lisp/org-roam/org-roam-pkg.el Normal file
View File

@@ -0,0 +1,17 @@
(define-package "org-roam" "20221205.355" "A database abstraction layer for Org-mode"
'((emacs "26.1")
(dash "2.13")
(org "9.4")
(emacsql "3.0.0")
(emacsql-sqlite "1.0.0")
(magit-section "3.0.0"))
:commit "f9228ce31969cab9ca46ad4890e82e2ea7de3738" :authors
'(("Jethro Kuan" . "jethrokuan95@gmail.com"))
:maintainer
'("Jethro Kuan" . "jethrokuan95@gmail.com")
:keywords
'("org-mode" "roam" "convenience")
:url "https://github.com/org-roam/org-roam")
;; Local Variables:
;; no-byte-compile: t
;; End:

174
lisp/org-roam/org-roam-protocol.el Normal file
View File

@@ -0,0 +1,174 @@
;;; org-roam-protocol.el --- Protocol handler for roam:// links -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.1"))
;; 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 extension extends `org-protocol', adding custom Org-roam handlers to it
;; to provide the next new protocols:
;;
;; 1. "roam-node": This protocol simply opens the node given by the node ID
;; 2. "roam-ref": This protocol creates or opens the node with the given REF
;;
;; You can find detailed instructions on how to setup the protocol in the
;; documentation for Org-roam.
;;
;;; Code:
(require 'org-protocol)
(require 'ol) ;; for org-link-decode
(require 'org-roam)
;;; Options
(defcustom org-roam-protocol-store-links nil
"Whether to store links when capturing websites with `org-roam-protocol'."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-capture-ref-templates
'(("r" "ref" plain "%?"
:target (file+head "${slug}.org"
"#+title: ${title}")
:unnarrowed t))
"The Org-roam templates used during a capture from the roam-ref protocol.
See `org-roam-capture-templates' for the template documentation."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :target)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
;;; Handlers
(defun org-roam-protocol-open-ref (info)
"Process an org-protocol://roam-ref?ref= style url with INFO.
It opens or creates a note with the given ref.
javascript:location.href = \\='org-protocol://roam-ref?template=r&ref=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' + \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())"
(unless (plist-get info :ref)
(user-error "No ref key provided"))
(org-roam-plist-map! (lambda (k v)
(org-link-decode
(if (equal k :ref)
(org-protocol-sanitize-uri v)
v))) info)
(when org-roam-protocol-store-links
(push (list (plist-get info :ref)
(plist-get info :title)) org-stored-links))
(org-link-store-props :type (and (string-match org-link-plain-re
(plist-get info :ref))
(match-string 1 (plist-get info :ref)))
:link (plist-get info :ref)
:annotation (org-link-make-string (plist-get info :ref)
(or (plist-get info :title)
(plist-get info :ref)))
:initial (or (plist-get info :body) ""))
(raise-frame)
(let ((org-capture-link-is-already-stored t))
(org-roam-capture-
:keys (plist-get info :template)
:node (org-roam-node-create :title (plist-get info :title))
:info (list :ref (plist-get info :ref)
:body (plist-get info :body))
:templates org-roam-capture-ref-templates))
nil)
(defun org-roam-protocol-open-node (info)
"This handler simply opens the file with emacsclient.
INFO is a plist containing additional information passed by the protocol URL.
It should contain the FILE key, pointing to the path of the file to open.
Example protocol string:
org-protocol://roam-node?node=uuid"
(when-let ((node (plist-get info :node)))
(raise-frame)
(org-roam-node-visit (org-roam-populate (org-roam-node-create :id node)) nil 'force))
nil)
(push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref)
org-protocol-protocol-alist)
(push '("org-roam-node" :protocol "roam-node" :function org-roam-protocol-open-node)
org-protocol-protocol-alist)
(provide 'org-roam-protocol)
;;; org-roam-protocol.el ends here

483
lisp/org-roam/org-roam-utils.el Normal file
View File

@@ -0,0 +1,483 @@
;;; org-roam-utils.el --- Utilities for Org-roam -*- lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4"))
;; 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 definitions for utilities that used throughout the
;; whole package.
;;
;;; Code:
(require 'org-roam)
(defun org-roam-require (libs)
"Require LIBS."
(dolist (lib libs)
(require lib nil 'noerror)))
;;; String utilities
;; TODO Refactor this.
(defun org-roam-replace-string (old new s)
"Replace OLD with NEW in S."
(declare (pure t) (side-effect-free t))
(replace-regexp-in-string (regexp-quote old) new s t t))
(defun org-roam-quote-string (s)
"Quotes string S."
(->> s
(org-roam-replace-string "\\" "\\\\")
(org-roam-replace-string "\"" "\\\"")))
(defun org-roam-word-wrap (len s)
"If S is longer than LEN, wrap the words with newlines."
(declare (side-effect-free t))
(save-match-data
(with-temp-buffer
(insert s)
(let ((fill-column len))
(fill-region (point-min) (point-max)))
(buffer-substring (point-min) (point-max)))))
(defun org-roam-string-equal (s1 s2)
"Return t if S1 and S2 are equal.
Like `string-equal', but case-insensitive."
(and (= (length s1) (length s2))
(or (string-equal s1 s2)
(string-equal (downcase s1) (downcase s2)))))
(defun org-roam-whitespace-content (s)
"Return the whitespace content at the end of S."
(with-temp-buffer
(let ((c 0))
(insert s)
(skip-chars-backward " \t\n")
(buffer-substring-no-properties
(point) (point-max)))))
(defun org-roam-strip-comments (s)
"Strip Org comments from string S."
(with-temp-buffer
(insert s)
(goto-char (point-min))
(while (not (eobp))
(if (org-at-comment-p)
(delete-region (point-at-bol) (progn (forward-line) (point)))
(forward-line)))
(buffer-string)))
;;; List utilities
(defun org-roam-plist-map! (fn plist)
"Map FN over PLIST, modifying it in-place and returning it.
FN must take two arguments: the key and the value."
(let ((plist-index plist))
(while plist-index
(let ((key (pop plist-index)))
(setf (car plist-index) (funcall fn key (car plist-index))
plist-index (cdr plist-index)))))
plist)
(defmacro org-roam-dolist-with-progress (spec msg &rest body)
"Loop over a list and report progress in the echo area.
Like `dolist-with-progress-reporter', but falls back to `dolist'
if the function does not yet exist.
Evaluate BODY with VAR bound to each car from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
MSG is a progress reporter object or a string. In the latter
case, use this string to create a progress reporter.
SPEC is a list, as per `dolist'."
(declare (indent 2))
(if (fboundp 'dolist-with-progress-reporter)
`(dolist-with-progress-reporter ,spec ,msg ,@body)
`(dolist ,spec ,@body)))
;;; File utilities
(defun org-roam-descendant-of-p (a b)
"Return t if A is descendant of B."
(unless (equal (file-truename a) (file-truename b))
(string-prefix-p (replace-regexp-in-string "^\\([A-Za-z]\\):" 'downcase (expand-file-name b) t t)
(replace-regexp-in-string "^\\([A-Za-z]\\):" 'downcase (expand-file-name a) t t))))
(defmacro org-roam-with-file (file keep-buf-p &rest body)
"Execute BODY within FILE.
If FILE is nil, execute BODY in the current buffer.
Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited."
(declare (indent 2) (debug t))
`(let* (new-buf
(auto-mode-alist nil)
(find-file-hook nil)
(buf (or (and (not ,file)
(current-buffer)) ;If FILE is nil, use current buffer
(find-buffer-visiting ,file) ; If FILE is already visited, find buffer
(progn
(setq new-buf t)
(find-file-noselect ,file)))) ; Else, visit FILE and return buffer
res)
(with-current-buffer buf
(unless (derived-mode-p 'org-mode)
(delay-mode-hooks
(let ((org-inhibit-startup t)
(org-agenda-files nil))
(org-mode)
(hack-local-variables))))
(setq res (progn ,@body))
(unless (and new-buf (not ,keep-buf-p))
(save-buffer)))
(if (and new-buf (not ,keep-buf-p))
(when (find-buffer-visiting ,file)
(kill-buffer (find-buffer-visiting ,file))))
res))
;;; Buffer utilities
(defmacro org-roam-with-temp-buffer (file &rest body)
"Execute BODY within a temp buffer.
Like `with-temp-buffer', but propagates `org-roam-directory'.
If FILE, set `default-directory' to FILE's directory and insert its contents."
(declare (indent 1) (debug t))
(let ((current-org-roam-directory (make-symbol "current-org-roam-directory")))
`(let ((,current-org-roam-directory org-roam-directory))
(with-temp-buffer
(let ((org-roam-directory ,current-org-roam-directory))
(delay-mode-hooks (org-mode))
(when ,file
(insert-file-contents ,file)
(setq-local default-directory (file-name-directory ,file)))
,@body)))))
;;; Formatting
(defun org-roam-format-template (template replacer)
"Format TEMPLATE with the function REPLACER.
The templates are of form ${foo} for variable foo, and
${foo=default} for variable foo with default value \"default\".
REPLACER takes an argument of the format variable and the default
value (possibly nil). Adapted from `s-format'."
(let ((saved-match-data (match-data)))
(unwind-protect
(replace-regexp-in-string
"\\${\\([^}]+\\)}"
(lambda (md)
(let ((var (match-string 1 md))
(replacer-match-data (match-data))
default-val)
(when (string-match "\\(.+\\)=\\(.+\\)" var)
(setq default-val (match-string 2 var)
var (match-string 1 var)))
(unwind-protect
(let ((v (progn
(set-match-data saved-match-data)
(funcall replacer var default-val))))
(if v
(format (apply #'propertize "%s" (text-properties-at 0 var)) v)
(signal 'org-roam-format-resolve md)))
(set-match-data replacer-match-data))))
(if (functionp template)
(funcall template)
template)
;; Need literal to make sure it works
t t)
(set-match-data saved-match-data))))
;;; Fontification
(defvar org-ref-buffer-hacked)
(defun org-roam-fontify-like-in-org-mode (s)
"Fontify string S like in Org mode.
Like `org-fontify-like-in-org-mode', but supports `org-ref'."
;; NOTE: pretend that the temporary buffer created by `org-fontify-like-in-org-mode' to
;; fontify a `cite:' reference has been hacked by org-ref, whatever that means;
;;
;; `org-ref-cite-link-face-fn', which is used to supply a face for `cite:' links, calls
;; `hack-dir-local-variables' rationalizing that `bibtex-completion' would throw some warnings
;; otherwise. This doesn't seem to be the case and calling this function just before
;; `org-font-lock-ensure' (alias of `font-lock-ensure') actually instead of fixing the alleged
;; warnings messes the things so badly that `font-lock-ensure' crashes with error and doesn't let
;; org-roam to proceed further. I don't know what's happening there exactly but disabling this hackery
;; fixes the crashing. Fortunately, org-ref provides the `org-ref-buffer-hacked' switch, which we use
;; here to make it believe that the buffer was hacked.
;;
;; This is a workaround for `cite:' links and does not have any effect on other ref types.
;;
;; `org-ref-buffer-hacked' is a buffer-local variable, therefore we inline
;; `org-fontify-like-in-org-mode' here
(with-temp-buffer
(insert s)
(let ((org-ref-buffer-hacked t)
(org-fold-core-style 'overlays))
(org-mode)
(font-lock-ensure)
(buffer-string))))
;;;; Shielding regions
(defface org-roam-shielded
'((t :inherit (warning)))
"Face for regions that are shielded (marked as read-only).
This face is used on the region target by org-roam-insertion
during an `org-roam-capture'."
:group 'org-roam-faces)
(defun org-roam-shield-region (beg end)
"Shield region against modifications.
BEG and END are markers for the beginning and end regions.
REGION must be a cons-cell containing the marker to the region
beginning and maximum values."
(add-text-properties beg end
'(font-lock-face org-roam-shielded
read-only t)
(marker-buffer beg)))
(defun org-roam-unshield-region (beg end)
"Unshield the shielded REGION.
BEG and END are markers for the beginning and end regions."
(let ((inhibit-read-only t))
(remove-text-properties beg end
'(font-lock-face org-roam-shielded
read-only t)
(marker-buffer beg))))
;;; Org-mode utilities
;;;; Motions
(defun org-roam-up-heading-or-point-min ()
"Fixed version of Org's `org-up-heading-or-point-min'."
(ignore-errors (org-back-to-heading t))
(let ((p (point)))
(if (< 1 (funcall outline-level))
(progn
(org-up-heading-safe)
(when (= (point) p)
(goto-char (point-min))))
(unless (bobp) (goto-char (point-min))))))
;;;; Keywords
(defun org-roam-get-keyword (name &optional file bound)
"Return keyword property NAME from an org FILE.
FILE defaults to current file.
Only scans up to BOUND bytes of the document."
(unless bound
(setq bound 1024))
(if file
(with-temp-buffer
(insert-file-contents file nil 0 bound)
(org-roam--get-keyword name))
(org-roam--get-keyword name bound)))
(defun org-roam--get-keyword (name &optional bound)
"Return keyword property NAME in current buffer.
If BOUND, scan up to BOUND bytes of the buffer."
(save-excursion
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name))))
(goto-char (point-min))
(when (re-search-forward re bound t)
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))))
(defun org-roam-end-of-meta-data (&optional full)
"Like `org-end-of-meta-data', but supports file-level metadata.
When FULL is non-nil but not t, skip planning information,
properties, clocking lines and logbook drawers.
When optional argument FULL is t, skip everything above, and also
skip keywords."
(org-back-to-heading-or-point-min t)
(when (org-at-heading-p) (forward-line))
;; Skip planning information.
(when (looking-at-p org-planning-line-re) (forward-line))
;; Skip property drawer.
(when (looking-at org-property-drawer-re)
(goto-char (match-end 0))
(forward-line))
;; When FULL is not nil, skip more.
(when (and full (not (org-at-heading-p)))
(catch 'exit
(let ((end (save-excursion (outline-next-heading) (point)))
(re (concat "[ \t]*$" "\\|" org-clock-line-re)))
(while (not (eobp))
(cond ;; Skip clock lines.
((looking-at-p re) (forward-line))
;; Skip logbook drawer.
((looking-at-p org-logbook-drawer-re)
(if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
(forward-line)
(throw 'exit t)))
((looking-at-p org-drawer-regexp)
(if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
(forward-line)
(throw 'exit t)))
;; When FULL is t, skip keywords too.
((and (eq full t)
(looking-at-p org-keyword-regexp))
(forward-line))
(t (throw 'exit t))))))))
(defun org-roam-set-keyword (key value)
"Set keyword KEY to VALUE.
If the property is already set, it's value is replaced."
(org-with-point-at 1
(let ((case-fold-search t))
(if (re-search-forward (concat "^#\\+" key ":\\(.*\\)") (point-max) t)
(if (string-blank-p value)
(kill-whole-line)
(replace-match (concat " " value) 'fixedcase nil nil 1))
(org-roam-end-of-meta-data 'drawers)
(if (save-excursion (end-of-line) (eobp))
(progn
(end-of-line)
(insert "\n"))
(forward-line)
(beginning-of-line))
(insert "#+" key ": " value "\n")))))
(defun org-roam-erase-keyword (keyword)
"Erase the line where the KEYWORD is, setting line from the top of the file."
(let ((case-fold-search t))
(org-with-point-at 1
(when (re-search-forward (concat "^#\\+" keyword ":") nil t)
(beginning-of-line)
(delete-region (point) (line-end-position))
(delete-char 1)))))
;;;; Properties
(defun org-roam-add-property (val prop)
"Add VAL value to PROP property for the node at point.
Both, VAL and PROP are strings."
(org-roam-property-add prop val))
(defun org-roam-remove-property (prop &optional val)
"Remove VAL value from PROP property for the node at point.
Both VAL and PROP are strings.
If VAL is not specified, user is prompted to select a value."
(org-roam-property-remove prop val))
(defun org-roam-property-add (prop val)
"Add VAL value to PROP property for the node at point.
Both, VAL and PROP are strings."
(let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p)))
(lst (if (memq val lst) lst (cons val lst)))
(lst (seq-uniq lst)))
(org-set-property prop (combine-and-quote-strings lst))
val))
(defun org-roam-property-remove (prop &optional val)
"Remove VAL value from PROP property for the node at point.
Both VAL and PROP are strings.
If VAL is not specified, user is prompted to select a value."
(let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p)))
(prop-to-remove (or val (completing-read "Remove: " lst)))
(lst (delete prop-to-remove lst)))
(if lst
(org-set-property prop (combine-and-quote-strings lst))
(org-delete-property prop))
prop-to-remove))
;;; Refs
(defun org-roam-org-ref-path-to-keys (path)
"Return a list of keys given an org-ref cite: PATH.
Accounts for both v2 and v3."
(cond ((fboundp 'org-ref-parse-cite-path)
(mapcar (lambda (cite) (plist-get cite :key))
(plist-get (org-ref-parse-cite-path path) :references)))
((fboundp 'org-ref-split-and-strip-string)
(org-ref-split-and-strip-string path))))
;;; Logs
(defvar org-roam-verbose)
(defun org-roam-message (format-string &rest args)
"Pass FORMAT-STRING and ARGS to `message' when `org-roam-verbose' is t."
(when org-roam-verbose
(apply #'message `(,(concat "(org-roam) " format-string) ,@args))))
;;; Diagnostics
;; TODO Update this to also get commit hash
;;;###autoload
(defun org-roam-version (&optional message)
"Return `org-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) "org-roam-utils.el"))
(setq toplib (locate-library "org-roam-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.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)))
(defun org-roam--straight-chase-links (filename)
"Chase links in FILENAME until a name that is not a link.
This is the same as `file-chase-links', except that it also
handles fake symlinks that are created by the package manager
straight.el on Windows.
See <https://github.com/raxod502/straight.el/issues/520>."
(when (and (bound-and-true-p straight-symlink-emulation-mode)
(fboundp 'straight-chase-emulated-symlink))
(when-let ((target (straight-chase-emulated-symlink filename)))
(unless (eq target 'broken)
(setq filename target))))
(file-chase-links filename))
;;;###autoload
(defun org-roam-diagnostics ()
"Collect and print info for `org-roam' issues."
(interactive)
(with-current-buffer (switch-to-buffer-other-window (get-buffer-create "*org-roam diagnostics*"))
(erase-buffer)
(insert (propertize "Copy info below this line into issue:\n" 'face '(:weight bold)))
(insert (format "- Emacs: %s\n" (emacs-version)))
(insert (format "- Framework: %s\n"
(condition-case _
(completing-read "I'm using the following Emacs framework:"
'("Doom" "Spacemacs" "N/A" "I don't know"))
(quit "N/A"))))
(insert (format "- Org: %s\n" (org-version nil 'full)))
(insert (format "- Org-roam: %s" (org-roam-version)))
(insert (format "- sqlite-connector: %s" org-roam-database-connector))))
(provide 'org-roam-utils)
;;; org-roam-utils.el ends here

345
lisp/org-roam/org-roam.el Normal file
View File

@@ -0,0 +1,345 @@
;;; org-roam.el --- A database abstraction layer for Org-mode -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.2.2
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.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:
;;
;; Org-roam is a Roam Research inspired Emacs package and is an addition to
;; Org-mode to have a way to quickly process complex SQL-like queries over a
;; large set of plain text Org-mode files. To achieve this Org-roam provides a
;; database abstraction layer, the capabilities of which include, but are not
;; limited to:
;;
;; - Link graph traversal and visualization.
;; - Instantaneous SQL-like queries on headlines
;; - What are my TODOs, scheduled for X, or due by Y?
;; - Accessing the properties of a node, such as its tags, refs, TODO state or
;; priority.
;;
;; All of these functionality is powered by this layer. Hence, at its core
;; Org-roam's primary goal is to provide a resilient dual representation of
;; what's already available in plain text, while cached in a binary database,
;; that is cheap to maintain, easy to understand, and is as up-to-date as it
;; possibly can. For users who would like to perform arbitrary programmatic
;; queries on their Org files Org-roam also exposes an API to this database
;; abstraction layer.
;;
;; -----------------------------------------------------------------------------
;;
;; In order for the package to correctly work through your interactive session
;; it's mandatory to add somewhere to your configuration the next form:
;;
;; (org-roam-db-autosync-mode)
;;
;; The form can be called both, before or after loading the package, which is up
;; to your preferences. If you call this before the package is loaded, then it
;; will automatically load the package.
;;
;; -----------------------------------------------------------------------------
;;
;; This package also comes with a set of officially supported extensions that
;; provide extra features. You can find them in the "extensions/" subdirectory.
;; These extensions are not automatically loaded with `org-roam`, but they still
;; will be lazy-loaded through their own `autoload's.
;;
;; Org-roam also has other extensions that don't come together with this package.
;; Such extensions are distributed as their own packages, while also
;; authored and maintained by different people on distinct repositories. The
;; majority of them can be found at https://github.com/org-roam and MELPA.
;;
;;; Code:
(require 'dash)
(require 'rx)
(require 'seq)
(require 'cl-lib)
(require 'magit-section)
(require 'emacsql)
(require 'emacsql-sqlite)
(require 'org)
(require 'org-attach) ; To set `org-attach-id-dir'
(require 'org-id)
(require 'ol)
(require 'org-element)
(require 'org-capture)
(require 'ansi-color) ; to strip ANSI color codes in `org-roam--list-files'
(eval-when-compile
(require 'subr-x))
;;; Options
(defgroup org-roam nil
"A database abstraction layer for Org-mode."
:group 'org
:prefix "org-roam-"
:link '(url-link :tag "Github" "https://github.com/org-roam/org-roam")
:link '(url-link :tag "Online Manual" "https://www.orgroam.com/manual.html"))
(defgroup org-roam-faces nil
"Faces used by Org-roam."
:group 'org-roam
:group 'faces)
(defcustom org-roam-verbose t
"Echo messages that are not errors."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-directory (expand-file-name "~/org-roam/")
"Default path to Org-roam files.
All Org files, at any level of nesting, are considered part of the Org-roam."
:type 'directory
:group 'org-roam)
(defcustom org-roam-find-file-hook nil
"Hook run when an Org-roam file is visited."
:group 'org-roam
:type 'hook)
(defcustom org-roam-post-node-insert-hook nil
"Hook run when an Org-roam node is inserted as an Org link.
Each function takes two arguments: the id of the node, and the link description."
:group 'org-roam
:type 'hook)
(defcustom org-roam-file-extensions '("org")
"List of file extensions to be included by Org-Roam.
While a file extension different from \".org\" may be used, the
file still needs to be an `org-mode' file, and it is the user's
responsibility to ensure that."
:type '(repeat string)
:group 'org-roam)
(defcustom org-roam-file-exclude-regexp (list org-attach-id-dir)
"Files matching this regular expression are excluded from the Org-roam."
:type '(choice
(repeat
(string :tag "Regular expression matching files to ignore"))
(string :tag "Regular expression matching files to ignore")
(const :tag "Include everything" nil))
:group 'org-roam)
(defcustom org-roam-list-files-commands
(if (member system-type '(windows-nt ms-dos cygwin))
nil
'(find fd fdfind rg))
"Commands that will be used to find Org-roam files.
It should be a list of symbols or cons cells representing any of the following
supported file search methods.
The commands will be tried in order until an executable for a command is found.
The Elisp implementation is used if no command in the list is found.
`find'
Use find as the file search method.
Example command:
find /path/to/dir -type f \( -name \"*.org\" -o -name \"*.org.gpg\" \)
`fd'
Use fd as the file search method.
Example command: fd /path/to/dir/ --type file -e \".org\" -e \".org.gpg\"
`fdfind'
Same as `fd'. It's an alias that used in some OSes (e.g. Debian, Ubuntu)
`rg'
Use ripgrep as the file search method.
Example command: rg /path/to/dir/ --files -g \"*.org\" -g \"*.org.gpg\"
By default, `executable-find' will be used to look up the path to the
executable. If a custom path is required, it can be specified together with the
method symbol as a cons cell. For example: '(find (rg . \"/path/to/rg\"))."
:type '(set (const :tag "find" find)
(const :tag "fd" fd)
(const :tag "fdfind" fdfind)
(const :tag "rg" rg)
(const :tag "elisp" nil)))
;;; Library
(defun org-roam-file-p (&optional file)
"Return t if FILE is an Org-roam file, nil otherwise.
If FILE is not specified, use the current buffer's file-path.
FILE is an Org-roam file if:
- It's located somewhere under `org-roam-directory'
- It has a matching file extension (`org-roam-file-extensions')
- It doesn't match excluded regexp (`org-roam-file-exclude-regexp')"
(when (or file (buffer-file-name (buffer-base-buffer)))
(let* ((path (or file (buffer-file-name (buffer-base-buffer))))
(relative-path (file-relative-name path org-roam-directory))
(ext (org-roam--file-name-extension path))
(ext (if (string= ext "gpg")
(org-roam--file-name-extension (file-name-sans-extension path))
ext))
(org-roam-dir-p (org-roam-descendant-of-p path org-roam-directory))
(valid-file-ext-p (member ext org-roam-file-extensions))
(match-exclude-regexp-p
(cond
((not org-roam-file-exclude-regexp) nil)
((stringp org-roam-file-exclude-regexp)
(string-match-p org-roam-file-exclude-regexp relative-path))
((listp org-roam-file-exclude-regexp)
(let (is-match)
(dolist (exclude-re org-roam-file-exclude-regexp)
(setq is-match (or is-match (string-match-p exclude-re relative-path))))
is-match)))))
(save-match-data
(and
path
org-roam-dir-p
valid-file-ext-p
(not match-exclude-regexp-p))))))
;;;###autoload
(defun org-roam-list-files ()
"Return a list of all Org-roam files under `org-roam-directory'.
See `org-roam-file-p' for how each file is determined to be as
part of Org-Roam."
(org-roam--list-files (expand-file-name org-roam-directory)))
(defun org-roam-buffer-p (&optional buffer)
"Return t if BUFFER is for an Org-roam file.
If BUFFER is not specified, use the current buffer."
(let ((buffer (or buffer (current-buffer)))
path)
(with-current-buffer buffer
(and (derived-mode-p 'org-mode)
(setq path (buffer-file-name (buffer-base-buffer)))
(org-roam-file-p path)))))
(defun org-roam-buffer-list ()
"Return a list of buffers that are Org-roam files."
(--filter (org-roam-buffer-p it)
(buffer-list)))
(defun org-roam--file-name-extension (filename)
"Return file name extension for FILENAME.
Like `file-name-extension', but does not strip version number."
(save-match-data
(let ((file (file-name-nondirectory filename)))
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) 1))))))
(defun org-roam--list-files (dir)
"Return all Org-roam files located recursively within DIR.
Use external shell commands if defined in `org-roam-list-files-commands'."
(let (path exe)
(cl-dolist (cmd org-roam-list-files-commands)
(pcase cmd
(`(,e . ,path)
(setq path (executable-find path)
exe (symbol-name e)))
((pred symbolp)
(setq path (executable-find (symbol-name cmd))
exe (symbol-name cmd)))
(wrong-type
(signal 'wrong-type-argument
`((consp symbolp)
,wrong-type))))
(when path (cl-return)))
(if-let* ((files (when path
(let ((fn (intern (concat "org-roam--list-files-" exe))))
(unless (fboundp fn) (user-error "%s is not an implemented search method" fn))
(funcall fn path (format "\"%s\"" dir)))))
(files (seq-filter #'org-roam-file-p files))
(files (mapcar #'expand-file-name files))) ; canonicalize names
files
(org-roam--list-files-elisp dir))))
(defun org-roam--shell-command-files (cmd)
"Run CMD in the shell and return a list of files.
If no files are found, an empty list is returned."
(--> cmd
(shell-command-to-string it)
(ansi-color-filter-apply it)
(split-string it "\n")
(seq-filter (lambda (s)
(not (or (null s) (string= "" s)))) it)))
(defun org-roam--list-files-search-globs (exts)
"Given EXTS, return a list of search globs.
E.g. (\".org\") => (\"*.org\" \"*.org.gpg\")"
(cl-loop for e in exts
append (list (format "\"*.%s\"" e)
(format "\"*.%s.gpg\"" e))))
(defun org-roam--list-files-find (executable dir)
"Return all Org-roam files under DIR, using \"find\", provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(names (string-join (mapcar (lambda (glob) (concat "-name " glob)) globs) " -o "))
(command (string-join `(,executable "-L" ,dir "-type f \\(" ,names "\\)") " ")))
(org-roam--shell-command-files command)))
(defun org-roam--list-files-fd (executable dir)
"Return all Org-roam files under DIR, using \"fd\", provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(extensions (string-join (mapcar (lambda (glob) (concat "-e " (substring glob 2 -1))) globs) " "))
(command (string-join `(,executable "-L" "--type file" ,extensions "." ,dir) " ")))
(org-roam--shell-command-files command)))
(defalias 'org-roam--list-files-fdfind #'org-roam--list-files-fd)
(defun org-roam--list-files-rg (executable dir)
"Return all Org-roam files under DIR, using \"rg\", provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(command (string-join `(,executable "-L" ,dir "--files"
,@(mapcar (lambda (glob) (concat "-g " glob)) globs)) " ")))
(org-roam--shell-command-files command)))
(declare-function org-roam--directory-files-recursively "org-roam-compat")
(defun org-roam--list-files-elisp (dir)
"Return all Org-roam files under DIR, using Elisp based implementation."
(let ((regex (concat "\\.\\(?:"(mapconcat
#'regexp-quote org-roam-file-extensions
"\\|" )"\\)\\(?:\\.gpg\\)?\\'"))
result)
(dolist (file (org-roam--directory-files-recursively dir regex nil nil t) result)
(when (and (file-readable-p file)
(org-roam-file-p file))
(push file result)))))
;;; Package bootstrap
(provide 'org-roam)
(cl-eval-when (load eval)
(require 'org-roam-compat)
(require 'org-roam-utils)
(require 'org-roam-db)
(require 'org-roam-node)
(require 'org-roam-id)
(require 'org-roam-capture)
(require 'org-roam-mode)
(require 'org-roam-log)
(require 'org-roam-migrate))
;;; org-roam.el ends here

2721
lisp/org-roam/org-roam.info Normal file
View File

File diff suppressed because it is too large Load Diff