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))))))