Author: junrue Date: Wed Jan 3 22:04:43 2007 New Revision: 423 Added: trunk/src/uitoolkit/widgets/status-bar.lisp Modified: trunk/docs/manual/api.xml trunk/docs/manual/gfw-symbols.xml trunk/docs/manual/graphic-forms.xml trunk/docs/manual/protocols.xml trunk/docs/website/index.html trunk/graphic-forms-uitoolkit.asd trunk/src/demos/textedit/textedit-window.lisp trunk/src/packages.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/widgets/dialog.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/label.lisp trunk/src/uitoolkit/widgets/top-level.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/window.lisp Log: check in a snapshot of status bar work Modified: trunk/docs/manual/api.xml ============================================================================== --- trunk/docs/manual/api.xml (original) +++ trunk/docs/manual/api.xml Wed Jan 3 22:04:43 2007 @@ -11,6 +11,7 @@ </para> &constants; + &protocols; &gfcpkg; &gfgpkg; &gfspkg; Modified: trunk/docs/manual/gfw-symbols.xml ============================================================================== --- trunk/docs/manual/gfw-symbols.xml (original) +++ trunk/docs/manual/gfw-symbols.xml Wed Jan 3 22:04:43 2007 @@ -2,7 +2,7 @@ <!-- gfw-symbols.xml - Copyright (c) 2006, Jack D. Unrue + Copyright (c) 2006-2007, Jack D. Unrue --> <package name="gfw" fullname="graphic-forms.uitoolkit.widgets"> @@ -1284,8 +1284,8 @@ <argument name=":style"> <description> This is a <refclhs>list</refclhs> of keyword symbols that define - the look-and-feel of the dialog. Currently, only one of the following - symbols may be specified: + the look-and-feel of the dialog. One of the following + primary styles may be specified: <enum> <argument name=":application-modal"> <description> @@ -1309,6 +1309,10 @@ </description> </argument> </enum> + The following optional style may also be specified: + <enum> + <argument name=":status-bar"/> + </enum> </description> </argument> <argument name=":text"> @@ -1335,6 +1339,7 @@ <reftopic>gfw:owner</reftopic> <reftopic>gfw:parent</reftopic> <reftopic>gfw:text</reftopic> + <reftopic>gfw:status-bar-of</reftopic> </seealso> </class> @@ -1415,7 +1420,7 @@ One or more of the following optional styles: <enum> <argument name=":horizontal-scrollbar"/> - <argument name=":statusbar"/> + <argument name=":status-bar"/> <argument name=":vertical-scrollbar"/> </enum> </description> @@ -1449,7 +1454,7 @@ <reftopic>gfw:text</reftopic> <reftopic>gfw:obtain-horizontal-scrollbar</reftopic> <reftopic>gfw:obtain-vertical-scrollbar</reftopic> - <reftopic>gfw:obtain-status-bar</reftopic> + <reftopic>gfw:status-bar-of</reftopic> </seealso> </class> @@ -3783,29 +3788,6 @@ </seealso> </generic-function> - <generic-function name="obtain-status-bar"> - <syntax> - <arguments> - <argument name="self"> - <description> - An object configured with a statusbar. - </description> - </argument> - </arguments> - <return> - <reftopic>gfw:status-bar</reftopic> - </return> - </syntax> - <description> - Returns the <reftopic>gfw:status-bar</reftopic> - attached to the bottom of <arg0/>, if <arg0/> is configured to - have one. - </description> - <seealso> - <reftopic>gfw:status-item</reftopic> - </seealso> - </generic-function> - <generic-function name="menu-bar"> <syntax with-setf="t"> <arguments> @@ -6121,6 +6103,30 @@ <!-- ACCESSORS --> + <slot-accessor name="status-bar-of"> + <syntax> + <arguments> + <argument name="self"> + <description> + An instance of <reftopic>gfw:top-level</reftopic> or + <reftopic>gfw:dialog</reftopic>. + </description> + </argument> + </arguments> + <return> + <reftopic>gfw:status-bar</reftopic> + </return> + </syntax> + <description> + If <arg0/> was created with the :status-bar style, then this function + returns an object representing the status bar widget; otherwise, this + function returns NIL. + </description> + <seealso> + <reftopic>gfw:status-item</reftopic> + </seealso> + </slot-accessor> + <slot-accessor name="style-of"> <syntax with-setf="t"> <arguments> Modified: trunk/docs/manual/graphic-forms.xml ============================================================================== --- trunk/docs/manual/graphic-forms.xml (original) +++ trunk/docs/manual/graphic-forms.xml Wed Jan 3 22:04:43 2007 @@ -34,7 +34,6 @@ &legal; &introduction; &api; - &protocols; &misctopics; &glossary; Modified: trunk/docs/manual/protocols.xml ============================================================================== --- trunk/docs/manual/protocols.xml (original) +++ trunk/docs/manual/protocols.xml Wed Jan 3 22:04:43 2007 @@ -7,7 +7,7 @@ <title>Protocols</title> <para role="normal"> - This chapter's sections discuss the <glossterm linkend="protocol">protocols</glossterm> + This section discusses the <glossterm linkend="protocol">protocols</glossterm> representing major functional areas of Graphic-Forms. </para> Modified: trunk/docs/website/index.html ============================================================================== --- trunk/docs/website/index.html (original) +++ trunk/docs/website/index.html Wed Jan 3 22:04:43 2007 @@ -76,12 +76,8 @@ <div class="footer"> <a class="footerleft" href="http://common-lisp.net">common-lisp.net home</a> - Copyright © 2006 by <a href="http://home.earthlink.net/~jdunrue/">Jack D. Unrue</a> + Copyright © 2006-2007 by <a href="http://home.earthlink.net/~jdunrue/">Jack D. Unrue</a> </div> -<!-- - <a href="http://sourceforge.net"><IMG src="http://sourceforge.net/sflogo.php?group_id=20959" width="88" height="31" border="0" alt="SourceForge Logo"></a> ---> - </body> </html> Modified: trunk/graphic-forms-uitoolkit.asd ============================================================================== --- trunk/graphic-forms-uitoolkit.asd (original) +++ trunk/graphic-forms-uitoolkit.asd Wed Jan 3 22:04:43 2007 @@ -147,6 +147,7 @@ (:file "scrolling-helper") (:file "scrollbar") (:file "slider") + (:file "status-bar") (:file "window") (:file "root-window") (:file "top-level") Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Wed Jan 3 22:04:43 2007 @@ -189,7 +189,7 @@ :submenu ((:item "&About TextEdit" :callback #'about-textedit))))))) (setf *textedit-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'textedit-win-events) :layout (make-instance 'gfw:heap-layout) - :style '(:frame))) + :style '(:frame :status-bar))) (setf *textedit-control* (make-instance 'gfw:edit :parent *textedit-win* :style '(:multi-line :auto-vscroll Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; packages.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -285,6 +285,7 @@ #:scrollbar #:scrolling-helper #:slider + #:status-bar #:timer #:top-level #:widget @@ -536,6 +537,7 @@ #:size #:spacing-of #:startup + #:status-bar-of #:step-increments #:style-of #:sub-menu Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; system-constants.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; dialog.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -165,6 +165,10 @@ (reenable-top-levels) (if (visible-p self) (show self nil)) + (let ((sbar (status-bar-of self))) + (when sbar + (delete-widget (thread-context) (gfs:handle sbar)) + (setf (slot-value self 'status-bar) nil))) (call-next-method)) (defmethod initialize-instance :after ((self dialog) &key owner text &allow-other-keys) Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Wed Jan 3 22:04:43 2007 @@ -495,7 +495,6 @@ 0) (defmethod process-message (hwnd (msg (eql gfs::+wm-size+)) wparam lparam) - (declare (ignore lparam)) (let* ((tc (thread-context)) (w (get-widget tc hwnd)) (type (cond @@ -503,9 +502,13 @@ ((= wparam gfs::+size-minimized+) :minimized) ((= wparam gfs::+size-restored+) :restored) (t nil)))) - (when w + (when (and w (not (typep w 'status-bar))) (outer-size w (size-event-size tc)) - (event-resize (dispatcher w) w (size-event-size tc) type))) + (event-resize (dispatcher w) w (size-event-size tc) type) + (if (or (typep w 'top-level) (typep w 'dialog)) + (let ((sbar (status-bar-of w))) + (if sbar + (gfs::send-message (gfs:handle sbar) gfs::+wm-size+ wparam lparam)))))) 0) (defmethod process-message (hwnd (msg (eql gfs::+wm-sizing+)) wparam lparam) Modified: trunk/src/uitoolkit/widgets/label.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/label.lisp (original) +++ trunk/src/uitoolkit/widgets/label.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; label.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -81,30 +81,30 @@ ;;; methods ;;; -(defmethod (setf gfg:background-color) (color (label label)) +(defmethod (setf gfg:background-color) (color (self label)) (declare (ignorable color)) (call-next-method) - (let ((image (image label)) - (pnt (pixel-point-of label))) + (let ((image (image self)) + (pnt (pixel-point-of self))) (when image (if pnt (setf (gfg:transparency-pixel-of image) pnt)) - (setf (image label) image)))) + (setf (image self) image)))) -(defmethod compute-style-flags ((label label) &rest extra-data) +(defmethod compute-style-flags ((self 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 gfs::+ws-child+ gfs::+ws-visible+ (cond ((first extra-data) - (compute-image-style-flags (style-of label))) + (compute-image-style-flags (style-of self))) ((second extra-data) - (if (find :vertical (style-of label)) + (if (find :vertical (style-of self)) gfs::+ss-etchedvert+ gfs::+ss-etchedhorz+)) (t - (compute-text-style-flags (style-of label))))))) + (compute-text-style-flags (style-of self))))))) (values std-style 0))) (defmethod initialize-instance :after ((self label) &key image parent text &allow-other-keys) Added: trunk/src/uitoolkit/widgets/status-bar.lisp ============================================================================== --- (empty file) +++ trunk/src/uitoolkit/widgets/status-bar.lisp Wed Jan 3 22:04:43 2007 @@ -0,0 +1,45 @@ +;;;; +;;;; status-bar.lisp +;;;; +;;;; Copyright (C) 2007, Jack D. Unrue +;;;; All rights reserved. +;;;; +;;;; Redistribution and use in source and binary forms, with or without +;;;; modification, are permitted provided that the following conditions +;;;; are met: +;;;; +;;;; 1. Redistributions of source code must retain the above copyright +;;;; notice, this list of conditions and the following disclaimer. +;;;; +;;;; 2. Redistributions in binary form must reproduce the above copyright +;;;; notice, this list of conditions and the following disclaimer in the +;;;; documentation and/or other materials provided with the distribution. +;;;; +;;;; 3. Neither the names of the authors nor the names of its contributors +;;;; may be used to endorse or promote products derived from this software +;;;; without specific prior written permission. +;;;; +;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY +;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS- +;;;; CLAIMED. IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY +;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; + +(in-package :graphic-forms.uitoolkit.widgets) + +;;; +;;; methods +;;; + +(defmethod compute-style-flags ((self status-bar) &rest extra-data) + (declare (ignore extra-data)) + (values (logior gfs::+ws-child+ gfs::+ws-visible+ gfs::+sbars-sizegrip+) 0)) + +(defmethod initialize-instance :after ((self status-bar) &key parent &allow-other-keys) + (create-control self parent "" gfs::+icc-win95-classes+)) Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; top-level.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -120,15 +120,21 @@ |# (:horizontal-scrollbar (setf std-flags (logior std-flags gfs::+ws-hscroll+))) + (:status-bar) ;; nothing to do, but need to allow this style symbol (:vertical-scrollbar (setf std-flags (logior std-flags gfs::+ws-vscroll+))))) (values std-flags ex-flags))) (defmethod gfs:dispose ((self top-level)) - (let ((m (menu-bar self))) - (unless (null m) - (visit-menu-tree m #'menu-cleanup-callback) - (delete-widget (thread-context) (gfs:handle m)))) + (let ((menu (menu-bar self)) + (sbar (status-bar-of self)) + (tc (thread-context))) + (when menu + (visit-menu-tree menu #'menu-cleanup-callback) + (delete-widget tc (gfs:handle menu))) + (when sbar + (delete-widget tc (gfs:handle sbar)) + (setf (slot-value self 'status-bar) nil))) (call-next-method)) (defmethod initialize-instance :after ((self top-level) &key owner text &allow-other-keys) Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; widget-classes.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -245,6 +245,13 @@ :allocation :class)) ; shadowing same slot from event-source (:documentation "The menu class represents a container for menu items (and submenus).")) +(defclass status-bar (control item-manager layout-managed) + ((system-classname + :reader system-classname-of + :initform "msctls_statusbar32" + :allocation :class)) + (:documentation "This class represents the status bar widget configured within top-level windows.")) + (defclass window (widget layout-managed) ((max-size :initarg :maximum-size @@ -254,7 +261,10 @@ :initform nil)) (:documentation "Base class for user-defined widgets that serve as containers.")) -(defclass dialog (window) () +(defclass dialog (window) + ((status-bar + :reader status-bar-of + :initform nil)) (:documentation "The dialog class is the base class for both system-defined and application-defined dialogs.")) (defclass panel (window) () @@ -263,7 +273,10 @@ (defclass root-window (window) () (:documentation "This class encapsulates the root of the desktop window hierarchy.")) -(defclass top-level (window) () +(defclass top-level (window) + ((status-bar + :reader status-bar-of + :initform nil)) (:documentation "Base class for windows that can be moved and resized by the user, and which normally have title bars.")) (defclass timer (event-source) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Wed Jan 3 22:04:43 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; window.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -61,6 +61,8 @@ (if (find :keyboard-navigation (style-of win)) (put-kbdnav-widget tc win)) (put-widget tc win)) + (if (find :status-bar (style-of win)) + (setf (slot-value win 'status-bar) (make-instance 'status-bar :parent win))) ;; FIXME: this is a temporary hack to allow layout management testing; ;; it breaks in the presence of virtual containers like group ;; @@ -269,8 +271,8 @@ (update-scrollbar-page-sizes self) (update-scrolling-state self :both)) -(defmethod event-resize ((disp event-dispatcher) (self window) size type) - (declare (ignore size type)) +(defmethod event-resize (disp (self window) size type) + (declare (ignore disp size type)) (unless (null (layout-of self)) (let ((sz (client-size self))) (perform (layout-of self) self (gfs:size-width sz) (gfs:size-height sz)))))