wilderjds
/
org-roam
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #47 from jethrokuan/feat/async-cache

Browse Source 
Move all expensive build-cache computation to async-process
master
Jethro Kuan 6 years ago committed by GitHub
parent 6f1938e1ac 64693f572d
commit 152c3cecdc
1 changed files with 87 additions and 70 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 157
      org-roam.el

157
org-roam.el
Unescape View File

@ -234,86 +234,103 @@ If `ABSOLUTE', return the absolute file-path. Else, return the relative file-pat
(defun org-roam--build-cache-async ()
"Builds the cache asychronously, saving it into `org-roam-cache'."
(interactive)
(setq org-roam-files (org-roam--find-all-files))
(async-start
`(lambda ()
(require 'org)
(require 'org-element)
(require 'subr-x) ; temp-fix
(require 'cl-lib)
,(async-inject-variables "org-roam-files")
,(async-inject-variables "org-roam-directory")
(let ((backward-links (make-hash-table :test #'equal))
(forward-links (make-hash-table :test #'equal))
(file-titles (make-hash-table :test #'equal)))
(cl-flet* ((org-roam--parse-content
(file)
(with-temp-buffer
(insert-file-contents file)
(with-current-buffer (current-buffer)
(org-element-map (org-element-parse-buffer) 'link
(lambda (link)
(let ((type (org-element-property :type link))
(path (org-element-property :path link))
(start (org-element-property :begin link)))
(when (and (string= type "file")
(string= (file-name-extension path) "org"))
(goto-char start)
(let* ((element (org-element-at-point))
(content (or (org-element-property :raw-value element)
(buffer-substring
(or (org-element-property :content-begin element)
(org-element-property :begin element))
(or (org-element-property :content-end element)
(org-element-property :end element))))))
(list :from file
:to (file-truename (expand-file-name path org-roam-directory))
:content (string-trim content))))))))))
(org-roam--process-items
(items)
(mapcar
(lambda (item)
(pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item))
;; Build forward-links
(let ((links (gethash p-from forward-links)))
(if links
(puthash p-from
(if (member p-to links)
links
(cons p-to links)) forward-links)
(puthash p-from (list p-to) forward-links)))
;; Build backward-links
(let ((contents-hash (gethash p-to backward-links)))
(if contents-hash
(if-let ((contents-list (gethash p-from contents-hash)))
(let ((updated (cons content contents-list)))
(puthash p-from updated contents-hash)
(puthash p-to contents-hash backward-links))
(progn
(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--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))
(cl-labels ((org-roam--find-files
(dir)
(if (file-exists-p dir)
(let ((files (directory-files dir t "." t))
(dir-ignore-regexp (concat "\\(?:"
"\\."
"\\|\\.\\."
"\\)$"))
result)
(dolist (file files)
(cond
((file-directory-p file)
(when (not (string-match dir-ignore-regexp file))
(setq result (append (org-roam--find-files file) result))))
((and (file-readable-p file)
(string= (file-name-extension file) "org"))
(setq result (cons (file-truename file) result)))))
result)))
(org-roam--parse-content
(file)
(with-temp-buffer
(insert-file-contents file)
(with-current-buffer (current-buffer)
(org-element-map (org-element-parse-buffer) 'link
(lambda (link)
(let ((type (org-element-property :type link))
(path (org-element-property :path link))
(start (org-element-property :begin link)))
(when (and (string= type "file")
(string= (file-name-extension path) "org"))
(goto-char start)
(let* ((element (org-element-at-point))
(content (or (org-element-property :raw-value element)
(buffer-substring
(or (org-element-property :content-begin element)
(org-element-property :begin element))
(or (org-element-property :content-end element)
(org-element-property :end element))))))
(list :from file
:to (file-truename (expand-file-name path org-roam-directory))
:content (string-trim content))))))))))
(org-roam--process-items
(items)
(mapcar
(lambda (item)
(pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item))
;; Build forward-links
(let ((links (gethash p-from forward-links)))
(if links
(puthash p-from
(if (member p-to links)
links
(cons p-to links)) forward-links)
(puthash p-from (list p-to) forward-links)))
;; Build backward-links
(let ((contents-hash (gethash p-to backward-links)))
(if contents-hash
(if-let ((contents-list (gethash p-from contents-hash)))
(let ((updated (cons content contents-list)))
(puthash p-from updated contents-hash)
(puthash p-to contents-hash backward-links))
(progn
(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))))
(let ((org-roam-files (org-roam--find-files org-roam-directory)))
(mapcar #'org-roam--process-items
(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
:forward forward-links
:backward backward-links

Write Preview
Loading…
Cancel
Save