[graphic-forms-cvs] r302 - in trunk: . src/demos src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Thu Oct 12 03:14:02 UTC 2006
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
More information about the Graphic-forms-cvs
mailing list