[mcclim-cvs] CVS update: mcclim/panes.lisp

[Gilbert Baumann]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv13495

Modified Files:
	panes.lisp 
Log Message:
SCROLLER-PANE
    We now interpret the x-spacing and y-spacing options as extra
    space to put around the viewport. The default for that is now 4 to
    reading what is in a stream pane easier.

Date: Tue Nov 29 15:46:54 2005
Author: gbaumann

Index: mcclim/panes.lisp
diff -u mcclim/panes.lisp:1.162 mcclim/panes.lisp:1.163
--- mcclim/panes.lisp:1.162	Tue Nov 29 14:18:28 2005
+++ mcclim/panes.lisp	Tue Nov 29 15:46:53 2005
@@ -27,7 +27,7 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;;; Boston, MA  02111-1307  USA.
 
-;;; $Id: panes.lisp,v 1.162 2005/11/29 13:18:28 gbaumann Exp $
+;;; $Id: panes.lisp,v 1.163 2005/11/29 14:46:53 gbaumann Exp $
 
 (in-package :clim-internals)
 
@@ -1848,7 +1848,10 @@
    (vscrollbar :initform nil)
    (hscrollbar :initform nil)
    (suggested-width  :initform 300 :initarg :suggested-width)
-   (suggested-height :initform 300 :initarg :suggested-height)))
+   (suggested-height :initform 300 :initarg :suggested-height))
+  (:default-initargs
+   :x-spacing 4
+   :y-spacing 4))
 
 (defmacro scrolling ((&rest options) &body contents)
   `(let ((viewport (make-pane 'viewport-pane :contents (list , at contents))))
@@ -1889,7 +1892,7 @@
         (make-space-requirement))))
 
 (defmethod allocate-space ((pane scroller-pane) width height)
-  (with-slots (viewport vscrollbar hscrollbar) pane
+  (with-slots (viewport vscrollbar hscrollbar x-spacing y-spacing) pane
     (let ((viewport-width  (if vscrollbar (- width  *scrollbar-thickness*) width))
           (viewport-height (if hscrollbar (- height *scrollbar-thickness*) height)))
       
@@ -1946,10 +1949,11 @@
       (when viewport
         (setf (sheet-transformation viewport)
               (make-translation-transformation
-                   (if vscrollbar *scrollbar-thickness* 0) 0))
+                   (+ x-spacing (if vscrollbar *scrollbar-thickness* 0))
+                   (+ y-spacing 0)))
         (allocate-space viewport
-                        viewport-width
-                        viewport-height)))))
+                        (- viewport-width (* 2 x-spacing))
+                        (- viewport-height (* 2 y-spacing)))))))
 
 ;;;; Initialization
 
@@ -1999,6 +2003,12 @@
   (sheet-adopt-child pane (first contents))
   (with-slots (scroll-bar viewport vscrollbar hscrollbar) pane
     (setq viewport (first (sheet-children pane)))
+    ;; make the background of the viewport match the background of the
+    ;; things scrolled.
+    (when (first (sheet-children viewport))
+      (setf (slot-value pane 'background)  ;### hmm ...
+            (pane-background (first (sheet-children viewport)))))
+    ;;
     (when (member scroll-bar '(:vertical t))
       (setq vscrollbar
             (make-pane 'scroll-bar-pane