CLIM: Specify table columns using classes
This commit is contained in:
contrapunctus
parent
5d93dd48bc
commit
c5d5ba419e
|
|
@ -2597,56 +2597,89 @@ s-expressions in a text column.")
|
|||
(:layouts (default (vertically () task-duration int))))
|
||||
#+END_SRC
|
||||
|
||||
**** *table-specification* :custom:variable:
|
||||
**** task-duration-table
|
||||
***** column-specifier :class:
|
||||
#+BEGIN_SRC lisp
|
||||
(defvar *table-specification*
|
||||
`((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.")
|
||||
(defclass column-specifier ()
|
||||
((name :initarg :name :type keyword :accessor column-name)
|
||||
(label :initarg :label :type string :accessor column-label)))
|
||||
#+END_SRC
|
||||
|
||||
**** table-function :function:
|
||||
***** make-column-specifier :constructor:function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun table-function (table-specification)
|
||||
(defun make-column-specifier (name label)
|
||||
(make-instance 'column-specifier :name name :label label))
|
||||
#+END_SRC
|
||||
|
||||
***** cell-data :method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric cell-data (name index task date)
|
||||
(:documentation "Function to determine the data of cell NAME.
|
||||
NAME must be a keyword.
|
||||
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."))
|
||||
(defmethod cell-data ((name (eql :index)) (index integer) (task string) (date integer))
|
||||
index)
|
||||
(defmethod cell-data ((name (eql :task)) (index integer) (task string) (date integer))
|
||||
task)
|
||||
(defmethod cell-data ((name (eql :duration)) (index integer) (task string) (date integer))
|
||||
(task-duration-one-day task date))
|
||||
#+END_SRC
|
||||
|
||||
***** cell-print :method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric cell-print (name index task date cell-data frame pane)
|
||||
(:documentation "Function to determine the data of cell NAME.
|
||||
NAME must be a keyword.
|
||||
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.
|
||||
CELL-DATA is the return value of `cell-data'
|
||||
FRAME and PANE are the CLIM frame and pane as passed to the display function."))
|
||||
(defmethod cell-print ((name (eql :index))
|
||||
(index integer) (task string) (date integer)
|
||||
cell-data-index
|
||||
frame pane)
|
||||
(format t "~2@A" cell-data-index))
|
||||
(defmethod cell-print ((name (eql :task))
|
||||
(index integer) (task string) (date integer)
|
||||
cell-data-task
|
||||
frame pane)
|
||||
(with-output-as-presentation (pane cell-data-task 'task-name)
|
||||
(format t "~A" cell-data-task)))
|
||||
(defmethod cell-print ((name (eql :duration))
|
||||
(index integer) (task string) (date integer)
|
||||
duration
|
||||
frame pane)
|
||||
(with-output-as-presentation (pane duration 'number)
|
||||
(format t "~A" duration)))
|
||||
#+END_SRC
|
||||
|
||||
***** *task-duration-table-spec* :custom:variable:
|
||||
#+BEGIN_SRC lisp
|
||||
(defvar *task-duration-table-spec*
|
||||
(loop for (keyword . string) in '((:index . "#")
|
||||
(:task . "Task")
|
||||
(:duration . "Time")
|
||||
;; (:activity . "Active")
|
||||
)
|
||||
collect (make-column-specifier keyword string))
|
||||
"List of table `column-specifier' instances.")
|
||||
#+END_SRC
|
||||
|
||||
***** task-duration-table-function :function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defun task-duration-table-function (table-specification)
|
||||
(loop with date = (timestamp-to-unix (today))
|
||||
for task in (task-list)
|
||||
for index from 0
|
||||
when (zerop index)
|
||||
collect (mapcar #'second table-specification)
|
||||
collect (mapcar #'column-label table-specification)
|
||||
else
|
||||
collect (loop for (symbol label data-fn print-fn) in table-specification
|
||||
collect (funcall data-fn index task date))))
|
||||
collect (loop for column-spec in table-specification
|
||||
collect (cell-data (column-name column-spec)
|
||||
index task date))))
|
||||
#+END_SRC
|
||||
|
||||
**** display
|
||||
|
|
@ -2664,30 +2697,32 @@ PRINT-FN is a function accepting three arguments - DATA, FRAME, and PANE.
|
|||
***** display-pane :generic:function:
|
||||
#+BEGIN_SRC lisp
|
||||
(defgeneric display-pane (frame stream pane-name)
|
||||
(:documentation "Display Chronometrist application panes."))
|
||||
(:documentation "Display a Chronometrist application pane."))
|
||||
#+END_SRC
|
||||
|
||||
***** display-pane :method:
|
||||
#+BEGIN_SRC lisp
|
||||
(defmethod display-pane (frame pane (pane-name (eql 'task-duration)))
|
||||
"Display the task-duration pane, using `*task-duration-table-spec*'."
|
||||
(declare (ignorable frame pane pane-name))
|
||||
;; (format *debug-io* "*application-frame*: ~a~%" *application-frame*)
|
||||
(let ((stream *standard-output*)
|
||||
(task-list (task-list)))
|
||||
(let ((stream *standard-output*))
|
||||
(formatting-table (stream)
|
||||
(loop
|
||||
with date = (timestamp-to-unix (today))
|
||||
for task in task-list
|
||||
for task in (task-list)
|
||||
for row in (task-duration-table-function *task-duration-table-spec*)
|
||||
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)))))))))
|
||||
(if (zerop index)
|
||||
(loop for string in row
|
||||
do (formatting-cell (stream)
|
||||
(format t "~A" string)))
|
||||
(loop for data in row
|
||||
for col-spec in *task-duration-table-spec*
|
||||
do (formatting-cell (stream)
|
||||
(cell-print (column-name col-spec)
|
||||
index task date data frame pane)))))))))
|
||||
#+END_SRC
|
||||
|
||||
**** refresh :command:
|
||||
|
|
|
|||
Reference in New Issue