Author: junrue Date: Tue Mar 28 23:30:00 2006 New Revision: 82

Added: trunk/src/uitoolkit/graphics/font-data.lisp trunk/src/uitoolkit/graphics/graphics-constants.lisp Modified: trunk/docs/manual/api.texinfo trunk/docs/manual/reference.texinfo trunk/graphic-forms-uitoolkit.asd trunk/src/packages.lisp trunk/src/tests/uitoolkit/drawing-tester.lisp trunk/src/tests/uitoolkit/hello-world.lisp trunk/src/uitoolkit/graphics/graphics-classes.lisp trunk/src/uitoolkit/graphics/graphics-context.lisp trunk/src/uitoolkit/system/gdi32.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/system/system-types.lisp trunk/src/uitoolkit/system/system-utils.lisp trunk/src/uitoolkit/widgets/button.lisp trunk/src/uitoolkit/widgets/label.lisp trunk/src/uitoolkit/widgets/panel.lisp trunk/src/uitoolkit/widgets/top-level.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp Log: implemented font-data structure and data->font converter function, as a precursor to allowing fonts to be selected in graphics contexts

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Tue Mar 28 23:30:00 2006 @@ -689,6 +689,68 @@ object. @xref{font-metrics}. @end deftp

+@anchor{font-data} +@deftp Structure font-data char-set face-name point-size style +This structure describes basic attributes of a font that the system font mapper +can use to match a logical @ref{font}.@*@* +The @code{face-name} slot holds the text name of the requested font. +For example, @samp{Times New Roman}.@*@* +The @code{char-set} slot identifies the character set of the requested +font. It can be one of the following values: +@itemize @bullet +@item @code{+ansi-charset+} +@item @code{+arabic-charset+} +@item @code{+baltic-charset+} +@item @code{+chinesebig5-charset+} +@item @code{+default-charset+} +@item @code{+easteurope-charset+} +@item @code{+gb2312-charset+} +@item @code{+greek-charset+} +@item @code{+hangeul-charset+} +@item @code{+hangul-charset+} +@item @code{+hebrew-charset+} +@item @code{+johab-charset+} +@item @code{+mac-charset+} +@item @code{+oem-charset+} +@item @code{+russian-charset+} +@item @code{+shiftjis-charset+} +@item @code{+symbol-charset+} +@item @code{+thai-charset+} +@item @code{+turkish-charset+} +@item @code{+vietnamese-charset+} +@end itemize +@strong{Note:} a future release will include Unicode support by +default; in the meantime, the actual character range is currently +limited to @sc{ascii}.@*@* +The @code{point-size} slot holds the font's point size. The +special value @code{0} instructs the mapper to return a font in the +default size defined for the corresponding face name and style.@*@* +The @code{style} slot holds a list of keywords that further specify attributes +of the requested font. One or more of the following may be specified: +@itemize @bullet +@item one of the following font weight keywords: +@itemize @minus +@item @code{:bold} specifies that the font should be bold +@item @code{:normal} specifies that the font should be normal weight (this is the default) +@end itemize +@item one of the following pitch keywords: +@itemize @minus +@item @code{:fixed} to request a fixed-width font +@item @code{:variable} to request a variable-width font +@end itemize +@item one of the following precision keywords: +@itemize @minus +@item @code{:truetype-only} requests that only a TrueType@registeredsymbol{} font should +be returned +@item @code{:outline} may be specified to request an outline +font or a TrueType@registeredsymbol{} font +@end itemize +@item @code{:italic} may be included to request an italic effect +@item @code{:strikeout} may be included to request a strike-through effect +@item @code{:underline} may be included to request an underline effect +@end itemize +@end deftp + @anchor{font-metrics} @deftp Structure font-metrics ascent descent leading avg-char-width max-char-width This structure describes basic attributes of a font in terms that drawing code

Modified: trunk/docs/manual/reference.texinfo ============================================================================== --- trunk/docs/manual/reference.texinfo (original) +++ trunk/docs/manual/reference.texinfo Tue Mar 28 23:30:00 2006 @@ -126,7 +126,7 @@

@titlepage @title Graphic-Forms Programming Reference -@c @subtitle Version 0.2.0 +@c @subtitle Version 0.3 @c @author Jack D. Unrue

@page @@ -136,7 +136,7 @@

@ifnottex @node Top -@top Graphic-Forms Programming Reference (version 0.2) +@top Graphic-Forms Programming Reference (version 0.3) @insertcopying @end ifnottex

