Author: junrue Date: Wed Sep 13 23:44:06 2006 New Revision: 260
Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget.lisp trunk/src/uitoolkit/widgets/window.lisp Log: added some missing scrollbar-related methods to window
Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Wed Sep 13 23:44:06 2006 @@ -192,7 +192,7 @@ (defgeneric header-visible-p (self) (:documentation "Returns T if the object's header is visible; nil otherwise."))
-(defgeneric horizontal-scrollbar (self) +(defgeneric horizontal-scrollbar-p (self) (:documentation "Returns T if this object currently has a horizontal scrollbar; nil otherwise."))
(defgeneric iconify (self flag) @@ -432,7 +432,7 @@ (defgeneric update-native-style (self flags) (:documentation "Modifies self's native style flags and refreshes self's visual appearance."))
-(defgeneric vertical-scrollbar (self) +(defgeneric vertical-scrollbar-p (self) (:documentation "Returns T if this object currently has a vertical scrollbar; nil otherwise."))
(defgeneric visible-item-count (self)
Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Wed Sep 13 23:44:06 2006 @@ -206,9 +206,21 @@ (if flag (redraw self)))
+(defmethod enable-scrollbars :before ((self widget) horizontal vertical) + (declare (ignore horizontal vertical)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + (defmethod enabled-p ((self widget)) (/= (gfs::is-window-enabled (gfs:handle self)) 0))
+(defmethod horizontal-scrollbar-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod horizontal-scrollbar-p ((self widget)) + nil) + (defmethod image :before ((self widget)) (if (gfs:disposed-p self) (error 'gfs:disposed-error))) @@ -430,6 +442,13 @@ (if (gfs:disposed-p self) (error 'gfs:disposed-error)))
+(defmethod vertical-scrollbar-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod vertical-scrollbar-p ((self widget)) + nil) + (defmethod visible-p :before ((self widget)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)))
Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Wed Sep 13 23:44:06 2006 @@ -193,12 +193,22 @@ (let ((sz (client-size self))) (perform (layout-of self) self (gfs:size-width sz) (gfs:size-height sz)))))
-(defmethod event-resize ((d event-dispatcher) (self window) size type) +(defmethod event-resize ((disp event-dispatcher) (self window) size type) (declare (ignore size type)) (unless (null (layout-of self)) (let ((sz (client-size self))) (perform (layout-of self) self (gfs:size-width sz) (gfs:size-height sz)))))
+(defmethod enable-scrollbars ((self window) horizontal vertical) + (let ((bits (get-native-style self))) + (if horizontal + (setf bits (logior bits gfs::+ws-hscroll+)) + (setf bits (logand bits (lognot gfs::+ws-hscroll+)))) + (if vertical + (setf bits (logior bits gfs::+ws-vscroll+)) + (setf bits (logand bits (lognot gfs::+ws-vscroll+)))) + (update-native-style self bits))) + (defmethod focus-p :before ((self window)) (if (gfs:disposed-p self) (error 'gfs:disposed-error))) @@ -214,6 +224,9 @@ (defmethod give-focus ((self window)) (gfs::set-focus (gfs:handle self)))
+(defmethod horizontal-scrollbar-p ((self top-level)) + (test-native-style self gfs::+ws-hscroll+)) + (defmethod image ((self window)) (let ((small (gfs::send-message (gfs:handle self) gfs::+wm-geticon+ gfs::+icon-small+ 0)) (large (gfs::send-message (gfs:handle self) gfs::+wm-geticon+ gfs::+icon-big+ 0)) @@ -334,6 +347,9 @@ gfs::+swp-nozorder+))) flags)
+(defmethod vertical-scrollbar-p ((self top-level)) + (test-native-style self gfs::+ws-vscroll+)) + (defmethod window->display :before ((self window)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)))