CLIM mail archive
[Prev][Next][Index][Thread]

Cell borders in formatting tables

Clim 1.1 with Allegro 4.1/Lucid 4.1 on Decstation and SPARCstation

I am trying to get a table that has borders around arbitrary cells, in
particular I want one that looks like this:

  |  X1  X2  X3
--+------------
Y1| 7.2   3   1
Y2|   2  -5   3
Y3|   4   2   5

I first tried using the surrounding-output-with-borders macro to put
boxes around the X and Y labels, figuring I could write a border type
for a line on the right hand side of a cell, but the boxes don't show
up in the right places.  I tried putting the
surrounding-output-with-borders outside the formatting-cell and inside
and both gave me the same results.  The boxes are horizontally
adjacent and each is a few pixels lower than the previous one.  How do
I arbitrarily put borders around cells in a table?

Also, if you look closely at the demo, you will see that the size of
the border is determined by the size of the contents in the cell.
This makes sense if the surrounding-output-with-borders were inside
the formatting-cell, but if it's outside (as it is in the demo), it
would be nice if it surrounding the entire area of the cell.  (What if
I wanted my table in a grid, spreadsheet style?)

The following is some code that will demonstrate the problem:

;; This code should display a matrix, with row and column labels, the
;; X labels should be boxed, the Y labels should be underlined and each
;; data cell should be drop-shadow boxed

(defvar *border-bug-root* nil)

(defvar *border-bug-frame* nil)

(defvar *x-labels* '("X1" "X2" "X3"))

(defvar *y-labels* '("Y1" "Y2" "Y3"))

(defvar *data*
    (make-array '(3 3) :initial-contents '((7.2 3 1) (2 -5 3) (4 2 5))))

(clim:define-application-frame
	border-bug-frame () ()
	(:panes ((display :application)))
	(:top-level (border-bug-top-level)))

(defun border-bug (&optional reinit)
  (when (or reinit
	    (null *border-bug-frame*))
    (setf *border-bug-frame*
      (clim:make-application-frame 'border-bug-frame
				   :parent (setf *border-bug-root*
					     (open-root))))
    (clim:run-frame-top-level *border-bug-frame*)))

(defun open-root ()
  ;;thanks to Oliver Christ <oli@adler.ims.uni-stuttgart.de> for the code below
  #+Lucid (clim:open-root-window
	   :clx
	   :host (lcl:environment-variable "DISPLAY"))
  #+Allegro-v4.1 (clim:open-root-window
		  :clx
		  :host (system:getenv "DISPLAY"))
  #+MCL          (clim:open-root-window :mcl)
  #+Genera       (clim:open-root-window :sheet)
  ;;Please contact keunen@nrb.be if you modify this source code.
  #-(or Lucid Allegro-v4.1 MCL Genera)
  (warning "Unknown CLIM/LISP combination.  Please modify the
`open-root' function to your needs."))

(defmethod border-bug-top-level (frame)
  (let ((stream (clim:get-frame-pane frame 'display)))
    (flet ((format-label (string)
	     (clim:formatting-cell (stream :align-x :right)
				   (format stream string)))
	   (format-value (value)
	     (clim:formatting-cell (stream :align-x :right)
				   (clim:present value 'real :stream stream))))
    (clim:formatting-table
     (stream)
     (clim:formatting-row
      (stream)
      (clim:formatting-cell (stream) (declare (ignore stream)))
      (dolist (x-label *x-labels*)
	(clim:surrounding-output-with-border
	 (stream) (format-label x-label))))
     (dotimes (y 3)
       (clim:formatting-row
	(stream)
	(clim:surrounding-output-with-border
	 (stream :shape :underline) (format-label (nth y *y-labels*)))
	(dotimes (x 3)
	  (clim:surrounding-output-with-border
	   (stream :shape :drop-shadow)
	   (format-value (aref *data* x y))))))))
    (clim:accept 'symbol :stream stream)))
Follow-Ups:
Main Index | Thread Index