mirror of
https://github.com/SqrtMinusOne/org-clock-agg.git
synced 2025-12-10 14:03:02 +03:00
org-clock-agg: basic ui with widget.el
This commit is contained in:
parent
05b5512f31
commit
baa3672af6
1 changed files with 175 additions and 29 deletions
204
org-clock-agg.el
204
org-clock-agg.el
|
|
@ -28,6 +28,7 @@
|
|||
;; TODO
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'font-lock)
|
||||
(require 'outline)
|
||||
(require 'org)
|
||||
|
|
@ -41,6 +42,17 @@
|
|||
"Aggregate org-clock statistics."
|
||||
:group 'org-clock)
|
||||
|
||||
(defcustom org-clock-agg-duration-format "%h:%.2m"
|
||||
"Format string for durations in org-clock-agg views.
|
||||
|
||||
See `format-seconds' for the list of available format specifiers."
|
||||
:type 'string
|
||||
:group 'org-clock-agg)
|
||||
|
||||
(defcustom org-clock-agg-files-preset nil
|
||||
"Presets for the \"files\" parameter in org-clock-agg views."
|
||||
:type '(alist :key-type string :value-type (repeat string)))
|
||||
|
||||
(defface org-clock-agg-group-face
|
||||
'((t :inherit font-lock-comment-face))
|
||||
"Face for group names in org-clock-agg tree views."
|
||||
|
|
@ -51,15 +63,14 @@
|
|||
"Face for durations in org-clock-agg tree views."
|
||||
:group 'org-clock-agg)
|
||||
|
||||
(defcustom org-clock-agg-duration-format "%h:%.2m"
|
||||
"Format string for durations in org-clock-agg views.
|
||||
|
||||
See `format-seconds' for the list of available format specifiers."
|
||||
:type 'string
|
||||
(defface org-clock-agg-param-face
|
||||
'((t :inherit font-lock-variable-name-face))
|
||||
"Face for parameters in org-clock-agg tree views."
|
||||
:group 'org-clock-agg)
|
||||
|
||||
;; Reset org-ql cache
|
||||
(setq org-ql-cache (make-hash-table :weakness 'key))
|
||||
(setq org-clock-agg-groupby nil)
|
||||
|
||||
;;; Querying
|
||||
(defun org-clock-agg--parse-clocks (headline)
|
||||
|
|
@ -119,6 +130,17 @@ See `format-seconds' for the list of available format specifiers."
|
|||
(defvar org-clock-agg-groupby nil
|
||||
"Group by functions.")
|
||||
|
||||
(defmacro org-clock-agg--extract-params (body &rest params)
|
||||
`(while-let ((symbol (and
|
||||
(member (car-safe body) ',params)
|
||||
(car-safe body))))
|
||||
,@(mapcar
|
||||
(lambda (param)
|
||||
`(when (eq symbol ,param)
|
||||
(setq ,(intern (substring (symbol-name param) 1)) (cadr body))))
|
||||
params)
|
||||
(setq body (cddr body))))
|
||||
|
||||
(cl-defmacro org-clock-agg-defgroupby (name doc &body body)
|
||||
(declare (indent defun)
|
||||
(doc-string 2))
|
||||
|
|
@ -126,18 +148,13 @@ See `format-seconds' for the list of available format specifiers."
|
|||
readable-name
|
||||
hidden)
|
||||
;; Parse keyword arguments in BODY
|
||||
(while-let ((symbol (and
|
||||
(member (car-safe body) '(:hidden :readable-name))
|
||||
(car-safe body))))
|
||||
(when (eq :hidden symbol) (setq hidden (cadr body)))
|
||||
(when (eq :readable-name symbol) (setq readable-name (cadr body)))
|
||||
(setq body (cddr body)))
|
||||
(org-clock-agg--extract-params body :readable-name :hidden)
|
||||
(unless readable-name
|
||||
(setq readable-name (symbol-name name)))
|
||||
`(progn
|
||||
(defun ,func-name (elem)
|
||||
,doc
|
||||
,@body)
|
||||
(unless readable-name
|
||||
(setq readable-name (symbol-name name)))
|
||||
(push (cons ',name '((:function . ,func-name)
|
||||
(:hidden . ,hidden)
|
||||
(:readable-name . ,readable-name)))
|
||||
|
|
@ -145,22 +162,26 @@ See `format-seconds' for the list of available format specifiers."
|
|||
|
||||
(org-clock-agg-defgroupby category
|
||||
"Group org-clock entries by category."
|
||||
:readable-name "Category"
|
||||
(list (alist-get :category elem)))
|
||||
|
||||
(org-clock-agg-defgroupby org-file
|
||||
"Group org-clock entries by file in `org-directory'."
|
||||
:readable-name "Org file"
|
||||
(list
|
||||
(file-relative-name (alist-get :file elem)
|
||||
(directory-file-name org-directory))))
|
||||
|
||||
(org-clock-agg-defgroupby outline-path
|
||||
"Group org-clock entries by outline path."
|
||||
:readable-name "Outline path"
|
||||
(alist-get :outline-path elem))
|
||||
|
||||
(org-clock-agg-defgroupby root--group
|
||||
(org-clock-agg-defgroupby root-group
|
||||
"Return \"Root\". Used for the root group."
|
||||
:readable-name "Root"
|
||||
:hidden t
|
||||
(list "Root"))
|
||||
(list "Results"))
|
||||
|
||||
(defun org-clock-agg--groupby-apply (alist groups elem)
|
||||
(let* ((key (caar groups))
|
||||
|
|
@ -182,7 +203,7 @@ See `format-seconds' for the list of available format specifiers."
|
|||
(defun org-clock-agg--groupby (elems groupby-list)
|
||||
(let (res)
|
||||
(dolist (elem elems)
|
||||
(let* ((group-symbols (cons 'root--group groupby-list))
|
||||
(let* ((group-symbols (cons 'root-group groupby-list))
|
||||
(groups
|
||||
(cl-loop for group-symbol in group-symbols
|
||||
for groupby = (alist-get group-symbol org-clock-agg-groupby)
|
||||
|
|
@ -195,7 +216,7 @@ See `format-seconds' for the list of available format specifiers."
|
|||
(setq res (org-clock-agg--groupby-apply res groups elem))))
|
||||
res))
|
||||
|
||||
(defun org-clock-agg--groupby-sort (tree)
|
||||
(defun org-clock-agg--groupby-sort (tree sort)
|
||||
(setq tree (seq-sort-by (lambda (elem)
|
||||
(alist-get :total elem))
|
||||
#'> tree))
|
||||
|
|
@ -203,10 +224,13 @@ See `format-seconds' for the list of available format specifiers."
|
|||
(let ((children (alist-get :children elem)))
|
||||
(when children
|
||||
(setf (alist-get :children elem)
|
||||
(org-clock-agg--groupby-sort children)))))
|
||||
(org-clock-agg--groupby-sort children sort)))))
|
||||
tree)
|
||||
|
||||
;; View results
|
||||
;; View & manage results
|
||||
(defvar-local org-clock-agg--params nil
|
||||
"Parameters for the current org-clock-agg buffer.")
|
||||
|
||||
(defun org-clock-agg-quit ()
|
||||
(interactive)
|
||||
(quit-window t))
|
||||
|
|
@ -214,25 +238,115 @@ See `format-seconds' for the list of available format specifiers."
|
|||
(defvar org-clock-agg-tree-mode-map
|
||||
(let ((keymap (make-sparse-keymap)))
|
||||
(define-key keymap (kbd "q") #'org-clock-agg-quit)
|
||||
(define-key keymap (kbd "r") #'org-clock-agg-refresh)
|
||||
(define-key keymap (kbd "<tab>") #'outline-toggle-children)
|
||||
(when (fboundp 'evil-define-key*)
|
||||
(evil-define-key* 'normal keymap
|
||||
"q" #'org-clock-agg-quit
|
||||
"<tab>" #'outline-toggle-children))
|
||||
"gr" #'org-clock-agg-refresh
|
||||
(kbd "<tab>") #'outline-toggle-children))
|
||||
keymap))
|
||||
|
||||
(define-derived-mode org-clock-agg-tree-mode special-mode "Org Clock Agg Tree"
|
||||
(define-derived-mode org-clock-agg-tree-mode fundamental-mode "Org Clock Agg Tree"
|
||||
"Major mode for viewing org-clock-agg results."
|
||||
(outline-minor-mode 1))
|
||||
|
||||
(defun org-clock-agg--render-controls ()
|
||||
(remove-overlays)
|
||||
(insert (propertize "* Parameters" 'face 'org-level-1) "\n")
|
||||
(apply
|
||||
#'widget-create 'menu-choice
|
||||
:tag "Files"
|
||||
:value (alist-get :files org-clock-agg--params)
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(setf (alist-get :files org-clock-agg--params)
|
||||
(widget-value widget)))
|
||||
'(item :tag "Org Agenda" :value org-agenda)
|
||||
(append
|
||||
(mapcar
|
||||
(lambda (item)
|
||||
`(item :tag ,(car item) :value ,(cdr item)))
|
||||
org-clock-agg-files-preset)
|
||||
'((editable-list :tag "File"
|
||||
:entry-format "%i %d %v"
|
||||
:menu-tag "Custom list"
|
||||
:value nil
|
||||
(editable-field :tag "File" :value "")))))
|
||||
(insert "\n")
|
||||
|
||||
(widget-create 'editable-field
|
||||
:size 20
|
||||
:format (concat (propertize "Date from: " 'face 'widget-button) "%v ")
|
||||
:value (let ((val (alist-get :from org-clock-agg--params)))
|
||||
(if (numberp val)
|
||||
(number-to-string val)
|
||||
val))
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(let ((val (widget-value widget)))
|
||||
(when (string-match-p (rx bos (? "-") (+ digit) eos) val)
|
||||
(setq val (string-to-number val)))
|
||||
(setf (alist-get :from org-clock-agg--params) val))))
|
||||
(widget-create 'editable-field
|
||||
:size 20
|
||||
:format (concat (propertize "To: " 'face 'widget-button)
|
||||
"%v ")
|
||||
:value (let ((val (alist-get :to org-clock-agg--params)))
|
||||
(if (numberp val)
|
||||
(number-to-string val)
|
||||
val))
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(let ((val (widget-value widget)))
|
||||
(when (string-match-p (rx bos (? "-") (+ digit) eos) val)
|
||||
(setq val (string-to-number val)))
|
||||
(setf (alist-get :to org-clock-agg--params) val))))
|
||||
(insert "\n\n")
|
||||
|
||||
(insert (propertize "Group by: " 'face 'widget-button) "\n")
|
||||
(widget-create 'editable-list
|
||||
:tag "Group by"
|
||||
:entry-format "%i %d %v"
|
||||
:value (alist-get :groupby org-clock-agg--params)
|
||||
:notify
|
||||
(lambda (widget &rest ignore)
|
||||
(setf (alist-get :groupby org-clock-agg--params)
|
||||
(widget-value widget)))
|
||||
`(menu-choice
|
||||
:tag "Group"
|
||||
,@(thread-last
|
||||
org-clock-agg-groupby
|
||||
(seq-filter (lambda (groupby)
|
||||
(not (alist-get :hidden (cdr groupby)))))
|
||||
(mapcar (lambda (groupby)
|
||||
(let ((name (car groupby))
|
||||
(readable-name (alist-get :readable-name (cdr groupby))))
|
||||
`(item :tag ,readable-name
|
||||
:value ,name
|
||||
:menu-tag ,readable-name)))))))
|
||||
(insert "\n")
|
||||
(widget-create 'push-button
|
||||
:notify (lambda (&rest ignore)
|
||||
(org-clock-agg-refresh))
|
||||
"Refresh")
|
||||
(insert "\n\n")
|
||||
(widget-setup))
|
||||
|
||||
(defun org-clock-agg--trim-string (string max-len)
|
||||
(let ((len (length string)))
|
||||
(if (> len max-len)
|
||||
(concat (substring string 0 (- max-len 3)) "...")
|
||||
string)))
|
||||
|
||||
(defun org-clock-agg--render-tree-elem (elem &optional level)
|
||||
(unless level
|
||||
(setq level 1))
|
||||
(let ((level-face (nth (mod (1- level) 8) org-level-faces))
|
||||
(level-string (make-string level ?*)))
|
||||
(level-string (make-string level ?*))
|
||||
(title-width (- (window-width) 40)))
|
||||
(insert
|
||||
(format "%-50s %20s %8s"
|
||||
(propertize (concat level-string " " (car elem))
|
||||
(format (format "%%-%ds %%20s %%8s" title-width)
|
||||
(propertize (org-clock-agg--trim-string
|
||||
(concat level-string " " (car elem))
|
||||
title-width)
|
||||
'face level-face)
|
||||
(propertize
|
||||
(alist-get :readable-name (alist-get :groupby (cdr elem)))
|
||||
|
|
@ -247,14 +361,46 @@ See `format-seconds' for the list of available format specifiers."
|
|||
(org-clock-agg--render-tree-elem child (1+ level)))
|
||||
(alist-get :children (cdr elem))))
|
||||
|
||||
(defun org-clock-agg--render-tree (tree)
|
||||
(let ((buffer (generate-new-buffer "*org-clock-agg*")))
|
||||
(defun org-clock-agg--parse-files (files)
|
||||
(cond ((eq files 'org-agenda)
|
||||
(org-agenda-files))
|
||||
((member files (mapcar #'car org-clock-agg-files-preset))
|
||||
(alist-get files org-clock-agg-files-preset nil nil #'equal))
|
||||
(t files)))
|
||||
|
||||
(defun org-clock-agg-refresh ()
|
||||
(interactive)
|
||||
(cl-destructuring-bind (&key from to files groupby sort)
|
||||
(cl--alist-to-plist org-clock-agg--params)
|
||||
(let* ((files (org-clock-agg--parse-files files))
|
||||
(elems (org-clock-agg--query from to files))
|
||||
(tree (org-clock-agg--groupby elems groupby))
|
||||
(tree (org-clock-agg--groupby-sort tree sort)))
|
||||
(save-excursion
|
||||
(let ((inhibit-read-only t))
|
||||
(goto-char (point-min))
|
||||
(search-forward (format "* Results") nil 'noerror)
|
||||
(beginning-of-line)
|
||||
(delete-region (point) (point-max))
|
||||
(mapc #'org-clock-agg--render-tree-elem tree))))))
|
||||
|
||||
(defun org-clock-agg (from to files groupby sort)
|
||||
(interactive (list -7 0 'org-agenda nil nil))
|
||||
(let* ((buffer (generate-new-buffer "*org-clock-agg*")))
|
||||
(switch-to-buffer-other-window buffer)
|
||||
|
||||
(with-current-buffer buffer
|
||||
(org-clock-agg-tree-mode)
|
||||
(setq-local org-clock-agg--params
|
||||
`((:from . ,from)
|
||||
(:to . ,to)
|
||||
(:files . ,files)
|
||||
(:groupby . ,groupby)
|
||||
(:sort . ,sort)))
|
||||
(let ((inhibit-read-only t))
|
||||
(mapc #'org-clock-agg--render-tree-elem tree))
|
||||
(goto-char (point-min)))
|
||||
(switch-to-buffer buffer)))
|
||||
(org-clock-agg--render-controls)
|
||||
(org-clock-agg-refresh))
|
||||
(goto-char (point-min)))))
|
||||
|
||||
(provide 'org-clock-agg)
|
||||
;;; org-clock-agg.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue