[graphic-forms-cvs] r89 - in trunk: docs/manual src/tests/uitoolkit src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Apr 4 02:50:21 UTC 2006
Author: junrue
Date: Mon Apr 3 22:50:20 2006
New Revision: 89
Modified:
trunk/docs/manual/api.texinfo
trunk/src/tests/uitoolkit/drawing-tester.lisp
trunk/src/tests/uitoolkit/hello-world.lisp
trunk/src/tests/uitoolkit/layout-tester.lisp
trunk/src/uitoolkit/widgets/panel.lisp
trunk/src/uitoolkit/widgets/top-level.lisp
trunk/src/uitoolkit/widgets/window.lisp
Log:
modified class registration to differentiate between window styles for which the system automatically paints the background vs. those that the app must paint
Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo (original)
+++ trunk/docs/manual/api.texinfo Mon Apr 3 22:50:20 2006
@@ -310,17 +310,24 @@
@item :borderless
a window with a one-pixel border (so not really @emph{borderless} in the
strictest sense); no frame icon, system menu, minimize/maximize buttons,
-or close buttons
+or close buttons; the system does not paint the background
+ at item :frame
+the standard top-level frame style with system menu, close box, and
+minimize/maximize buttons; this window type is resizable; it differs
+from the @code{:workspace} style in that the application is completely
+responsible for painting the contents
@item :miniframe
a resizable window with a shorter than normal caption; has a close box
-but no system menu or minimize/maximize buttons
+but no system menu or minimize/maximize buttons; the system does not
+paint the background
@item :palette
similar to the @code{:miniframe} style, but in this case the window
-does not have resize frame
+does not have a resize frame; the system does not paint the background
@item :workspace
the standard top-level frame style with system menu, close box, and
-minimize/maximize buttons; this window is resizable and normally hosts
-the primary user interface for an application
+minimize/maximize buttons; this window type is resizable; it differs
+from the @code{:frame} style in that the system paints the background
+using the @sc{color_appworkspace} color scheme
@end table
@end deffn
@end deftp
Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/drawing-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/drawing-tester.lisp Mon Apr 3 22:50:20 2006
@@ -362,7 +362,7 @@
(setf *drawing-dispatcher* (make-instance 'drawing-win-events))
(setf (draw-func-of *drawing-dispatcher*) #'draw-arcs)
(setf *drawing-win* (make-instance 'gfw:top-level :dispatcher *drawing-dispatcher*
- :style '(:workspace)))
+ :style '(:frame)))
(setf (gfw:menu-bar *drawing-win*) menubar)
(setf (gfw:size *drawing-win*) (gfs:make-size :width 390 :height 310))
(setf (gfw:text *drawing-win*) "Drawing Tester")
Modified: trunk/src/tests/uitoolkit/hello-world.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/hello-world.lisp (original)
+++ trunk/src/tests/uitoolkit/hello-world.lisp Mon Apr 3 22:50:20 2006
@@ -61,7 +61,7 @@
(defun run-hello-world-internal ()
(let ((menubar nil))
(setf *hello-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'hellowin-events)
- :style '(:workspace)))
+ :style '(:frame)))
(setf menubar (gfw:defmenu ((:item "&File"
:submenu ((:item "E&xit" :callback #'exit-fn))))))
(setf (gfw:menu-bar *hello-win*) menubar)
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/layout-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/layout-tester.lisp Mon Apr 3 22:50:20 2006
@@ -70,6 +70,14 @@
:initarg :id
:initform 0)))
+(defmethod gfw:event-paint ((self layout-tester-widget-events) window time gc rect)
+ (declare (ignore time rect))
+ (setf (gfg:background-color gc) gfg:*color-white*)
+ (setf (gfg:foreground-color gc) gfg:*color-white*)
+ (gfg:draw-filled-rectangle gc
+ (make-instance 'gfs:rectangle :location (gfs:make-point)
+ :size (gfw:client-size window))))
+
(defclass test-panel (gfw:panel) ())
(defmethod gfw:preferred-size ((win test-panel) width-hint height-hint)
Modified: trunk/src/uitoolkit/widgets/panel.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/panel.lisp (original)
+++ trunk/src/uitoolkit/widgets/panel.lisp Mon Apr 3 22:50:20 2006
@@ -43,7 +43,7 @@
(register-window-class +panel-window-classname+
(cffi:get-callback 'uit_widgets_wndproc)
gfs::+cs-dblclks+
- gfs::+color-btnface+))
+ -1))
;;;
;;; methods
Modified: trunk/src/uitoolkit/widgets/top-level.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/top-level.lisp (original)
+++ trunk/src/uitoolkit/widgets/top-level.lisp Mon Apr 3 22:50:20 2006
@@ -33,7 +33,8 @@
(in-package :graphic-forms.uitoolkit.widgets)
-(defconstant +toplevel-window-classname+ "GraphicFormsTopLevel")
+(defconstant +toplevel-erasebkgnd-window-classname+ "GraphicFormsTopLevelEraseBkgnd")
+(defconstant +toplevel-noerasebkgnd-window-classname+ "GraphicFormsTopLevelNoEraseBkgnd")
(defconstant +default-window-title+ "New Window")
@@ -41,12 +42,18 @@
;;; helper functions
;;;
-(defun register-toplevel-window-class ()
- (register-window-class +toplevel-window-classname+
+(defun register-toplevel-erasebkgnd-window-class ()
+ (register-window-class +toplevel-erasebkgnd-window-classname+
(cffi:get-callback 'uit_widgets_wndproc)
gfs::+cs-dblclks+
gfs::+color-appworkspace+))
+(defun register-toplevel-noerasebkgnd-window-class ()
+ (register-window-class +toplevel-noerasebkgnd-window-classname+
+ (cffi:get-callback 'uit_widgets_wndproc)
+ gfs::+cs-dblclks+
+ -1))
+
;;;
;;; methods
;;;
@@ -102,7 +109,7 @@
gfs::+ws-caption+))
(setf ex-flags (logior gfs::+ws-ex-appwindow+
gfs::+ws-ex-toolwindow+)))
- ((eq sym :workspace)
+ ((or (eq sym :workspace) (eq sym :frame))
(setf std-flags (logior gfs::+ws-overlappedwindow+
gfs::+ws-clipsiblings+
gfs::+ws-clipchildren+))
@@ -125,7 +132,12 @@
(setf title +default-window-title+))
(if (not (listp style))
(setf style (list style)))
- (init-window win +toplevel-window-classname+ #'register-toplevel-window-class style owner title))
+ (let ((classname +toplevel-noerasebkgnd-window-classname+)
+ (register-func #'register-toplevel-noerasebkgnd-window-class))
+ (when (not (null (find :workspace style)))
+ (setf classname +toplevel-erasebkgnd-window-classname+)
+ (setf register-func #'register-toplevel-erasebkgnd-window-class))
+ (init-window win classname register-func style owner title)))
(defmethod menu-bar :before ((win top-level))
(if (gfs:disposed-p win)
Modified: trunk/src/uitoolkit/widgets/window.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/window.lisp (original)
+++ trunk/src/uitoolkit/widgets/window.lisp Mon Apr 3 22:50:20 2006
@@ -124,7 +124,9 @@
gfs::+image-cursor+ 0 0
(logior gfs::+lr-defaultcolor+
gfs::+lr-shared+)))
- (setf gfs::hbrush (cffi:make-pointer (1+ bkgcolor)))
+ (setf gfs::hbrush (if (< bkgcolor 0)
+ (cffi:null-pointer)
+ (cffi:make-pointer (1+ bkgcolor))))
(setf gfs::menuname (cffi:null-pointer))
(setf gfs::classname str-ptr)
(setf gfs::smallicon (cffi:null-pointer))
More information about the Graphic-forms-cvs
mailing list