From c5d5ba419e7024f4152e141232e948267337d6ca Mon Sep 17 00:00:00 2001 From: contrapunctus Date: Sat, 23 Apr 2022 08:19:56 +0530 Subject: [PATCH] CLIM: Specify table columns using classes --- cl/chronometrist.org | 141 +++++++++++++++++++++++++++---------------- 1 file changed, 88 insertions(+), 53 deletions(-) diff --git a/cl/chronometrist.org b/cl/chronometrist.org index ae7b87e..ac5ff81 100644 --- a/cl/chronometrist.org +++ b/cl/chronometrist.org @@ -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: