Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defun my/roam-open-reference ()
- "Open Org-roam links and references with helm."
- (interactive)
- (unless (buffer-file-name (or (buffer-base-buffer)
- (current-buffer)))
- (error "Not visiting a file."))
- (let* ((file-path (buffer-file-name (or (buffer-base-buffer)
- (current-buffer))))
- (links-out (my//get-links-out file-path))
- (backlinks (my//roam-file-backlink-info file-path))
- (sources nil))
- ;; Back-references to current page
- (when-let* ((filtered-backlinks (--filter
- (not (f-same? file-path (plist-get it :file)))
- backlinks))
- (candidites
- (--map (cons (format "%s\t%s"
- (plist-get it :title)
- (propertize (plist-get it :line)
- 'face
- 'helm-separator))
- it)
- filtered-backlinks)))
- (push (helm-build-sync-source "Back-references"
- :candidates candidites
- :action my//ror-actions
- :keymap my//ror-actions-keymap)
- sources))
- ;; Walk through pages of outgoing links
- (dolist (link-info links-out)
- (let* ((link-title (plist-get link-info :title))
- (link-file (plist-get link-info :file))
- (link-links-out (my//get-links-out link-file))
- (link-backlinks (my//roam-file-backlink-info link-file))
- ;; First line is link to source
- (candidites (list (cons (propertize link-title 'face 'org-roam-link)
- link-info))))
- ;; Links from current page out
- (when link-links-out
- (dolist (info link-links-out)
- (unless (or (equal file-path (plist-get info :file))
- (equal link-file (plist-get info :file)))
- (push (cons (format "🔗 %s"
- (propertize (plist-get info :title)
- 'face 'org-roam-link))
- info)
- candidites))))
- ;; ;; Back-references to current page
- (when link-backlinks
- (dolist (info link-backlinks)
- (unless (or (equal file-path (plist-get info :file))
- (equal link-file (plist-get info :file)))
- (push (cons (format "← %s\t%s"
- (propertize (plist-get info :title)
- 'face 'org-roam-link)
- (propertize (plist-get info :line)
- 'face
- 'helm-separator))
- info)
- candidites))))
- ;; Build source for link
- (push (helm-build-sync-source link-title
- :candidates (nreverse candidites)
- :action my//ror-actions
- :keymap my//ror-actions-keymap)
- sources)))
- (helm :sources (nreverse sources) :prompt "Pick reference: ")))
- ;; -- Helper functions ---------------------------------------------------------
- (defun my//roam-file-backlink-info (file-path &optional drop-to)
- "Produce a list of info on backlink."
- (when-let* ((backlinks (org-roam--get-backlinks file-path))
- (grouped-backlinks (--group-by (nth 0 it) backlinks)))
- (let (bl-info)
- (dolist (group grouped-backlinks)
- (let* ((file-from (car group)))
- (unless (equal drop-to file-from)
- (let* ((bls (cdr group))
- (title (org-roam--get-title-or-slug file-from)))
- (dolist (backlink bls)
- (pcase-let ((`(,file-from ,file-to ,props) backlink))
- (let* ((file-point (plist-get props :point))
- (line (-> (plist-get props :content)
- s-trim
- org-link-display-format
- substring-no-properties)))
- (push (list :file file-from
- :title title
- :line line
- :file-point file-point)
- bl-info))))))))
- bl-info)))
- (defun my//get-links-out (file-path &optional ignore-to)
- "Produce a list of info on link."
- (-as-> (org-roam-sql [:select [file-to] :from file-links
- :where (= file-from $s1)]
- file-path)
- prev
- (mapcar #'car prev)
- (-remove-item ignore-to prev)
- (-uniq prev)
- (--map (list :title (org-roam--get-title-or-slug it)
- :file it) prev)
- (--sort (string-lessp (plist-get it :title)
- (plist-get other :title))
- prev)))
- ;; -- Helm Actions -------------------------------------------------------------
- (defun my//ror-open (candidite)
- (find-file (plist-get candidite :file))
- (when-let ((pos (plist-get candidite :file-point)))
- (goto-char pos)))
- (defun my//ror-run-open ()
- (interactive)
- (with-helm-alive-p (helm-exit-and-execute-action 'my//ror-open)))
- (defun my//ror-open-other-window (candidite)
- (find-file-other-window (plist-get candidite :file))
- (when-let ((pos (plist-get candidite :file-point)))
- (goto-char pos)))
- ;; -- Helm Extra ---------------------------------------------------------------
- (setq my//ror-actions
- `(("Open file other window" . ,#'my//ror-open-other-window)
- ("Open file" . ,#'my//ror-open)))
- (setq my//ror-actions-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map helm-map)
- (define-key map (kbd "C-<return>") #'my//ror-run-open)
- map))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement