jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add: Caching

Browse source 
Seems to work well so far.  Hopefully no bugs will be found (ha,
ha)...

Fixes #6.  Thanks to @yantar92 for suggesting!
<https://www.reddit.com/r/emacs/comments/990swh/querying_org_files_for_due_items_and_showing/e4kduul/>
This commit is contained in:
Adam Porter 2018-08-22 13:35:17 -05:00
parent cdbe750b7c
commit a2d8ed2eeb
1 changed files with 34 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

35
org-ql.el
View file

@ -15,6 +15,13 @@
(defvar org-ql--today nil) (defvar org-ql--today nil)
(defvar org-ql-cache (make-hash-table :weakness 'key)
;; IIUC, setting weakness to `key' means that, when a buffer is closed, its entries will be
;; removed from this table at the next GC.
"Query cache, keyed by buffer. Each value is a list of the
buffer's modified tick and another hash table, keyed by arguments
passed to `org-ql--select-cached'.")
;;;; Macros ;;;; Macros
(cl-defmacro org-ql (buffers-or-files pred-body &key sort narrow markers (cl-defmacro org-ql (buffers-or-files pred-body &key sort narrow markers
@ -110,7 +117,7 @@ a list of defined `org-ql' sorting methods: `date', `deadline',
(user-error "Can't open file: %s" it))))) (user-error "Can't open file: %s" it)))))
;; Filter buffers (i.e. select items) ;; Filter buffers (i.e. select items)
(--map (with-current-buffer it (--map (with-current-buffer it
(org-ql--select :predicate predicate :action action :narrow narrow))) (org-ql--select-cached :predicate predicate :action action :narrow narrow)))
;; Flatten items ;; Flatten items
(-flatten-n 1)))) (-flatten-n 1))))
;; Sort items ;; Sort items
@ -124,6 +131,32 @@ a list of defined `org-ql' sorting methods: `date', `deadline',
(org-ql--sort-by items sort)) (org-ql--sort-by items sort))
(_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)"))))) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)")))))
(define-hash-table-test 'org-ql-hash-test #'equal (lambda (args)
(sxhash-equal (prin1-to-string args))))
(defun org-ql--select-cached (&rest args)
"Return results for ARGS and current buffer using cache."
;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a
;; buffer is closed, or when a query is run after modifying a buffer.
(if-let* ((buffer-cache (gethash (current-buffer) org-ql-cache))
(query-cache (cadr buffer-cache))
(modified-tick (car buffer-cache))
(buffer-unmodified-p (eq (buffer-modified-tick) modified-tick))
(cached-result (gethash args query-cache)))
(pcase cached-result
('org-ql-nil nil)
(_ cached-result))
(let ((new-result (apply #'org-ql--select args)))
(cond ((or (not query-cache)
(not buffer-unmodified-p))
(puthash (current-buffer)
(list (buffer-modified-tick)
(aprog1 (make-hash-table :test 'org-ql-hash-test)
(puthash args (or new-result 'org-ql-nil) it)))
org-ql-cache))
(t (puthash args (or new-result 'org-ql-nil) query-cache)))
new-result)))
(cl-defun org-ql--select (&key predicate action narrow) (cl-defun org-ql--select (&key predicate action narrow)
"Return results of mapping function ACTION across entries in current buffer matching function PREDICATE. "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE.
If NARROW is non-nil, buffer will not be widened." If NARROW is non-nil, buffer will not be widened."