[cells-cvs] CVS Celtk

[fgoenninger]

Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv6379

Modified Files:
	scroll.lisp 
Log Message:
Added: scrollbar widget: support for width, activestyle,
       selectforeground, selectbackground, selectmode

--- /project/cells/cvsroot/Celtk/scroll.lisp	2007/11/16 10:01:44	1.5
+++ /project/cells/cvsroot/Celtk/scroll.lisp	2008/03/23 11:43:15	1.6
@@ -38,7 +38,17 @@
   ((list-item-keys :initarg :list-item-keys :accessor list-item-keys :initform nil)
    (list-item-factory :initarg :list-item-factory :accessor list-item-factory :initform nil)
    (list-height :initarg :list-height :accessor list-height :initform nil)
-   (tkfont :initarg :tkfont :accessor tkfont :initform (c-in '(courier 9))))
+   (tkfont :initarg :tkfont :accessor tkfont :initform (c-in '(courier 9)))
+   (width :initarg :width :accessor width :initform (c-in 20))
+   (activestyle :initarg :activestyle :accessor activestyle :initform (c-in nil))
+   (selectforeground :initarg :selectforeground
+                     :accessor selectforeground :initform (c-in "black"))
+   (selectbackground :initarg :selectbackground
+                     :accessor selectbackground :initform (c-in nil))
+   (selectmode :initarg :selectmode
+                     :accessor selectmode :initform (c-in 'single))
+   
+   )
   (:default-initargs
       :list-height (c? (max 1 (length (^list-item-keys))))
     :kids-packing nil
@@ -48,6 +58,11 @@
                               (mapcar (list-item-factory .parent)
                                 (list-item-keys .parent))))
                    :tkfont (c? (tkfont .parent))
+                   :width (c? (width .parent))
+                   :activestyle (c? (activestyle .parent))
+                   :selectforeground (c? (selectforeground .parent))
+                   :selectbackground (c? (selectbackground .parent))
+                   :selectmode (c? (selectmode .parent))
                    :state (c? (if (enabled .parent) 'normal 'disabled))
                    :takefocus (c? (if (enabled .parent) 1 0))
                    :height (c? (list-height .parent))
@@ -64,6 +79,8 @@
   (when new-value
     (let ((lb (car (^kids)))
           (item-no (position new-value (^list-item-keys) :test 'equal)))
+      (trc nil "tk-output selection: lb | item-no | path of lb " lb item-no (path lb))
+
       (if item-no
           (tk-format `(:selection ,self) "~(~a~) selection set ~a" (path lb) item-no)
         (break "~&scrolled-list ~a selection ~a not found in item keys ~a" self new-value (^list-item-keys))))))