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

A few improvements

Browse source
This commit is contained in:
Adam Porter 2018-01-03 06:58:49 -06:00
parent 9c3b78d6c4
commit 0abe04b916
1 changed files with 18 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

27
org-agenda-ng.el
View file

@ -1,3 +1,6 @@
;; -*- lexical-binding: t; -*-
;;; Commentary: ;;; Commentary:
;; This is just a proof-of-concept for how the agenda code might be ;; This is just a proof-of-concept for how the agenda code might be
@ -118,7 +121,7 @@
;;;; Commands ;;;; Commands
(cl-defun org-agenda-ng--agenda (&key files all any none) (cl-defun org-agenda-ng--agenda (&key files all any none pred)
(unless files (unless files
(setq files (buffer-file-name (current-buffer)))) (setq files (buffer-file-name (current-buffer))))
(unless (listp files) (unless (listp files)
@ -132,7 +135,7 @@
;; position instead of returning a list of ;; position instead of returning a list of
;; positions and then having to go back ;; positions and then having to go back
;; and get the entries at each position. ;; and get the entries at each position.
(let* ((positions (org-agenda-ng--filter-buffer :all all :any any :none none)) (let* ((positions (org-agenda-ng--filter-buffer :all all :any any :none none :pred pred))
(elements (--map (org-with-point-at it (elements (--map (org-with-point-at it
(org-element-headline-parser (org-element-headline-parser
;; FIXME: This is a hack ;; FIXME: This is a hack
@ -194,12 +197,20 @@
;; collect (point) ;; collect (point)
;; while (outline-next-heading))))) ;; while (outline-next-heading)))))
(cl-defun org-agenda-ng--filter-buffer (&key all any none) (cl-defun org-agenda-ng--filter-buffer (&key all any none pred)
"Return positions of matching headings in current buffer. "Return positions of matching headings in current buffer.
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." NONE-PREDS."
;; NOTE: Build lambda so typecase doesn't run for every item ;; NOTE: Build lambda so typecase doesn't run for every item
(let ((pred (org-agenda-ng--test-lambda :all all :any any :none none))) (let* ((our-lambda (when (or all any none)
(org-agenda-ng--test-lambda :all all :any any :none none)))
(pred (cond ((and our-lambda pred)
(lambda ()
(and (funcall our-lambda)
(funcall pred))))
(our-lambda our-lambda)
(pred pred)
(t (user-error "No tests given")))))
(org-with-wide-buffer (org-with-wide-buffer
(goto-char (point-min)) (goto-char (point-min))
(when (org-before-first-heading-p) (when (org-before-first-heading-p)
@ -332,16 +343,14 @@ Its property list should be the second item in the list, as returned by `org-ele
;;;; Predicates ;;;; Predicates
(defun org-agenda-ng--todo-p (keywords &rest more) (defun org-agenda-ng--todo-p (&rest keywords)
"Return non-nil if current heading is a TODO item. "Return non-nil if current heading is a TODO item.
With KEYWORDS, return non-nil if its keyword is one of KEYWORDS." With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
(when more
(cons more keywords))
(when-let ((state (org-get-todo-state))) (when-let ((state (org-get-todo-state)))
(pcase keywords (pcase keywords
('nil t) ('nil t)
((pred stringp) ;; ((pred stringp)
(string= state keywords)) ;; (string= state keywords))
((pred listp) ((pred listp)
(member state keywords)) (member state keywords))
((pred symbolp) ((pred symbolp)