Author: junrue Date: Wed Oct 11 23:14:01 2006 New Revision: 302
Modified: trunk/NEWS.txt trunk/src/demos/demo-utils.lisp trunk/src/uitoolkit/widgets/control.lisp trunk/src/uitoolkit/widgets/dialog.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/label.lisp trunk/src/uitoolkit/widgets/panel.lisp Log: fix keyboard traversal due to default control style
Modified: trunk/NEWS.txt ============================================================================== --- trunk/NEWS.txt (original) +++ trunk/NEWS.txt Wed Oct 11 23:14:01 2006 @@ -4,6 +4,21 @@ CLISP 2.40 or later (due to a change in the argument list of CLISP's FFI:FOREIGN-LIBRARY-FUNCTION).
+. Implemented scrolling protocol and related helper objects and functions + to facilitate scrolling functionality in applications: + + * window styles :horizontal-scrollbar and :vertical-scrollbar + + * methods to retrieve window scrollbars + + * event-scroll method for handling raw scrolling events + + * scrolling-event-dispatcher for automatic management of a scrollable + child panel and window scrollbars (works in combination with + heap-layout) + + * integral scrolling and resizing for step sizes greater than 1 + . Initial list box control functionality implemented:
* three selection modes (none / multiple / extend) @@ -18,14 +33,7 @@
Additional list box features will be provided in a future release.
-. Implemented scrolling support: - - * window styles :horizontal-scrollbar and :vertical-scrollbar - - * event-scroll method for handling raw scrolling events - - * scrolling-event-dispatcher for automatic management of a scrollable - child panel and window scrollbars +. Implemented stand-alone scrollbar and slider control types.
. Implemented GFW:EVENT-PRE-RESIZE function so that applications can customize the behavior of a window's size drag rectangle.
Modified: trunk/src/demos/demo-utils.lisp ============================================================================== --- trunk/src/demos/demo-utils.lisp (original) +++ trunk/src/demos/demo-utils.lisp Wed Oct 11 23:14:01 2006 @@ -83,7 +83,7 @@ :callback (lambda (disp btn) (declare (ignore disp btn)) (gfs:dispose dlg)) - :style '(:cancel-button) + :style '(:default-button) :text "Close" :parent btn-panel))) (declare (ignore line1 line2 line3 line4 line5 line6 close-btn))
Modified: trunk/src/uitoolkit/widgets/control.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/control.lisp (original) +++ trunk/src/uitoolkit/widgets/control.lisp Wed Oct 11 23:14:01 2006 @@ -54,7 +54,7 @@ (gfs:handle parent) std-style ex-style - id))) + (or id (increment-widget-id (thread-context)))))) (setf (slot-value ctrl 'gfs:handle) hwnd) (subclass-wndproc hwnd) (put-widget (thread-context) ctrl)
Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Wed Oct 11 23:14:01 2006 @@ -76,8 +76,12 @@
(defmethod compute-style-flags ((dlg dialog) &rest extra-data) (declare (ignore extra-data)) - (values (logior gfs::+ws-caption+ gfs::+ws-popup+ gfs::+ws-sysmenu+) - (logior gfs::+ws-ex-dlgmodalframe+ gfs::+ws-ex-windowedge+))) + (values (logior gfs::+ws-caption+ + gfs::+ws-popup+ + gfs::+ws-sysmenu+) + (logior gfs::+ws-ex-controlparent+ + gfs::+ws-ex-dlgmodalframe+ + gfs::+ws-ex-windowedge+)))
(defmethod cancel-widget :before ((self dialog)) (if (gfs:disposed-p self)
Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Wed Oct 11 23:14:01 2006 @@ -55,7 +55,6 @@ ;; primary edit styles ;; (:multi-line (setf std-flags (logior +default-child-style+ - gfs::+ws-tabstop+ gfs::+es-multiline+))) ;; styles that can be combined ;;
Modified: trunk/src/uitoolkit/widgets/label.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/label.lisp (original) +++ trunk/src/uitoolkit/widgets/label.lisp Wed Oct 11 23:14:01 2006 @@ -94,7 +94,8 @@ (defmethod compute-style-flags ((label label) &rest extra-data) (if (> (count-if-not #'null extra-data) 1) (error 'gfs:toolkit-error :detail "only one of :image, :separator, or :text are allowed")) - (let ((std-style (logior +default-child-style+ + (let ((std-style (logior gfs::+ws-child+ + gfs::+ws-visible+ (cond ((first extra-data) (compute-image-style-flags (style-of label))) @@ -106,6 +107,11 @@ (compute-text-style-flags (style-of label))))))) (values std-style 0)))
+(defmethod initialize-instance :after ((self label) &key image parent text &allow-other-keys) + (create-control self parent text gfs::+icc-standard-classes+) + (if image + (setf (image self) image))) + (defmethod image ((label label)) (if (gfs:disposed-p label) (error 'gfs:disposed-error)) @@ -124,7 +130,7 @@ gfs::+ss-bitmap+ gfs::+ss-realsizeimage+ gfs::+ss-centerimage+ - +default-child-style+)) + (logior gfs::+ws-child+ gfs::+ws-visible+))) (tr-pnt (gfg:transparency-pixel-of image))) (if tr-pnt (let* ((color (gfg:background-color label)) @@ -147,11 +153,6 @@ gfs::+image-bitmap+ (cffi:pointer-address (gfs:handle image)))))
-(defmethod initialize-instance :after ((self label) &key image parent text &allow-other-keys) - (create-control self parent text gfs::+icc-standard-classes+) - (if image - (setf (image self) image))) - (defmethod preferred-size ((self label) width-hint height-hint) (let ((bits (get-native-style self)) (b-width (* (border-width self) 2))) @@ -185,7 +186,7 @@ (multiple-value-bind (std-flags ex-flags) (compute-style-flags self nil nil str) (declare (ignore ex-flags)) - (update-native-style self (logior etch-flags std-flags +default-child-style+)))) + (update-native-style self (logior etch-flags std-flags gfs::+ws-child+ gfs::+ws-visible+)))) (set-widget-text self str))
(defmethod text-baseline ((self label))
Modified: trunk/src/uitoolkit/widgets/panel.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/panel.lisp (original) +++ trunk/src/uitoolkit/widgets/panel.lisp Wed Oct 11 23:14:01 2006 @@ -55,7 +55,7 @@
(defmethod compute-style-flags ((self panel) &rest extra-data) (declare (ignore extra-data)) - (let ((std-flags +default-child-style+)) + (let ((std-flags (logior gfs::+ws-child+ gfs::+ws-visible+))) (loop for sym in (style-of self) do (ecase sym ;; styles that can be combined