Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv7926/src/renderer

Modified Files: tables.lisp renderer2.lisp clim-draw.lisp Log Message: Complete the renaming *MEDIUM* -> *PANE*.

Panes are CLIM extended-streams, and remember output to them in output records. Mediums are much simpler, and don't have this kind of memory. So, though the same drawing functions (DRAW-TEXT, DRAW-LINE) can have the same initial effect applied to a pane and a medium, the output-record state is very different.

Date: Mon Jul 11 17:57:57 2005 Author: crhodes

Index: closure/src/renderer/tables.lisp diff -u closure/src/renderer/tables.lisp:1.3 closure/src/renderer/tables.lisp:1.4 --- closure/src/renderer/tables.lisp:1.3 Sun Mar 13 19:03:25 2005 +++ closure/src/renderer/tables.lisp Mon Jul 11 17:57:56 2005 @@ -943,8 +943,8 @@ (rc-first-line-tasks new-rc) nil (rc-left-floating-boxen new-rc) nil (rc-right-floating-boxen new-rc) nil) - (clim:with-new-output-record (clim-user::*medium* 'clim:standard-sequence-output-record record) - (clim:with-output-recording-options (clim-user::*medium* :record t :draw nil) + (clim:with-new-output-record (clim-user::*pane* 'clim:standard-sequence-output-record record) + (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil) (let* ((fake-parent (make-bbox)) (bbox (brender new-rc (cell-content cell) fake-parent))) (if bbox @@ -1030,15 +1030,15 @@ (defun render-table (rc pt parent-box) ;; Now, while we render a table, we unfortunatly have to disable ;; drawing. - (clim:with-output-recording-options (clim-user::*medium* :record t :draw nil) + (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil) ;;; xxx not yet correct - (funcall (if t ;(clim:stream-drawing-p clim-user::*medium*) + (funcall (if t ;(clim:stream-drawing-p clim-user::*pane*) #'clim:replay-output-record #'values) - (clim:with-new-output-record (clim-user::*medium*) + (clim:with-new-output-record (clim-user::*pane*) ;; why does drawp nest proper? (render-table-2 rc pt parent-box)) - clim-user::*medium* clim:+everywhere+ 0 0))) + clim-user::*pane* clim:+everywhere+ 0 0)))

(defun render-table-2 (rc pt parent-box) (let ((table (parse-table pt))

Index: closure/src/renderer/renderer2.lisp diff -u closure/src/renderer/renderer2.lisp:1.8 closure/src/renderer/renderer2.lisp:1.9 --- closure/src/renderer/renderer2.lisp:1.8 Sun Jul 10 13:18:35 2005 +++ closure/src/renderer/renderer2.lisp Mon Jul 11 17:57:56 2005 @@ -4,7 +4,7 @@ ;;; Created: somewhen late 2002 ;;; Author: Gilbert Baumann gilbert@base-engineering.com ;;; License: MIT style (see below) -;;; $Id: renderer2.lisp,v 1.8 2005/07/10 11:18:35 emarsden Exp $ +;;; $Id: renderer2.lisp,v 1.9 2005/07/11 15:57:56 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann

@@ -435,8 +435,8 @@ (open-chunk-dy chunk)) ))) (when (eql pass 1) - (clim:draw-text* clim-user::*medium* q x y)) - (incf x (clim:text-size clim-user::*medium* q)))) + (clim:draw-text* clim-user::*pane* q x y)) + (incf x (clim:text-size clim-user::*pane* q)))) (push dy ys) (setf dy (open-chunk-dy chunk)) (push (bounding-chunk-style chunk) ss) @@ -451,7 +451,7 @@ (let (p q res.text-seen-p) (cond (link (clim:with-output-as-presentation - (clim-user::*medium* + (clim-user::*pane* (url:unparse-url (hyper-link-url (imap-area-link link))) 'clim-user::url @@ -470,8 +470,8 @@ (chunk-debug-name q) ""))) (when (eql pass 1) - (clim:draw-text* clim-user::*medium* q x y)) - (incf x (clim:text-size clim-user::*medium* q)) + (clim:draw-text* clim-user::*pane* q x y)) + (incf x (clim:text-size clim-user::*pane* q)) )))

(pop ss) @@ -483,7 +483,7 @@ ;; replaced objects are different to dimensions of regular ;; inline boxen. (cond (replaced-object-p - (draw-box-decoration clim-user::*medium* + (draw-box-decoration clim-user::*pane* x1 (- (+ y dy) (open-chunk-height oc) (cooked-style-padding-top (bounding-chunk-style oc)) (- (cooked-style-padding-top (bounding-chunk-style oc))) @@ -499,7 +499,7 @@ :right-halfp (not (bounding-chunk-halfp q)) )) (t - (draw-box-decoration clim-user::*medium* + (draw-box-decoration clim-user::*pane* x1 (- (+ y dy) (open-chunk-height oc) (cooked-style-padding-top (bounding-chunk-style oc))) x (+ (+ y dy) (open-chunk-depth oc) @@ -528,7 +528,7 @@ (when (eql pass 1) (setf (clim:medium-ink clim-user::*medium*) (css-color-ink (cooked-style-color (black-chunk-style chunk)))) - (clim-draw-runes* clim-user::*medium* + (clim-draw-runes* clim-user::*pane* x (+ dy y) (black-chunk-data chunk) 0 (length (black-chunk-data chunk)) @@ -539,7 +539,7 @@ (let ((ro (replaced-object-chunk-object chunk))) (when (eql pass 1) (closure/clim-device::medium-draw-ro* - clim-user::*medium* + clim-user::*pane* ro x (+ dy y))) (incf x (chunk-width chunk))) ))))) ;; @@ -1177,99 +1177,6 @@ (defvar *zzz* nil) (defvar *dyn-elm* nil)

-#+emarsden2005-06-23 -(defun tata (mode) - (let ((clim-user::*medium* (clim:find-pane-named clim-user::*frame* 'clim-user::canvas)) - (closure-protocol:*document-language* - (make-instance 'r2::html-4.0-document-language)) - (closure-protocol:*user-agent* nil)) - (multiple-value-bind (x c) - (ignore-errors - ;; first find the chunk - (let ((offender *dyn-elm*) - (the-pb nil)) - (block suche - (labels ((walk (x) - (etypecase x - (marker-box) - (block-box - (mapc #'walk (block-box-content x))) - (para-box - (mapc #'(lambda (z) (walk-chunk x z)) (para-box-items x))))) - (walk-chunk (pb x) - (etypecase x - (floating-chunk) - (bounding-chunk - (setf (bounding-chunk-pt x) offender) - #+NIL - (when (eq (bounding-chunk-pt x) offender) - '(cond ((eql mode :highlight) - (setf (slot-value (bounding-chunk-style x) 'css::border-left-width) 1 - (slot-value (bounding-chunk-style x) 'css::border-left-style) :solid - (slot-value (bounding-chunk-style x) 'css::border-right-width) 1 - (slot-value (bounding-chunk-style x) 'css::border-right-style) :solid - (slot-value (bounding-chunk-style x) 'css::border-top-width) 1 - (slot-value (bounding-chunk-style x) 'css::border-top-style) :solid - (slot-value (bounding-chunk-style x) 'css::border-bottom-width) 1 - (slot-value (bounding-chunk-style x) 'css::border-bottom-style) :solid)) - (t - (setf (slot-value (bounding-chunk-style x) 'css::border-left-width) 0 - (slot-value (bounding-chunk-style x) 'css::border-left-style) :none - (slot-value (bounding-chunk-style x) 'css::border-right-width) 0 - (slot-value (bounding-chunk-style x) 'css::border-right-style) :none - (slot-value (bounding-chunk-style x) 'css::border-top-width) 0 - (slot-value (bounding-chunk-style x) 'css::border-top-style) :none - (slot-value (bounding-chunk-style x) 'css::border-bottom-width) 0 - (slot-value (bounding-chunk-style x) 'css::border-bottom-style) :none))) - '(setf (slot-value (bounding-chunk-style x) 'css::background-color) - (if (eq mode :highlight) - "#ccccff" - :transparent)) - '(setf (slot-value (bounding-chunk-style x) 'css::text-decoration) - (if (eq mode :highlight) - (list :underline) - :none)) - )) - (kern-chunk) - (disc-chunk - (mapc #'(lambda (x) (walk-chunk pb x)) - (disc-chunk-here x)) - (mapc #'(lambda (x) (walk-chunk pb x)) - (disc-chunk-after x)) - (mapc #'(lambda (x) (walk-chunk pb x)) - (disc-chunk-before x))) - (black-chunk - '(setf (slot-value (black-chunk-style x) 'css::color) - (if (eq mode :highlight) - "#ff0000" - "#000000")) - ) - (replaced-object-chunk - (when (typep (replaced-object-chunk-object x) - 'lazy-image) - (setf (replaced-object-chunk-object x) - (replaced-element-p *document* *device* (replaced-object-chunk-element x))) - (setf the-pb pb) - (return-from suche nil)) - )))) - (walk *zzz*))) - - (dprint "@@@@@@@ offender = ~S." offender) - (dprint "@@@@@@@ the-pb = ~S." the-pb) - (when the-pb - (let ( - (papa (clim:output-record-parent (para-box-output-record the-pb)))) - (dprint "@@@@@@@ papa = ~S." papa) - (clim:delete-output-record (para-box-output-record the-pb) papa) - ;; now clim is so inherently broken .... - (setf (para-box-output-record the-pb) - (clim:with-new-output-record (clim-user::*pane*) - (funcall (para-box-genesis the-pb))))) - (tata mode)) - )) - (when c - (dprint "Error: ~A." c))))) - (defun format-block (item x1 x2 ss before-markers #||# pos-vertical-margin neg-vertical-margin yy) (let (res) (setf (block-box-output-record item) @@ -1549,7 +1456,7 @@ (+ x2 pr) (- yy (cooked-style-border-bottom-width s) )) - (draw-box-decoration clim-user::*medium* x1 y1 x2 y2 block-style) + (draw-box-decoration clim-user::*pane* x1 y1 x2 y2 block-style) (incf y1 (cooked-style-padding-top s)) (decf y2 (cooked-style-padding-bottom s)) (when (realp (cooked-style-height s)) @@ -1558,7 +1465,7 @@ (error "Fubar"))) #+NIL (unless (or (= x1 x2) (= y1 y2)) - (clim:draw-rectangle* clim-user::*medium* x1 y1 x2 y2 + (clim:draw-rectangle* clim-user::*pane* x1 y1 x2 y2 :ink clim:+red+ :filled nil)) ) @@ -2162,7 +2069,7 @@ (unless (or (= x1 (+ x1 w)) (= yyy yy)) #-NIL - (clim:draw-rectangle* clim-user::*medium* + (clim:draw-rectangle* clim-user::*pane* x1 yyy (+ x1 w) yy :ink (elt *table-depth-color* (mod *table-depth* (length *table-depth-color*))) @@ -2272,7 +2179,7 @@ (let ((new-record (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil) (clim:with-new-output-record (clim-user::*pane*) - (draw-box-decoration clim-user::*medium* (+ x1 xx1) y1 (+ x1 xx2) y2 + (draw-box-decoration clim-user::*pane* (+ x1 xx1) y1 (+ x1 xx2) y2 (block-box-style (table-cell-content cell))))))) (clim:delete-output-record new-record (clim:output-record-parent new-record)) (clim:add-output-record new-record bg-record))))))) @@ -2286,7 +2193,7 @@ (let ((new-record (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil) (clim:with-new-output-record (clim-user::*pane*) - (draw-box-decoration clim-user::*medium* x1 y1 x2 y2 + (draw-box-decoration clim-user::*pane* x1 y1 x2 y2 (table-style table)))))) (clim:delete-output-record new-record (clim:output-record-parent new-record)) (clim:add-output-record new-record bg-record))) @@ -2303,7 +2210,7 @@ (multiple-value-bind (x1 x2) (table-column-coordinates table column-widths j) (let* ( (y1 (+ yy (loop for k below i sum (elt row-heights k))))) - (clim:draw-line* clim-user::*medium* + (clim:draw-line* clim-user::*pane* x1 y1 x2 y1 :ink (clim-user::parse-x11-color color) :line-thickness width))))))) @@ -2317,7 +2224,7 @@ (let* ((y1 (+ yy (loop for k below i sum (elt row-heights k)))) (y2 (+ y1 (elt row-heights i))) (x1 (+ x1 (loop for k below j sum (elt column-widths k))))) - (clim:draw-line* clim-user::*medium* + (clim:draw-line* clim-user::*pane* x1 y1 x1 y2 :ink (clim-user::parse-x11-color color) :line-thickness width)))))) ) @@ -5061,6 +4968,15 @@

;; $Log: renderer2.lisp,v $ +;; Revision 1.9 2005/07/11 15:57:56 crhodes +;; Complete the renaming *MEDIUM* -> *PANE*. +;; +;; Panes are CLIM extended-streams, and remember output to them in output +;; records. Mediums are much simpler, and don't have this kind of +;; memory. So, though the same drawing functions (DRAW-TEXT, DRAW-LINE) +;; can have the same initial effect applied to a pane and a medium, the +;; output-record state is very different. +;; ;; Revision 1.8 2005/07/10 11:18:35 emarsden ;; Distinguish between pane and medium in the CLIM GUI. This should ;; fix image display.

Index: closure/src/renderer/clim-draw.lisp diff -u closure/src/renderer/clim-draw.lisp:1.3 closure/src/renderer/clim-draw.lisp:1.4 --- closure/src/renderer/clim-draw.lisp:1.3 Sun Mar 13 22:39:19 2005 +++ closure/src/renderer/clim-draw.lisp Mon Jul 11 17:57:56 2005 @@ -4,7 +4,7 @@ ;;; Created: 2003-03-08 ;;; Author: Gilbert Baumann gilbert@base-engineering.com ;;; License: MIT style (see below) -;;; $Id: clim-draw.lisp,v 1.3 2005/03/13 21:39:19 emarsden Exp $ +;;; $Id: clim-draw.lisp,v 1.4 2005/07/11 15:57:56 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann

@@ -171,14 +171,14 @@ (dolist (deco text-decoration) (case deco (:underline - (clim:draw-line* clim-user::*medium* + (clim:draw-line* clim-user::*pane* xx1 (+ yy 2) xx (+ yy 2) :ink (clim-user::parse-x11-color color))) (:overline ;; xxx hack - (clim:draw-line* clim-user::*medium* + (clim:draw-line* clim-user::*pane* xx1 (- yy 12) xx (- yy 12) :ink (clim-user::parse-x11-color color))) (:line-through - (clim:draw-line* clim-user::*medium* + (clim:draw-line* clim-user::*pane* xx1 (- yy 6) xx (- yy 6) :ink (clim-user::parse-x11-color color))) ))))

;;;; Runes