Build additional titles cache

This commit is contained in:
Jethro Kuan
2020-02-10 12:50:13 +08:00
parent 66ba96289f
commit e165486dc5

View File

@@ -169,60 +169,83 @@ If `ABSOLUTE', return the absolute file-path. Else, return the relative file-pat
,(async-inject-variables "org-roam-files") ,(async-inject-variables "org-roam-files")
,(async-inject-variables "org-roam-directory") ,(async-inject-variables "org-roam-directory")
(let ((backward-links (make-hash-table :test #'equal)) (let ((backward-links (make-hash-table :test #'equal))
(forward-links (make-hash-table :test #'equal))) (forward-links (make-hash-table :test #'equal))
(cl-flet* ((org-roam--parse-content (file) (with-temp-buffer (file-titles (make-hash-table :test #'equal)))
(insert-file-contents file) (cl-flet* ((org-roam--parse-content
(with-current-buffer (current-buffer) (file)
(org-element-map (org-element-parse-buffer) 'link (with-temp-buffer
(lambda (link) (insert-file-contents file)
(let ((type (org-element-property :type link)) (with-current-buffer (current-buffer)
(path (org-element-property :path link)) (org-element-map (org-element-parse-buffer) 'link
(start (org-element-property :begin link))) (lambda (link)
(when (and (string= type "file") (let ((type (org-element-property :type link))
(string= (file-name-extension path) "org")) (path (org-element-property :path link))
(goto-char start) (start (org-element-property :begin link)))
(let* ((element (org-element-at-point)) (when (and (string= type "file")
(content (or (org-element-property :raw-value element) (string= (file-name-extension path) "org"))
(buffer-substring (goto-char start)
(or (org-element-property :content-begin element) (let* ((element (org-element-at-point))
(org-element-property :begin element)) (content (or (org-element-property :raw-value element)
(or (org-element-property :content-end element) (buffer-substring
(org-element-property :end element)))))) (or (org-element-property :content-begin element)
(list :from file (org-element-property :begin element))
:to (file-truename (expand-file-name path org-roam-directory)) (or (org-element-property :content-end element)
:content (string-trim content)))))))))) (org-element-property :end element))))))
(org-roam--process-items (items) (mapcar (list :from file
(lambda (item) :to (file-truename (expand-file-name path org-roam-directory))
(pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item)) :content (string-trim content))))))))))
;; Build forward-links (org-roam--process-items
(let ((links (gethash p-from forward-links))) (items)
(if links (mapcar
(puthash p-from (lambda (item)
(if (member p-to links) (pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item))
links ;; Build forward-links
(cons p-to links)) forward-links) (let ((links (gethash p-from forward-links)))
(puthash p-from (list p-to) forward-links))) (if links
;; Build backward-links (puthash p-from
(let ((contents-hash (gethash p-to backward-links))) (if (member p-to links)
(if contents-hash links
(if-let ((contents-list (gethash p-from contents-hash))) (cons p-to links)) forward-links)
(let ((updated (cons content contents-list))) (puthash p-from (list p-to) forward-links)))
(puthash p-from updated contents-hash) ;; Build backward-links
(puthash p-to contents-hash backward-links)) (let ((contents-hash (gethash p-to backward-links)))
(progn (if contents-hash
(puthash p-from (list content) contents-hash) (if-let ((contents-list (gethash p-from contents-hash)))
(puthash p-to contents-hash backward-links))) (let ((updated (cons content contents-list)))
(let ((contents-hash (make-hash-table :test #'equal))) (puthash p-from updated contents-hash)
(puthash p-from (list content) contents-hash) (puthash p-to contents-hash backward-links))
(puthash p-to contents-hash backward-links)))))) (progn
items))) (puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-links)))
(let ((contents-hash (make-hash-table :test #'equal)))
(puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-links))))))
items))
(org-roam--extract-title
(buffer)
(with-current-buffer buffer
(org-element-map
(org-element-parse-buffer)
'keyword
(lambda (kw)
(when (string= (org-element-property :key kw) "TITLE")
(org-element-property :value kw)))
:first-match t))))
(mapcar #'org-roam--process-items (mapcar #'org-roam--process-items
(mapcar #'org-roam--parse-content org-roam-files))) (mapcar #'org-roam--parse-content org-roam-files))
(mapcar (lambda (file)
(with-temp-buffer
(insert-file-contents file)
(when-let ((title (org-roam--extract-title (current-buffer))))
(puthash file title file-titles))))
org-roam-files))
(list (list
:forward forward-links :forward forward-links
:backward backward-links))) :backward backward-links
:titles file-titles)))
(lambda (cache) (lambda (cache)
(setq org-roam-cache cache)))) (setq org-roam-cache cache)
(message "Org-roam cache built!"))))
(defun org-roam--insert-item (item) (defun org-roam--insert-item (item)
"Insert `ITEM' into `org-roam-cache'. "Insert `ITEM' into `org-roam-cache'.
@@ -231,7 +254,8 @@ If `ABSOLUTE', return the absolute file-path. Else, return the relative file-pat
Before calling this function, `org-roam-cache' should be already populated." Before calling this function, `org-roam-cache' should be already populated."
(let ((forward-cache (plist-get org-roam-cache :forward)) (let ((forward-cache (plist-get org-roam-cache :forward))
(backward-cache (plist-get org-roam-cache :backward))) (backward-cache (plist-get org-roam-cache :backward))
(title-cache (plist-get org-roam-cache :titles)))
(pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item)) (pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item))
;; Build forward-links ;; Build forward-links
(let ((links (gethash p-from forward-cache))) (let ((links (gethash p-from forward-cache)))
@@ -255,7 +279,8 @@ Before calling this function, `org-roam-cache' should be already populated."
(puthash p-from (list content) contents-hash) (puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-cache)))) (puthash p-to contents-hash backward-cache))))
(setq org-roam-cache (list :forward forward-cache (setq org-roam-cache (list :forward forward-cache
:backward backward-cache))))) :backward backward-cache
:titles title-cache)))))
(defun org-roam--parse-content () (defun org-roam--parse-content ()
"Parse the current buffer, and return a list of items for processing." "Parse the current buffer, and return a list of items for processing."
@@ -286,8 +311,9 @@ This is equivalent to removing the node from the graph."
(with-current-buffer (current-buffer) (with-current-buffer (current-buffer)
(let ((file (file-truename (buffer-file-name buffer))) (let ((file (file-truename (buffer-file-name buffer)))
(forward-cache (plist-get org-roam-cache :forward)) (forward-cache (plist-get org-roam-cache :forward))
(backward-cache (plist-get org-roam-cache :backward))) (backward-cache (plist-get org-roam-cache :backward))
;; Setup 1: Remove all existing links for file (titles-cache (plist-get org-roam-cache :titles)))
;; Step 1: Remove all existing links for file
(when-let ((forward-links (gethash file forward-cache))) (when-let ((forward-links (gethash file forward-cache)))
;; Delete backlinks to file ;; Delete backlinks to file
(dolist (link forward-links) (dolist (link forward-links)
@@ -296,12 +322,28 @@ This is equivalent to removing the node from the graph."
(puthash link backward-links backward-cache))) (puthash link backward-links backward-cache)))
;; Clean out forward links ;; Clean out forward links
(remhash file forward-cache)) (remhash file forward-cache))
(setq org-roam-cache (list :forward forward-cache :backward backward-cache))))) ;; Step 2: Remove from the title cache
(remhash file titles-cache)
(setq org-roam-cache (list :forward forward-cache
:backward backward-cache
:titles titles-cache)))))
(defun org-roam--update-cache-title (buffer)
"Inserts the `TITLE' of file in buffer into the cache."
(when-let ((titles-cache (plist-get org-roam-cache :titles))
(title (org-roam--extract-title buffer)))
(puthash (file-truename (buffer-file-name buffer))
title
titles-cache)
(setq org-roam-cache (plist-put org-roam-cache :titles titles-cache))))
(defun org-roam--update-cache () (defun org-roam--update-cache ()
"Update `org-roam-cache' for the current buffer file." "Update `org-roam-cache' for the current buffer file."
(save-excursion (save-excursion
(org-roam--clear-cache-for-buffer (current-buffer)) (org-roam--clear-cache-for-buffer (current-buffer))
;; Insert into title cache
(org-roam--update-cache-title (current-buffer))
;; Insert new items
(let ((items (org-roam--parse-content))) (let ((items (org-roam--parse-content)))
(dolist (item items) (dolist (item items)
(org-roam--insert-item item))))) (org-roam--insert-item item)))))