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

WIP

Browse source
This commit is contained in:
Adam Porter 2019-09-07 17:43:25 -05:00
parent 0ff109ed10
commit d0705dce0b
2 changed files with 28 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

16
org-ql-view-section.el
View file

@ -33,6 +33,7 @@
;;;; Macros ;;;; Macros
(defmacro org-ql-defkeymap (name copy docstring &rest maps) (defmacro org-ql-defkeymap (name copy docstring &rest maps)
;; Copied from `defkeymap' in elexandria.el.
"Define a new keymap variable (using `defvar'). "Define a new keymap variable (using `defvar').
NAME is a symbol, which will be the new variable's symbol. COPY NAME is a symbol, which will be the new variable's symbol. COPY
@ -310,7 +311,7 @@ Does not include newline."
(otherwise 1))))) (otherwise 1)))))
(with-slots (header items) section (with-slots (header items) section
(concat (propertize (format "%s" (concat (propertize (format "%s"
(or header "Section")) (or header "None"))
'face 'magit-section-heading) 'face 'magit-section-heading)
" (" (number-to-string (num-items items)) ")")))) " (" (number-to-string (num-items items)) ")"))))
@ -318,23 +319,16 @@ Does not include newline."
"Insert ITEM into current buffer. "Insert ITEM into current buffer.
Does not insert newline." Does not insert newline."
(pcase-let* (((cl-struct org-ql-item todo priority heading tags) item) (pcase-let* (((cl-struct org-ql-item todo priority heading tags) item)
(todo (when todo
(propertize todo 'face (org-get-todo-face todo))))
(priority (when priority
(propertize (concat "[#" priority "]") 'face (org-get-priority-face priority))))
(tags (when tags
(propertize (s-join ":" tags) 'face 'org-tag-group)
))
(beg (point))) (beg (point)))
(insert org-ql-view-item-indent) (insert org-ql-view-item-indent)
(when todo (when todo
(insert todo " ")) (insert (propertize todo 'face (org-get-todo-face todo)) " "))
(when priority (when priority
(insert priority " ")) (insert (propertize (concat "[#" priority "]") 'face (org-get-priority-face priority)) " "))
(when heading (when heading
(insert heading " ")) (insert heading " "))
(when tags (when tags
(insert tags)) (insert (propertize (s-join ":" tags) 'face 'org-tag-group)))
(put-text-property beg (point) :org-ql-view-section item))) (put-text-property beg (point) :org-ql-view-section item)))
(cl-defmethod org-ql-view-insert ((item string)) (cl-defmethod org-ql-view-insert ((item string))

23
test-org-ql-view-section.el
View file

@ -107,6 +107,29 @@
(ts-format "%d %B" it))) (ts-format "%d %B" it)))
)) ))
(pop-to-buffer buffer))) (pop-to-buffer buffer)))
(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
(items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
'(todo)
:action #'org-ql-item-at)
(-sort (-on #'string< #'org-ql-item-priority))
(org-ql-view-sort-planning)))
(top-section (org-ql-view-section
:header "To-Do by Planning Date"
:items items))
(inhibit-read-only t))
(with-current-buffer buffer
(read-only-mode 1)
(erase-buffer)
(org-ql-view-insert top-section
:group-by (list (lambda (item)
(awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
(ts-format "%B %Y" it)))
(lambda (item)
(awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
(ts-format "%d %B" it)))
'org-ql-item-todo
))
(pop-to-buffer buffer)))
(let* ((buffer (get-buffer-create "test-org-ql-view-section")) (let* ((buffer (get-buffer-create "test-org-ql-view-section"))
(items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org" (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
'(todo) '(todo)