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

SIGNIFICANT speedup of org-ql-select (requires customization!)

Browse source 
With this change, and customizing org-ql-open-buffers to it's
non-default value will give HUGE performance improvements to org-ql
queries when files are queried that aren't already loaded into
buffers.

This change does not modify any defaults and org-ql will work just as
before (and as slow) until org-ql-open-buffers is modified by the
user.  This is due to backwards compatability.

* org-ql.el (org-ql-select): Don't always read files into buffers,
  depending on user customization.
  (org-ql--prepair-work-buffer, org-ql--work-buffer)
  (org-ql--init-work-buffer): Helper functions to work with new
  hidden work-buffer.
  (org-ql--work-buffer-name): New variable for name of work-buffer.
  (org-ql-open-buffers): User customization to choose whether org-ql
  should open all files in separate buffers or not.
This commit is contained in:
Gustav Wikström 2021-03-13 20:49:08 +01:00
parent 208e103ecc
commit 9a2a694843
1 changed files with 65 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

90
org-ql.el
View file

@ -96,6 +96,8 @@ but the match groups were changed, so they are not compatible.")
(defvar org-ql--today nil) (defvar org-ql--today nil)
(defvar org-ql--work-buffer-name " *org-ql-work*")
(defvar org-ql-use-preamble t (defvar org-ql-use-preamble t
;; MAYBE: Naming things is hard. There must be a better term than "preamble." ;; MAYBE: Naming things is hard. There must be a better term than "preamble."
"Use query preambles to speed up searches. "Use query preambles to speed up searches.
@ -157,6 +159,17 @@ See Info node `(org-ql)Queries'."
:type 'boolean :type 'boolean
:risky t) :risky t)
(defcustom org-ql-open-buffers t
"Choose whether org-ql shall open all files to be queried in separate buffers.
Opening files in their own separate buffer will significantly
lower performance. It will also leave the buffers open after the
query has executed. It will, however, allow for actions on the
files that mutate them or checkes file metadata, something that
otherwise is not possible since the file will be loaded into a
separate work-buffer, see `org-ql-work-buffer-name'."
:type 'boolean)
;;;; Macros ;;;; Macros
;;;###autoload ;;;###autoload
@ -210,25 +223,31 @@ SORT is either nil, in which case items are not sorted; or one or
a list of defined `org-ql' sorting methods (`date', `deadline', a list of defined `org-ql' sorting methods (`date', `deadline',
`scheduled', `todo', `priority', or `random'); or a user-defined `scheduled', `todo', `priority', or `random'); or a user-defined
comparator function that accepts two items as arguments and comparator function that accepts two items as arguments and
returns nil or non-nil." returns nil or non-nil.
Uses `org-ql-open-buffers to determine if all files that aren't
yet loaded into a buffer should be loaded or not. Choosing to not
load buffers will give a significant improvement to performance when
multiple files are queried."
(declare (indent defun)) (declare (indent defun))
(-let* ((buffers (->> (cl-typecase buffers-or-files (-let* ((buffers-or-files (->> (cl-typecase buffers-or-files
(null (list (current-buffer))) (null (list (current-buffer)))
(function (funcall buffers-or-files)) (function (funcall buffers-or-files))
(list buffers-or-files) (list buffers-or-files)
(otherwise (list buffers-or-files))) (otherwise (list buffers-or-files)))
(--map (cl-etypecase it (--map (cl-etypecase it
;; NOTE: This etypecase is essential to opening links safely, ;; NOTE: This etypecase is essential to opening links safely,
;; as it rejects, e.g. lambdas in the buffers-files argument. ;; as it rejects, e.g. lambdas in the buffers-files argument.
(buffer it) (buffer it)
(string (or (find-buffer-visiting it) (string (or (find-buffer-visiting it)
(when (file-readable-p it) (when (file-readable-p it)
;; It feels unintuitive that `find-file-noselect' returns (if org-ql-open-buffers
;; a buffer if the filename doesn't exist. (find-file-noselect it)
(find-file-noselect it)) it))
(user-error "Can't open file: %s" it))))) (user-error "Can't open file: %s" it)))))
;; Ignore special/hidden buffers. ;; Ignore special/hidden buffers.
(--remove (string-prefix-p " " (buffer-name it))))) (--remove (when (bufferp it)
(string-prefix-p " " (buffer-name it))))))
(query (org-ql--normalize-query query)) (query (org-ql--normalize-query query))
((&plist :query :preamble :preamble-case-fold) (org-ql--query-preamble query)) ((&plist :query :preamble :preamble-case-fold) (org-ql--query-preamble query))
(predicate (org-ql--query-predicate query)) (predicate (org-ql--query-predicate query))
@ -263,13 +282,15 @@ returns nil or non-nil."
;; Temporarily set new function definition. ;; Temporarily set new function definition.
(fset name fn))) (fset name fn)))
;; Run query on buffers. ;; Run query on buffers.
(->> buffers (->> buffers-or-files
(--map (with-current-buffer it (--map (with-current-buffer (if (bufferp it)
(unless (derived-mode-p 'org-mode) it
(user-error "Not an Org buffer: %s" (buffer-name))) (org-ql--prepair-work-buffer it))
(org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold (unless (derived-mode-p 'org-mode)
:predicate predicate :action action :narrow narrow))) (user-error "Not an Org buffer: %s" (buffer-name)))
(-flatten-n 1))) (org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold
:predicate predicate :action action :narrow narrow)))
(-flatten-n 1)))
(--each orig-fns (--each orig-fns
;; Restore original function mappings. ;; Restore original function mappings.
(-let (((&plist :name :fn) it)) (-let (((&plist :name :fn) it))
@ -537,6 +558,25 @@ returns nil."
query-string " Execute it? ")) query-string " Execute it? "))
(user-error "Query aborted by user"))))) (user-error "Query aborted by user")))))
(defun org-ql--init-work-buffer ()
"Initiate hidden buffer."
(let ((buf (get-buffer-create (format org-ql--work-buffer-name))))
(with-current-buffer buf
(delay-mode-hooks (org-mode)))
buf))
(defun org-ql--work-buffer ()
"Return the hidden buffer used for crawling operations."
(if-let ((buf (get-buffer org-ql--work-buffer-name)))
buf
(org-ql--init-work-buffer)))
(defun org-ql--prepair-work-buffer (file)
"Load file into the work buffer and return the buffer."
(with-current-buffer (org-ql--work-buffer)
(insert-file-contents file nil nil nil 'replace)
(current-buffer)))
;;;;; Query processing ;;;;; Query processing
;; Processing, compiling, etc. for queries. ;; Processing, compiling, etc. for queries.