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