Author: junrue Date: Sun Sep 10 17:31:01 2006 New Revision: 254

Modified: trunk/docs/manual/widget-functions.texinfo trunk/src/packages.lisp trunk/src/tests/uitoolkit/widget-tester.lisp trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/button.lisp trunk/src/uitoolkit/widgets/item-manager.lisp trunk/src/uitoolkit/widgets/list-box.lisp trunk/src/uitoolkit/widgets/list-item.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: fixed a bug in checked-p for buttons; implemented low-level select and deselect functions for list-box; enhanced test-native-style to support more than one bit to test

Modified: trunk/docs/manual/widget-functions.texinfo ============================================================================== --- trunk/docs/manual/widget-functions.texinfo (original) +++ trunk/docs/manual/widget-functions.texinfo Sun Sep 10 17:31:01 2006 @@ -16,22 +16,35 @@

@anchor{append-item} @deffn GenericFunction append-item self thing dispatcher &optional disabled checked => @ref{item} -Adds a new item representing @var{thing} to @var{self}, where the -class of @var{self} must derive from @ref{item-manager}. The -newly-created item is returned. The @var{dispatcher} parameter must -be an instance of @ref{event-dispatcher} or a subclass thereof. The -optional @var{checked} and @var{disabled} arguments can be used to set -the item's initial state. +Adds a new item representing @var{thing} to @var{self}, where @var{thing} +can be any @sc{object}. The newly-created item is returned. +The @var{dispatcher} parameter must be one of the following: +@itemize @bullet +@item An instance of @ref{event-dispatcher} or a subclass thereof. +@item A function whose argument list matches the event method +identified by the @var{callback-event-name} slot in @var{self}'s +class. + +See also @ref{items-of}. +@end itemize + +The optional @var{checked} and @var{disabled} arguments will each be +interpreted as @sc{generalized boolean} values in order to set the +item's initial state. Note, however, that not all @ref{item-manager} +subclasses support enabled or checked states for individual items. @end deffn

@deffn GenericFunction append-separator self => @ref{item} -Adds a separator item to @var{self}, and returns the newly-created item. +Adds a separator to @var{self}, and returns a newly-created item to +wrap the separator. A separator is a thin etched divider that serves +to visually separate groups of items and has no other behavior. @end deffn

-@deffn GenericFunction append-submenu self text submenu dispatcher &optional disabled checked => @ref{item} +@deffn GenericFunction append-submenu self text submenu dispatcher &optional disabled checked => @ref{menu-item} Adds @var{submenu} anchored to @var{self} and returns the corresponding -@ref{menu-item}. The optional @var{checked} and @var{disabled} arguments can -be used to set the menu item's initial state. +menu-item. The optional @var{checked} and @var{disabled} arguments +will each be interpreted as @sc{generalized boolean} values +in order to set the menu item's initial state. @end deffn

@anchor{auto-hscroll-p} @@ -139,6 +152,16 @@ presses @sc{enter}. @end deffn

+@anchor{data-of} +@deffn Accessor data-of self +(setf (@strong{data-of} @var{self}) @var{object})@* + +Returns application-specific data associated with @var{self}. + +The corresponding @sc{set} function associates new data with +@var{self}. +@end deffn + @deffn GenericFunction delete-all self Removes all content from @var{self}. @end deffn @@ -259,8 +282,33 @@ an image or an icon-bundle. @end deffn

+@anchor{item-count} +@deffn GenericFunction item-count self => integer +Returns the number of instances of @ref{item} subclasses contained within +@var{self}. +@end deffn + +@anchor{item-index} @deffn GenericFunction item-index self item -Return the zero-based index of the location of the other object in this object. +Return the zero-based index of the location of @var{item} within @var{self}. +@end deffn + +@anchor{items-of} +@deffn GenericFunction items-of self +(setf (@strong{items-of} @var{self}) @var{items})@* + +Returns a fresh @sc{list} of @ref{item} subclasses appropriate for +@var{self}'s type. + +The corresponding @sc{setf} function accepts a list whose contents +are any combination of: +@itemize @bullet +@item Instances of @ref{item} subclasses appropriate for @var{self}. +@item Instances of any @sc{object} type; these will be wrapped by item +objects, to be accessible later via the @ref{data-of} method. +@end itemize +Existing items contained by @var{self} are replaced, and then the +native control is refreshed. See also @ref{append-item}. @end deffn

