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

Move all expensive build-cache computation to async-process

Browse Source
master
Jethro Kuan 6 years ago
parent a0c5e2c05a
commit 64693f572d
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

@ -214,86 +214,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