Compare commits

..

9 Commits

Author SHA1 Message Date
3a78422a09 (fix): update filter-fn docstring (#1589)
Fix inconsistency for filter-fn in ref and node functions, and update
docstrings to be consistent.
2021-07-17 21:09:38 +08:00
aee3467b3e Org-roam V2 (#1401) 2021-07-17 19:29:30 +08:00
756f6215b6 (feat): allow setting #+roam_alias and #+roam_tag on multiple lines (#1540)
This brings them more in line with how other Org keywords, such as
\#+PROPERTY, are declared.

Previously

    #+roam_alias: abc def
    #+roam_alias: ghi

would result in only the last one ("ghi") being extracted. Now ("abc"
"def" "ghi") are all extracted (in that order).

* org-roam.el (org-roam--extract-tags-prop, org-roam--extract-titles-alias): Accept and return all values in a list, not just from one line.
(org-roam--extract-prop-as-list): New function. List prop extraction refactored from `org-roam--extract-tags-prop` and `org-roam--extract-titles-alias`

* tests/test-org-roam.el: Add tests for defining tags and aliases in multiple lines
2021-06-09 20:21:08 +08:00
53c9a16e90 (fix): files not excluded when org-roam-list-files-commands is nil (#1542) 2021-06-09 20:07:47 +08:00
8ad1414030 (fix): tags: fix vanilla option (#1520)
Set `org-file-tags` before pulling tags from buffer. Should fix the
'vanilla option in `org-roam-tag-sources`
2021-05-13 15:04:49 +07:00
f754160402 (fix): Fix chronology issue between renaming notes and updating links (#1517) 2021-05-12 09:06:11 +02:00
02e35e3b01 (feat): add org-roam-graph-filetype (#1513)
Co-authored-by: Greg Coladonato <gcoladonato3@gatech.edu>
2021-05-06 19:23:46 +08:00
d2e933cc3e Fix auto save buffer in org-roam-doctor (#1493) 2021-05-03 03:36:09 +08:00
15c1a46e41 (doc): Add file-truename to set org-roam-directory (README and documentation) (#1487)
* (doc): Add file-truename to set org-roam-directory

Refer this debuging Slack exchange:
https://orgroam.slack.com/archives/CV160S8EL/p1619089118195300

Not using `file-truename` to set
`org-roam-directory` can lead to an issue that is
hard to identify.

It appears that cache database may updates with
files but `org-roam-buffer` fails to find the file
as symbolic links do not resolve. This is
confusing as the table query to the table seems to
return what appears to be correct entries, but the
backlink fails to insert context around the
link (as Org-roam fails to find the file).

There have been similiar issues -- by making sure
`file-truename` is added in the documentation and
README, it is hoped to eliminate such issues to
recur.

This is probably relevant for V2.

* undo changes to texi

Co-authored-by: Jethro Kuan <jethrokuan95@gmail.com>
2021-04-28 13:43:42 +08:00
19 changed files with 2276 additions and 1698 deletions

View File

@ -9,4 +9,5 @@
(org-with-point-at . 1) (org-with-point-at . 1)
(magit-insert-section . defun) (magit-insert-section . defun)
(magit-section-case . 0) (magit-section-case . 0)
(->> . 1)
(org-roam-with-file . 2))))) (org-roam-with-file . 2)))))

View File

@ -11,6 +11,8 @@
### Changed ### Changed
- [#1352](https://github.com/org-roam/org-roam/pull/1352) prefer lower-case for roam_tag and roam_alias in interactive commands - [#1352](https://github.com/org-roam/org-roam/pull/1352) prefer lower-case for roam_tag and roam_alias in interactive commands
- [#1513](https://github.com/org-roam/org-roam/pull/1513) replaced hardcoded "svg" with defcustom org-roam-graph-filetype
- [#1540](https://github.com/org-roam/org-roam/pull/1540) allow `roam_tag` and `roam_alias` to be specified on multiple lines
### Fixed ### Fixed
@ -25,6 +27,7 @@
- [#1375](https://github.com/org-roam/org-roam/pull/1375) fix org-roam-protocol to use existing ref file - [#1375](https://github.com/org-roam/org-roam/pull/1375) fix org-roam-protocol to use existing ref file
- [#1403](https://github.com/org-roam/org-roam/issues/1403) fixed inconsistency between how we write and read props like alias and tags - [#1403](https://github.com/org-roam/org-roam/issues/1403) fixed inconsistency between how we write and read props like alias and tags
- [#1409](https://github.com/org-roam/org-roam/issues/1398) prevent inclusion of non-org-roam files in `org-roam-dailies--list-files` - [#1409](https://github.com/org-roam/org-roam/issues/1398) prevent inclusion of non-org-roam files in `org-roam-dailies--list-files`
- [#1542](https://github.com/org-roam/org-roam/issues/1542) fix files not excluded when `org-roam-list-files-commands` is nil
## 1.2.3 (13-11-2020) ## 1.2.3 (13-11-2020)

View File

@ -44,18 +44,24 @@ Here's a sample configuration with `use-package`:
```emacs-lisp ```emacs-lisp
(use-package org-roam (use-package org-roam
:ensure t :ensure t
:hook
(after-init . org-roam-mode)
:custom :custom
(org-roam-directory "/path/to/org-files/") (org-roam-directory (file-truename "/path/to/org-files/"))
:bind (:map org-roam-mode-map :bind (("C-c n l" . org-roam-buffer-toggle)
(("C-c n l" . org-roam) ("C-c n f" . org-roam-node-find)
("C-c n f" . org-roam-find-file) ("C-c n g" . org-roam-graph)
("C-c n g" . org-roam-graph)) ("C-c n i" . org-roam-node-insert)
:map org-mode-map ("C-c n c" . org-roam-capture)
(("C-c n i" . org-roam-insert)))) ;; Dailies
("C-c n j" . org-roam-dailies-capture-today))
:config
(org-roam-setup)
;; If using org-roam-protocol
(require 'org-roam-protocol))
``` ```
The `file-truename` function is only necessary when you use symbolic links
inside `org-roam-directory`: Org-roam does not resolve symbolic links.
Org-roam requires sqlite to function. Org-roam optionally uses Graphviz for Org-roam requires sqlite to function. Org-roam optionally uses Graphviz for
graph-related functionality. It is recommended to install PCRE-enabled ripgrep graph-related functionality. It is recommended to install PCRE-enabled ripgrep
for better performance and extended functionality. for better performance and extended functionality.

File diff suppressed because it is too large Load Diff

View File

@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -33,13 +33,16 @@
;;;; Library Requires ;;;; Library Requires
(require 'org-capture) (require 'org-capture)
(eval-when-compile (eval-when-compile
(require 'org-roam-macs)) (require 'org-roam-macs)
(require 'org-macs))
(require 'org-roam-db) (require 'org-roam-db)
(require 'dash) (require 'dash)
(require 'cl-lib) (require 'cl-lib)
;; Declarations ;; Declarations
(declare-function org-roam-ref-add "org-roam" (ref)) (declare-function org-roam-ref-add "org-roam" (ref))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-datetree-find-month-create "org-datetree" (d &optional keep-restriction))
(defvar org-roam-directory) (defvar org-roam-directory)
@ -53,7 +56,8 @@ during the Org-roam capture process.")
This variable is populated dynamically, and is only non-nil This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.") during the Org-roam capture process.")
(defconst org-roam-capture--template-keywords '(:if-new :id :link-description :call-location) (defconst org-roam-capture--template-keywords (list :if-new :id :link-description :call-location
:region :override-default-time)
"Keywords used in `org-roam-capture-templates' specific to Org-roam.") "Keywords used in `org-roam-capture-templates' specific to Org-roam.")
(defcustom org-roam-capture-templates (defcustom org-roam-capture-templates
@ -121,15 +125,20 @@ the following options:
The file will be created, prescribed an ID, and head content will be The file will be created, prescribed an ID, and head content will be
inserted into the file. inserted into the file.
(file+olp \"path/to/file\" '(\"h1\" \"h2\")) (file+olp \"path/to/file\" (\"h1\" \"h2\"))
The file will be created, prescribed an ID. The OLP (h1, h2) will be The file will be created, prescribed an ID. The OLP (h1, h2) will be
created, and the point placed after. created, and the point placed after.
(file+head+olp \"path/to/file\" \"head content\" '(\"h1\" \"h2\")) (file+head+olp \"path/to/file\" \"head content\" (\"h1\" \"h2\"))
The file will be created, prescribed an ID. Head content will be The file will be created, prescribed an ID. Head content will be
inserted at the start of the file. The OLP (h1, h2) will be created, inserted at the start of the file. The OLP (h1, h2) will be created,
and the point placed after. and the point placed after.
(file+datetree \"path/to/file\" day)
The file will be created, prescribed an ID. Head content will be
inserted at the start of the file. The datetree will be created,
available options are day, week, month.
The rest of the entry is a property list of additional options. Recognized The rest of the entry is a property list of additional options. Recognized
properties are: properties are:
@ -311,13 +320,13 @@ streamlined user experience in Org-roam."
(const :format "" file+olp) (const :format "" file+olp)
(string :tag " File") (string :tag " File")
(list :tag "Outline path" (list :tag "Outline path"
(repeat string :tag "Headline"))) (repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path" (list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp) (const :format "" file+head+olp)
(string :tag " File") (string :tag " File")
(string :tag " Head Content") (string :tag " Head Content")
(list :tag "Outline path" (list :tag "Outline path"
(repeat string :tag "Headline"))))) (repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t)) ((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t)) ((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t)) ((const :format "%v " :jump-to-captured) (const t))
@ -382,13 +391,13 @@ See `org-roam-capture-templates' for the template documentation."
(const :format "" file+olp) (const :format "" file+olp)
(string :tag " File") (string :tag " File")
(list :tag "Outline path" (list :tag "Outline path"
(repeat string :tag "Headline"))) (repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path" (list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp) (const :format "" file+head+olp)
(string :tag " File") (string :tag " File")
(string :tag " Head Content") (string :tag " Head Content")
(list :tag "Outline path" (list :tag "Outline path"
(repeat string :tag "Headline"))))) (repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t)) ((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t)) ((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t)) ((const :format "%v " :jump-to-captured) (const t))
@ -468,10 +477,18 @@ This function is to be called in the Org-capture finalization process."
"Finalize the `org-roam-capture' process." "Finalize the `org-roam-capture' process."
(when-let ((region (org-roam-capture--get :region))) (when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region))) (org-roam-unshield-region (car region) (cdr region)))
(unless org-note-abort (if org-note-abort
(when-let ((finalize (org-roam-capture--get :finalize))) (when-let ((new-file (org-roam-capture--get :new-file)))
(funcall (intern (concat "org-roam-capture--finalize-" (org-roam-message "Deleting file for aborted capture %s" new-file)
(symbol-name (org-roam-capture--get :finalize))))))) (when (find-buffer-visiting new-file)
(kill-buffer (find-buffer-visiting new-file)))
(delete-file new-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)) (remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize))
(defun org-roam-capture--install-finalize () (defun org-roam-capture--install-finalize ()
@ -489,11 +506,14 @@ also run Org-capture's template expansion."
(org-roam-format (org-roam-format
template template
(lambda (key) (lambda (key)
(let ((fn (intern (concat "org-roam-node-" key))) (let ((fn (intern key))
(node-fn (intern (concat "org-roam-node-" key)))
(ksym (intern (concat ":" key)))) (ksym (intern (concat ":" key))))
(cond (cond
((fboundp fn) ((fboundp fn)
(funcall fn org-roam-capture--node)) (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)
(plist-get org-roam-capture--info ksym)) (plist-get org-roam-capture--info ksym))
(t (let ((r (completing-read (format "%s: " key) nil))) (t (let ((r (completing-read (format "%s: " key) nil)))
@ -515,14 +535,18 @@ Return the ID of the location."
(setq path (expand-file-name (setq path (expand-file-name
(string-trim (org-roam-capture--fill-template path t)) (string-trim (org-roam-capture--fill-template path t))
org-roam-directory)) org-roam-directory))
(unless (file-exists-p path)
(org-roam-capture--put :new-file path))
(set-buffer (org-capture-target-buffer path)) (set-buffer (org-capture-target-buffer path))
(widen) (widen)
(setq p (point))) (setq p (goto-char (point-min))))
(`(file+olp ,path ,olp) (`(file+olp ,path ,olp)
(setq path (expand-file-name (setq path (expand-file-name
(string-trim (org-roam-capture--fill-template path t)) (string-trim (org-roam-capture--fill-template path t))
org-roam-directory)) org-roam-directory))
(set-buffer (org-capture-target-buffer path)) (set-buffer (org-capture-target-buffer path))
(unless (file-exists-p path)
(org-roam-capture--put :new-file path))
(setq p (point-min)) (setq p (point-min))
(let ((m (org-roam-capture-find-or-create-olp olp))) (let ((m (org-roam-capture-find-or-create-olp olp)))
(goto-char m)) (goto-char m))
@ -531,24 +555,69 @@ Return the ID of the location."
(setq path (expand-file-name (setq path (expand-file-name
(string-trim (org-roam-capture--fill-template path t)) (string-trim (org-roam-capture--fill-template path t))
org-roam-directory)) org-roam-directory))
(let ((exists-p (file-exists-p path)))
(set-buffer (org-capture-target-buffer path)) (set-buffer (org-capture-target-buffer path))
(unless exists-p (unless (file-exists-p path)
(insert (org-roam-capture--fill-template head t)))) (org-roam-capture--put :new-file path)
(insert (org-roam-capture--fill-template head t)))
(widen) (widen)
(setq p (point-min))) (setq p (goto-char (point-min))))
(`(file+head+olp ,path ,head ,olp) (`(file+head+olp ,path ,head ,olp)
(setq path (expand-file-name (setq path (expand-file-name
(string-trim (org-roam-capture--fill-template path t)) (string-trim (org-roam-capture--fill-template path t))
org-roam-directory)) org-roam-directory))
(widen) (widen)
(let ((exists-p (file-exists-p path)))
(set-buffer (org-capture-target-buffer path)) (set-buffer (org-capture-target-buffer path))
(unless exists-p (unless (file-exists-p path)
(insert (org-roam-capture--fill-template head t)))) (org-roam-capture--put :new-file path)
(insert (org-roam-capture--fill-template head t)))
(setq p (point-min)) (setq p (point-min))
(let ((m (org-roam-capture-find-or-create-olp olp))) (let ((m (org-roam-capture-find-or-create-olp olp)))
(goto-char m))) (goto-char m)))
(`(file+datetree ,path ,tree-type)
(setq path (expand-file-name
(string-trim (org-roam-capture--fill-template path t))
org-roam-directory))
(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) (`(node ,title-or-id)
;; first try to get ID, then try to get title/alias ;; first try to get ID, then try to get title/alias
(let ((node (or (org-roam-node-from-id title-or-id) (let ((node (or (org-roam-node-from-id title-or-id)
@ -556,12 +625,52 @@ Return the ID of the location."
(user-error "No node with title or id \"%s\" 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))) (set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node)) (goto-char (org-roam-node-point node))
(setq p (org-roam-node-point node)) (setq p (org-roam-node-point node)))))
(org-end-of-subtree t t)))) (prog1
;; Setup `org-id' for the current capture target and return it back to
;; the caller.
(save-excursion (save-excursion
(goto-char p) (goto-char p)
(run-hooks 'org-roam-capture-new-node-hook) (when-let* ((node org-roam-capture--node)
(org-id-get-create)))) (id (org-roam-node-id node)))
(org-entry-put p "ID" id))
(prog1
(org-id-get-create)
(run-hooks 'org-roam-capture-new-node-hook)))
;; Adjust the point only after ID was generated and polluted to the
;; current target in the capture buffer.
(org-roam-capture--adjust-point-for-capture-type))))
(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))
(defun org-roam-capture-find-or-create-olp (olp) (defun org-roam-capture-find-or-create-olp (olp)
"Return a marker pointing to the entry at OLP in the current buffer. "Return a marker pointing to the entry at OLP in the current buffer.
@ -592,8 +701,10 @@ you can catch it with `condition-case'."
;; Create heading if it doesn't exist ;; Create heading if it doesn't exist
(goto-char end) (goto-char end)
(unless (bolp) (newline)) (unless (bolp) (newline))
(org-insert-heading nil nil t) (let (org-insert-heading-respect-content)
(unless (= lmax 1) (org-do-demote)) (org-insert-heading nil nil t))
(unless (= lmax 1)
(dotimes (_ level) (org-do-demote)))
(insert heading) (insert heading)
(setq end (point)) (setq end (point))
(goto-char start) (goto-char start)
@ -605,7 +716,7 @@ you can catch it with `condition-case'."
(setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq start found (setq start found
end (save-excursion (org-end-of-subtree t t)))) end (save-excursion (org-end-of-subtree t t))))
(copy-marker end)))) (point-marker))))
(defun org-roam-capture--get-node-from-ref (ref) (defun org-roam-capture--get-node-from-ref (ref)
"Return the node from reference REF." "Return the node from reference REF."
@ -628,6 +739,8 @@ you can catch it with `condition-case'."
"Return exact point to file for org-capture-template. "Return exact point to file for org-capture-template.
This function is used solely in Org-roam's capture templates: see This function is used solely in Org-roam's capture templates: see
`org-roam-capture-templates'." `org-roam-capture-templates'."
(when (org-roam-capture--get :override-default-time)
(org-capture-put :default-time (org-roam-capture--get :override-default-time)))
(let ((id (cond ((plist-get org-roam-capture--info :ref) (let ((id (cond ((plist-get org-roam-capture--info :ref)
(if-let ((node (org-roam-capture--get-node-from-ref (if-let ((node (org-roam-capture--get-node-from-ref
(plist-get org-roam-capture--info :ref)))) (plist-get org-roam-capture--info :ref))))
@ -657,7 +770,7 @@ This function is used solely in Org-roam's capture templates: see
PROPS is a plist containing additional Org-roam specific PROPS is a plist containing additional Org-roam specific
properties to be added to the template." properties to be added to the template."
(pcase template (pcase template
(`(,key ,desc) (`(,_key ,_desc)
template) template)
(`(,key ,desc ,type ,body . ,rest) (`(,key ,desc ,type ,body . ,rest)
(setq rest (append rest props)) (setq rest (append rest props))

View File

@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.

View File

@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
@ -42,11 +42,6 @@
(declare-function org-roam--get-titles "org-roam") (declare-function org-roam--get-titles "org-roam")
(defcustom org-roam-completion-ignore-case t
"Whether to ignore case in Org-roam `completion-at-point' completions."
:group 'org-roam
:type 'boolean)
(defcustom org-roam-completion-everywhere nil (defcustom org-roam-completion-everywhere nil
"When non-nil, provide link completion matching outside of Org links." "When non-nil, provide link completion matching outside of Org links."
:group 'org-roam :group 'org-roam
@ -56,75 +51,54 @@
#'org-roam-complete-everywhere) #'org-roam-complete-everywhere)
"List of functions to be used with `completion-at-point' for Org-roam.") "List of functions to be used with `completion-at-point' for Org-roam.")
(defconst org-roam-bracket-completion-re
"\\[\\[\\(\\(?:roam:\\)?\\)\\([^z-a]*\\)]]"
"Regex for completion within link brackets.
We use this as a substitute for `org-link-bracket-re', because
`org-link-bracket-re' requires content within the brackets for a match.")
(defun org-roam-complete-everywhere () (defun org-roam-complete-everywhere ()
"Provides completions for links for any word at point. "Provides completions for links for any word at point.
This is a `completion-at-point' function, and is active when This is a `completion-at-point' function, and is active when
`org-roam-completion-everywhere' is non-nil." `org-roam-completion-everywhere' is non-nil."
(let ((end (point))
(start (point))
(exit-fn (lambda (&rest _) nil))
collection)
(when (and org-roam-completion-everywhere (when (and org-roam-completion-everywhere
(thing-at-point 'word) (thing-at-point 'word)
(not (save-match-data (org-in-regexp org-link-any-re)))) (not (save-match-data (org-in-regexp org-link-any-re))))
(let ((bounds (bounds-of-thing-at-point 'word))) (let ((bounds (bounds-of-thing-at-point 'word)))
(setq start (car bounds) (list (car bounds) (cdr bounds)
end (cdr bounds)
collection #'org-roam--get-titles
exit-fn (lambda (str _status)
(delete-char (- (length str)))
(insert "[[roam:" str "]]")))))
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end
(if (functionp collection)
(completion-table-case-fold
(completion-table-dynamic (completion-table-dynamic
(lambda (_) (lambda (_)
(cl-remove-if (apply-partially #'string= prefix) (funcall #'org-roam--get-titles)))
(funcall collection)))) :exit-function
(not org-roam-completion-ignore-case)) (lambda (str _status)
collection) (delete-char (- (length str)))
:exit-function exit-fn))))) (insert "[[roam:" str "]]"))))))
(defun org-roam-complete-link-at-point () (defun org-roam-complete-link-at-point ()
"Do appropriate completion for the link at point." "Do appropriate completion for the link at point."
(let ((end (point)) (let (roam-p start end)
(start (point)) (when (org-in-regexp org-roam-bracket-completion-re 1)
collection link-type) (setq roam-p (not (string-blank-p (match-string 1)))
(when (org-in-regexp org-link-bracket-re 1) start (match-beginning 2)
(setq start (match-beginning 1) end (match-end 2))
end (match-end 1))
(let ((context (org-element-context)))
(pcase (org-element-lineage context '(link) t)
(`nil nil)
(link
(setq link-type (org-element-property :type link))
(when (member link-type '("roam" "fuzzy"))
(when (string= link-type "roam") (setq start (+ start (length "roam:"))))
(setq collection #'org-roam--get-titles))))))
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end (list start end
(if (functionp collection)
(completion-table-case-fold
(completion-table-dynamic (completion-table-dynamic
(lambda (_) (lambda (_)
(cl-remove-if (apply-partially #'string= prefix) (funcall #'org-roam--get-titles)))
(funcall collection))))
(not org-roam-completion-ignore-case))
collection)
:exit-function :exit-function
(lambda (str &rest _) (lambda (str &rest _)
(delete-char (- 0 (length str))) (delete-char (- 0 (length str)))
(insert (concat (unless (string= link-type "roam") "roam:") (insert (concat (unless roam-p "roam:")
str)) str))
(forward-char 2))))))) (forward-char 2))))))
(defun org-roam-complete-at-point ()
"."
(run-hook-with-args-until-success 'org-roam-completion-functions))
(defun org-roam--register-completion-functions () (defun org-roam--register-completion-functions ()
"." "."
(dolist (fn org-roam-completion-functions) (add-hook 'completion-at-point-functions #'org-roam-complete-at-point nil t))
(add-hook 'completion-at-point-functions fn nil t)))
(add-hook 'org-roam-find-file-hook #'org-roam--register-completion-functions) (add-hook 'org-roam-find-file-hook #'org-roam--register-completion-functions)

View File

@ -8,7 +8,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -41,7 +41,7 @@
;;;; Declarations ;;;; Declarations
(defvar org-roam-directory) (defvar org-roam-directory)
(defvar org-roam-file-extensions) (defvar org-roam-file-extensions)
(declare-function org-roam--org-file-p "org-roam") (declare-function org-roam-file-p "org-roam")
;;;; Faces ;;;; Faces
(defface org-roam-dailies-calendar-note (defface org-roam-dailies-calendar-note
@ -51,7 +51,8 @@
;;;; Customizable variables ;;;; Customizable variables
(defcustom org-roam-dailies-directory "daily/" (defcustom org-roam-dailies-directory "daily/"
"Path to daily-notes." "Path to daily-notes.
This path is relative to `org-roam-directory'."
:group 'org-roam :group 'org-roam
:type 'string) :type 'string)
@ -61,9 +62,9 @@
:type 'hook) :type 'hook)
(defcustom org-roam-dailies-capture-templates (defcustom org-roam-dailies-capture-templates
'(("d" "default" entry `(("d" "default" entry
"* %?" "* %?"
:if-new `(file+head ,(concat org-roam-dailies-directory "%<%Y-%m-%d>.org") :if-new (file+head "%<%Y-%m-%d>.org"
"#+title: %<%Y-%m-%d>\n"))) "#+title: %<%Y-%m-%d>\n")))
"Capture templates for daily-notes in Org-roam. "Capture templates for daily-notes in Org-roam.
See `org-roam-capture-templates' for the template documentation." See `org-roam-capture-templates' for the template documentation."
@ -104,13 +105,13 @@ See `org-roam-capture-templates' for the template documentation."
(const :format "" file+olp) (const :format "" file+olp)
(string :tag " File") (string :tag " File")
(list :tag "Outline path" (list :tag "Outline path"
(repeat string :tag "Headline"))) (repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path" (list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp) (const :format "" file+head+olp)
(string :tag " File") (string :tag " File")
(string :tag " Head Content") (string :tag " Head Content")
(list :tag "Outline path" (list :tag "Outline path"
(repeat string :tag "Headline"))))) (repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t)) ((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t)) ((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t)) ((const :format "%v " :jump-to-captured) (const t))
@ -126,55 +127,52 @@ See `org-roam-capture-templates' for the template documentation."
((const :format "%v " :table-line-pos) (string)) ((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t)))))))) ((const :format "%v " :kill-buffer) (const t))))))))
;;;; Utilities ;;;###autoload
(defun org-roam-dailies-directory--get-absolute-path ()
"Get absolute path to `org-roam-dailies-directory'."
(expand-file-name org-roam-dailies-directory org-roam-directory))
(defun org-roam-dailies-find-directory () (defun org-roam-dailies-find-directory ()
"Find and open `org-roam-dailies-directory'." "Find and open `org-roam-dailies-directory'."
(interactive) (interactive)
(find-file (org-roam-dailies-directory--get-absolute-path))) (find-file (expand-file-name org-roam-dailies-directory org-roam-directory)))
(defun org-roam-dailies--daily-note-p (&optional file) (defun org-roam-dailies--daily-note-p (&optional file)
"Return t if FILE is an Org-roam daily-note, nil otherwise. "Return t if FILE is an Org-roam daily-note, nil otherwise.
If FILE is not specified, use the current buffer's file-path." If FILE is not specified, use the current buffer's file-path."
(when-let ((path (or file (when-let ((path (expand-file-name
(buffer-base-buffer (buffer-file-name)))) (or file
(directory (org-roam-dailies-directory--get-absolute-path))) (buffer-file-name (buffer-base-buffer)))))
(directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(setq path (expand-file-name path)) (setq path (expand-file-name path))
(save-match-data (save-match-data
(and (and
(org-roam--org-file-p path) (org-roam-file-p path)
(f-descendant-of-p path directory))))) (f-descendant-of-p path directory)))))
(defun org-roam-dailies--capture (time &optional goto) (defun org-roam-dailies--capture (time &optional goto)
"Capture an entry in a daily-note for TIME, creating it if necessary. "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." When GOTO is non-nil, go the note without creating an entry."
(let ((org-roam-directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(org-roam-capture- :goto (when goto '(4)) (org-roam-capture- :goto (when goto '(4))
:node (org-roam-node-create) :node (org-roam-node-create)
:templates org-roam-dailies-capture-templates :templates org-roam-dailies-capture-templates
:props (list :default-time time))) :props (list :override-default-time time)))
(when goto (run-hooks 'org-roam-dailies-find-file-hook)))
;;;; Commands ;;;; Commands
;;; Today ;;; Today
;;;###autoload
(defun org-roam-dailies-capture-today (&optional goto) (defun org-roam-dailies-capture-today (&optional goto)
"Create an entry in the daily-note for today. "Create an entry in the daily-note for today.
When GOTO is non-nil, go the note without creating an entry." When GOTO is non-nil, go the note without creating an entry."
(interactive "P") (interactive "P")
(org-roam-dailies--capture (current-time) goto) (org-roam-dailies--capture (current-time) goto))
(when goto
(run-hooks 'org-roam-dailies-find-file-hook)))
(defun org-roam-dailies-find-today () ;;;###autoload
(defun org-roam-dailies-goto-today ()
"Find the daily-note for today, creating it if necessary." "Find the daily-note for today, creating it if necessary."
(interactive) (interactive)
(org-roam-dailies-capture-today t)) (org-roam-dailies-capture-today t))
;;; Tomorrow ;;; Tomorrow
;;;###autoload
(defun org-roam-dailies-capture-tomorrow (n &optional goto) (defun org-roam-dailies-capture-tomorrow (n &optional goto)
"Create an entry in the daily-note for tomorrow. "Create an entry in the daily-note for tomorrow.
@ -185,7 +183,8 @@ creating an entry."
(interactive "p") (interactive "p")
(org-roam-dailies--capture (time-add (* n 86400) (current-time)) goto)) (org-roam-dailies--capture (time-add (* n 86400) (current-time)) goto))
(defun org-roam-dailies-find-tomorrow (n) ;;;###autoload
(defun org-roam-dailies-goto-tomorrow (n)
"Find the daily-note for tomorrow, creating it if necessary. "Find the daily-note for tomorrow, creating it if necessary.
With numeric argument N, use the daily-note N days in the With numeric argument N, use the daily-note N days in the
@ -194,6 +193,7 @@ future."
(org-roam-dailies-capture-tomorrow n t)) (org-roam-dailies-capture-tomorrow n t))
;;; Yesterday ;;; Yesterday
;;;###autoload
(defun org-roam-dailies-capture-yesterday (n &optional goto) (defun org-roam-dailies-capture-yesterday (n &optional goto)
"Create an entry in the daily-note for yesteday. "Create an entry in the daily-note for yesteday.
@ -203,7 +203,8 @@ When GOTO is non-nil, go the note without creating an entry."
(interactive "p") (interactive "p")
(org-roam-dailies-capture-tomorrow (- n) goto)) (org-roam-dailies-capture-tomorrow (- n) goto))
(defun org-roam-dailies-find-yesterday (n) ;;;###autoload
(defun org-roam-dailies-goto-yesterday (n)
"Find the daily-note for yesterday, creating it if necessary. "Find the daily-note for yesterday, creating it if necessary.
With numeric argument N, use the daily-note N days in the With numeric argument N, use the daily-note N days in the
@ -212,23 +213,8 @@ future."
(org-roam-dailies-capture-tomorrow (- n) t)) (org-roam-dailies-capture-tomorrow (- n) t))
;;; Calendar ;;; Calendar
(defvar org-roam-dailies-calendar-hook (list 'org-roam-dailies-calendar-mark-entries)
"Hooks to run when showing the `org-roam-dailies-calendar'.")
(defun org-roam-dailies-calendar--install-hook ()
"Install Org-roam-dailies hooks to calendar."
(add-hook 'calendar-today-visible-hook #'org-roam-dailies-calendar--run-hook)
(add-hook 'calendar-today-invisible-hook #'org-roam-dailies-calendar--run-hook))
(defun org-roam-dailies-calendar--run-hook ()
"Run Org-roam-dailies hooks to calendar."
(run-hooks 'org-roam-dailies-calendar-hook)
(remove-hook 'calendar-today-visible-hook #'org-roam-dailies-calendar--run-hook)
(remove-hook 'calendar-today-invisible-hook #'org-roam-dailies-calendar--run-hook))
(defun org-roam-dailies-calendar--file-to-date (&optional file) (defun org-roam-dailies-calendar--file-to-date (&optional file)
"Convert FILE to date. "Convert FILE to date.
Return (MONTH DAY YEAR)." Return (MONTH DAY YEAR)."
(let ((file (or file (let ((file (or file
(buffer-base-buffer (buffer-file-name))))) (buffer-base-buffer (buffer-file-name)))))
@ -239,37 +225,33 @@ Return (MONTH DAY YEAR)."
(list m d y)))) (list m d y))))
(defun org-roam-dailies-calendar--date-to-time (date) (defun org-roam-dailies-calendar--date-to-time (date)
"Convert DATE as returned from the calendar (MONTH DAY YEAR) to a time." "Convert DATE as returned from then calendar (MONTH DAY YEAR) to a time."
(encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))) (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))
(defun org-roam-dailies-calendar-mark-entries () (defun org-roam-dailies-calendar-mark-entries ()
"Mark days in the calendar for which a daily-note is present." "Mark days in the calendar for which a daily-note is present."
(when (file-exists-p (org-roam-dailies-directory--get-absolute-path)) (when (file-exists-p (expand-file-name org-roam-dailies-directory org-roam-directory))
(dolist (date (mapcar #'org-roam-dailies-calendar--file-to-date (dolist (date (mapcar #'org-roam-dailies-calendar--file-to-date
(org-roam-dailies--list-files))) (org-roam-dailies--list-files)))
(when (calendar-date-is-visible-p date) (when (calendar-date-is-visible-p date)
(calendar-mark-visible-date date 'org-roam-dailies-calendar-note))))) (calendar-mark-visible-date date 'org-roam-dailies-calendar-note)))))
;;; Date ;;; Date
;;;###autoload
(defun org-roam-dailies-capture-date (&optional goto prefer-future) (defun org-roam-dailies-capture-date (&optional goto prefer-future)
"Create an entry in the daily-note for a date using the calendar. "Create an entry in the daily-note for a date using the calendar.
Prefer past dates, unless PREFER-FUTURE is non-nil. Prefer past dates, unless PREFER-FUTURE is non-nil.
With a `C-u' prefix or when GOTO is non-nil, go the note without With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry." creating an entry."
(interactive "P") (interactive "P")
(org-roam-dailies-calendar--install-hook) (let ((time (let ((org-read-date-prefer-future prefer-future))
(let* ((time-str (let ((org-read-date-prefer-future prefer-future)) (org-read-date t t nil (if goto
(org-read-date nil nil nil (if goto
"Find daily-note: " "Find daily-note: "
"Capture to daily-note: ")))) "Capture to daily-note: ")))))
(time (org-read-date nil t time-str))) (org-roam-dailies--capture time goto)))
(org-roam-dailies--capture time goto)
(when goto
(run-hooks 'org-roam-dailies-find-file-hook))))
(defun org-roam-dailies-find-date (&optional prefer-future) ;;;###autoload
(defun org-roam-dailies-goto-date (&optional prefer-future)
"Find the daily-note for a date using the calendar, creating it if necessary. "Find the daily-note for a date using the calendar, creating it if necessary.
Prefer past dates, unless PREFER-FUTURE is non-nil." Prefer past dates, unless PREFER-FUTURE is non-nil."
(interactive) (interactive)
@ -279,7 +261,7 @@ Prefer past dates, unless PREFER-FUTURE is non-nil."
(defun org-roam-dailies--list-files (&rest extra-files) (defun org-roam-dailies--list-files (&rest extra-files)
"List all files in `org-roam-dailies-directory'. "List all files in `org-roam-dailies-directory'.
EXTRA-FILES can be used to append extra files to the list." EXTRA-FILES can be used to append extra files to the list."
(let ((dir (org-roam-dailies-directory--get-absolute-path)) (let ((dir (expand-file-name org-roam-dailies-directory org-roam-directory))
(regexp (rx-to-string `(and "." (or ,@org-roam-file-extensions))))) (regexp (rx-to-string `(and "." (or ,@org-roam-file-extensions)))))
(append (--remove (let ((file (file-name-nondirectory it))) (append (--remove (let ((file (file-name-nondirectory it)))
(when (or (auto-save-file-name-p file) (when (or (auto-save-file-name-p file)
@ -289,7 +271,7 @@ EXTRA-FILES can be used to append extra files to the list."
(directory-files-recursively dir regexp)) (directory-files-recursively dir regexp))
extra-files))) extra-files)))
(defun org-roam-dailies-find-next-note (&optional n) (defun org-roam-dailies-goto-next-note (&optional n)
"Find next daily-note. "Find next daily-note.
With numeric argument N, find note N days in the future. If N is With numeric argument N, find note N days in the future. If N is
@ -317,14 +299,17 @@ negative, find note N days in the past."
(find-file note) (find-file note)
(run-hooks 'org-roam-dailies-find-file-hook))) (run-hooks 'org-roam-dailies-find-file-hook)))
(defun org-roam-dailies-find-previous-note (&optional n) (defun org-roam-dailies-goto-previous-note (&optional n)
"Find previous daily-note. "Find previous daily-note.
With numeric argument N, find note N days in the past. If N is With numeric argument N, find note N days in the past. If N is
negative, find note N days in the future." negative, find note N days in the future."
(interactive "p") (interactive "p")
(let ((n (if n (- n) -1))) (let ((n (if n (- n) -1)))
(org-roam-dailies-find-next-note n))) (org-roam-dailies-goto-next-note n)))
(add-hook 'calendar-today-visible-hook #'org-roam-dailies-calendar-mark-entries)
(add-hook 'calendar-today-invisible-hook #'org-roam-dailies-calendar-mark-entries)
;;;; Bindings ;;;; Bindings
(defvar org-roam-dailies-map (make-sparse-keymap) (defvar org-roam-dailies-map (make-sparse-keymap)
@ -332,16 +317,35 @@ negative, find note N days in the future."
(define-prefix-command 'org-roam-dailies-map) (define-prefix-command 'org-roam-dailies-map)
(define-key org-roam-dailies-map (kbd "d") #'org-roam-dailies-find-today) (define-key org-roam-dailies-map (kbd "d") #'org-roam-dailies-goto-today)
(define-key org-roam-dailies-map (kbd "y") #'org-roam-dailies-find-yesterday) (define-key org-roam-dailies-map (kbd "y") #'org-roam-dailies-goto-yesterday)
(define-key org-roam-dailies-map (kbd "t") #'org-roam-dailies-find-tomorrow) (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 "n") #'org-roam-dailies-capture-today)
(define-key org-roam-dailies-map (kbd "f") #'org-roam-dailies-find-next-note) (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-find-previous-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-find-date) (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 "v") #'org-roam-dailies-capture-date)
(define-key org-roam-dailies-map (kbd ".") #'org-roam-dailies-find-directory) (define-key org-roam-dailies-map (kbd ".") #'org-roam-dailies-find-directory)
(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")
(provide 'org-roam-dailies) (provide 'org-roam-dailies)
;;; org-roam-dailies.el ends here ;;; org-roam-dailies.el ends here

View File

@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -33,7 +33,7 @@
;;;; Library Requires ;;;; Library Requires
(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'subr-x))
(require 'emacsql) (require 'emacsql)
(require 'emacsql-sqlite3) (require 'emacsql-sqlite)
(require 'seq) (require 'seq)
(eval-and-compile (eval-and-compile
@ -50,7 +50,6 @@
(defvar org-agenda-files) (defvar org-agenda-files)
(declare-function org-roam-id-at-point "org-roam") (declare-function org-roam-id-at-point "org-roam")
(declare-function org-roam--org-roam-file-p "org-roam")
(declare-function org-roam--list-all-files "org-roam") (declare-function org-roam--list-all-files "org-roam")
(declare-function org-roam-node-at-point "org-roam") (declare-function org-roam-node-at-point "org-roam")
@ -79,7 +78,16 @@ value like `most-positive-fixnum'."
:type 'int :type 'int
:group 'org-roam) :group 'org-roam)
(defconst org-roam-db--version 12) (defcustom org-roam-db-node-include-function (lambda () t)
"A custom function to check if the headline at point is a node."
:type 'function
:group 'org-roam)
(defconst org-roam-db-version 16)
(defconst org-roam--sqlite-available-p
(with-demoted-errors "Org-roam initialization: %S"
(emacsql-sqlite-ensure-binary)
t))
(defvar org-roam-db--connection (make-hash-table :test #'equal) (defvar org-roam-db--connection (make-hash-table :test #'equal)
"Database connection to Org-roam database.") "Database connection to Org-roam database.")
@ -99,7 +107,7 @@ Performs a database upgrade when required."
(emacsql-live-p (org-roam-db--get-connection))) (emacsql-live-p (org-roam-db--get-connection)))
(let ((init-db (not (file-exists-p org-roam-db-location)))) (let ((init-db (not (file-exists-p org-roam-db-location))))
(make-directory (file-name-directory org-roam-db-location) t) (make-directory (file-name-directory org-roam-db-location) t)
(let ((conn (emacsql-sqlite3 org-roam-db-location))) (let ((conn (emacsql-sqlite org-roam-db-location)))
(set-process-query-on-exit-flag (emacsql-process conn) nil) (set-process-query-on-exit-flag (emacsql-process conn) nil)
(puthash (expand-file-name org-roam-directory) (puthash (expand-file-name org-roam-directory)
conn conn
@ -109,34 +117,43 @@ Performs a database upgrade when required."
(let* ((version (caar (emacsql conn "PRAGMA user_version"))) (let* ((version (caar (emacsql conn "PRAGMA user_version")))
(version (org-roam-db--upgrade-maybe conn version))) (version (org-roam-db--upgrade-maybe conn version)))
(cond (cond
((> version org-roam-db--version) ((> version org-roam-db-version)
(emacsql-close conn) (emacsql-close conn)
(user-error (user-error
"The Org-roam database was created with a newer Org-roam version. " "The Org-roam database was created with a newer Org-roam version. "
"You need to update the Org-roam package")) "You need to update the Org-roam package"))
((< version org-roam-db--version) ((< version org-roam-db-version)
(emacsql-close conn) (emacsql-close conn)
(error "BUG: The Org-roam database scheme changed %s" (error "BUG: The Org-roam database scheme changed %s"
"and there is no upgrade path"))))))) "and there is no upgrade path")))))))
(org-roam-db--get-connection)) (org-roam-db--get-connection))
;;;; Entrypoint: (org-roam-db-query) ;;;; Entrypoint: (org-roam-db-query)
(define-error 'emacsql-constraint "SQL constraint violation")
(defun org-roam-db-query (sql &rest args) (defun org-roam-db-query (sql &rest args)
"Run SQL query on Org-roam database with ARGS. "Run SQL query on Org-roam database with ARGS.
SQL can be either the emacsql vector representation, or a string." SQL can be either the emacsql vector representation, or a string."
(if (stringp sql) (apply #'emacsql (org-roam-db) sql args))
(emacsql (org-roam-db) (apply #'format sql args))
(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 ;;;; Schemata
;; NOTE: Foreign key somehow doesn't work! Adding a file column to every table as a workaround.
(defconst org-roam-db--table-schemata (defconst org-roam-db--table-schemata
'((files '((files
[(file :unique :primary-key) [(file :unique :primary-key)
(hash :not-null)]) (hash :not-null)
(atime :not-null)
(mtime :not-null)])
(nodes (nodes
[(id :primary-key :not-null) ([(id :not-null :primary-key)
(file :not-null) (file :not-null)
(level :not-null) (level :not-null)
(pos :not-null) (pos :not-null)
@ -144,36 +161,39 @@ SQL can be either the emacsql vector representation, or a string."
priority priority
(scheduled text) (scheduled text)
(deadline text) (deadline text)
title] title
(:foreign-key [file] :references files [file] :on-delete :cascade)) properties
olp]
(:foreign-key [file] :references files [file] :on-delete :cascade)))
(aliases (aliases
[(file :not-null) ([(node-id :not-null)
(node-id :not-null)
alias] alias]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)) (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(refs (refs
([(file :not-null) ([(node-id :not-null)
(node-id :not-null)
(ref :not-null) (ref :not-null)
(type :not-null)] (type :not-null)]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade))) (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(tags (tags
[(file :not-null) ([(node-id :not-null)
(node-id :not-null)
tag] tag]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)) (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(links (links
[(file :not-null) ([(pos :not-null)
(pos :not-null)
(source :not-null) (source :not-null)
(dest :not-null) (dest :not-null)
(type :not-null) (type :not-null)
(properties :not-null)] (properties :not-null)]
(:foreign-key [file] :references files [file] :on-delete :cascade)))) (: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) (defun org-roam-db--init (db)
"Initialize database DB with the correct schema and user version." "Initialize database DB with the correct schema and user version."
@ -181,16 +201,18 @@ SQL can be either the emacsql vector representation, or a string."
(emacsql db "PRAGMA foreign_keys = ON") (emacsql db "PRAGMA foreign_keys = ON")
(pcase-dolist (`(,table ,schema) org-roam-db--table-schemata) (pcase-dolist (`(,table ,schema) org-roam-db--table-schemata)
(emacsql db [:create-table $i1 $S2] table schema)) (emacsql db [:create-table $i1 $S2] table schema))
(emacsql db (format "PRAGMA user_version = %s" org-roam-db--version)))) (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) (defun org-roam-db--upgrade-maybe (db version)
"Upgrades the database schema for DB, if VERSION is old." "Upgrades the database schema for DB, if VERSION is old."
(emacsql-with-transaction db (emacsql-with-transaction db
'ignore 'ignore
(if (< version org-roam-db--version) (if (< version org-roam-db-version)
(progn (progn
(org-roam-message (format "Upgrading the Org-roam database from version %d to version %d" (org-roam-message (format "Upgrading the Org-roam database from version %d to version %d"
version org-roam-db--version)) version org-roam-db-version))
(org-roam-db-sync t)))) (org-roam-db-sync t))))
version) version)
@ -222,21 +244,23 @@ the current `org-roam-directory'."
This is equivalent to removing the node from the graph. This is equivalent to removing the node from the graph.
If FILE is nil, clear the current buffer." If FILE is nil, clear the current buffer."
(setq file (or file (buffer-file-name (buffer-base-buffer)))) (setq file (or file (buffer-file-name (buffer-base-buffer))))
(dolist (table (mapcar #'car org-roam-db--table-schemata)) (org-roam-db-query [:delete :from files
(org-roam-db-query `[:delete :from ,table
:where (= file $s1)] :where (= file $s1)]
file))) file))
;;;;; Updating tables ;;;;; Updating tables
(defun org-roam-db-insert-file () (defun org-roam-db-insert-file ()
"Update the files table for the current buffer. "Update the files table for the current buffer.
If UPDATE-P is non-nil, first remove the file in the database." If UPDATE-P is non-nil, first remove the file in the database."
(let* ((file (buffer-file-name)) (let* ((file (buffer-file-name))
(attr (file-attributes file))
(atime (file-attribute-access-time attr))
(mtime (file-attribute-modification-time attr))
(hash (org-roam-db--file-hash))) (hash (org-roam-db--file-hash)))
(org-roam-db-query (org-roam-db-query
[:insert :into files [:insert :into files
:values $v1] :values $v1]
(list (vector file hash))))) (list (vector file hash atime mtime)))))
(defun org-roam-db-get-scheduled-time () (defun org-roam-db-get-scheduled-time ()
"Return the scheduled time at point in ISO8601 format." "Return the scheduled time at point in ISO8601 format."
@ -248,13 +272,20 @@ If UPDATE-P is non-nil, first remove the file in the database."
(when-let ((time (org-get-deadline-time (point)))) (when-let ((time (org-get-deadline-time (point))))
(org-format-time-string "%FT%T%z" time))) (org-format-time-string "%FT%T%z" time)))
(defun org-roam-db-map-headlines (fns) (defun org-roam-db-node-p ()
"Run FNS over all headlines in the current buffer." "Return t if headline at point is a node, else return nil."
(and (org-id-get)
(not (cdr (assoc "ROAM_EXCLUDE" (org-entry-properties))))
(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-point-at 1 (org-with-point-at 1
(org-map-entries (org-map-entries
(lambda () (lambda ()
(when (org-roam-db-node-p)
(dolist (fn fns) (dolist (fn fns)
(funcall fn)))))) (funcall fn)))))))
(defun org-roam-db-map-links (fns) (defun org-roam-db-map-links (fns)
"Run FNS over all links in the current buffer." "Run FNS over all links in the current buffer."
@ -267,12 +298,14 @@ If UPDATE-P is non-nil, first remove the file in the database."
(defun org-roam-db-insert-file-node () (defun org-roam-db-insert-file-node ()
"Insert the file-level node into the Org-roam cache." "Insert the file-level node into the Org-roam cache."
(org-with-point-at 1 (org-with-point-at 1
(when (= (org-outline-level) 0) (when (and (= (org-outline-level) 0)
(org-roam-db-node-p))
(when-let ((id (org-id-get))) (when-let ((id (org-id-get)))
(let* ((file (buffer-file-name (buffer-base-buffer))) (let* ((file (buffer-file-name (buffer-base-buffer)))
(title (or (cadr (assoc "TITLE" (org-collect-keywords '("title")) (title (org-link-display-format
(or (cadr (assoc "TITLE" (org-collect-keywords '("title"))
#'string-equal)) #'string-equal))
(file-relative-name file org-roam-directory))) (file-relative-name file org-roam-directory))))
(pos (point)) (pos (point))
(todo nil) (todo nil)
(priority nil) (priority nil)
@ -281,27 +314,31 @@ If UPDATE-P is non-nil, first remove the file in the database."
(level 0) (level 0)
(aliases (org-entry-get (point) "ROAM_ALIASES")) (aliases (org-entry-get (point) "ROAM_ALIASES"))
(tags org-file-tags) (tags org-file-tags)
(refs (org-entry-get (point) "ROAM_REFS"))) (refs (org-entry-get (point) "ROAM_REFS"))
(condition-case nil (properties (org-entry-properties))
(progn (olp (org-get-outline-path)))
(org-roam-db-query (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 [:insert :into nodes
:values $v1] :values $v1]
(vector id file level pos todo priority (vector id file level pos todo priority
scheduled deadline title)) scheduled deadline title properties olp))
(when tags (when tags
(org-roam-db-query (org-roam-db-query
[:insert :into tags [:insert :into tags
:values $v1] :values $v1]
(mapcar (lambda (tag) (mapcar (lambda (tag)
(vector file id (substring-no-properties tag))) (vector id (substring-no-properties tag)))
tags))) tags)))
(when aliases (when aliases
(org-roam-db-query (org-roam-db-query
[:insert :into aliases [:insert :into aliases
:values $v1] :values $v1]
(mapcar (lambda (alias) (mapcar (lambda (alias)
(vector file id alias)) (vector id alias))
(split-string-and-unquote aliases)))) (split-string-and-unquote aliases))))
(when refs (when refs
(setq refs (split-string-and-unquote refs)) (setq refs (split-string-and-unquote refs))
@ -309,7 +346,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(dolist (ref refs) (dolist (ref refs)
(if (string-match org-link-plain-re ref) (if (string-match org-link-plain-re ref)
(progn (progn
(push (vector file id (match-string 2 ref) (push (vector id (match-string 2 ref)
(match-string 1 ref)) rows)) (match-string 1 ref)) rows))
(lwarn '(org-roam) :warning (lwarn '(org-roam) :warning
"%s:%s\tInvalid ref %s, skipping..." "%s:%s\tInvalid ref %s, skipping..."
@ -318,9 +355,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(org-roam-db-query (org-roam-db-query
[:insert :into refs [:insert :into refs
:values $v1] :values $v1]
rows))))) rows)))))))))
(t
(lwarn '(org-roam) :error "Duplicate ID %s, skipping..." id))))))))
(defun org-roam-db-insert-node-data () (defun org-roam-db-insert-node-data ()
"Insert node data for headline at point into the Org-roam cache." "Insert node data for headline at point into the Org-roam cache."
@ -333,42 +368,41 @@ If UPDATE-P is non-nil, first remove the file in the database."
(level (nth 1 heading-components)) (level (nth 1 heading-components))
(scheduled (org-roam-db-get-scheduled-time)) (scheduled (org-roam-db-get-scheduled-time))
(deadline (org-roam-db-get-deadline-time)) (deadline (org-roam-db-get-deadline-time))
(title (nth 4 heading-components))) (title (org-link-display-format (nth 4 heading-components)))
(condition-case nil (properties (org-entry-properties))
(org-roam-db-query (olp (org-get-outline-path)))
(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 [:insert :into nodes
:values $v1] :values $v1]
(vector id file level pos todo priority (vector id file level pos todo priority
scheduled deadline title)) scheduled deadline title properties olp)))))
(t
(lwarn '(org-roam) :error
"Duplicate ID %s, skipping..." id))))))
(defun org-roam-db-insert-aliases () (defun org-roam-db-insert-aliases ()
"Insert aliases for node at point into Org-roam cache." "Insert aliases for node at point into Org-roam cache."
(when-let ((file (buffer-file-name (buffer-base-buffer))) (when-let ((node-id (org-id-get))
(node-id (org-id-get))
(aliases (org-entry-get (point) "ROAM_ALIASES"))) (aliases (org-entry-get (point) "ROAM_ALIASES")))
(org-roam-db-query [:insert :into aliases (org-roam-db-query [:insert :into aliases
:values $v1] :values $v1]
(mapcar (lambda (alias) (mapcar (lambda (alias)
(vector file node-id alias)) (vector node-id alias))
(split-string-and-unquote aliases))))) (split-string-and-unquote aliases)))))
(defun org-roam-db-insert-tags () (defun org-roam-db-insert-tags ()
"Insert tags for node at point into Org-roam cache." "Insert tags for node at point into Org-roam cache."
(when-let ((file (buffer-file-name (buffer-base-buffer))) (when-let ((node-id (org-id-get))
(node-id (org-id-get))
(tags (org-get-tags))) (tags (org-get-tags)))
(org-roam-db-query [:insert :into tags (org-roam-db-query [:insert :into tags
:values $v1] :values $v1]
(mapcar (lambda (tag) (mapcar (lambda (tag)
(vector file node-id tag)) tags)))) (vector node-id (substring-no-properties tag))) tags))))
(defun org-roam-db-insert-refs () (defun org-roam-db-insert-refs ()
"Insert refs for node at point into Org-roam cache." "Insert refs for node at point into Org-roam cache."
(when-let* ((file (buffer-file-name (buffer-base-buffer))) (when-let* ((node-id (org-id-get))
(node-id (org-id-get))
(refs (org-entry-get (point) "ROAM_REFS")) (refs (org-entry-get (point) "ROAM_REFS"))
(refs (split-string-and-unquote refs))) (refs (split-string-and-unquote refs)))
(let (rows) (let (rows)
@ -376,7 +410,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(save-match-data (save-match-data
(if (string-match org-link-plain-re ref) (if (string-match org-link-plain-re ref)
(progn (progn
(push (vector file node-id (match-string 2 ref) (match-string 1 ref)) rows)) (push (vector node-id (match-string 2 ref) (match-string 1 ref)) rows))
(lwarn '(org-roam) :warning (lwarn '(org-roam) :warning
"%s:%s\tInvalid ref %s, skipping..." (buffer-file-name) (point) ref)))) "%s:%s\tInvalid ref %s, skipping..." (buffer-file-name) (point) ref))))
(org-roam-db-query [:insert :into refs (org-roam-db-query [:insert :into refs
@ -387,8 +421,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
"Insert link data for LINK at current point into the Org-roam cache." "Insert link data for LINK at current point into the Org-roam cache."
(save-excursion (save-excursion
(goto-char (org-element-property :begin link)) (goto-char (org-element-property :begin link))
(let ((file (buffer-file-name (buffer-base-buffer))) (let ((type (org-element-property :type link))
(type (org-element-property :type link))
(dest (org-element-property :path link)) (dest (org-element-property :path link))
(properties (list :outline (org-get-outline-path))) (properties (list :outline (org-get-outline-path)))
(source (org-roam-id-at-point))) (source (org-roam-id-at-point)))
@ -396,7 +429,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(org-roam-db-query (org-roam-db-query
[:insert :into links [:insert :into links
:values $v1] :values $v1]
(vector file (point) source dest type properties)))))) (vector (point) source dest type properties))))))
;;;;; Fetching ;;;;; Fetching
(defun org-roam-db--get-current-files () (defun org-roam-db--get-current-files ()
@ -418,6 +451,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(secure-hash 'sha1 (current-buffer))))) (secure-hash 'sha1 (current-buffer)))))
;;;;; Updating ;;;;; Updating
;;;###autoload
(defun org-roam-db-sync (&optional force) (defun org-roam-db-sync (&optional force)
"Synchronize the cache state with the current Org files on-disk. "Synchronize the cache state with the current Org files on-disk.
If FORCE, force a rebuild of the cache from scratch." If FORCE, force a rebuild of the cache from scratch."
@ -436,6 +470,7 @@ If FORCE, force a rebuild of the cache from scratch."
contents-hash) contents-hash)
(push file modified-files))) (push file modified-files)))
(remhash file current-files)) (remhash file current-files))
(emacsql-with-transaction (org-roam-db)
(if (fboundp 'dolist-with-progress-reporter) (if (fboundp 'dolist-with-progress-reporter)
(dolist-with-progress-reporter (file (hash-table-keys current-files)) (dolist-with-progress-reporter (file (hash-table-keys current-files))
"Clearing removed files..." "Clearing removed files..."
@ -447,7 +482,7 @@ If FORCE, force a rebuild of the cache from scratch."
"Processing modified files..." "Processing modified files..."
(org-roam-db-update-file file)) (org-roam-db-update-file file))
(dolist (file modified-files) (dolist (file modified-files)
(org-roam-db-update-file file))))) (org-roam-db-update-file file))))))
(defun org-roam-db-update-file (&optional file-path) (defun org-roam-db-update-file (&optional file-path)
"Update Org-roam cache for FILE-PATH. "Update Org-roam cache for FILE-PATH.
@ -464,7 +499,7 @@ If the file exists, update the cache with information."
(org-roam-db-clear-file) (org-roam-db-clear-file)
(org-roam-db-insert-file) (org-roam-db-insert-file)
(org-roam-db-insert-file-node) (org-roam-db-insert-file-node)
(org-roam-db-map-headlines (org-roam-db-map-nodes
(list #'org-roam-db-insert-node-data (list #'org-roam-db-insert-node-data
#'org-roam-db-insert-aliases #'org-roam-db-insert-aliases
#'org-roam-db-insert-tags #'org-roam-db-insert-tags
@ -476,7 +511,7 @@ If the file exists, update the cache with information."
"." "."
(add-hook 'after-save-hook #'org-roam-db-update-file nil t)) (add-hook 'after-save-hook #'org-roam-db-update-file nil t))
(add-to-list 'org-roam-find-file-hook #'org-roam-db--update-on-save-h) (add-hook 'org-roam-find-file-hook #'org-roam-db--update-on-save-h)
;; Diagnostic Interactives ;; Diagnostic Interactives
(defun org-roam-db-diagnose-node () (defun org-roam-db-diagnose-node ()

View File

@ -1,221 +0,0 @@
;;; org-roam-doctor.el --- Linter for Org-roam files -*- coding: utf-8; lexical-binding: t; -*-
;;
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/jethrokuan/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.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 library provides `org-roam-doctor', a utility for diagnosing and fixing
;; Org-roam files. Running `org-roam-doctor' launches a list of checks defined
;; by `org-roam-doctor--checkers'. Every checker is an instance of
;; `org-roam-doctor-checker'.
;;
;; Each checker is given the Org parse tree (AST), and is expected to return a
;; list of errors. The checker can also provide "actions" for auto-fixing errors
;; (see `org-roam-doctor--remove-link' for an example).
;;
;; The UX experience is inspired by both org-lint and checkdoc, and their code
;; is heavily referenced.
;;
;;; Code:
;; Library Requires
(require 'cl-lib)
(require 'org)
(require 'org-element)
(require 'dash)
(eval-when-compile
(require 'org-roam-macs))
(require 'org-roam)
(defvar org-roam-mode-map)
(declare-function org-roam--get-roam-buffers "org-roam")
(declare-function org-roam--list-all-files "org-roam")
(declare-function org-roam--org-roam-file-p "org-roam")
(defvar org-roam-verbose)
(defcustom org-roam-doctor-inhibit-startup t
"Inhibit `org-mode' startup when processing files with `org-doctor'.
When non-nil, images and LaTeX preview will not be generated,
tables will not be aligned, and headlines will not respect
startup visability. This significantly improves performance when
processing multiple files"
:type 'boolean
:group 'org-roam)
(cl-defstruct (org-roam-doctor-checker (:copier nil))
(name 'missing-checker-name)
(description "")
(actions nil))
(defconst org-roam-doctor--checkers
(list
(make-org-roam-doctor-checker
:name 'org-roam-doctor-broken-links
:description "Fix broken links."
:actions '(("d" . ("Unlink" . org-roam-doctor--remove-link))
("r" . ("Replace link" . org-roam-doctor--replace-link))))))
(defun org-roam-doctor-broken-links (ast)
"Checker for detecting broken links.
AST is the org-element parse tree."
(let (reports)
(org-element-map ast 'link
(lambda (l)
(when (equal "id" (org-element-property :type l))
(let ((id (org-element-property :path l)))
(unless (org-id-find id)
(push `(,(org-element-property :begin l)
,(format "Broken id link \"%s\"" id))
reports))))))
reports))
(defun org-roam-doctor--check (buffer checkers)
"Check BUFFER for errors.
CHECKERS is the list of checkers used."
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(let* ((ast (org-element-parse-buffer))
(errors (sort (cl-mapcan
(lambda (c)
(mapcar
(lambda (report)
(list (set-marker (make-marker) (car report))
(nth 1 report) c))
(save-excursion
(funcall
(org-roam-doctor-checker-name c)
ast))))
checkers)
#'car-less-than-car)))
(dolist (e errors)
(pcase-let ((`(,m ,msg ,checker) e))
(switch-to-buffer buffer)
(goto-char m)
(org-reveal)
(undo-boundary)
(org-roam-doctor--resolve msg checker)
(set-marker m nil)))
errors))))
;;; Actions
(defun org-roam-doctor--recursive-edit ()
"Launch into a recursive edit."
(message "When you're done editing press C-M-c to continue.")
(recursive-edit))
(defun org-roam-doctor--skip ()
"Skip the current error."
(org-roam-message "Skipping..."))
(defun org-roam-doctor--replace-link ()
"Replace the current link with a new link."
(save-match-data
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(let ((orig (buffer-string))
(p (point)))
(condition-case nil
(save-excursion
(replace-match "")
(org-roam-node-insert))
(quit (progn
(replace-buffer-contents orig)
(goto-char p)))))))
(defun org-roam-doctor--remove-link ()
"Unlink the text at point."
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(save-excursion
(let ((label (if (match-end 2)
(match-string-no-properties 2)
(org-link-unescape (match-string-no-properties 1)))))
(delete-region (match-beginning 0) (match-end 0))
(insert label))))
(defun org-roam-doctor--resolve (msg checker)
"Resolve an error.
MSG is the error that was found, which is displayed in a help buffer.
CHECKER is a `org-roam-doctor' checker instance."
(let ((actions (org-roam-doctor-checker-actions checker))
c)
(push '("e" . ("Edit" . org-roam-doctor--recursive-edit)) actions)
(push '("s" . ("Skip" . org-roam-doctor--skip)) actions)
(with-output-to-temp-buffer "*Org-roam-doctor Help*"
(mapc #'princ
(list "Error message:\n " msg "\n\n"))
(dolist (action actions)
(princ (format "[%s]: %s\n"
(car action)
(cadr action))))
(princ "\n\n"))
(shrink-window-if-larger-than-buffer
(get-buffer-window "*Org-roam-doctor Help*"))
(message "Press key for command:")
(unwind-protect
(progn
(cl-loop
do (setq c (char-to-string (read-char-exclusive)))
until (assoc c actions)
do (message "Please enter a valid key for command:"))
(funcall (cddr (assoc c actions)))
(redisplay))
(when (get-buffer-window "*Org-roam-doctor Help*")
(delete-window (get-buffer-window "*Org-roam-doctor Help*"))
(kill-buffer "*Org-roam-doctor Help*")))))
;;;###autoload
(defun org-roam-doctor (&optional checkall)
"Perform a check on the current buffer to ensure cleanliness.
If CHECKALL, run the check for all Org-roam files."
(interactive "P")
(let ((files (if checkall
(org-roam--list-all-files)
(unless (org-roam--org-roam-file-p)
(user-error "Not in an org-roam file"))
`(,(buffer-file-name)))))
(org-roam-doctor-start files org-roam-doctor--checkers)))
(defun org-roam-doctor-start (files checkers)
"Lint FILES using CHECKERS."
(save-window-excursion
(let ((existing-buffers (org-roam--get-roam-buffers))
(org-inhibit-startup org-roam-doctor-inhibit-startup))
(org-id-update-id-locations)
(dolist (f files)
(let ((buf (find-file-noselect f)))
(org-roam-doctor--check buf checkers)
(unless (memq buf existing-buffers)
(save-buffer buf)
(kill-buffer buf))))))
(org-roam-message "Linting completed."))
(provide 'org-roam-doctor)
;;; org-roam-doctor.el ends here

281
org-roam-graph.el Normal file
View File

@ -0,0 +1,281 @@
;;; org-roam-graph.el --- Graphing API -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 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.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.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 library provides graphing functionality for org-roam.
;;
;;; Code:
(require 'xml) ;xml-escape-string
(eval-and-compile
(require 'org-roam-macs))
(require 'org-roam-db)
;;;; Declarations
(defvar org-roam-directory)
;;;; 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" . (("shape" . "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)
(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--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 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 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 (&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 (org-roam--nodes-table))
(seen-nodes (list))
(edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links]))))
(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--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 (org-roam-truncate org-roam-graph-max-title-length title))
(`wrap (s-word-wrap org-roam-graph-max-title-length title))
(_ title)))))
(setq node-id (org-roam-node-id node)
node-properties `(("label" . ,shortened-title)
("URL" . ,(concat "org-protocol://roam-node?node="
(url-hexify-string (org-roam-node-id 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--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--build-process*"
:buffer "*org-roam-graph--build-process*"
: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))
(funcall callback temp-graph)))))))
(defun org-roam-graph--open (file)
"Open FILE using `org-roam-graph-viewer' with `view-file' as a fallback."
(pcase org-roam-graph-viewer
((pred stringp)
(if (executable-find org-roam-graph-viewer)
(condition-case err
(call-process org-roam-graph-viewer nil 0 nil file)
(error (user-error "Failed to open org-roam graph: %s" err)))
(user-error "Executable not found: \"%s\"" org-roam-graph-viewer)))
((pred functionp) (funcall org-roam-graph-viewer file))
('nil (view-file file))
(_ (signal 'wrong-type-argument `((functionp stringp null) ,org-roam-graph-viewer)))))
;;;; Commands
;;;###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)))
(provide 'org-roam-graph)
;;; org-roam-graph.el ends here

View File

@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -48,6 +48,7 @@ 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." Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited."
(declare (indent 2) (debug t)) (declare (indent 2) (debug t))
`(let* (new-buf `(let* (new-buf
(auto-mode-alist nil)
(buf (or (and (not ,file) (buf (or (and (not ,file)
(current-buffer)) ;If FILE is nil, use current buffer (current-buffer)) ;If FILE is nil, use current buffer
(find-buffer-visiting ,file) ; If FILE is already visited, find buffer (find-buffer-visiting ,file) ; If FILE is already visited, find buffer
@ -57,7 +58,10 @@ Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited."
res) res)
(with-current-buffer buf (with-current-buffer buf
(unless (equal major-mode 'org-mode) (unless (equal major-mode 'org-mode)
(delay-mode-hooks (org-mode))) (delay-mode-hooks
(let ((org-inhibit-startup t)
(org-agenda-files nil))
(org-mode))))
(setq res (progn ,@body)) (setq res (progn ,@body))
(unless (and new-buf (not ,keep-buf-p)) (unless (and new-buf (not ,keep-buf-p))
(save-buffer))) (save-buffer)))

192
org-roam-migrate.el Normal file
View File

@ -0,0 +1,192 @@
;;; org-roam-migrate.el --- Migration utilities from v1 to v2 -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 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.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.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:
;;
;; To ease transition from v1 to v2, we provide various migration utilities.
;; This library helps convert v1 notes to v2, and informs the user.
;;
;;; Code:
;;;; Dependencies
;;;;
;;; v1 breaking warning
(require 'org-roam-db)
(defvar org-roam-v2-ack nil)
(unless org-roam-v2-ack
(lwarn 'org-roam :error "
------------------------------------
WARNING: You're now on Org-roam v2!
------------------------------------
You may have arrived here from a package upgrade. Please read the
wiki entry at
https://github.com/org-roam/org-roam/wiki/Hitchhiker's-Rough-Guide-to-Org-roam-V2
for an overview of the major changes.
Notes taken in v1 are incompatible with v1, but you can upgrade
them to the v2 format via a simple command. To migrate your
notes, run:
M-x org-roam-migrate-wizard
If you wish to stay on v1, v1 is unfortunately not distributed on
MELPA. See org-roam/org-roam-v1 on GitHub on how to install v1.
If you've gone through the migration steps (if necessary), and
know what you're doing set `org-roam-v2-ack' to `t' to disable
this warning. You can do so by adding:
(setq org-roam-v2-ack t)
To your init file.
"))
;;;###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))
;; Convert v1 to v2
(dolist (f (org-roam--list-all-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-all-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"))))))
(let ((case-fold-search t))
(org-with-point-at 1
(dolist (alias aliases)
(org-roam-alias-add alias))
(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 (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" (string-join 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))))))))
(provide 'org-roam-migrate)
;;; org-roam-migrate.el ends here

View File

@ -5,7 +5,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -37,7 +37,6 @@
(defvar org-roam-directory) (defvar org-roam-directory)
(defvar org-roam-find-file-hook) (defvar org-roam-find-file-hook)
(declare-function org-roam--org-file-p "org-roam")
(declare-function org-roam-node-at-point "org-roam") (declare-function org-roam-node-at-point "org-roam")
;;; Faces ;;; Faces
@ -124,11 +123,15 @@ and `:slant'."
(defvar org-roam-current-node nil (defvar org-roam-current-node nil
"The current node at point.") "The current node at point.")
(defcustom org-roam-mode-sections (list #'org-roam-backlinks-section (defvar org-roam-current-directory nil
"The `org-roam-directory' value for the current node.")
(defcustom org-roam-mode-section-functions (list #'org-roam-backlinks-section
#'org-roam-reflinks-section) #'org-roam-reflinks-section)
"List of functions that insert sections for Org-roam." "Functions which insert sections of the `org-roam-buffer'.
Each function is called with one argument, which is the current org-roam node at point."
:group 'org-roam :group 'org-roam
:type '(repeat function)) :type 'hook)
;;; The mode ;;; The mode
(defvar org-roam-mode-map (defvar org-roam-mode-map
@ -159,16 +162,18 @@ which visits the thing at point."
(when (derived-mode-p 'org-roam-mode) (when (derived-mode-p 'org-roam-mode)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(setq-local default-directory org-roam-current-directory)
(setq-local org-roam-directory org-roam-current-directory)
(org-roam-set-header-line-format (org-roam-node-title org-roam-current-node)) (org-roam-set-header-line-format (org-roam-node-title org-roam-current-node))
(magit-insert-section (org-roam) (magit-insert-section (org-roam)
(magit-insert-heading) (magit-insert-heading)
(dolist (fn org-roam-mode-sections) (run-hook-with-args 'org-roam-mode-section-functions org-roam-current-node)))))
(funcall fn org-roam-current-node))))))
(defun org-roam-buffer () (defun org-roam-buffer ()
"Launch an Org-roam buffer for the current node at point." "Launch an Org-roam buffer for the current node at point."
(interactive) (interactive)
(if-let ((node (org-roam-node-at-point))) (if-let ((node (org-roam-node-at-point))
(source-org-roam-directory org-roam-directory))
(progn (progn
(let ((buffer (get-buffer-create (let ((buffer (get-buffer-create
(concat "org-roam: " (concat "org-roam: "
@ -176,6 +181,7 @@ which visits the thing at point."
(with-current-buffer buffer (with-current-buffer buffer
(org-roam-mode) (org-roam-mode)
(setq-local org-roam-current-node node) (setq-local org-roam-current-node node)
(setq-local org-roam-current-directory source-org-roam-directory)
(org-roam-buffer-render)) (org-roam-buffer-render))
(switch-to-buffer-other-window buffer))) (switch-to-buffer-other-window buffer)))
(user-error "No node at point"))) (user-error "No node at point")))
@ -193,6 +199,7 @@ the Org-roam buffer."
(when-let ((node (org-roam-node-at-point))) (when-let ((node (org-roam-node-at-point)))
(unless (equal node org-roam-current-node) (unless (equal node org-roam-current-node)
(setq org-roam-current-node node) (setq org-roam-current-node node)
(setq org-roam-current-directory org-roam-directory)
(org-roam-buffer-persistent-redisplay))))) (org-roam-buffer-persistent-redisplay)))))
(define-inline org-roam-buffer--visibility () (define-inline org-roam-buffer--visibility ()
@ -215,8 +222,9 @@ Valid states are 'visible, 'exists and 'none."
(remove-hook 'post-command-hook #'org-roam-buffer--post-command-h))) (remove-hook 'post-command-hook #'org-roam-buffer--post-command-h)))
((or 'exists 'none) ((or 'exists 'none)
(progn (progn
(setq org-roam-current-node (org-roam-node-at-point)
org-roam-current-directory org-roam-directory)
(display-buffer (get-buffer-create org-roam-buffer)) (display-buffer (get-buffer-create org-roam-buffer))
(setq org-roam-current-node (org-roam-node-at-point))
(org-roam-buffer-persistent-redisplay))))) (org-roam-buffer-persistent-redisplay)))))
(defun org-roam-buffer-persistent-redisplay () (defun org-roam-buffer-persistent-redisplay ()
@ -227,10 +235,12 @@ Has no effect when `org-roam-current-node' is nil."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(org-roam-mode) (org-roam-mode)
(setq-local default-directory org-roam-current-directory)
(setq-local org-roam-directory org-roam-current-directory)
(org-roam-set-header-line-format (org-roam-node-title org-roam-current-node)) (org-roam-set-header-line-format (org-roam-node-title org-roam-current-node))
(magit-insert-section (org-roam) (magit-insert-section (org-roam)
(magit-insert-heading) (magit-insert-heading)
(dolist (fn org-roam-mode-sections) (dolist (fn org-roam-mode-section-functions)
(funcall fn org-roam-current-node))))))) (funcall fn org-roam-current-node)))))))
(defun org-roam-buffer--redisplay () (defun org-roam-buffer--redisplay ()
@ -349,7 +359,7 @@ Sorts by title."
"Keymap for Org-roam grep result sections.") "Keymap for Org-roam grep result sections.")
(defclass org-roam-grep-section (magit-section) (defclass org-roam-grep-section (magit-section)
((keymap :initform org-roam-grep-map) ((keymap :initform 'org-roam-grep-map)
(file :initform nil) (file :initform nil)
(row :initform nil) (row :initform nil)
(col :initform nil))) (col :initform nil)))
@ -419,9 +429,9 @@ References from FILE are excluded."
(let* ((titles (cons (org-roam-node-title node) (let* ((titles (cons (org-roam-node-title node)
(org-roam-node-aliases node))) (org-roam-node-aliases node)))
(rg-command (concat "rg -o --vimgrep -P -i " (rg-command (concat "rg -o --vimgrep -P -i "
(string-join (mapcar (lambda (glob) (concat "-g " glob)) (mapconcat (lambda (glob) (concat "-g " glob))
(org-roam--list-files-search-globs (org-roam--list-files-search-globs org-roam-file-extensions)
org-roam-file-extensions)) " ") " ")
(format " '\\[([^[]]++|(?R))*\\]%s' " (format " '\\[([^[]]++|(?R))*\\]%s' "
(mapconcat (lambda (title) (mapconcat (lambda (title)
(format "|(\\b%s\\b)" (shell-quote-argument title))) (format "|(\\b%s\\b)" (shell-quote-argument title)))

98
org-roam-overlay.el Normal file
View File

@ -0,0 +1,98 @@
;;; org-roam-overlay.el --- Link overlay for Org-roam nodes -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 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.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.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 library is an attempt at injecting Roam functionality into Org-mode.
;; This is achieved primarily through building caches for forward links,
;; backward links, and file titles.
;;
;;
;;; Code:
;;;; Dependencies
(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

View File

@ -5,7 +5,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -31,7 +31,7 @@
;; ;;
;; We define 2 protocols: ;; We define 2 protocols:
;; ;;
;; 1. "roam-file": This protocol simply opens the file given by the FILE key ;; 1. "roam-node": This protocol simply opens the node given by the node ID
;; 2. "roam-ref": This protocol creates or opens a note with the given REF ;; 2. "roam-ref": This protocol creates or opens a note with the given REF
;; ;;
;;; Code: ;;; Code:
@ -83,7 +83,7 @@ It opens or creates a note with the given ref.
:templates org-roam-capture-ref-templates) :templates org-roam-capture-ref-templates)
nil) nil)
(defun org-roam-protocol-open-file (info) (defun org-roam-protocol-open-node (info)
"This handler simply opens the file with emacsclient. "This handler simply opens the file with emacsclient.
INFO is an alist containing additional information passed by the protocol URL. INFO is an alist containing additional information passed by the protocol URL.
@ -91,15 +91,15 @@ It should contain the FILE key, pointing to the path of the file to open.
Example protocol string: Example protocol string:
org-protocol://roam-file?file=/path/to/file.org" org-protocol://roam-node?node=uuid"
(when-let ((file (plist-get info :file))) (when-let ((node (plist-get info :node)))
(raise-frame) (raise-frame)
(find-file file)) (org-roam-node-visit (org-roam-populate (org-roam-node-create :id node))))
nil) nil)
(push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref) (push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref)
org-protocol-protocol-alist) org-protocol-protocol-alist)
(push '("org-roam-file" :protocol "roam-file" :function org-roam-protocol-open-file) (push '("org-roam-node" :protocol "roam-node" :function org-roam-protocol-open-node)
org-protocol-protocol-alist) org-protocol-protocol-alist)
(provide 'org-roam-protocol) (provide 'org-roam-protocol)

View File

@ -1,77 +0,0 @@
;;; org-roam-refile.el --- Refile Org-roam Notes -*- lexical-binding: t; -*-
;; Copyright © 2020 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.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.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:
;;
;; Org-roam refile allows you to refile notes to your nodes.
;;
;;; Code:
(defvar org-auto-align-tags)
(defvar org-loop-over-headlines-in-active-region)
(defun org-roam-refile ()
"Refile to node."
(interactive)
(let* ((regionp (org-region-active-p))
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
(node (org-roam-node-read nil nil 'require-match))
(file (org-roam-node-file node))
(nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
level reversed)
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
(org-save-markers-in-region region-start region-end))
(org-copy-subtree 1 nil t))
(with-current-buffer nbuf
(org-with-wide-buffer
(goto-char (org-roam-node-point node))
(setq level (org-get-valid-level (funcall outline-level) 1)
reversed (org-notes-order-reversed-p))
(goto-char
(if reversed
(or (outline-next-heading) (point-max))
(or (save-excursion (org-get-next-sibling))
(org-end-of-subtree t t)
(point-max))))
(unless (bolp) (newline))
(org-paste-subtree level nil nil t)
(and org-auto-align-tags
(let ((org-loop-over-headlines-in-active-region nil))
(org-align-tags)))
(when (fboundp 'deactivate-mark) (deactivate-mark))))
(if regionp
(delete-region (point) (+ (point) (- region-end region-start)))
(org-preserve-local-variables
(delete-region
(and (org-back-to-heading t) (point))
(min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))))
(provide 'org-roam-refile)
;;; org-roam-refile.el ends here

View File

@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -34,7 +34,10 @@
;;; Code: ;;; Code:
;;;; Library Requires ;;;; Library Requires
(require 'dash) (require 'dash)
(require 's)
(eval-when-compile
(require 'org-roam-macs)
(require 'org-macs))
(defvar org-roam-verbose) (defvar org-roam-verbose)
@ -43,6 +46,32 @@
;; regardless of whether Org is loaded before their compilation. ;; regardless of whether Org is loaded before their compilation.
(require 'org) (require 'org)
;;;; String Utilities
(defun org-roam-truncate (len s &optional ellipsis)
"If S is longer than LEN, cut it down and add ELLIPSIS to the end.
The resulting string, including ellipsis, will be LEN characters
long.
When not specified, ELLIPSIS defaults to ...."
(declare (pure t) (side-effect-free t))
(unless ellipsis
(setq ellipsis "..."))
(if (> (length s) len)
(format "%s%s" (substring s 0 (- len (length ellipsis))) ellipsis)
s))
(defun org-roam-replace (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 "\\" "\\\\")
(org-roam-replace "\"" "\\\"")))
;;;; Utility Functions ;;;; Utility Functions
(defun org-roam--list-interleave (lst separator) (defun org-roam--list-interleave (lst separator)
"Interleaves elements in LST with SEPARATOR." "Interleaves elements in LST with SEPARATOR."
@ -105,6 +134,28 @@ it aligns with the text area."
(concat (propertize " " 'display '(space :align-to 0)) (concat (propertize " " 'display '(space :align-to 0))
string))) string)))
;;; Keywords
(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-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-literally file nil 0 bound)
(org-roam--get-keyword name))
(org-roam--get-keyword name bound)))
;;; Shielding regions ;;; Shielding regions
(defface org-roam-shielded (defface org-roam-shielded
'((t :inherit (warning))) '((t :inherit (warning)))
@ -156,8 +207,12 @@ Adapted from `s-format'."
t t) t t)
(set-match-data saved-match-data)))) (set-match-data saved-match-data))))
(defvar org-roam--cached-display-format nil)
(defun org-roam--process-display-format (format) (defun org-roam--process-display-format (format)
"Pre-calculate minimal widths needed by the FORMAT string." "Pre-calculate minimal widths needed by the FORMAT string."
(or org-roam--cached-display-format
(setq org-roam--cached-display-format
(let* ((fields-width 0) (let* ((fields-width 0)
(string-width (string-width
(string-width (string-width
@ -169,7 +224,39 @@ Adapted from `s-format'."
(string-to-number (string-to-number
(or (cadr (split-string field ":")) (or (cadr (split-string field ":"))
""))))))))) "")))))))))
(cons format (+ fields-width string-width)))) (cons format (+ fields-width string-width))))))
;;; for org-roam-demote-entire-buffer in org-roam-refile.el
(defun org-roam--file-keyword-get (keyword)
"Pull a KEYWORD setting from the top of the file.
Keyword must be specified in ALL CAPS."
(cadr (assoc keyword
(org-collect-keywords (list keyword)))))
(defun org-roam--file-keyword-kill (keyword)
"Erase KEYWORD 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)))))
(defun org-roam--kill-empty-buffer ()
"If the source buffer has been emptied, kill it.
If the buffer is associated with a file, delete the file.
If the buffer is associated with an in-process capture operation, abort the operation."
(when (eq (buffer-size) 0)
(if (buffer-file-name)
(delete-file (buffer-file-name)))
(set-buffer-modified-p nil)
(when (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(org-capture-kill))
(kill-buffer (current-buffer))))
;;; Diagnostics ;;; Diagnostics
;;;###autoload ;;;###autoload

View File

@ -1,12 +1,12 @@
;;; org-roam.el --- Roam Research replica with Org-mode -*- coding: utf-8; lexical-binding: t; -*- ;;; org-roam.el --- Roam Research replica with Org-mode -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com> ;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com> ;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam ;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience ;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0 ;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2") (magit-section "2.90.1")) ;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -48,9 +48,11 @@
(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'subr-x))
;;;; Features ;;;; Features
(require 'org-roam-migrate)
(require 'org-roam-compat) (require 'org-roam-compat)
(eval-when-compile (eval-when-compile
(require 'org-roam-macs)) (require 'org-roam-macs)
(require 'org-macs))
(require 'org-roam-utils) (require 'org-roam-utils)
(require 'org-roam-mode) (require 'org-roam-mode)
(require 'org-roam-completion) (require 'org-roam-completion)
@ -78,6 +80,11 @@
:group 'faces) :group 'faces)
;;;; Variables ;;;; Variables
(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/") (defcustom org-roam-directory (expand-file-name "~/org-roam/")
"Default path to Org-roam files. "Default path to Org-roam files.
All Org files, at any level of nesting, are considered part of the Org-roam." All Org files, at any level of nesting, are considered part of the Org-roam."
@ -103,7 +110,7 @@ ensure that."
(defcustom org-roam-list-files-commands (defcustom org-roam-list-files-commands
(if (member system-type '(windows-nt ms-dos cygwin)) (if (member system-type '(windows-nt ms-dos cygwin))
nil nil
'(find rg)) '(find fd fdfind rg))
"Commands that will be used to find Org-roam files. "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 It should be a list of symbols or cons cells representing any of the following
@ -112,66 +119,39 @@ It should be a list of symbols or cons cells representing any of the following
The commands will be tried in order until an executable for a command is found. 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. The Elisp implementation is used if no command in the list is found.
`rg'
Use ripgrep as the file search method.
Example command: rg /path/to/dir/ --files -g \"*.org\" -g \"*.org.gpg\"
`find' `find'
Use find as the file search method. Use find as the file search method.
Example command: Example command:
find /path/to/dir -type f \( -name \"*.org\" -o -name \"*.org.gpg\" \) 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 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 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\"))." method symbol as a cons cell. For example: '(find (rg . \"/path/to/rg\"))."
:type '(set (const :tag "find" find) :type '(set (const :tag "find" find)
(const :tag "rg" rg))) (const :tag "rg" rg)))
(defcustom org-roam-slug-trim-chars
'(;; Combining Diacritical Marks https://www.unicode.org/charts/PDF/U0300.pdf
768 ; U+0300 COMBINING GRAVE ACCENT
769 ; U+0301 COMBINING ACUTE ACCENT
770 ; U+0302 COMBINING CIRCUMFLEX ACCENT
771 ; U+0303 COMBINING TILDE
772 ; U+0304 COMBINING MACRON
774 ; U+0306 COMBINING BREVE
775 ; U+0307 COMBINING DOT ABOVE
776 ; U+0308 COMBINING DIAERESIS
777 ; U+0309 COMBINING HOOK ABOVE
778 ; U+030A COMBINING RING ABOVE
780 ; U+030C COMBINING CARON
795 ; U+031B COMBINING HORN
803 ; U+0323 COMBINING DOT BELOW
804 ; U+0324 COMBINING DIAERESIS BELOW
805 ; U+0325 COMBINING RING BELOW
807 ; U+0327 COMBINING CEDILLA
813 ; U+032D COMBINING CIRCUMFLEX ACCENT BELOW
814 ; U+032E COMBINING BREVE BELOW
816 ; U+0330 COMBINING TILDE BELOW
817 ; U+0331 COMBINING MACRON BELOW
)
"Characters to trim from Unicode normalization for slug.
By default, the characters are specified to remove Diacritical Marks from the Latin alphabet."
:type '(repeat character)
:group 'org-roam)
(defcustom org-roam-verbose t
"Echo messages that are not errors."
:type 'boolean
:group 'org-roam)
;;;; ID Utilities ;;;; ID Utilities
(defun org-roam-id-at-point () (defun org-roam-id-at-point ()
"Return the ID at point, if any. "Return the ID at point, if any.
Recursively traverses up the headline tree to find the Recursively traverses up the headline tree to find the
first encapsulating ID." first encapsulating ID."
(let (source)
(org-with-wide-buffer (org-with-wide-buffer
(while (and (not (setq source (org-id-get))) (org-back-to-heading-or-point-min)
(while (and (not (org-roam-db-node-p))
(not (bobp))) (not (bobp)))
(org-roam-up-heading-or-point-min))) (org-roam-up-heading-or-point-min))
source)) (org-id-get)))
;;;; File functions and predicates ;;;; File functions and predicates
(defun org-roam--file-name-extension (filename) (defun org-roam--file-name-extension (filename)
@ -183,21 +163,17 @@ Like `file-name-extension', but does not strip version number."
(not (eq 0 (match-beginning 0)))) (not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) 1)))))) (substring file (+ (match-beginning 0) 1))))))
(defun org-roam--org-file-p (path) (defun org-roam-file-p (&optional file)
"Check if PATH is pointing to an org file."
(let ((ext (org-roam--file-name-extension path)))
(when (string= ext "gpg") ; Handle encrypted files
(setq ext (org-roam--file-name-extension (file-name-sans-extension path))))
(member ext org-roam-file-extensions)))
(defun org-roam--org-roam-file-p (&optional file)
"Return t if FILE is part of Org-roam system, nil otherwise. "Return t if FILE is part of Org-roam system, nil otherwise.
If FILE is not specified, use the current buffer's file-path." If FILE is not specified, use the current buffer's file-path."
(when-let ((path (or file (let* ((path (or file (buffer-file-name (buffer-base-buffer))))
(buffer-file-name (buffer-base-buffer))))) (ext (org-roam--file-name-extension path))
(ext (if (string= ext "gpg")
(org-roam--file-name-extension (file-name-sans-extension path))
ext)))
(save-match-data (save-match-data
(and (and
(org-roam--org-file-p path) (member ext org-roam-file-extensions)
(not (and org-roam-file-exclude-regexp (not (and org-roam-file-exclude-regexp
(string-match-p org-roam-file-exclude-regexp path))) (string-match-p org-roam-file-exclude-regexp path)))
(f-descendant-of-p path (expand-file-name org-roam-directory)))))) (f-descendant-of-p path (expand-file-name org-roam-directory))))))
@ -217,6 +193,15 @@ E.g. (\".org\") => (\"*.org\" \"*.org.gpg\")"
append (list (format "\"*.%s\"" e) append (list (format "\"*.%s\"" e)
(format "\"*.%s.gpg\"" e)))) (format "\"*.%s.gpg\"" e))))
(defun org-roam--list-files-fd (executable dir)
"Return all Org-roam files located recursively within DIR, using fd, provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(extensions (s-join " -e " (mapcar (lambda (glob) (substring glob 2 -1)) globs)))
(command (s-join " " `(,executable "-L" ,dir "--type file" ,extensions))))
(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) (defun org-roam--list-files-rg (executable dir)
"Return all Org-roam files located recursively within DIR, using ripgrep, provided as EXECUTABLE." "Return all Org-roam files located recursively within DIR, using ripgrep, provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
@ -294,14 +279,13 @@ recursion."
(defun org-roam--list-files-elisp (dir) (defun org-roam--list-files-elisp (dir)
"Return all Org-roam files located recursively within DIR, using elisp." "Return all Org-roam files located recursively within DIR, using elisp."
(let* ((file-regex (concat "\\.\\(?:" (let ((regex (concat "\\.\\(?:"(mapconcat
(mapconcat #'regexp-quote org-roam-file-extensions "\\|") #'regexp-quote org-roam-file-extensions
"\\)\\(?:\\.gpg\\)?\\'")) "\\|" )"\\)\\(?:\\.gpg\\)?\\'"))
(files (org-roam--directory-files-recursively dir file-regex nil nil t))
result) result)
(dolist (file files result) (dolist (file (org-roam--directory-files-recursively dir regex nil nil t) result)
(when (and (file-readable-p file) (when (and (file-readable-p file)
(org-roam--org-file-p file)) (org-roam-file-p file))
(push file result))))) (push file result)))))
(defun org-roam--list-files (dir) (defun org-roam--list-files (dir)
@ -325,7 +309,7 @@ Use external shell commands if defined in `org-roam-list-files-commands'."
(let ((fn (intern (concat "org-roam--list-files-" exe)))) (let ((fn (intern (concat "org-roam--list-files-" exe))))
(unless (fboundp fn) (user-error "%s is not an implemented search method" fn)) (unless (fboundp fn) (user-error "%s is not an implemented search method" fn))
(funcall fn path (format "\"%s\"" dir))))) (funcall fn path (format "\"%s\"" dir)))))
(files (seq-filter #'org-roam--org-roam-file-p files)) (files (seq-filter #'org-roam-file-p files))
(files (mapcar #'expand-file-name files))) ; canonicalize names (files (mapcar #'expand-file-name files))) ; canonicalize names
files files
(org-roam--list-files-elisp dir)))) (org-roam--list-files-elisp dir))))
@ -334,40 +318,42 @@ Use external shell commands if defined in `org-roam-list-files-commands'."
"Return a list of all Org-roam files within `org-roam-directory'." "Return a list of all Org-roam files within `org-roam-directory'."
(org-roam--list-files (expand-file-name org-roam-directory))) (org-roam--list-files (expand-file-name org-roam-directory)))
(defun org-roam--tags-table () (defun org-roam--nodes-table ()
"Return a hash table of node ID to list of tags." "Return a hash table of node ID to org-roam-nodes."
(let ((ht (make-hash-table :test #'equal))) (let ((ht (make-hash-table :test #'equal)))
(pcase-dolist (`(,node-id ,tag) (org-roam-db-query [:select [node-id tag] :from tags])) (pcase-dolist (`(,id ,file ,title)
(puthash node-id (cons tag (gethash node-id ht)) ht)) (org-roam-db-query [:select [id file title] :from nodes]))
(puthash id (org-roam-node-create :file file :id id :title title) ht))
ht)) ht))
(defun org-roam--get-roam-buffers () (defun org-roam-buffer-p (&optional buffer)
"Return t if BUFFER is accessing a part of Org-roam system.
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." "Return a list of buffers that are Org-roam files."
(--filter (and (with-current-buffer it (derived-mode-p 'org-mode)) (--filter (org-roam-buffer-p it)
(buffer-file-name it)
(org-roam--org-roam-file-p (buffer-file-name it)))
(buffer-list))) (buffer-list)))
(defun org-roam--get-titles () (defun org-roam--get-titles ()
"Return all titles and aliases in the Org-roam database." "Return all distinct titles and aliases in the Org-roam database."
(let* ((titles (mapcar #'car (org-roam-db-query [:select title :from nodes]))) (mapcar #'car (org-roam-db-query [:select :distinct title :from nodes
(aliases (mapcar #'car (org-roam-db-query [:select alias :from aliases]))) :union :select alias :from aliases])))
(completions (append titles aliases)))
completions))
;;; Org-roam setup and teardown ;;; Org-roam setup and teardown
(defvar org-roam-find-file-hook nil (defvar org-roam-find-file-hook nil
"Hook run when an Org-roam file is visited.") "Hook run when an Org-roam file is visited.")
;;;###autoload
(defun org-roam-setup () (defun org-roam-setup ()
"Setup Org-roam." "Setup Org-roam."
(interactive) (interactive)
(unless (or (and (bound-and-true-p emacsql-sqlite3-executable)
(file-executable-p emacsql-sqlite3-executable))
(executable-find "sqlite3"))
(lwarn '(org-roam) :error "Cannot find executable 'sqlite3'. \
Ensure it is installed and can be found within `exec-path'. \
M-x info for more information at Org-roam > Installation > Post-Installation Tasks."))
(add-hook 'find-file-hook #'org-roam--file-setup) (add-hook 'find-file-hook #'org-roam--file-setup)
(add-hook 'kill-emacs-hook #'org-roam-db--close-all) (add-hook 'kill-emacs-hook #'org-roam-db--close-all)
(advice-add 'rename-file :after #'org-roam--rename-file-advice) (advice-add 'rename-file :after #'org-roam--rename-file-advice)
@ -383,14 +369,14 @@ M-x info for more information at Org-roam > Installation > Post-Installation Tas
(advice-remove 'delete-file #'org-roam--delete-file-advice) (advice-remove 'delete-file #'org-roam--delete-file-advice)
(org-roam-db--close-all) (org-roam-db--close-all)
;; Disable local hooks for all org-roam buffers ;; Disable local hooks for all org-roam buffers
(dolist (buf (org-roam--get-roam-buffers)) (dolist (buf (org-roam-buffer-list))
(with-current-buffer buf (with-current-buffer buf
(remove-hook 'after-save-hook #'org-roam-db-update-file t)))) (remove-hook 'after-save-hook #'org-roam-db-update-file t))))
;;; Hooks and advices ;;; Hooks and advices
(defun org-roam--file-setup () (defun org-roam--file-setup ()
"Setup an Org-roam file." "Setup an Org-roam file."
(when (org-roam--org-roam-file-p) (when (org-roam-file-p)
(run-hooks 'org-roam-find-file-hook))) (run-hooks 'org-roam-find-file-hook)))
(defun org-roam--delete-file-advice (file &optional _trash) (defun org-roam--delete-file-advice (file &optional _trash)
@ -398,7 +384,7 @@ M-x info for more information at Org-roam > Installation > Post-Installation Tas
FILE is removed from the database." FILE is removed from the database."
(when (and (not (auto-save-file-name-p file)) (when (and (not (auto-save-file-name-p file))
(not (backup-file-name-p file)) (not (backup-file-name-p file))
(org-roam--org-roam-file-p file)) (org-roam-file-p file))
(org-roam-db-clear-file (expand-file-name file)))) (org-roam-db-clear-file (expand-file-name file))))
(defun org-roam--rename-file-advice (old-file new-file-or-dir &rest _args) (defun org-roam--rename-file-advice (old-file new-file-or-dir &rest _args)
@ -413,22 +399,45 @@ OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
(not (auto-save-file-name-p new-file)) (not (auto-save-file-name-p new-file))
(not (backup-file-name-p old-file)) (not (backup-file-name-p old-file))
(not (backup-file-name-p new-file)) (not (backup-file-name-p new-file))
(org-roam--org-roam-file-p old-file)) (org-roam-file-p old-file))
(org-roam-db-clear-file old-file)) (org-roam-db-clear-file old-file))
(when (org-roam--org-roam-file-p new-file) (when (org-roam-file-p new-file)
(org-roam-db-update-file new-file)))) (org-roam-db-update-file new-file))))
;;;; Nodes ;;;; Nodes
(cl-defstruct (org-roam-node (:constructor org-roam-node-create) (cl-defstruct (org-roam-node (:constructor org-roam-node-create)
(:copier nil)) (:copier nil))
id file level point todo priority scheduled deadline title file file-hash file-atime file-mtime
id level point todo priority scheduled deadline title properties olp
tags aliases refs) tags aliases refs)
(cl-defmethod org-roam-node-slug ((node org-roam-node)) (cl-defmethod org-roam-node-slug ((node org-roam-node))
"Return the slug of NODE." "Return the slug of NODE."
(let ((title (org-roam-node-title node))) (let ((title (org-roam-node-title node))
(slug-trim-chars '(;; Combining Diacritical Marks https://www.unicode.org/charts/PDF/U0300.pdf
768 ; U+0300 COMBINING GRAVE ACCENT
769 ; U+0301 COMBINING ACUTE ACCENT
770 ; U+0302 COMBINING CIRCUMFLEX ACCENT
771 ; U+0303 COMBINING TILDE
772 ; U+0304 COMBINING MACRON
774 ; U+0306 COMBINING BREVE
775 ; U+0307 COMBINING DOT ABOVE
776 ; U+0308 COMBINING DIAERESIS
777 ; U+0309 COMBINING HOOK ABOVE
778 ; U+030A COMBINING RING ABOVE
780 ; U+030C COMBINING CARON
795 ; U+031B COMBINING HORN
803 ; U+0323 COMBINING DOT BELOW
804 ; U+0324 COMBINING DIAERESIS BELOW
805 ; U+0325 COMBINING RING BELOW
807 ; U+0327 COMBINING CEDILLA
813 ; U+032D COMBINING CIRCUMFLEX ACCENT BELOW
814 ; U+032E COMBINING BREVE BELOW
816 ; U+0330 COMBINING TILDE BELOW
817 ; U+0331 COMBINING MACRON BELOW
)))
(cl-flet* ((nonspacing-mark-p (char) (cl-flet* ((nonspacing-mark-p (char)
(memq char org-roam-slug-trim-chars)) (memq char slug-trim-chars))
(strip-nonspacing-marks (s) (strip-nonspacing-marks (s)
(ucs-normalize-NFC-string (ucs-normalize-NFC-string
(apply #'string (seq-remove #'nonspacing-mark-p (apply #'string (seq-remove #'nonspacing-mark-p
@ -450,7 +459,7 @@ OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
"Keymap for Org-roam node sections.") "Keymap for Org-roam node sections.")
(defclass org-roam-node-section (magit-section) (defclass org-roam-node-section (magit-section)
((keymap :initform org-roam-node-map) ((keymap :initform 'org-roam-node-map)
(node :initform nil))) (node :initform nil)))
(defvar org-roam-preview-map (defvar org-roam-preview-map
@ -461,7 +470,7 @@ OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
"Keymap for Org-roam preview.") "Keymap for Org-roam preview.")
(defclass org-roam-preview-section (magit-section) (defclass org-roam-preview-section (magit-section)
((keymap :initform org-roam-preview-map) ((keymap :initform 'org-roam-preview-map)
(file :initform nil) (file :initform nil)
(begin :initform nil) (begin :initform nil)
(end :initform nil))) (end :initform nil)))
@ -471,11 +480,17 @@ OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
Uses the ID, and fetches remaining details from the database. Uses the ID, and fetches remaining details from the database.
This can be quite costly: avoid, unless dealing with very few This can be quite costly: avoid, unless dealing with very few
nodes." nodes."
(let ((node-info (car (org-roam-db-query [:select [file level pos todo priority scheduled deadline title] (when-let ((node-info (car (org-roam-db-query [:select [file level pos todo priority
scheduled deadline title properties olp]
:from nodes :from nodes
:where (= id $s1) :where (= id $s1)
:limit 1] :limit 1]
(org-roam-node-id node)))) (org-roam-node-id node)))))
(pcase-let* ((`(,file ,level ,pos ,todo ,priority ,scheduled ,deadline ,title ,properties ,olp) node-info)
(`(,atime ,mtime) (car (org-roam-db-query [:select [atime mtime]
:from files
:where (= file $s1)]
file)))
(tag-info (mapcar #'car (org-roam-db-query [:select [tag] :from tags (tag-info (mapcar #'car (org-roam-db-query [:select [tag] :from tags
:where (= node-id $s1)] :where (= node-id $s1)]
(org-roam-node-id node)))) (org-roam-node-id node))))
@ -485,8 +500,9 @@ nodes."
(refs-info (mapcar #'car (org-roam-db-query [:select [ref] :from refs (refs-info (mapcar #'car (org-roam-db-query [:select [ref] :from refs
:where (= node-id $s1)] :where (= node-id $s1)]
(org-roam-node-id node))))) (org-roam-node-id node)))))
(pcase-let ((`(,file ,level ,pos ,todo ,priority ,scheduled ,deadline ,title) node-info))
(setf (org-roam-node-file node) file (setf (org-roam-node-file node) file
(org-roam-node-file-atime node) atime
(org-roam-node-file-mtime node) mtime
(org-roam-node-level node) level (org-roam-node-level node) level
(org-roam-node-point node) pos (org-roam-node-point node) pos
(org-roam-node-todo node) todo (org-roam-node-todo node) todo
@ -494,26 +510,33 @@ nodes."
(org-roam-node-scheduled node) scheduled (org-roam-node-scheduled node) scheduled
(org-roam-node-deadline node) deadline (org-roam-node-deadline node) deadline
(org-roam-node-title node) title (org-roam-node-title node) title
(org-roam-node-properties node) properties
(org-roam-node-olp node) olp
(org-roam-node-tags node) tag-info (org-roam-node-tags node) tag-info
(org-roam-node-refs node) refs-info (org-roam-node-refs node) refs-info
(org-roam-node-aliases node) alias-info)) (org-roam-node-aliases node) alias-info)))
node)) node)
(defcustom org-roam-node-display-template (defcustom org-roam-node-display-template
"${title:*} ${tags:10}" "${title:*} ${tags:10}"
"Configures display formatting for Org-roam node." "Configures display formatting for Org-roam node.
Patterns of form \"${field-name:length}\" are interpolated based
on the current node. \"field-name\" is replaced with the
corresponding value of the field of the current node. \"length\"
specifies how many characters are used to display the value of
the field. A \"length\" of \"*\" specifies that as many
characters as possible should be used."
:group 'org-roam :group 'org-roam
:type 'string) :type 'string)
(defun org-roam--tags-to-str (tags) (defun org-roam--tags-to-str (tags)
"Convert list of TAGS into a string." "Convert list of TAGS into a string."
(string-join (mapconcat (lambda (s) (concat "#" s)) tags " "))
(mapcar (lambda (s) (concat "#" s)) tags)
" "))
(defun org-roam-node--format-entry (node width) (defun org-roam-node--format-entry (node width)
"Formats NODE for display in the results list. "Formats NODE for display in the results list.
WIDTH is the width of the results list." WIDTH is the width of the results list.
Uses `org-roam-node-display-template' to format the entry."
(let ((fmt (org-roam--process-display-format org-roam-node-display-template))) (let ((fmt (org-roam--process-display-format org-roam-node-display-template)))
(org-roam-format (org-roam-format
(car fmt) (car fmt)
@ -529,6 +552,9 @@ WIDTH is the width of the results list."
(when (and (equal field-name "file") (when (and (equal field-name "file")
field-value) field-value)
(setq field-value (file-relative-name field-value org-roam-directory))) (setq field-value (file-relative-name field-value org-roam-directory)))
(when (and (equal field-name "olp")
field-value)
(setq field-value (string-join field-value " > ")))
(if (not field-width) (if (not field-width)
field-value field-value
(setq field-width (string-to-number field-width)) (setq field-width (string-to-number field-width))
@ -553,11 +579,22 @@ WIDTH is the width of the results list."
(defun org-roam-node-at-point (&optional assert) (defun org-roam-node-at-point (&optional assert)
"Return the node at point. "Return the node at point.
If ASSERT, throw an error." If ASSERT, throw an error if there is no node at point.
This function also returns the node if it has yet to be cached in the
database. In this scenario, only expect `:id' and `:point' to be
populated."
(if-let ((node (magit-section-case (if-let ((node (magit-section-case
(org-roam-node-section (oref it node)) (org-roam-node-section (oref it node))
(t (when-let ((id (org-roam-id-at-point))) (t (org-with-wide-buffer
(org-roam-populate (org-roam-node-create :id id))))))) (org-back-to-heading-or-point-min)
(while (and (not (org-roam-db-node-p))
(not (bobp)))
(org-roam-up-heading-or-point-min))
(when-let ((id (org-id-get)))
(org-roam-populate
(org-roam-node-create
:id id
:point (point)))))))))
node node
(when assert (when assert
(user-error "No node at point")))) (user-error "No node at point"))))
@ -601,8 +638,7 @@ Throw an error if multiple choices exist."
:where (= title $s1)] :where (= title $s1)]
s) s)
(org-roam-db-query [:select [node-id] :from aliases (org-roam-db-query [:select [node-id] :from aliases
:left :join nodes :on (= nodes:id aliases:node-id) :where (= alias $s1)]
:where (= aliases:node-id $s1)]
s))))) s)))))
(cond (cond
((seq-empty-p matches) ((seq-empty-p matches)
@ -612,30 +648,112 @@ Throw an error if multiple choices exist."
(t (t
(user-error "Multiple nodes exist with title or alias \"%s\"" s))))) (user-error "Multiple nodes exist with title or alias \"%s\"" s)))))
(defun org-roam-node-list ()
"Return a list of all nodes."
(let ((rows (org-roam-db-query
"SELECT
id,
file,
\"level\",
todo,
pos,
priority ,
scheduled ,
deadline ,
title,
properties ,
olp,
atime,
mtime,
'(' || group_concat(tags, ' ') || ')' as tags,
aliases,
refs
FROM
(
SELECT
id,
file,
\"level\",
todo,
pos,
priority ,
scheduled ,
deadline ,
title,
properties ,
olp,
atime,
mtime,
tags,
'(' || group_concat(aliases, ' ') || ')' as aliases,
refs
FROM
(
SELECT
nodes.id as id,
nodes.file as file,
nodes.\"level\" as \"level\",
nodes.todo as todo,
nodes.pos as pos,
nodes.priority as priority,
nodes.scheduled as scheduled,
nodes.deadline as deadline,
nodes.title as title,
nodes.properties as properties,
nodes.olp as olp,
files.atime as atime,
files.mtime as mtime,
tags.tag as tags,
aliases.alias as aliases,
'(' || group_concat(RTRIM (refs.\"type\", '\"') || ':' || LTRIM(refs.ref, '\"'), ' ') || ')' as refs
FROM nodes
LEFT JOIN files ON files.file = nodes.file
LEFT JOIN tags ON tags.node_id = nodes.id
LEFT JOIN aliases ON aliases.node_id = nodes.id
LEFT JOIN refs ON refs.node_id = nodes.id
GROUP BY nodes.id, tags.tag, aliases.alias )
GROUP BY id, tags )
GROUP BY id")))
(cl-loop for row in rows
append (pcase-let* ((`(,id ,file ,level ,todo ,pos ,priority ,scheduled ,deadline
,title ,properties ,olp ,atime ,mtime ,tags ,aliases ,refs)
row)
(all-titles (cons title aliases)))
(mapcar (lambda (temp-title)
(org-roam-node-create :id id
:file file
:file-atime atime
:file-mtime mtime
:level level
:point pos
:todo todo
:priority priority
:scheduled scheduled
:deadline deadline
:title temp-title
:properties properties
:olp olp
:tags tags
:refs refs))
all-titles)))))
(defun org-roam-node--to-candidate (node)
"Return a minibuffer completion candidate given NODE."
(let ((candidate-main (org-roam-node--format-entry node (1- (frame-width))))
(tag-str (org-roam--tags-to-str (org-roam-node-tags node))))
(cons (propertize (concat candidate-main
(propertize tag-str 'invisible t))
'node node)
node)))
(defun org-roam-node--completions () (defun org-roam-node--completions ()
"Return an alist for node completion. "Return an alist for node completion.
The car is the displayed title or alias for the node, and the cdr The car is the displayed title or alias for the node, and the cdr
is the `org-roam-node'." is the `org-roam-node'.
(let ((tags-table (org-roam--tags-table))) The displayed title is formatted according to `org-roam-node-display-template'."
(cl-loop for row in (append (setq org-roam--cached-display-format nil)
(org-roam-db-query [:select [file pos title title id] (let ((nodes (org-roam-node-list)))
:from nodes]) (mapcar #'org-roam-node--to-candidate nodes)))
(org-roam-db-query [:select [nodes:file pos alias title node-id]
:from aliases
:left-join nodes
:on (= aliases:node-id nodes:id)]))
collect (pcase-let* ((`(,file ,pos ,alias ,title ,id) row)
(node (org-roam-node-create :id id
:file file
:title alias
:point pos
:tags (gethash id tags-table)))
(candidate-main (org-roam-node--format-entry node (1- (frame-width))))
(tag-str (org-roam--tags-to-str (org-roam-node-tags node))))
(cons (propertize (concat (propertize tag-str 'invisible t)
candidate-main)
'node node)
node)))))
(defcustom org-roam-node-annotation-function #'org-roam-node--annotation (defcustom org-roam-node-annotation-function #'org-roam-node--annotation
"The function used to return annotations in the minibuffer for Org-roam nodes. "The function used to return annotations in the minibuffer for Org-roam nodes.
@ -643,13 +761,43 @@ This function takes a single argument NODE, which is an `org-roam-node' construc
:group 'org-roam :group 'org-roam
:type 'function) :type 'function)
(defun org-roam-node-read (&optional initial-input filter-fn require-match) (defcustom org-roam-node-default-sort 'file-mtime
"Default sort order for Org-roam node completions."
:type 'const
:group 'org-roam)
(defun org-roam-node-sort-by-file-mtime (completion-a completion-b)
"Sort files such that files modified more recently are shown first.
COMPLETION-A and COMPLETION-B are items in the form of (node-title org-roam-node-struct)"
(let ((node-a (cdr completion-a))
(node-b (cdr completion-b)))
(time-less-p (org-roam-node-file-mtime node-b)
(org-roam-node-file-mtime node-a))))
(defun org-roam-node-sort-by-file-atime (completion-a completion-b)
"Sort files such that files accessed more recently are shown first.
COMPLETION-A and COMPLETION-B are items in the form of (node-title org-roam-node-struct)"
"Sort completions list by file modification time."
(let ((node-a (cdr completion-a))
(node-b (cdr completion-b)))
(time-less-p (org-roam-node-file-atime node-b)
(org-roam-node-file-atime node-a))))
(defun org-roam-node-read (&optional initial-input filter-fn sort-fn require-match)
"Read and return an `org-roam-node'. "Read and return an `org-roam-node'.
INITIAL-INPUT is the initial prompt value. INITIAL-INPUT is the initial minibuffer prompt value.
FILTER-FN is a function applied to the completion list. FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
If REQUIRE-MATCH, require returning a match." and when nil is returned the node will be filtered out.
SORT-FN is a function to sort nodes. See `org-roam-node-sort-by-file-mtime'
for an example sort function.
If REQUIRE-MATCH, the minibuffer prompt will require a match."
(let* ((nodes (org-roam-node--completions)) (let* ((nodes (org-roam-node--completions))
(nodes (funcall (or filter-fn #'identity) nodes)) (nodes (cl-remove-if-not (lambda (n)
(if filter-fn (funcall filter-fn (cdr n)) t)) nodes))
(sort-fn (or sort-fn
(when org-roam-node-default-sort
(intern (concat "org-roam-node-sort-by-" (symbol-name org-roam-node-default-sort))))))
(_ (when sort-fn (setq nodes (seq-sort sort-fn nodes))))
(node (completing-read (node (completing-read
"Node: " "Node: "
(lambda (string pred action) (lambda (string pred action)
@ -691,8 +839,7 @@ POINT is the point in buffer for the link.
PROPERTIES contains properties about the link." PROPERTIES contains properties about the link."
(magit-insert-section section (org-roam-node-section) (magit-insert-section section (org-roam-node-section)
(let ((outline (if-let ((outline (plist-get properties :outline))) (let ((outline (if-let ((outline (plist-get properties :outline)))
(string-join (mapcar #'org-link-display-format outline) (mapconcat #'org-link-display-format outline " > ")
" > ")
"Top"))) "Top")))
(insert (concat (propertize (org-roam-node-title source-node) (insert (concat (propertize (org-roam-node-title source-node)
'font-lock-face 'org-roam-title) 'font-lock-face 'org-roam-title)
@ -713,8 +860,8 @@ PROPERTIES contains properties about the link."
(defun org-roam-node-find (&optional other-window initial-input filter-fn) (defun org-roam-node-find (&optional other-window initial-input filter-fn)
"Find and open an Org-roam node by its title or alias. "Find and open an Org-roam node by its title or alias.
INITIAL-INPUT is the initial input for the prompt. INITIAL-INPUT is the initial input for the prompt.
FILTER-FN is the name of a function to apply on the candidates FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
which takes as its argument an alist of path-completions. and when nil is returned the node will be filtered out.
If OTHER-WINDOW, visit the NODE in another window." If OTHER-WINDOW, visit the NODE in another window."
(interactive current-prefix-arg) (interactive current-prefix-arg)
(let ((node (org-roam-node-read initial-input filter-fn))) (let ((node (org-roam-node-read initial-input filter-fn)))
@ -724,12 +871,13 @@ If OTHER-WINDOW, visit the NODE in another window."
:node node :node node
:props '(:finalize find-file))))) :props '(:finalize find-file)))))
;;;###autoload
(defun org-roam-node-insert (&optional filter-fn) (defun org-roam-node-insert (&optional filter-fn)
"Find an Org-roam file, and insert a relative org link to it at point. "Find an Org-roam file, and insert a relative org link to it at point.
Return selected file if it exists. Return selected file if it exists.
If LOWERCASE is non-nil, downcase the link description. If LOWERCASE is non-nil, downcase the link description.
FILTER-FN is the name of a function to apply on the candidates FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
which takes as its argument an alist of path-completions." and when nil is returned the node will be filtered out."
(interactive) (interactive)
(unwind-protect (unwind-protect
;; Group functions together to avoid inconsistent state on quit ;; Group functions together to avoid inconsistent state on quit
@ -754,11 +902,12 @@ which takes as its argument an alist of path-completions."
description))) description)))
(org-roam-capture- (org-roam-capture-
:node node :node node
:props (list :region (when (and beg end) :props (append
(cons beg end)) (when (and beg end)
:insert-at (point-marker) (list :region (cons beg end)))
(list :insert-at (point-marker)
:link-description description :link-description description
:finalize 'insert-link))))) :finalize 'insert-link))))))
(deactivate-mark))) (deactivate-mark)))
;;;###autoload ;;;###autoload
@ -778,42 +927,124 @@ window instead."
"Add S to property PROP." "Add S to property PROP."
(let* ((p (org-entry-get (point) prop)) (let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p))) (lst (when p (split-string-and-unquote p)))
(lst (if (memq s lst) lst (cons s lst)))) (lst (if (memq s lst) lst (cons s lst)))
(org-set-property prop (combine-and-quote-strings lst)))) (lst (seq-uniq lst)))
(org-set-property prop (combine-and-quote-strings lst))
s))
(defun org-roam-remove-property (prop) (defun org-roam-remove-property (prop &optional s)
"Prompt to remove an item from PROP." "Remove S from property PROP.
If S is not specified, user is prompted to select a value."
(let* ((p (org-entry-get (point) prop)) (let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p))) (lst (when p (split-string-and-unquote p)))
(prop-to-remove (completing-read "Remove: " lst)) (prop-to-remove (or s (completing-read "Remove: " lst)))
(lst (delete prop-to-remove lst))) (lst (delete prop-to-remove lst)))
(if lst (if lst
(org-set-property prop (combine-and-quote-strings lst)) (org-set-property prop (combine-and-quote-strings lst))
(org-delete-property prop)))) (org-delete-property prop))
prop-to-remove))
(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))
(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 "#+" key ": " value "\n")))))
;;;; Tags
(defun org-roam-tag-completions ()
"Return list of tags for completions within Org-roam."
(let ((roam-tags (mapcar #'car (org-roam-db-query [:select :distinct [tag] :from tags])))
(org-tags (cl-loop for tagg in org-tag-alist
nconc (pcase tagg
('(:newline)
nil)
(`(,tag . ,_)
(list tag))
(_ nil)))))
(seq-uniq (append roam-tags org-tags))))
(defun org-roam-tag-add (tags)
"Add TAGS to the node at point."
(interactive
(list (completing-read-multiple "Tag: " (org-roam-tag-completions))))
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(if (= (org-outline-level) 0)
(let ((current-tags (split-string (or (cadr (assoc "FILETAGS"
(org-collect-keywords '("filetags"))))
""))))
(org-roam-set-keyword "filetags" (string-join (seq-uniq (append tags current-tags)) " ")))
(org-set-tags (seq-uniq (append tags (org-get-tags)))))
tags)))
(defun org-roam-tag-remove (&optional tags)
"Remove TAGS from the node at point."
(interactive)
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(if (= (org-outline-level) 0)
(let* ((current-tags (split-string (or (cadr (assoc "FILETAGS"
(org-collect-keywords '("filetags"))))
(user-error "No tag to remove"))))
(tags (or tags (completing-read-multiple "Tag: " current-tags))))
(org-roam-set-keyword "filetags"
(string-join (seq-difference current-tags tags #'string-equal) " ")))
(let* ((current-tags (or (org-get-tags)
(user-error "No tag to remove")))
(tags (completing-read-multiple "Tag: " current-tags)))
(org-set-tags (seq-difference current-tags tags #'string-equal))))
tags)))
;;;; Aliases ;;;; Aliases
(defun org-roam-alias-add (alias) (defun org-roam-alias-add (alias)
"Add ALIAS to the node at point." "Add ALIAS to the node at point."
(interactive "sAlias: ") (interactive "sAlias: ")
(org-roam-add-property alias "ROAM_ALIASES")) (let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-add-property alias "ROAM_ALIASES"))))
(defun org-roam-alias-remove () (defun org-roam-alias-remove (&optional alias)
"Remove an alias from the node at point." "Remove an ALIAS from the node at point."
(interactive) (interactive)
(org-roam-remove-property "ROAM_ALIASES")) (let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-remove-property "ROAM_ALIASES" alias))))
;;;; Refs ;;;; Refs
(defun org-roam-ref-add (ref) (defun org-roam-ref-add (ref)
"Add REF to the node at point." "Add REF to the node at point."
(interactive "sRef: ") (interactive "sRef: ")
(org-roam-add-property ref "ROAM_REFS")) (let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-add-property ref "ROAM_REFS"))))
(defun org-roam-ref-remove () (defun org-roam-ref-remove (&optional ref)
"Remove a ref from the node at point." "Remove a REF from the node at point."
(interactive) (interactive)
(org-roam-remove-property "ROAM_REFS")) (let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-remove-property "ROAM_REFS" ref))))
;;;; Refs
(defun org-roam-ref--completions () (defun org-roam-ref--completions ()
"Return an alist for ref completion. "Return an alist for ref completion.
The car is the ref, and the cdr is the corresponding node for the ref." The car is the ref, and the cdr is the corresponding node for the ref."
@ -836,9 +1067,12 @@ The car is the ref, and the cdr is the corresponding node for the ref."
"Read an Org-roam ref. "Read an Org-roam ref.
Return a string, is propertized in `meta' with additional properties. Return a string, is propertized in `meta' with additional properties.
INITIAL-INPUT is the initial prompt value. INITIAL-INPUT is the initial prompt value.
FILTER-FN is a function applied to the completion list." 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.
filtered out."
(let* ((refs (org-roam-ref--completions)) (let* ((refs (org-roam-ref--completions))
(refs (funcall (or filter-fn #'identity) refs)) (refs (cl-remove-if-not (lambda (n)
(if filter-fn (funcall filter-fn (cdr n)) t)) refs))
(ref (completing-read "Ref: " (ref (completing-read "Ref: "
(lambda (string pred action) (lambda (string pred action)
(if (eq action 'metadata) (if (eq action 'metadata)
@ -857,12 +1091,14 @@ REF is assumed to be a propertized string."
(when title (when title
(concat " " title)))) (concat " " title))))
;;;###autoload
(defun org-roam-ref-find (&optional initial-input filter-fn) (defun org-roam-ref-find (&optional initial-input filter-fn)
"Find and open and Org-roam file from REF if it exists. "Find and open and Org-roam file from REF if it exists.
REF should be the value of '#+roam_key:' without any REF should be the value of '#+roam_key:' without any
type-information (e.g. 'cite:'). type-information (e.g. 'cite:').
INITIAL-INPUT is the initial input to the prompt. INITIAL-INPUT is the initial input to the prompt.
FILTER-FN is applied to the ref list to filter out candidates." 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."
(interactive) (interactive)
(let* ((node (org-roam-ref-read initial-input filter-fn))) (let* ((node (org-roam-ref-read initial-input filter-fn)))
(find-file (org-roam-node-file node)) (find-file (org-roam-node-file node))
@ -877,20 +1113,49 @@ FILTER-FN is applied to the ref list to filter out candidates."
;;; the roam: link ;;; the roam: link
(org-link-set-parameters "roam" :follow #'org-roam-link-follow-link) (org-link-set-parameters "roam" :follow #'org-roam-link-follow-link)
(defun org-roam-link-replace-at-point (&optional link)
"Replace the roam: LINK at point with an id link."
(save-excursion
(save-match-data
(let* ((link (or link (org-element-context)))
(type (org-element-property :type link))
(path (org-element-property :path link))
node)
(goto-char (org-element-property :begin link))
(when (and (org-in-regexp org-link-any-re 1)
(string-equal type "roam")
(setq node (org-roam-node-from-title-or-alias path)))
(replace-match (org-link-make-string
(concat "id:" (org-roam-node-id node))
path)))))))
(defun org-roam-link-replace-all ()
"Replace all \"roam:\" links in buffer with \"id:\" links."
(interactive)
(org-with-point-at 1
(while (re-search-forward org-link-bracket-re nil t)
(org-roam-link-replace-at-point))))
(defun org-roam--replace-roam-links-on-save-h ()
"Run `org-roam-link-replace-all' before buffer is saved to its file."
(when org-roam-link-auto-replace
(add-hook 'before-save-hook #'org-roam-link-replace-all nil t)))
(add-hook 'org-roam-find-file-hook #'org-roam--replace-roam-links-on-save-h)
(defun org-roam-link-follow-link (path) (defun org-roam-link-follow-link (path)
"Org-roam's roam: link navigation with description PATH. "Org-roam's roam: link navigation with description PATH.
This function is called by Org when following links of the type This function is called by Org when following links of the type
`roam'. While the path is passed, assume that the cursor is on `roam'. While the path is passed, assume that the cursor is on
the link." the link."
(let ((node (org-roam-node-from-title-or-alias path))) (if-let ((node (org-roam-node-from-title-or-alias path)))
(progn
(when org-roam-link-auto-replace (when org-roam-link-auto-replace
(save-excursion (org-roam-link-replace-at-point))
(save-match-data (org-id-goto (org-roam-node-id node)))
(org-in-regexp org-link-bracket-re 1) (org-roam-capture-
(replace-match (org-link-make-string :node (org-roam-node-create :title path)
(concat "id:" (org-roam-node-id node)) :props '(:finalize find-file))))
path)))))
(org-id-goto (org-roam-node-id node))))
(defun org-roam-open-id-at-point () (defun org-roam-open-id-at-point ()
"Navigates to the ID at point. "Navigates to the ID at point.
@ -913,5 +1178,70 @@ To be added to `org-open-at-point-functions'."
(add-hook 'org-roam-find-file-hook #'org-roam-open-id-with-org-roam-db-h) (add-hook 'org-roam-find-file-hook #'org-roam-open-id-with-org-roam-db-h)
;;; Refiling
(defun org-roam-demote-entire-buffer ()
"Convert an org buffer with any top level content to a single node.
All headings are demoted one level.
The #+TITLE: keyword is converted into a level-1 heading and deleted.
Any tags declared on #+FILETAGS: are transferred to tags on the new top heading.
Any top level properties drawers are incorporated into the new heading."
(interactive)
(org-with-point-at 1
(org-map-entries 'org-do-demote)
(insert "* "
(org-roam--file-keyword-get "TITLE")
"\n")
(org-back-to-heading)
(org-set-tags (org-roam--file-keyword-get "FILETAGS"))
(org-roam--file-keyword-kill "TITLE")
(org-roam--file-keyword-kill "FILETAGS")))
(defun org-roam-refile ()
"Refile to node."
(interactive)
(let* ((regionp (org-region-active-p))
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
(node (org-roam-node-read nil nil nil 'require-match))
(file (org-roam-node-file node))
(nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
level reversed)
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
(org-save-markers-in-region region-start region-end))
(progn
(if (org-before-first-heading-p)
(org-roam-demote-entire-buffer))
(org-copy-subtree 1 nil t)))
(with-current-buffer nbuf
(org-with-wide-buffer
(goto-char (org-roam-node-point node))
(setq level (org-get-valid-level (funcall outline-level) 1)
reversed (org-notes-order-reversed-p))
(goto-char
(if reversed
(or (outline-next-heading) (point-max))
(or (save-excursion (org-get-next-sibling))
(org-end-of-subtree t t)
(point-max))))
(unless (bolp) (newline))
(org-paste-subtree level nil nil t)
(and org-auto-align-tags
(let ((org-loop-over-headlines-in-active-region nil))
(org-align-tags)))
(when (fboundp 'deactivate-mark) (deactivate-mark))))
(if regionp
(delete-region (point) (+ (point) (- region-end region-start)))
(org-preserve-local-variables
(delete-region
(and (org-back-to-heading t) (point))
(min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))
(org-roam--kill-empty-buffer)))
(provide 'org-roam) (provide 'org-roam)
;;; org-roam.el ends here ;;; org-roam.el ends here