[graphic-forms-cvs] r457 - in trunk: docs/manual src/demos/unblocked src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Apr 3 02:37:55 UTC 2007
Author: junrue
Date: Mon Apr 2 22:37:50 2007
New Revision: 457
Modified:
trunk/docs/manual/gfw-symbols.xml
trunk/src/demos/unblocked/unblocked-window.lisp
trunk/src/uitoolkit/widgets/control.lisp
trunk/src/uitoolkit/widgets/status-bar.lisp
trunk/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: trunk/docs/manual/gfw-symbols.xml
==============================================================================
--- trunk/docs/manual/gfw-symbols.xml (original)
+++ trunk/docs/manual/gfw-symbols.xml Mon Apr 2 22:37:50 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: trunk/src/demos/unblocked/unblocked-window.lisp
==============================================================================
--- trunk/src/demos/unblocked/unblocked-window.lisp (original)
+++ trunk/src/demos/unblocked/unblocked-window.lisp Mon Apr 2 22:37:50 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: trunk/src/uitoolkit/widgets/control.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/control.lisp (original)
+++ trunk/src/uitoolkit/widgets/control.lisp Mon Apr 2 22:37:50 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: trunk/src/uitoolkit/widgets/status-bar.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/status-bar.lisp (original)
+++ trunk/src/uitoolkit/widgets/status-bar.lisp Mon Apr 2 22:37:50 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: trunk/src/uitoolkit/widgets/top-level.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/top-level.lisp (original)
+++ trunk/src/uitoolkit/widgets/top-level.lisp Mon Apr 2 22:37:50 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