@anchor{layout} @@ -284,7 +332,10 @@ Calls @var{func}, which is a function of two arguments, for each child of @var{self} and places @var{func}'s return value in @var{result-list}. @var{func}'s two arguments are @var{self} and -the current child. +the current child. Note that @code{mapchildren} accesses @var{self}'s +@emph{actual} children as determined by the underlying window's +data structures, regardless of any @ref{layout-manager} assigned +to @var{self}. @end deffn

@anchor{maximum-size} @@ -464,16 +515,18 @@ @deffn GenericFunction selected-items self => list (setf (@strong{selected-items} @var{self}) @var{list})

-Returns a @sc{list} containing subclasses of @ref{item} appropriate -for @var{self} that correspond to selections made by the user, or -@sc{nil} if there are no selections. This function is defined only -for @ref{widget}s whose notion of @emph{selection} is a set of -item objects. - -The @sc{setf} function takes a @var{list} of item subclasses -appropriate for @var{self} which identify the items in -@var{self} that should be selected. Passing @sc{nil} will unselect all -items, which is equivalent to calling @ref{select-all} with @sc{nil}. +Returns a fresh @sc{list} containing subclasses of @ref{item} +appropriate for @var{self} that correspond to selections made by the +user, or @sc{nil} if there are no selections. This function is defined +only for @ref{widget}s whose notion of @emph{selection} is a set of +instances of @ref{item} subclasses. + +The @sc{setf} function takes a @sc{list} of instances of item +subclasses appropriate for @var{self} which identify the items in +@var{self} that should be selected.@footnote{In this respect, +@ref{selected-items} is not symmetric with @ref{items-of}.} Passing +@sc{nil} will unselect all items, which is equivalent to calling +@ref{select-all} with @sc{nil}. @end deffn

@anchor{selected-p}

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Sun Sep 10 17:31:01 2006 @@ -436,6 +436,7 @@ #:initial-delay-of #:horizontal-scrollbar #:image + #:item-count #:item-height #:item-id #:item-index

Modified: trunk/src/tests/uitoolkit/widget-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/widget-tester.lisp (original) +++ trunk/src/tests/uitoolkit/widget-tester.lisp Sun Sep 10 17:31:01 2006 @@ -65,10 +65,12 @@ (gfg:foreground-color gc) color)) (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window))))