Modified: trunk/graphic-forms-uitoolkit.asd ============================================================================== --- trunk/graphic-forms-uitoolkit.asd (original) +++ trunk/graphic-forms-uitoolkit.asd Tue Mar 28 23:30:00 2006 @@ -69,12 +69,14 @@ :components ((:file "magick-core-types") (:file "magick-core-api") + (:file "graphics-constants") (:file "graphics-classes") (:file "graphics-generics") (:file "color") (:file "palette") (:file "image-data") (:file "image") + (:file "font-data") (:file "font") (:file "graphics-context"))) (:module "widgets"

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Tue Mar 28 23:30:00 2006 @@ -62,6 +62,7 @@ #:detail #:dispose #:disposed-p + #:flatten #:handle #:location #:make-point @@ -77,6 +78,7 @@ #:size-width #:span-start #:span-end + #:zero-mem

;; conditions #:disposed-error @@ -96,6 +98,7 @@

;; classes and structs #:font + #:font-data #:font-metrics #:graphics-context #:image @@ -155,6 +158,10 @@ #:draw-text #:fill-rule #:font + #:font-data-char-set + #:font-data-face-name + #:font-data-point-size + #:font-data-style #:foreground-color #:foreground-pattern #:green-mask @@ -169,6 +176,8 @@ #:line-width #:load #:make-color + #:make-font-data + #:make-image-data #:matrix #:maximum-char-width #:metrics

Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/drawing-tester.lisp (original) +++ trunk/src/tests/uitoolkit/drawing-tester.lisp Tue Mar 28 23:30:00 2006 @@ -272,6 +272,16 @@ (setf (draw-func-of *drawing-dispatcher*) #'draw-rects) (gfw:redraw *drawing-win*))

+(defun draw-strings (gc) + (setf (gfg:foreground-color gc) gfg:*color-blue*) + (gfg:draw-text gc "This is a placeholder." (gfs:make-point))) + +(defun select-text (disp item time rect) + (declare (ignore disp time rect)) + (update-drawing-item-check item) + (setf (draw-func-of *drawing-dispatcher*) #'draw-strings) + (gfw:redraw *drawing-win*)) + (defun draw-wedges (gc) (let* ((rect-pnt (gfs:make-point :x 5 :y 10)) (rect-size (gfs:make-size :width 80 :height 65)) @@ -305,7 +315,8 @@ (:item "&Ellipses" :callback #'select-ellipses) (:item "&Lines and Polylines" :callback #'select-lines) (:item "&Pie Wedges" :callback #'select-wedges) - (:item "&Rectangles" :callback #'select-rects))))))) + (:item "&Rectangles" :callback #'select-rects) + (:item "&Text" :callback #'select-text))))))) (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*

Modified: trunk/src/tests/uitoolkit/hello-world.lisp ============================================================================== --- trunk/src/tests/uitoolkit/hello-world.lisp (original) +++ trunk/src/tests/uitoolkit/hello-world.lisp Tue Mar 28 23:30:00 2006 @@ -37,12 +37,17 @@

(defclass hellowin-events (gfw:event-dispatcher) ())

-(defmethod gfw:event-close ((d hellowin-events) window time) - (declare (ignore time)) - (gfs:dispose window) +(defun exit-fn (disp item time rect) + (declare (ignorable disp item time rect)) + (gfs:dispose *hello-win*) + (setf *hello-win* nil) (gfw:shutdown 0))

-(defmethod gfw:event-paint ((d hellowin-events) window time gc rect) +(defmethod gfw:event-close ((disp hellowin-events) window time) + (declare (ignore window)) + (exit-fn disp nil time nil)) + +(defmethod gfw:event-paint ((disp hellowin-events) window time gc rect) (declare (ignore time)) (setf rect (make-instance 'gfs:rectangle :location (gfs:make-point) :size (gfw:client-size window))) @@ -53,12 +58,6 @@ (setf (gfg:foreground-color gc) gfg:*color-green*) (gfg:draw-text gc "Hello World!" (gfs:make-point)))

-(defun exit-fn (disp item time rect) - (declare (ignorable disp item time rect)) - (gfs:dispose *hello-win*) - (setf *hello-win* nil) - (gfw:shutdown 0)) - (defun run-hello-world-internal () (let ((menubar nil)) (setf *hello-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'hellowin-events)

Added: trunk/src/uitoolkit/graphics/font-data.lisp ============================================================================== --- (empty file) +++ trunk/src/uitoolkit/graphics/font-data.lisp Tue Mar 28 23:30:00 2006 @@ -0,0 +1,79 @@ +;;;; +;;;; font-data.lisp +;;;; +;;;; Copyright (C) 2006, 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.graphics) + +(defun compute-font-weight (style) + (if (null (find :bold style)) + gfs::+fw-normal+ + gfs::+fw-bold+)) + +(defun compute-font-precis (style) + (if (find :truetype-only style) + (return-from compute-font-precis gfs::+out-tt-only-precis+)) + (if (find :outline style) + (return-from compute-font-precis gfs::+out-outline-precis+)) + gfs::+out-default-precis+) + +(defun compute-font-pitch (style) + (if (find :fixed style) + (return-from compute-font-pitch gfs::+fixed-pitch+)) + (if (find :variable style) + (return-from compute-font-pitch gfs::+variable-pitch+)) + gfs::+default-pitch+) + +(defun data->font (data) + (let ((hfont (cffi:null-pointer)) + (style (font-data-style data))) + (cffi:with-foreign-object (lf-ptr 'gfs::logfont) + (gfs:zero-mem lf-ptr gfs::logfont) + (cffi:with-foreign-slots ((gfs::lfheight gfs::lfweight gfs::lfitalic gfs::lfunderline + gfs::lfstrikeout gfs::lfcharset gfs::lfoutprec + gfs::lfpitchandfamily gfs::lffacename) + lf-ptr gfs::logfont) + (setf gfs::lfheight (- 0 (font-data-point-size data))) + (setf gfs::lfweight (compute-font-weight style)) + (setf gfs::lfitalic (if (null (find :italic style)) 0 1)) + (setf gfs::lfunderline (if (null (find :underline style)) 0 1)) + (setf gfs::lfstrikeout (if (null (find :strikeout style)) 0 1)) + (setf gfs::lfcharset (font-data-char-set data)) + (setf gfs::lfoutprec (compute-font-precis style)) + (setf gfs::lfpitchandfamily (compute-font-pitch style)) + (cffi:with-foreign-string (str (font-data-face-name data)) + (gfs::strncpy (cffi:foreign-slot-pointer lf-ptr 'gfs::logfont 'gfs::lffacename) + str + (1- gfs::+lf-facesize+)))) + (setf hfont (gfs::create-font-indirect lf-ptr)) + (if (gfs:null-handle-p hfont) + (error 'gfs:win32-error :detail "create-font-indirect failed"))) + hfont))

Modified: trunk/src/uitoolkit/graphics/graphics-classes.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/graphics-classes.lisp (original) +++ trunk/src/uitoolkit/graphics/graphics-classes.lisp Tue Mar 28 23:30:00 2006 @@ -39,6 +39,12 @@ (green 0) (blue 0))

+ (defstruct font-data + (char-set 1) ; gfg:+default-charset+ (ie., the default for the machine) + (face-name "") + (point-size 10) + (style nil)) + (defstruct font-metrics (ascent 0) (descent 0)

Added: trunk/src/uitoolkit/graphics/graphics-constants.lisp ============================================================================== --- (empty file) +++ trunk/src/uitoolkit/graphics/graphics-constants.lisp Tue Mar 28 23:30:00 2006 @@ -0,0 +1,59 @@ +;;;; +;;;; graphics-constants.lisp +;;;; +;;;; Copyright (C) 2006, 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.graphics) + +;;; The following are transcribed from WinGDI.h; +;;; specify one of them as the value of the char-set +;;; slot in the font-data structure. +;;; +(defconstant +ansi-charset+ 0) +(defconstant +default-charset+ 1) +(defconstant +symbol-charset+ 2) +(defconstant +shiftjis-charset+ 128) +(defconstant +hangeul-charset+ 129) +(defconstant +hangul-charset+ 129) +(defconstant +gb2312-charset+ 134) +(defconstant +chinesebig5-charset+ 136) +(defconstant +oem-charset+ 255) +(defconstant +johab-charset+ 130) +(defconstant +hebrew-charset+ 177) +(defconstant +arabic-charset+ 178) +(defconstant +greek-charset+ 161) +(defconstant +turkish-charset+ 162) +(defconstant +vietnamese-charset+ 163) +(defconstant +thai-charset+ 222) +(defconstant +easteurope-charset+ 238) +(defconstant +russian-charset+ 204) +(defconstant +mac-charset+ 77) +(defconstant +baltic-charset+ 186)

Modified: trunk/src/uitoolkit/graphics/graphics-context.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/graphics-context.lisp (original) +++ trunk/src/uitoolkit/graphics/graphics-context.lisp Tue Mar 28 23:30:00 2006 @@ -426,6 +426,8 @@ (when (null (gfs:handle self)) (setf (owns-dc self) t) (setf (slot-value self 'gfs:handle) (gfs::create-compatible-dc (cffi:null-pointer)))) + ;; ensure world-to-device transformation conformance + (gfs::set-graphics-mode (gfs:handle self) gfs::+gm-advanced+) (update-pen-for-gc self))

(defmethod (setf pen-style) :around (style (self graphics-context))

Modified: trunk/src/uitoolkit/system/gdi32.lisp ============================================================================== --- trunk/src/uitoolkit/system/gdi32.lisp (original) +++ trunk/src/uitoolkit/system/gdi32.lisp Tue Mar 28 23:30:00 2006 @@ -125,6 +125,11 @@ (offset DWORD))

(defcfun + ("CreateFontIndirectA" create-font-indirect) + HANDLE + (logfont LPTR)) + +(defcfun ("CreatePen" create-pen) HANDLE (style INT) @@ -349,6 +354,12 @@ (color-use UINT))

(defcfun + ("SetGraphicsMode" set-graphics-mode) + INT + (hdc HANDLE) + (mode INT)) + +(defcfun ("SetMiterLimit" set-miter-limit) BOOL (hdc HANDLE)

Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Tue Mar 28 23:30:00 2006 @@ -192,13 +192,31 @@

(defconstant +eto-opaque+ #x0002) (defconstant +eto-clipped+ #x0004) -(defconstant +eto-glyph_index+ #x0010) +(defconstant +eto-glyph-index+ #x0010) (defconstant +eto-rtlreading+ #x0080) (defconstant +eto-numericslocal+ #x0400) (defconstant +eto-numericslatin+ #x0800) (defconstant +eto-ignorelanguage+ #x1000) (defconstant +eto-pdy+ #x2000)

+(defconstant +ff-dontcare+ #x0000) +(defconstant +ff-roman+ #x0010) +(defconstant +ff-swiss+ #x0020) +(defconstant +ff-modern+ #x0030) +(defconstant +ff-script+ #x0040) +(defconstant +ff-decorative+ #x0050) + +(defconstant +fw-dontcare+ 0) +(defconstant +fw-thin+ 100) +(defconstant +fw-extralight+ 200) +(defconstant +fw-light+ 300) +(defconstant +fw-normal+ 400) +(defconstant +fw-medium+ 500) +(defconstant +fw-semibold+ 600) +(defconstant +fw-bold+ 700) +(defconstant +fw-extrabold+ 800) +(defconstant +fw-heavy+ 900) + (defconstant +ga-parent+ 1) (defconstant +ga-root+ 2) (defconstant +ga-rootowner+ 3) @@ -215,6 +233,10 @@ (defconstant +gcw-atom+ -32) (defconstant +gclp-hiconsm+ -34)

+(defconstant +gm-compatible+ 1) +(defconstant +gm-advanced+ 2) +(defconstant +gm-last+ 3) + (defconstant +gwlp-wndproc+ -4) (defconstant +gwlp-hinstance+ -6) (defconstant +gwl-hwndparent+ -8) @@ -235,6 +257,9 @@ (defconstant +image-cursor+ 2) (defconstant +image-enhmetafile+ 3)

+(defconstant +lf-facesize+ 32) +(defconstant +lf-fullfacesize+ 64) + (defconstant +lr-defaultcolor+ #x0000) (defconstant +lr-monochrome+ #x0001) (defconstant +lr-color+ #x0002) @@ -368,6 +393,18 @@ (defconstant +ocr-hand+ 32649) (defconstant +ocr-appstarting+ 32650)

+(defconstant +out-default-precis+ 0) +(defconstant +out-string-precis+ 1) +(defconstant +out-character-precis+ 2) +(defconstant +out-stroke-precis+ 3) +(defconstant +out-tt-precis+ 4) +(defconstant +out-device-precis+ 5) +(defconstant +out-raster-precis+ 6) +(defconstant +out-tt-only-precis+ 7) +(defconstant +out-outline-precis+ 8) +(defconstant +out-screen-outline-precis+ 9) +(defconstant +out-ps-only-precis+ 10) + (defconstant +qs-key+ #x0001) (defconstant +qs-mousemove+ #x0002) (defconstant +qs-mousebutton+ #x0004) @@ -751,3 +788,7 @@ (defconstant +default-gui-font+ 17) (defconstant +dc-brush+ 18) (defconstant +dc-pen+ 19) + +(defconstant +default-pitch+ 0) +(defconstant +fixed-pitch+ 1) +(defconstant +variable-pitch+ 2)

Modified: trunk/src/uitoolkit/system/system-types.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-types.lisp (original) +++ trunk/src/uitoolkit/system/system-types.lisp Tue Mar 28 23:30:00 2006 @@ -119,6 +119,22 @@ (color COLORREF) (hatch LONG))

+(defcstruct logfont + (lfheight LONG) + (lfwidth LONG) + (lfescapement LONG) + (lforientation LONG) + (lfweight LONG) + (lfitalic LONG) + (lfunderline LONG) + (lfstrikeout LONG) + (lfcharset LONG) + (lfoutprec LONG) + (lfclipprec LONG) + (lfquality LONG) + (lfpitchandfamily LONG) + (lffacename TCHAR :count 32)) ; LF_FACESIZE is 32 + (defcstruct menuinfo (cbsize DWORD) (mask DWORD)

Modified: trunk/src/uitoolkit/system/system-utils.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-utils.lisp (original) +++ trunk/src/uitoolkit/system/system-utils.lisp Tue Mar 28 23:30:00 2006 @@ -34,6 +34,23 @@ (in-package :graphic-forms.uitoolkit.system)

;;; +;;; convenience functions +;;; + +(defun flatten (tree) + (if (cl:atom tree) + (list tree) + (mapcan (function flatten) tree))) + +;;; lifted from lispbuilder-windows/windows/util.lisp +;;; author: Frank Buss +;;; +(defmacro zero-mem (object type) + (let ((i (gensym))) + `(loop for ,i from 0 below (foreign-type-size (quote ,type)) do + (setf (mem-aref ,object :char ,i) 0)))) + +;;; ;;; convenience macros ;;;

Modified: trunk/src/uitoolkit/widgets/button.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/button.lisp (original) +++ trunk/src/uitoolkit/widgets/button.lisp Tue Mar 28 23:30:00 2006 @@ -41,7 +41,7 @@ (declare (ignore btn)) (let ((std-flags 0) (ex-flags 0)) - (setf style (flatten style)) + (setf style (gfs:flatten style)) ;; FIXME: check whether any of the primary button ;; styles were specified, default to :push-button ;;

Modified: trunk/src/uitoolkit/widgets/label.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/label.lisp (original) +++ trunk/src/uitoolkit/widgets/label.lisp Tue Mar 28 23:30:00 2006 @@ -41,7 +41,7 @@ (declare (ignore label)) (let ((std-flags 0) (ex-flags 0)) - (setf style (flatten style)) + (setf style (gfs:flatten style)) (unless (or (find :beginning style) (find :center style) (find :end style))

Modified: trunk/src/uitoolkit/widgets/panel.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/panel.lisp (original) +++ trunk/src/uitoolkit/widgets/panel.lisp Tue Mar 28 23:30:00 2006 @@ -58,7 +58,7 @@ ;; ((eq sym :style-border) (setf std-flags (logior std-flags gfs::+ws-border+))))) - (flatten style)) + (gfs:flatten style)) (values std-flags ex-flags)))

(defmethod initialize-instance :after ((self panel) &key parent style &allow-other-keys)

Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Tue Mar 28 23:30:00 2006 @@ -107,7 +107,7 @@ gfs::+ws-clipsiblings+ gfs::+ws-clipchildren+)) (setf ex-flags 0)))) - (flatten style)) + (gfs:flatten style)) (values std-flags ex-flags)))

(defmethod gfs:dispose ((win top-level))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Tue Mar 28 23:30:00 2006 @@ -76,13 +76,6 @@ (cffi:null-pointer) 0))))

-;;; FIXME: move this to a common, non-UI module -;;; -(defun flatten (tree) - (if (atom tree) - (list tree) - (mapcan (function flatten) tree))) - (defun get-widget-text (w) (if (gfs:disposed-p w) (error 'gfs:disposed-error))