CLIM: Display durations
This commit is contained in:
contrapunctus
parent
e57f88a935
commit
5d93dd48bc
|
|
@ -400,7 +400,7 @@ Use =org-babel= (=org-babel-tangle= / =org-babel-tangle-file=), /not/ =literate-
|
|||
:xdg-config-home :xdg-data-home
|
||||
:strcat :split-string)
|
||||
(:import-from :local-time
|
||||
:parse-timestring :now :timestamp-to-unix :adjust-timestamp
|
||||
:parse-timestring :now :today :timestamp-to-unix :adjust-timestamp
|
||||
:timestamp< :format-timestring)
|
||||
(:export
|
||||
;; customizable variables
|
||||
|
|
@ -432,7 +432,7 @@ Use =org-babel= (=org-babel-tangle= / =org-babel-tangle-file=), /not/ =literate-
|
|||
:latest-record :task-records-for-date :latest-date-records
|
||||
;; helpers
|
||||
:make-hash-table-1 :split-plist :iso-to-date :plist-key-values
|
||||
:task-time-one-day
|
||||
:task-duration-one-day
|
||||
;; debugging
|
||||
:*debug-enable*
|
||||
:*debug-buffer*))
|
||||
|
|
@ -678,9 +678,10 @@ treated as though their time is 00:00:00."
|
|||
subset))
|
||||
#+END_SRC
|
||||
|
||||
*** task-time-one-day :reader:
|
||||
*** task-duration-one-day :reader:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun task-time-one-day (task &optional (date (today)) (backend (active-backend)))
|
||||
(defun task-duration-one-day (task &optional (date (timestamp-to-unix (today)))
|
||||
(backend (active-backend)))
|
||||
"Return total time spent on TASK today or on DATE.
|
||||
The return value is seconds, as an integer."
|
||||
(let ((task-intervals (task-records-for-date backend task date)))
|
||||
|
|
@ -696,7 +697,7 @@ The return value is seconds, as an integer."
|
|||
(defun active-time-on (&optional (date (date-ts)))
|
||||
"Return the total active time today, or on DATE.
|
||||
Return value is seconds as an integer."
|
||||
(->> (--map (task-time-one-day it date) (*task-list*))
|
||||
(->> (--map (task-duration-one-day it date) (*task-list*))
|
||||
(-reduce #'+)
|
||||
(truncate)))
|
||||
#+END_SRC
|
||||
|
|
@ -2574,6 +2575,8 @@ s-expressions in a text column.")
|
|||
(in-package :cl)
|
||||
(defpackage :chronometrist.clim
|
||||
(:use :clim :clim-lisp)
|
||||
(:import-from :local-time :now :today :timestamp-to-unix)
|
||||
(:import-from :chronometrist :task-list :task-duration-one-day)
|
||||
(:export :run-chronometrist))
|
||||
(in-package :chronometrist.clim)
|
||||
#+END_SRC
|
||||
|
|
@ -2595,27 +2598,55 @@ s-expressions in a text column.")
|
|||
#+END_SRC
|
||||
|
||||
**** *table-specification* :custom:variable:
|
||||
1. column name (unique symbol)
|
||||
2. column label (string)
|
||||
3. (optional) functions - called with row data as a list
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(defvar *table-specification*
|
||||
'((index "#")
|
||||
(task "Task")
|
||||
(duration "Time")
|
||||
(activity-indicator "Active")))
|
||||
`((index "#"
|
||||
,(lambda (index task date) index)
|
||||
,(lambda (index frame pane)
|
||||
(format t "~2@A" index)))
|
||||
(task "Task"
|
||||
,(lambda (index task date) task)
|
||||
,(lambda (task frame pane)
|
||||
(with-output-as-presentation (pane task 'task-name)
|
||||
(format t "~A" task))))
|
||||
(duration "Time"
|
||||
,(lambda (index task date)
|
||||
(task-duration-one-day task date))
|
||||
,(lambda (duration frame pane)
|
||||
(with-output-as-presentation (pane duration 'number)
|
||||
(format t "~A" duration))))
|
||||
;; (activity-indicator "Active")
|
||||
)
|
||||
"List of table column specifiers.
|
||||
Each specifier must be a list in the form...
|
||||
(NAME LABEL DATA-FN PRINT-FN)
|
||||
|
||||
...where -
|
||||
NAME is a symbol unique to this list
|
||||
|
||||
LABEL is a string to be displayed as the column header
|
||||
|
||||
DATA-FN is a function of three arguments - INDEX, TASK, and DATE.
|
||||
INDEX is a 1-indexed integer for the row.
|
||||
TASK is the name of the task in this row, as a string.
|
||||
DATE is the date, as integer seconds since the UNIX epoch.
|
||||
|
||||
PRINT-FN is a function accepting three arguments - DATA, FRAME, and PANE.
|
||||
DATA is the return value of DATA-FN.
|
||||
FRAME and PANE are the CLIM frame and pane as passed to the display function.")
|
||||
#+END_SRC
|
||||
|
||||
**** table-function :function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun table-function (table-specification)
|
||||
(loop ;; for col-spec in *table-specification*
|
||||
;; for (sym str) in *table-specification*
|
||||
with date = (today)
|
||||
for task in (chronometrist:task-list)
|
||||
for index from 1
|
||||
collect (list index task)))
|
||||
(loop with date = (timestamp-to-unix (today))
|
||||
for task in (task-list)
|
||||
for index from 0
|
||||
when (zerop index)
|
||||
collect (mapcar #'second table-specification)
|
||||
else
|
||||
collect (loop for (symbol label data-fn print-fn) in table-specification
|
||||
collect (funcall data-fn index task date))))
|
||||
#+END_SRC
|
||||
|
||||
**** display
|
||||
|
|
@ -2642,19 +2673,21 @@ s-expressions in a text column.")
|
|||
(declare (ignorable frame pane pane-name))
|
||||
;; (format *debug-io* "*application-frame*: ~a~%" *application-frame*)
|
||||
(let ((stream *standard-output*)
|
||||
(task-list (chronometrist:task-list)))
|
||||
(task-list (task-list)))
|
||||
(formatting-table (stream)
|
||||
(loop for task in task-list
|
||||
for index from 1 do
|
||||
(formatting-row (stream)
|
||||
(formatting-cell (stream)
|
||||
(format t "~2@A" index))
|
||||
(formatting-cell (stream)
|
||||
(with-output-as-presentation (pane task 'task-name)
|
||||
(format t "~A" task)))
|
||||
;; (formatting-cell (stream)
|
||||
;; )
|
||||
)))))
|
||||
(loop
|
||||
with date = (timestamp-to-unix (today))
|
||||
for task in task-list
|
||||
for index from 0 do
|
||||
(formatting-row (stream)
|
||||
(loop for (symbol label data-fn print-fn) in *table-specification*
|
||||
when (zerop index) do
|
||||
(formatting-cell (stream)
|
||||
(format t "~A" label))
|
||||
else do
|
||||
(formatting-cell (stream)
|
||||
(let ((data (funcall data-fn index task date)))
|
||||
(funcall print-fn data frame pane)))))))))
|
||||
#+END_SRC
|
||||
|
||||
**** refresh :command:
|
||||
|
|
|
|||
Reference in New Issue