[graphic-forms-cvs] r456 - in branches/graphic-forms-newtypes: . docs/manual src/demos/unblocked src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Apr 3 02:37:04 UTC 2007
Author: junrue
Date: Mon Apr 2 22:37:00 2007
New Revision: 456
Modified:
branches/graphic-forms-newtypes/NEWS.txt
branches/graphic-forms-newtypes/docs/manual/gfw-symbols.xml
branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp
branches/graphic-forms-newtypes/src/uitoolkit/widgets/control.lisp
branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp
branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp
Log:
implemented new top-level style :fixed-size and modified gfw:pack to set min and max sizes when :fixed-size has been set; added another optional parameter to CREATE-CONTROL convenience function to allow control initializers to pass params to their implementations of COMPUTE-STYLE-FLAGS
Modified: branches/graphic-forms-newtypes/NEWS.txt
==============================================================================
--- branches/graphic-forms-newtypes/NEWS.txt (original)
+++ branches/graphic-forms-newtypes/NEWS.txt Mon Apr 2 22:37:00 2007
@@ -3,6 +3,14 @@
stdcall calling convention (FIXME: change checked in this past Feb., need
to narrow down which snapshot actually has it).
+. Implemented simple-mode status bars, which have a single text field.
+ Multi-part status bars, and nested widget support, will be added in a
+ future release.
+
+. Simplified the mechanism for specifying fixed, non-resizable windows by
+ adding a new GFW:TOP-LEVEL style called :FIXED-SIZE and enhancing GFW:PACK
+ to do the right thing if that style flag has been specified.
+
. Greatly expanded the symbols for accessing predefined colors, and now
provide access to system color settings in a similar manner.
Modified: branches/graphic-forms-newtypes/docs/manual/gfw-symbols.xml
==============================================================================
--- branches/graphic-forms-newtypes/docs/manual/gfw-symbols.xml (original)
+++ branches/graphic-forms-newtypes/docs/manual/gfw-symbols.xml Mon Apr 2 22:37:00 2007
@@ -1419,6 +1419,12 @@
</enum>
One or more of the following optional styles:
<enum>
+ <argument name=":fixed-size">
+ <description>
+ The resulting window cannot be dragged to a new size, but a layout
+ manager can still resize it programmatically.
+ </description>
+ </argument>
<argument name=":horizontal-scrollbar"/>
<argument name=":status-bar"/>
<argument name=":vertical-scrollbar"/>
Modified: branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp (original)
+++ branches/graphic-forms-newtypes/src/demos/unblocked/unblocked-window.lisp Mon Apr 2 22:37:00 2007
@@ -112,7 +112,7 @@
:style :vertical
:spacing +spacing+
:margins +margin+)
- :style '(:workspace :status-bar)))
+ :style '(:fixed-size :workspace :status-bar)))
(setf (gfw:menu-bar *unblocked-win*) menubar)
(setf *scoreboard-panel* (make-instance 'scoreboard-panel
:parent *unblocked-win*
@@ -126,10 +126,7 @@
:buffer-size tile-buffer-size)))
(setf (gfw:text *unblocked-win*) "UnBlocked")
- (setf (gfw:resizable-p *unblocked-win*) nil)
- (let ((size (gfw:preferred-size *unblocked-win* -1 -1)))
- (setf (gfw:minimum-size *unblocked-win*) size
- (gfw:maximum-size *unblocked-win*) size))
+ (gfw:pack *unblocked-win*)
(new-unblocked nil nil)
(let ((*default-pathname-defaults* (parse-namestring gfsys::*unblocked-dir*)))
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/control.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/widgets/control.lisp (original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/control.lisp Mon Apr 2 22:37:00 2007
@@ -1,7 +1,7 @@
;;;;
;;;; control.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
@@ -45,10 +45,10 @@
(if (and (zerop (gfs::init-common-controls ic-ptr)) (/= (gfs::get-last-error) 0))
(warn 'gfs:win32-warning :detail "init-common-controls failed"))))
-(defun create-control (ctrl parent text icc-flags &optional id)
+(defun create-control (ctrl parent text icc-flags &optional id extra-data)
(initialize-comctl-classes icc-flags)
(multiple-value-bind (std-style ex-style)
- (compute-style-flags ctrl)
+ (compute-style-flags ctrl extra-data)
(let ((hwnd (create-window (system-classname-of ctrl)
(or text " ")
(gfs:handle parent)
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp (original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/status-bar.lisp Mon Apr 2 22:37:00 2007
@@ -104,11 +104,16 @@
(max (first widths) (second widths))))
(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))
+ (let ((extra-bits (if (first extra-data) 0 gfs::+sbars-sizegrip+)))
+ (values (logior gfs::+ws-child+ gfs::+ws-visible+ extra-bits) 0)))
(defmethod initialize-instance :after ((self status-bar) &key parent &allow-other-keys)
- (let ((hctl (create-control self parent "" gfs::+icc-win95-classes+)))
+ (let ((hctl (create-control self
+ parent
+ ""
+ gfs::+icc-win95-classes+
+ nil
+ (find :fixed-size (style-of parent)))))
(gfs::send-message hctl gfs::+sb-simple+ 1 0))
(let ((widths (stb-get-border-widths self)))
(setf (layout-of self) (make-instance 'flow-layout :spacing (third widths)))))
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp (original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp Mon Apr 2 22:37:00 2007
@@ -111,13 +111,10 @@
;; styles that can be combined
;;
-#|
- (:max (setf std-flags (logior std-flags gfs::+ws-maximizebox+)))
- (:min (setf std-flags (logior std-flags gfs::+ws-minimizebox+)))
- (:sysmenu (setf std-flags (logior std-flags gfs::+ws-sysmenu+)))
- (:title (setf std-flags (logior std-flags gfs::+ws-caption+)))
- (:top (setf ex-flags (logior ex-flags gfs::+ws-ex-topmost+)))
-|#
+ (:fixed-size
+ (setf std-flags (logand std-flags
+ (lognot (logior gfs::+ws-maximizebox+
+ gfs::+ws-thickframe+)))))
(:horizontal-scrollbar
(setf std-flags (logior std-flags gfs::+ws-hscroll+)))
(:status-bar) ;; nothing to do, but need to allow this style symbol
@@ -198,6 +195,13 @@
(when (and (maximum-size self) min-size)
(update-top-level-resizability self (gfs:equal-size-p min-size (maximum-size self)))))
+(defmethod pack ((win window))
+ (if (find :fixed-size (style-of win))
+ (let ((size (gfw:preferred-size win -1 -1)))
+ (setf (gfw:minimum-size win) size
+ (gfw:maximum-size win) size)))
+ (call-next-method))
+
(defmethod preferred-size ((self top-level) width-hint height-hint)
(declare (ignore width-hint height-hint))
(let ((size (call-next-method))
More information about the Graphic-forms-cvs
mailing list