Advertisement
6clk4mW8KYjKb5Af

Org-roam helm reference switcher V2

Mar 7th, 2020
384
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 6.03 KB | None | 0 0
  1. (defun my/roam-open-reference ()
  2.   "Open Org-roam links and references with helm."
  3.   (interactive)
  4.   (unless (buffer-file-name (or (buffer-base-buffer)
  5.                                 (current-buffer)))
  6.     (error "Not visiting a file."))
  7.   (let* ((file-path (buffer-file-name (or (buffer-base-buffer)
  8.                                           (current-buffer))))
  9.          (links-out (my//get-links-out file-path))
  10.          (backlinks (my//roam-file-backlink-info file-path))
  11.          (sources nil))
  12.  
  13.     ;; Back-references to current page
  14.     (when-let* ((filtered-backlinks (--filter
  15.                                      (not (f-same? file-path (plist-get it :file)))
  16.                                      backlinks))
  17.                 (candidites
  18.                  (--map (cons (format "%s\t%s"
  19.                                       (plist-get it :title)
  20.                                       (propertize (plist-get it :line)
  21.                                                   'face
  22.                                                   'helm-separator))
  23.                               it)
  24.                         filtered-backlinks)))
  25.       (push (helm-build-sync-source "Back-references"
  26.               :candidates candidites
  27.               :action my//ror-actions
  28.               :keymap my//ror-actions-keymap)
  29.             sources))
  30.  
  31.     ;; Walk through pages of outgoing links
  32.     (dolist (link-info links-out)
  33.       (let* ((link-title (plist-get link-info :title))
  34.              (link-file (plist-get link-info :file))
  35.              (link-links-out (my//get-links-out link-file))
  36.              (link-backlinks (my//roam-file-backlink-info link-file))
  37.              ;; First line is link to source
  38.              (candidites (list (cons (propertize link-title 'face 'org-roam-link)
  39.                                      link-info))))
  40.  
  41.         ;; Links from current page out
  42.         (when link-links-out
  43.           (dolist (info link-links-out)
  44.             (unless (or (equal file-path (plist-get info :file))
  45.                         (equal link-file (plist-get info :file)))
  46.               (push (cons (format "🔗 %s"
  47.                                   (propertize (plist-get info :title)
  48.                                               'face 'org-roam-link))
  49.                           info)
  50.                     candidites))))
  51.  
  52.  
  53.         ;; ;; Back-references to current page
  54.         (when link-backlinks
  55.           (dolist (info link-backlinks)
  56.             (unless (or (equal file-path (plist-get info :file))
  57.                         (equal link-file (plist-get info :file)))
  58.               (push (cons (format "← %s\t%s"
  59.                                   (propertize (plist-get info :title)
  60.                                               'face 'org-roam-link)
  61.                                   (propertize (plist-get info :line)
  62.                                               'face
  63.                                               'helm-separator))
  64.                           info)
  65.                     candidites))))
  66.  
  67.         ;; Build source for link
  68.         (push (helm-build-sync-source link-title
  69.                 :candidates (nreverse candidites)
  70.                 :action my//ror-actions
  71.                 :keymap my//ror-actions-keymap)
  72.               sources)))
  73.     (helm :sources (nreverse sources) :prompt "Pick reference: ")))
  74.  
  75. ;; -- Helper functions ---------------------------------------------------------
  76.  
  77. (defun my//roam-file-backlink-info (file-path &optional drop-to)
  78.   "Produce a list of info on backlink."
  79.   (when-let* ((backlinks (org-roam--get-backlinks file-path))
  80.               (grouped-backlinks (--group-by (nth 0 it) backlinks)))
  81.     (let (bl-info)
  82.       (dolist (group grouped-backlinks)
  83.         (let* ((file-from (car group)))
  84.           (unless (equal drop-to file-from)
  85.             (let* ((bls (cdr group))
  86.                    (title (org-roam--get-title-or-slug file-from)))
  87.               (dolist (backlink bls)
  88.                 (pcase-let ((`(,file-from ,file-to ,props) backlink))
  89.                   (let* ((file-point (plist-get props :point))
  90.                          (line (-> (plist-get props :content)
  91.                                    s-trim
  92.                                    org-link-display-format
  93.                                    substring-no-properties)))
  94.                     (push (list :file file-from
  95.                                 :title title
  96.                                 :line line
  97.                                 :file-point file-point)
  98.                           bl-info))))))))
  99.       bl-info)))
  100.  
  101. (defun my//get-links-out (file-path &optional ignore-to)
  102.   "Produce a list of info on link."
  103.   (-as-> (org-roam-sql [:select [file-to] :from file-links
  104.                                 :where (= file-from $s1)]
  105.                        file-path)
  106.          prev
  107.          (mapcar #'car prev)
  108.          (-remove-item ignore-to prev)
  109.          (-uniq prev)
  110.          (--map (list :title (org-roam--get-title-or-slug it)
  111.                       :file it) prev)
  112.          (--sort (string-lessp (plist-get it :title)
  113.                                (plist-get other :title))
  114.                  prev)))
  115.  
  116.  
  117. ;; -- Helm Actions -------------------------------------------------------------
  118.  
  119. (defun my//ror-open (candidite)
  120.   (find-file (plist-get candidite :file))
  121.  
  122.   (when-let ((pos (plist-get candidite :file-point)))
  123.     (goto-char pos)))
  124.  
  125. (defun my//ror-run-open ()
  126.   (interactive)
  127.   (with-helm-alive-p (helm-exit-and-execute-action 'my//ror-open)))
  128.  
  129. (defun my//ror-open-other-window (candidite)
  130.   (find-file-other-window (plist-get candidite :file))
  131.  
  132.   (when-let ((pos (plist-get candidite :file-point)))
  133.     (goto-char pos)))
  134.  
  135. ;; -- Helm Extra ---------------------------------------------------------------
  136.  
  137. (setq my//ror-actions
  138.       `(("Open file other window" . ,#'my//ror-open-other-window)
  139.         ("Open file" . ,#'my//ror-open)))
  140.  
  141. (setq my//ror-actions-keymap
  142.       (let ((map (make-sparse-keymap)))
  143.         (set-keymap-parent map helm-map)
  144.         (define-key map (kbd "C-<return>") #'my//ror-run-open)
  145.         map))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement