CLIM mail archive
[Prev][Next][Index][Thread]
Quickie question on formatting-table
Date: Tue, 21 Jan 1992 16:04 EST
From: Curt Eggemeyer <curt@eraserhead.jpl.nasa.gov>
Is it possible to use formatting-table, formatting-row, etc. within the
context of accepting-values where each cell in the table would be an individual accept with its own
prompt and default? I'm not sure this is allowed by what was illustrated in the docs.
That would be extremely handy if it is allowed. Do I need to do anything
special to implement this if it is possible?
Quite possible. You need not do anything special, though do take care
that all your accept-values-queries have UNIQUE query-identifiers, else
you will see some pretty bizarre display bugs.
Courtesy of SWM, with some influence from an earlier version of mine,
here is a little hardwired spreadsheet with row and column totals
implemented as a table inside accepting-values:
================================================================
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*-
(defparameter *default-cell-width* '(6 :character))
;; A spreadsheet consists of a bunch of rows, a row consisting of
;; column sums, and a total.
(defclass spreadsheet ()
((rows :reader spreadsheet-rows)
(column-sums :reader spreadsheet-column-sums)
(total :accessor spreadsheet-total :initform 0.0)
(cell-width :reader spreadsheet-cell-width
:initarg :cell-width :initform *default-cell-width*)))
(defmethod initialize-instance :after ((spreadsheet spreadsheet)
&key nrows ncells &allow-other-keys)
(with-slots (rows column-sums) spreadsheet
(setf rows (make-array nrows))
(dotimes (i nrows)
(setf (aref rows i) (make-instance 'spreadsheet-row :ncells ncells)))
(setf column-sums (make-instance 'spreadsheet-row :ncells ncells))))
;; A row consists of a bunch of cells and a row sum.
(defclass spreadsheet-row ()
((cells :reader spreadsheet-row-cells)
(row-sum :accessor spreadsheet-row-sum :initform 0.0)))
(defmethod initialize-instance :after ((row spreadsheet-row)
&key ncells &allow-other-keys)
(with-slots (cells) row
(setq cells (make-array ncells :element-type 'float :initial-element 0.0))))
;; Formatting a spreadsheet row consists of getting as input a
;; value for each cell in the row, using as a default the value
;; that is there right now.
(defun format-spreadsheet-row (row stream cell-width)
(let ((cells (spreadsheet-row-cells row)))
(formatting-row (stream)
(dotimes (i (length cells))
(formatting-cell (stream :align-x :right :minimum-width cell-width)
(setf (aref cells i)
(accept 'float
:default (aref cells i)
:prompt nil :prompt-mode :raw
:query-identifier (list cells i)
:stream stream))))
(present-sum (spreadsheet-row-sum row) stream cell-width))
(setf (spreadsheet-row-sum row) (reduce #'+ cells))))
(defun present-sum (sum stream cell-width)
(formatting-cell (stream :align-x :right :minimum-width cell-width)
(with-text-face (:bold stream)
(present sum 'float :stream stream))))
(defun spreadsheet (nrows ncells
&key (cell-width *default-cell-width*) (stream *query-io*))
(let* ((spreadsheet (make-instance 'spreadsheet
:nrows nrows :ncells ncells
:cell-width cell-width))
(rows (spreadsheet-rows spreadsheet))
(column-totals (spreadsheet-row-cells (spreadsheet-column-sums spreadsheet))))
(accepting-values (stream :own-window nil :resynchronize-every-pass t)
(formatting-table (stream :inter-column-spacing '(2 :character)
:equalize-column-widths t)
(map nil #'(lambda (row)
(format-spreadsheet-row row stream cell-width)) rows)
(formatting-row (stream)
(map nil #'(lambda (cell)
(present-sum cell stream cell-width)) column-totals)
(present-sum (spreadsheet-total spreadsheet) stream cell-width)))
(setf (spreadsheet-total spreadsheet) 0.0)
(dotimes (i ncells)
(setf (aref column-totals i) 0.0)
(dotimes (j nrows)
(incf (aref column-totals i) (aref (spreadsheet-row-cells (aref rows j)) i)))
(incf (spreadsheet-total spreadsheet) (aref column-totals i))))
spreadsheet))
References:
Main Index |
Thread Index