I moved away from the original idea of creating files for each url and using #+roam-key
, when I found that org-roam already parses and places all links, including urls in the database. This means that extending org-roam to support linking multiple urls to a file only requires a few other pieces.
I have a mock version of this implemented. Ended up calling it org-roam-protocol-open-url. Borrows code from the implementation of org-roam-find-file and other org roam utilities.
It looks over all the urls linked within all org roam files and checks if the url in question is one of them. No need for an explicit location within a file.
I have some further utilities to create an blacklist of files that shouldn’t have their links (urls) extracted which you can find on my repo.
explanation
running
javascript:location.href =
'org-protocol://roam-url?template=w&ref='
+ encodeURIComponent(location.href)
+ '&title='
+ encodeURIComponent(document.title);
});
checks if the url is referenced in any org roam file, if so lists those files as selection. If there is only one such file it directly opens it. If not, it uses org-roam-protocol-open-file to handle the url.
javascript:location.href =
'org-protocol://roam-url?template=w&ref='
+ encodeURIComponent(location.href)
+ '&title='
+ encodeURIComponent(document.title) + '&check=';
});
the difference is that if a matching file isn’t found, it does nothing. A good way to figure out if a file that references the url exists.
my setup
my setup for surfing-keys.
mapkey('cw', 'org protocol capture website', function() {
javascript:location.href =
'org-protocol://roam-url?template=w&ref='
+ encodeURIComponent(location.href)
+ '&title='
+ encodeURIComponent(document.title);
});
// setup org protocol website
mapkey('cc', 'org protocol capture check website', function() {
javascript:location.href =
'org-protocol://roam-url?template=w&ref='
+ encodeURIComponent(location.href)
+ '&title='
+ encodeURIComponent(document.title) + '&check=';
});
installation
script
quick setup
place the following in a file that is run when emacs starts up.
;;; Code:
(require 'org-protocol)
(require 'org-roam-protocol)
(require 'org-roam)
;;;; Functions
(defun org-roam--get-url-title-path-completions (url)
"Return an alist for completion.
The car is the displayed title for completion, and the cdr is the
to the file."
(let* ((url-path (s-replace-regexp "http[s]?:" "" url))
(rows (org-roam-db-query [:select [files:file titles:title tags:tags files:meta] :from titles
:left :join tags
:on (= titles:file tags:file)
:left :join files
:on (= titles:file files:file)
:left :join links
:on (= files:file links:from)
:where (= links:to $s1)
] url-path))
completions)
(setq rows (seq-sort-by (lambda (x)
(plist-get (nth 3 x) :mtime))
#'time-less-p
rows))
(dolist (row rows completions)
(pcase-let ((`(,file-path ,title ,tags) row))
(let ((k (org-roam--prepend-tag-string title tags))
(v (list :path file-path :title title)))
(push (cons k v) completions))))))
(defun org-roam--prepend-url-place (props title tags)
(concat (org-roam--prepend-tag-string title tags) " :" (number-to-string (plist-get props :point)) ":"
"\n"
"* "
(if-let ((outline (plist-get props :outline)))
(string-join outline " > ")
"Top")
"\n"
"=> " (s-trim (s-replace "\n" " "
(plist-get props :content)))
"\n\n"
))
(defun org-roam--get-url-place-title-path-completions (url)
"Return an alist for completion.
The car is the displayed title for completion, and the cdr is the
to the file."
(let* ((url-path (s-replace-regexp "http[s]?:" "" url))
(rows (org-roam-db-query [:select [links:properties files:file titles:title tags:tags files:meta] :from links
:left :join titles
:on (= links:from titles:file)
:left :join tags
:on (= titles:file tags:file)
:left :join files
:on (= titles:file files:file)
:where (= links:to $s1)
:order-by (asc links:from)
] url-path))
completions)
;; sort by point in file
(setq rows (seq-sort-by (lambda (x)
(plist-get (nth 0 x) :point))
#'<
rows))
;; then by file opening time
(setq rows (seq-sort-by (lambda (x)
(plist-get (nth 4 x) :mtime))
#'time-less-p
rows))
(dolist (row rows completions)
(pcase-let ((`(,props ,file-path ,title ,tags) row))
(let ((k (org-roam--prepend-url-place props title tags))
(v (list :path file-path :title title :point (plist-get props :point))))
(push (cons k v) completions))))
))
(cl-defun org-roam-completion--completing-read-url (prompt choices &key
require-match initial-input
action)
"Present a PROMPT with CHOICES and optional INITIAL-INPUT.
If REQUIRE-MATCH is t, the user must select one of the CHOICES.
Return user choice."
(setq org-roam-completion-system 'helm)
(let (res)
(setq res
(cond
((eq org-roam-completion-system 'ido)
(let ((candidates (mapcar #'car choices)))
(ido-completing-read prompt candidates nil require-match initial-input)))
((eq org-roam-completion-system 'default)
(completing-read prompt choices nil require-match initial-input))
((eq org-roam-completion-system 'ivy)
(if (fboundp 'ivy-read)
(ivy-read prompt choices
:initial-input initial-input
:require-match require-match
:action (prog1 action
(setq action nil))
:caller 'org-roam--completing-read)
(user-error "Please install ivy from \
https://github.com/abo-abo/swiper")))
((eq org-roam-completion-system 'helm)
(unless (and (fboundp 'helm)
(fboundp 'helm-make-source))
(user-error "Please install helm from \
https://github.com/emacs-helm/helm"))
(let ((source (helm-make-source prompt 'helm-source-sync
:candidates (mapcar #'car choices)
:multiline t
:filtered-candidate-transformer
(and (not require-match)
#'org-roam-completion--helm-candidate-transformer)))
(buf (concat "*org-roam "
(s-downcase (s-chop-suffix ":" (s-trim prompt)))
"*")))
(or (helm :sources source
:action (if action
(prog1 action
(setq action nil))
#'identity)
:prompt prompt
:input initial-input
:buffer buf)
(keyboard-quit))))))
(if action
(funcall action res)
res)))
(defun org-roam-find-file-url (&optional initial-prompt completions filter-fn no-confirm setup-fn)
"Find and open an Org-roam file.
INITIAL-PROMPT is the initial title prompt.
COMPLETIONS is a list of completions to be used instead of
`org-roam--get-title-path-completions`.
FILTER-FN is the name of a function to apply on the candidates
which takes as its argument an alist of path-completions. See
`org-roam--get-title-path-completions' for details.
If NO-CONFIRM, assume that the user does not want to modify the initial prompt."
(interactive)
(unless org-roam-mode (org-roam-mode))
(let* ((completions (funcall (or filter-fn #'identity)
completions))
(title-with-tags (case (length completions)
(0 nil)
(1 (caar completions))
(t (if no-confirm
initial-prompt
(when setup-fn (funcall setup-fn))
(org-roam-completion--completing-read-url "File: " completions
:initial-input initial-prompt)))))
(res (cdr (assoc title-with-tags completions)))
(file-path (plist-get res :path))
(point (plist-get res :point)))
(if file-path
(progn (find-file file-path) (goto-char point) '(t))
nil)
))
(defun org-roam-protocol-open-url (info)
"Process an org-protocol://roam-url?ref= style url with INFO.
It checks, opens, searchs or creates a note with the given ref.
When check is available in url, no matter what it is set to, just check if file exists, if not don't open anything or create org file.
javascript:location.href = \\='org-protocol://roam-url?template=r&ref=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection()) + \\ + \\='&check=\\='
"
(setq ref (plist-get info :ref))
(setq check (plist-get info :check))
(setq opened-file (org-roam-find-file-url nil (org-roam--get-url-place-title-path-completions ref) nil nil (lambda () (x-focus-frame nil) (raise-frame) (select-frame-set-input-focus (selected-frame)))))
(unless (or check opened-file)
(org-roam-protocol-open-ref info)
)
)
(push '("org-roam-url" :protocol "roam-url" :function org-roam-protocol-open-url)
org-protocol-protocol-alist)
(provide 'org-roam-protocol-url)
repo
you can also get it from my repo.
It is on
or just multi-url
and then setup it up, with melpa/qualpa.
(org-roam
:location (recipe :fetcher github
:repo "natask/org-roam"
:branch "my-latest" ;or "multi-url"
:files ( "*.el")
)
)
configuration
and then place the following alongside your normal org-roam initialization.
(use-package org-roam-protocol-url
:after org-protocol)
extensions
I will like to write something that promotes (maybe even demotes) urls to their own file with a key. it is not a high priority for me though.
I already have done some work on opening a url key of a file beforehand.
It is also possible to extend this to other types of links.