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