-(defun manage-lb-button-states (lb move-btn all-btn none-btn) +(defun manage-lb-button-states (lb move-btn selected-btn all-btn none-btn) (let ((sel-count (gfw:selected-count lb)) - (item-count (length (gfw:items-of lb)))) + (item-count (gfw:item-count lb))) (gfw:enable move-btn (> sel-count 0)) + (if selected-btn + (gfw:check selected-btn (> sel-count 0))) (if all-btn (gfw:enable all-btn (and (> item-count 0) (< sel-count item-count)))) (if none-btn @@ -80,39 +82,64 @@ (if sel-items (setf (gfw:items-of dest-lb) (append sel-items (gfw:items-of dest-lb))))))

+(defun select-lb-content (lb state) + (let ((count (gfw:item-count lb)) + (func (if state #'gfw::lb-select-item #'gfw::lb-deselect-item))) + (loop for index in '(0 2 4) + when (>= count (1+ index)) + do (funcall func lb index)))) +#| + (let ((items (gfw:items-of lb))) + (setf (gfw:selected-items lb) (subseq items 0 (min 4 (length items)))))) +|# + (defun populate-list-box-test-panel () (setf (gfw:text *widget-tester-win*) "Widget Tester (List Boxes)") (let* ((panel-disp (make-instance 'widget-tester-panel-events)) - (lb1 nil) - (lb2 nil) - (btn-left nil) - (btn-right nil) - (btn-all nil) - (btn-none nil) - (lb1-callback (lambda (disp lb) - (declare (ignore disp)) - (manage-lb-button-states lb btn-right btn-all btn-none))) - (lb2-callback (lambda (disp lb) - (declare (ignore disp)) - (manage-lb-button-states lb btn-left nil nil))) - (btn-left-callback (lambda (disp btn) - (declare (ignore disp btn)) - (move-lb-content lb2 lb1) - (manage-lb-button-states lb1 btn-right btn-all btn-none) - (manage-lb-button-states lb2 btn-left nil nil))) - (btn-right-callback (lambda (disp btn) - (declare (ignore disp btn)) - (move-lb-content lb1 lb2) - (manage-lb-button-states lb1 btn-right btn-all btn-none) - (manage-lb-button-states lb2 btn-left nil nil))) - (btn-all-callback (lambda (disp btn) - (declare (ignore disp btn)) - (gfw:select-all lb1 t) - (manage-lb-button-states lb1 btn-right btn-all btn-none))) - (btn-none-callback (lambda (disp btn) - (declare (ignore disp btn)) - (gfw:select-all lb1 nil) - (manage-lb-button-states lb1 btn-right btn-all btn-none))) + (latch nil) + (lb1 nil) + (lb2 nil) + (btn-left nil) + (btn-right nil) + (btn-all nil) + (btn-none nil) + (btn-select nil) + (lb1-callback (lambda (disp lb) + (declare (ignore disp)) + (manage-lb-button-states lb btn-right (if latch nil btn-select) btn-all btn-none))) + (lb2-callback (lambda (disp lb) + (declare (ignore disp)) + (manage-lb-button-states lb btn-left nil nil nil))) + (btn-left-callback (lambda (disp btn) + (declare (ignore disp btn)) + (move-lb-content lb2 lb1) + (manage-lb-button-states lb1 btn-right btn-select btn-all btn-none) + (manage-lb-button-states lb2 btn-left nil nil nil))) + (btn-right-callback (lambda (disp btn) + (declare (ignore disp btn)) + (move-lb-content lb1 lb2) + (manage-lb-button-states lb1 btn-right btn-select btn-all btn-none) + (manage-lb-button-states lb2 btn-left nil nil nil))) + (btn-all-callback (lambda (disp btn) + (declare (ignore disp btn)) + (gfw:select-all lb1 t) + (manage-lb-button-states lb1 btn-right btn-select btn-all btn-none))) + (btn-none-callback (lambda (disp btn) + (declare (ignore disp btn)) + (gfw:select-all lb1 nil) + (manage-lb-button-states lb1 btn-right btn-select btn-all btn-none))) + (btn-reset-callback (lambda (disp btn) + (declare (ignore disp btn)) + (gfw:delete-all lb2) + (setf (gfw:items-of lb1) *list-box-test-data*) + (manage-lb-button-states lb1 btn-right btn-select btn-all btn-none) + (manage-lb-button-states lb2 btn-left nil nil nil))) + (btn-select-callback (lambda (disp btn) + (declare (ignore disp)) + (setf latch t) + (select-lb-content lb1 (gfw:selected-p btn)) + (manage-lb-button-states lb1 btn-right nil btn-all btn-none) + (setf latch nil)))

(outer-panel (make-instance 'gfw:panel :dispatcher panel-disp :parent *widget-tester-win* @@ -135,21 +162,28 @@ :items (subseq *list-box-test-data* 4))) (gfw:pack lb1-panel)

- (setf btn-right (make-instance 'gfw:button :parent btn-panel - :text " ==> " - :callback btn-right-callback)) + (setf btn-right (make-instance 'gfw:button :parent btn-panel + :text " ==> " + :callback btn-right-callback)) (gfw:enable btn-right nil) - (setf btn-left (make-instance 'gfw:button :parent btn-panel - :text " <== " - :callback btn-left-callback)) + (setf btn-left (make-instance 'gfw:button :parent btn-panel + :text " <== " + :callback btn-left-callback)) (gfw:enable btn-left nil) - (setf btn-all (make-instance 'gfw:button :parent btn-panel - :text "Select All" - :callback btn-all-callback)) - (setf btn-none (make-instance 'gfw:button :parent btn-panel - :text "Select None" - :callback btn-none-callback)) + (setf btn-all (make-instance 'gfw:button :parent btn-panel + :text "Select All" + :callback btn-all-callback)) + (setf btn-none (make-instance 'gfw:button :parent btn-panel + :text "Select None" + :callback btn-none-callback)) (gfw:enable btn-none nil) + (make-instance 'gfw:button :parent btn-panel + :text "Reset" + :callback btn-reset-callback) + (setf btn-select (make-instance 'gfw:button :parent btn-panel + :text "Select 0,2,4" + :style '(:check-box) + :callback btn-select-callback)) (gfw:pack btn-panel)

(make-instance 'gfw:label :text "Extended Select:" :parent lb2-panel) @@ -160,12 +194,17 @@ (gfw:pack lb2-panel)

(gfw:pack outer-panel) + ;; FIXME: need to think of a more elegant solution for the following + ;; use-case where we want synchronize the sizes of two or more + ;; layout children + ;; (let ((size (gfw:size lb1))) (setf (gfw:maximum-size lb1) size (gfw:minimum-size lb1) size (gfw:maximum-size lb2) size (gfw:minimum-size lb2) size)) (setf (gfw:items-of lb1) *list-box-test-data*) + (manage-lb-button-states lb1 btn-right btn-select btn-all btn-none) (gfw:delete-all lb2) outer-panel))

Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Sun Sep 10 17:31:01 2006 @@ -729,3 +729,9 @@ ("UpdateWindow" update-window) BOOL (hwnd HANDLE)) + +(defcfun + ("ValidateRect" validate-rect) + BOOL + (hwnd HANDLE) + (rct LPTR))

Modified: trunk/src/uitoolkit/widgets/button.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/button.lisp (original) +++ trunk/src/uitoolkit/widgets/button.lisp Sun Sep 10 17:31:01 2006 @@ -46,10 +46,7 @@

(defmethod checked-p ((self button)) (let ((bits (gfs::send-message (gfs:handle self) gfs::+bm-getcheck+ 0 0))) - (case bits - (gfs::+bst-checked+ t) - (gfs::+bst-unchecked+ nil) - (otherwise nil)))) + (= (logand bits gfs::+bst-checked+) gfs::+bst-checked+)))

(defmethod compute-style-flags ((self button) &rest extra-data) (declare (ignore extra-data))

Modified: trunk/src/uitoolkit/widgets/item-manager.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/item-manager.lisp (original) +++ trunk/src/uitoolkit/widgets/item-manager.lisp Sun Sep 10 17:31:01 2006 @@ -124,6 +124,13 @@ (dotimes (i (length items)) (delete-tc-item tc (elt items i)))))

+(defmethod item-count :before ((self item-manager)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod item-count ((self item-manager)) + (length (slot-value self 'items))) + (defmethod item-index :before ((self item-manager) (it item)) (declare (ignore it)) (if (gfs:disposed-p self)

Modified: trunk/src/uitoolkit/widgets/list-box.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/list-box.lisp (original) +++ trunk/src/uitoolkit/widgets/list-box.lisp Sun Sep 10 17:31:01 2006 @@ -56,6 +56,11 @@ (logand orig-flags (lognot (logior gfs::+lbs-nosel+ gfs::+lbs-extendedsel+ gfs::+lbs-multiplesel+))))

+(defun lb-is-single-select (lb) + (not (test-native-style lb (logior gfs::+lbs-extendedsel+ + gfs::+lbs-multiplesel+ + gfs::+lbs-nosel+)))) + (defun lb-width (hwnd) (let ((width (gfs::send-message hwnd gfs::+lb-gethorizontalextent+ 0 0))) (if (< width 0) @@ -76,6 +81,90 @@ (setf (slot-value victim 'gfs:handle) nil) (gfs:dispose victim)))))

+;;; This function is based on the package private select( int, boolean ) +;;; method from SWT 3.2 located in List.java starting on line 998, without +;;; the additional scrolling logic. +;;; +(defun lb-select-item (lb index) + (let ((hwnd (gfs:handle lb))) + + ;; sanity-check the index + ;; + (if (or (< index 0) (>= index (gfs::send-message hwnd gfs::+lb-getcount+ 0 0))) + (return-from lb-select-item nil)) + + ;; save the index of the top-most item + ;; + (let ((top-index (gfs::send-message hwnd gfs::+lb-gettopindex+ 0 0))) + (cffi:with-foreign-object (top-item-rect-ptr 'gfs::rect) + (cffi:with-foreign-object (sel-item-rect-ptr 'gfs::rect) + + ;; get the rectangle for the top-most item which we + ;; will repaint at the end + ;; + (gfs::send-message hwnd gfs::+lb-getitemrect+ + top-index (cffi:pointer-address top-item-rect-ptr)) + (let ((redraw-needed (zerop (gfs::is-window-visible hwnd))) + (has-sel-item nil)) + + ;; if the list box is visible, disable repainting + ;; + (if redraw-needed + (enable-redraw lb nil)) + (unwind-protect + (progn + (if (lb-is-single-select lb) + + ;; single-select list boxes must be configured differently + ;; from multi-select + ;; + (let ((old-index (gfs::send-message hwnd gfs::+lb-getcursel+ 0 0))) + (setf has-sel-item (/= old-index -1)) + + ;; get the rectangle for the old selected item + ;; + (if has-sel-item + (gfs::send-message hwnd gfs::+lb-getitemrect+ + old-index (cffi:pointer-address sel-item-rect-ptr))) + + ;; set the new selection + ;; + (gfs::send-message hwnd gfs::+lb-setcursel+ index 0)) + + ;; configure new selection for multi-select list boxes + ;; + (let ((focus-index (gfs::send-message hwnd gfs::+lb-getcaretindex+ 0 0))) + + ;; set the new selection + ;; + (gfs::send-message hwnd gfs::+lb-setsel+ 1 index) + + ;; if there was an item with focus, restore it + ;; + (if (/= focus-index -1) + (gfs::send-message hwnd gfs::+lb-setcaretindex+ focus-index 0))))) + + ;; restore the original top-index, then update the + ;; list box and the top item and the selection item + ;; + (gfs::send-message hwnd gfs::+lb-settopindex+ top-index 0) + (when redraw-needed + (enable-redraw lb t) + (gfs::validate-rect hwnd (cffi:null-pointer)) + (gfs::invalidate-rect hwnd top-item-rect-ptr 1) + (if has-sel-item + (gfs::invalidate-rect hwnd sel-item-rect-ptr 1)))))))))) + +(defun lb-deselect-item (lb index) + (let ((hwnd (gfs:handle lb))) + (if (or (< index 0) (>= index (gfs::send-message hwnd gfs::+lb-getcount+ 0 0))) + (return-from lb-deselect-item nil)) + (if (lb-is-single-select lb) + (let ((curr-index (gfs::send-message hwnd gfs::+lb-getcursel+ 0 0))) + (if (= curr-index index) + (gfs::send-message hwnd gfs::+lb-setcursel+ -1 0))) + (gfs::send-message hwnd gfs::+lb-setsel+ 0 index)))) + ;;; ;;; methods ;;; @@ -202,8 +291,7 @@ size))

(defmethod select-all ((self list-box) flag) - (when (or (test-native-style self gfs::+lbs-extendedsel+) - (test-native-style self gfs::+lbs-multiplesel+)) + (when (test-native-style self (logior gfs::+lbs-extendedsel+ gfs::+lbs-multiplesel+)) (gfs::send-message (gfs:handle self) gfs::+lb-setsel+ (if flag 1 0) #xFFFFFFFF)))

(defmethod selected-count ((self list-box)) @@ -216,8 +304,7 @@ (defmethod selected-items ((self list-box)) (let ((hwnd (gfs:handle self)) (items (slot-value self 'items))) - (if (and (not (test-native-style self gfs::+lbs-extendedsel+)) - (not (test-native-style self gfs::+lbs-multiplesel+))) + (if (lb-is-single-select self) (let ((index (gfs::send-message hwnd gfs::+lb-getcursel+ 0 0))) (if (and (>= index 0) (< index (length items))) (list (elt items index))

Modified: trunk/src/uitoolkit/widgets/list-item.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/list-item.lisp (original) +++ trunk/src/uitoolkit/widgets/list-item.lisp Sun Sep 10 17:31:01 2006 @@ -51,6 +51,12 @@ (error 'gfs:win32-error :detail "LB_GETITEMHEIGHT failed")) height))

+(defun lb-item-text-length (hwnd index) + (let ((length (gfs::send-message hwnd gfs::+lb-gettextlen+ index 0))) + (if (< length 0) + (error 'gfs:win32-error :detail "LB_GETTEXTLEN failed")) + length)) + (defun lb-item-text (hwnd index &optional buffer-size) (if (or (null buffer-size) (<= buffer-size 0)) (setf buffer-size (lb-item-text-length hwnd index))) @@ -59,12 +65,6 @@ (error 'gfs:win32-error :detail "LB_GETTEXT failed")) (cffi:foreign-string-to-lisp str-ptr)))

-(defun lb-item-text-length (hwnd index) - (let ((length (gfs::send-message hwnd gfs::+lb-gettextlen+ index 0))) - (if (< length 0) - (error 'gfs:win32-error :detail "LB_GETTEXTLEN failed")) - length)) - ;;; ;;; methods ;;; @@ -76,3 +76,9 @@ (if (and owner (cffi:pointer-eq hwnd (gfs:handle owner))) (gfs::send-message hwnd gfs::+lb-deletestring+ (item-index owner self) 0))))) (call-next-method)) + +(defmethod text ((self list-item)) + (let ((hwnd (gfs:handle self))) + (if (or (null hwnd) (cffi:null-pointer-p hwnd)) + "" + (lb-item-text hwnd (item-index (get-widget (thread-context) hwnd) self)))))

Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Sun Sep 10 17:31:01 2006 @@ -39,6 +39,8 @@ (defclass event-dispatcher () () (:documentation "Instances of this class receive events on behalf of user interface objects."))

+(defvar *default-dispatcher* (make-instance 'event-dispatcher)) + (defclass layout-managed () ((layout-p :reader layout-p @@ -68,7 +70,7 @@ ((dispatcher :accessor dispatcher :initarg :dispatcher - :initform (make-instance 'event-dispatcher)) + :initform *default-dispatcher*) (callback-event-name :accessor callback-event-name-of :initform nil

Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Sun Sep 10 17:31:01 2006 @@ -207,6 +207,9 @@ (defgeneric (setf image) (image self) (:documentation "Sets self's image object."))

+(defgeneric item-count (self) + (:documentation "Returns the number of items contained within self.")) + (defgeneric item-height (self) (:documentation "Return the height of the area if one of the object's items were displayed."))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Sun Sep 10 17:31:01 2006 @@ -141,7 +141,7 @@ (defun show-common-dialog (dlg dlg-func) (let* ((struct-ptr (gfs:handle dlg)) (retval (funcall dlg-func struct-ptr))) - (if (and (zerop retval) (not (zerop (gfs::comm-dlg-extended-error)))) + (if (and (zerop retval) (/= (gfs::comm-dlg-extended-error) 0)) (error 'gfs:comdlg-error :detail (format nil "~a failed" (symbol-name dlg-func)))) retval))

@@ -286,7 +286,7 @@ (gfs::get-window-long (gfs:handle widget) gfs::+gwl-exstyle+))

(defun test-native-style (widget bits) - (= (logand (gfs::get-window-long (gfs:handle widget) gfs::+gwl-style+) bits) bits)) + (/= (logand (gfs::get-window-long (gfs:handle widget) gfs::+gwl-style+) bits) 0))

(defun test-native-exstyle (widget bits) - (= (logand (gfs::get-window-long (gfs:handle widget) gfs::+gwl-exstyle+) bits) bits)) + (/= (logand (gfs::get-window-long (gfs:handle widget) gfs::+gwl-exstyle+) bits) 0))

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Sun Sep 10 17:31:01 2006 @@ -207,7 +207,7 @@ (redraw self)))

(defmethod enabled-p ((self widget)) - (not (zerop (gfs::is-window-enabled (gfs:handle self))))) + (/= (gfs::is-window-enabled (gfs:handle self)) 0))

(defmethod image :before ((self widget)) (if (gfs:disposed-p self) @@ -435,4 +435,4 @@ (error 'gfs:disposed-error)))

(defmethod visible-p ((self widget)) - (not (zerop (gfs::is-window-visible (gfs:handle self))))) + (/= (gfs::is-window-visible (gfs:handle self)) 0))