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

Change: Minor refactoring

Browse source
This commit is contained in:
Adam Porter 2018-08-20 06:42:19 -05:00
parent 14351e617d
commit 88cf7f395e
1 changed files with 37 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

56
org-ql.el
View file

@ -44,14 +44,7 @@ buffer."
org-agenda-ng--add-markers org-agenda-ng--add-markers
,action-fn))))))) ,action-fn)))))))
`(org-ql--query ,buffers-or-files `(org-ql--query ,buffers-or-files
(byte-compile (lambda () ',pred-body
(cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
(= #'=)
(< #'<)
(> #'>)
(<= #'<=)
(>= #'>=))
,pred-body)))
:action-fn ,action-fn :action-fn ,action-fn
:narrow ,narrow :narrow ,narrow
:sort ',sort)) :sort ',sort))
@ -65,27 +58,45 @@ buffer."
;;;; Functions ;;;; Functions
(cl-defun org-ql--query (buffers-or-files pred &key (action-fn #'identity) narrow sort) (cl-defun org-ql--query (buffers-or-files pred-body &key (action-fn #'identity) narrow sort)
"FIXME: Add docstring." "FIXME: Add docstring."
;; MAYBE: Set :narrow t for buffers and nil for files. ;; MAYBE: Set :narrow t for buffers and nil for files.
(declare (indent defun)) (declare (indent defun))
(let* ((buffers-or-files (cl-typecase buffers-or-files (let* ((sources (pcase buffers-or-files
(null (list (current-buffer))) (`nil (list (current-buffer)))
(buffer (list buffers-or-files)) ((pred listp) buffers-or-files)
(list buffers-or-files) (_ ; Buffer or string
(string (list buffers-or-files)))) (list buffers-or-files))))
(predicate (byte-compile `(lambda ()
(cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
(= #'=)
(< #'<)
(> #'>)
(<= #'<=)
(>= #'>=))
,pred-body))))
;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature.
;; (org-use-tag-inheritance t) ;; (org-use-tag-inheritance t)
;; (org-trust-scanner-tags t) ;; (org-trust-scanner-tags t)
(org-ql--today (org-today)) (org-ql--today (org-today))
(items (-flatten-n 1 (--map (with-current-buffer (cl-typecase it (items (->> sources
;; List buffers
(--map (cl-etypecase it
(buffer it) (buffer it)
(string (or (find-buffer-visiting it) (string (or (find-buffer-visiting it)
(find-file-noselect it) (when (file-readable-p it)
(user-error "Can't open file: %s" it)))) ;; It feels unintuitive that `find-file-noselect' returns
;; a buffer if the filename doesn't exist.
(find-file-noselect it))
(user-error "Can't open file: %s" it)))))
;; Filter buffers (i.e. select items)
(--map (with-current-buffer it
;; action-fn must be called inside the source buffer.
(mapcar action-fn (mapcar action-fn
(org-ql--filter-buffer :pred pred :narrow narrow))) (org-ql--select :predicate predicate :narrow narrow))))
buffers-or-files)))) ;; Flatten items
(-flatten-n 1))))
;; Sort items
(pcase sort (pcase sort
(`nil items) (`nil items)
(`(function ,_) (`(function ,_)
@ -116,8 +127,9 @@ Or, when possible, fix the problem."
(org-ql--sanity-check-form (cdr elem))) (org-ql--sanity-check-form (cdr elem)))
else do (check elem)))) else do (check elem))))
(cl-defun org-ql--filter-buffer (&key pred narrow) (cl-defun org-ql--select (&key predicate narrow)
"Return positions of matching headings in current buffer. ;; FIXME: Docstring
"Return positions of entries in current buffer matching PREDICATE.
Headings should return non-nil for any ANY-PREDS and nil for all Headings should return non-nil for any ANY-PREDS and nil for all
NONE-PREDS. If NARROW is non-nil, buffer will not be widened NONE-PREDS. If NARROW is non-nil, buffer will not be widened
first." first."
@ -143,7 +155,7 @@ first."
(goto-char (point-min)) (goto-char (point-min))
(when (org-before-first-heading-p) (when (org-before-first-heading-p)
(outline-next-heading)) (outline-next-heading))
(cl-loop when (funcall pred) (cl-loop when (funcall predicate)
collect (org-element-headline-parser (line-end-position)) collect (org-element-headline-parser (line-end-position))
while (outline-next-heading)))))) while (outline-next-heading))))))