graphic-forms-cvs

graphic-forms-cvs@common-lisp.net

461 discussions

[graphic-forms-cvs] r481 - trunk/src/uitoolkit/system
by junrue＠common-lisp.net 09 Sep '07

09 Sep '07

Author: junrue Date: Sun Sep 9 15:38:06 2007 New Revision: 481 Modified: trunk/src/uitoolkit/system/system-conditions.lisp trunk/src/uitoolkit/system/system-constants.lisp Log: change derivation of toolkit-error and toolkit-warning to simple-error, so that we can take advantage of :format-control and :format-control, but continue to support detail slot Modified: trunk/src/uitoolkit/system/system-conditions.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-conditions.lisp (original) +++ trunk/src/uitoolkit/system/system-conditions.lisp Sun Sep 9 15:38:06 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; system-conditions.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 @@ -33,19 +33,27 @@ (in-package :graphic-forms.uitoolkit.system) -(define-condition toolkit-error (error) - ((detail :reader detail :initarg :detail :initform "not specified"))) +(define-condition toolkit-error (simple-error) + ((detail :reader detail :initarg :detail :initform nil))) (defmethod print-object ((obj toolkit-error) stream) - (print-unreadable-object (obj stream :type t) - (format stream "~s" (detail obj)))) + (let ((detail (detail obj))) + (cond + (detail + (format stream "~a" detail)) + (t + (call-next-method))))) -(define-condition toolkit-warning (warning) - ((detail :reader detail :initarg :detail :initform "not specified"))) +(define-condition toolkit-warning (simple-warning) + ((detail :reader detail :initarg :detail :initform nil))) (defmethod print-object ((obj toolkit-warning) stream) - (print-unreadable-object (obj stream :type t) - (format stream "~s" (detail obj)))) + (let ((detail (detail obj))) + (cond + (detail + (format stream "~a" detail)) + (t + (call-next-method))))) (define-condition disposed-error (error) ()) @@ -53,19 +61,16 @@ ((code :reader code :initarg :code :initform (get-last-error)))) (defmethod print-object ((obj win32-error) stream) - (print-unreadable-object (obj stream :type t) - (format stream "~s: error code: ~a" (detail obj) (code obj)))) + (format stream "code ~a: ~a" (code obj) (detail obj))) (define-condition win32-warning (toolkit-warning) ((code :reader code :initarg :code :initform (get-last-error)))) (defmethod print-object ((obj win32-warning) stream) - (print-unreadable-object (obj stream :type t) - (format stream "~s: error code: ~a" (detail obj) (code obj)))) + (format stream "code ~a: ~a" (code obj) (detail obj))) (define-condition comdlg-error (win32-error) ((dlg-code :reader dlg-code :initarg :dlg-code :initform (comm-dlg-extended-error)))) (defmethod print-object ((obj comdlg-error) stream) - (print-unreadable-object (obj stream :type t) - (format stream "~s: common dialog error code: ~a" (detail obj) (dlg-code obj)))) + (format stream "common dialog code ~a: ~a" (code obj) (detail obj))) Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Sun Sep 9 15:38:06 2007 @@ -1517,6 +1517,8 @@ (defconstant +wm-chartoitem+ #x002F) (defconstant +wm-setfont+ #x0030) (defconstant +wm-getfont+ #x0031) +(defconstant +wm-windowposchanging+ #x0046) +(defconstant +wm-windowposchanged+ #x0047) (defconstant +wm-contextmenu+ #x007B) (defconstant +wm-stylechanging+ #x007C) (defconstant +wm-stylechanged+ #x007D)

1 0

[graphic-forms-cvs] r479 - tags/release-0.8.0
by junrue＠common-lisp.net 21 Aug '07

21 Aug '07

Author: junrue Date: Tue Aug 21 01:11:48 2007 New Revision: 479 Added: tags/release-0.8.0/ - copied from r478, trunk/ Log: tagging the 0.8.0 release

1 0

[graphic-forms-cvs] r478 - trunk
by junrue＠common-lisp.net 21 Aug '07

21 Aug '07

Author: junrue Date: Tue Aug 21 01:11:09 2007 New Revision: 478 Modified: trunk/LICENSE.txt Log: doc updates for 0.8.0 release Modified: trunk/LICENSE.txt ============================================================================== --- trunk/LICENSE.txt (original) +++ trunk/LICENSE.txt Tue Aug 21 01:11:09 2007 @@ -1,4 +1,4 @@ -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

1 0

[graphic-forms-cvs] r477 - in trunk: . docs/website
by junrue＠common-lisp.net 21 Aug '07

21 Aug '07

Author: junrue Date: Tue Aug 21 01:07:21 2007 New Revision: 477 Modified: trunk/NEWS.txt trunk/README.txt trunk/docs/website/index.html Log: doc updates for 0.8.0 release Modified: trunk/NEWS.txt ============================================================================== --- trunk/NEWS.txt (original) +++ trunk/NEWS.txt Tue Aug 21 01:07:21 2007 @@ -1,3 +1,8 @@ +Release 0.8.0 of Graphic-Forms, a Common Lisp library for Windows GUI +programming, is now available. The API and feature set is still evolving, +so this is still another alpha release. + +New in this release: . Added a new macro GFW:DEFMENU2 and associated function GFW:MAKE-MENU to allow applications to create reusable menu factories. @@ -47,7 +52,7 @@ Jack Unrue jdunrue (at) gmail (dot) com -xx xxxxxxx 2007 +20 August 2007 ============================================================================== Modified: trunk/README.txt ============================================================================== --- trunk/README.txt (original) +++ trunk/README.txt Tue Aug 21 01:07:21 2007 @@ -1,5 +1,5 @@ -Graphic-Forms README for version 0.8.0 (xx xxxxxx 2007) +Graphic-Forms README for version 0.8.0 (20 August 2007) Copyright (c) 2006-2007, Jack D. Unrue Graphic-Forms is a user interface library implemented in Common Lisp focusing @@ -17,7 +17,7 @@ http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/ *note: ASDF is bundled with SBCL* - - CFFI (cffi-XXXXXX or later) + - CFFI (cffi-070816 or later) http://common-lisp.net/project/cffi/ - Closer to MOP Modified: trunk/docs/website/index.html ============================================================================== --- trunk/docs/website/index.html (original) +++ trunk/docs/website/index.html Tue Aug 21 01:07:21 2007 @@ -38,7 +38,7 @@ <p>The current version is <a href="http://sourceforge.net/project/showfiles.php?group_id=163034"> - 0.8.0</a>, released on xx xxxxxxx 2007.</p> + 0.8.0</a>, released on 20 August 2007.</p> <p>Graphic-Forms is in the alpha stage of development, meaning new features are still being added and existing features require

1 0

[graphic-forms-cvs] r476 - in trunk: . docs/website src/tests/uitoolkit src/uitoolkit/widgets
by junrue＠common-lisp.net 21 Aug '07

21 Aug '07

Author: junrue Date: Tue Aug 21 00:45:23 2007 New Revision: 476 Modified: trunk/NEWS.txt trunk/README.txt trunk/docs/website/index.html trunk/src/tests/uitoolkit/widget-tester.lisp trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/widgets/dialog.lisp Log: applied patch 1748354 submitted by Leon van Dyk, and enabled a simple test case by reusing the dialog definition from the windlg test program Modified: trunk/NEWS.txt ============================================================================== --- trunk/NEWS.txt (original) +++ trunk/NEWS.txt Tue Aug 21 00:45:23 2007 @@ -5,6 +5,12 @@ . Latest CFFI is required to take advantage of built-in support for the stdcall calling convention. +. Integrated patch submitted by Leon van Dyk that enables dialog-only + applications. The GFT::STANDALONE-DIALOG function demonstrates this + feature, but NOTE that when this is invoked from SLIME, an old problem + reappears where the dialog is not initially visible; however, the same + demo run directly from the REPL works OK. + . Ported the library to Allegro CL 8.0. . Upgraded to LispWorks 5.0.1 (note: 4.4.6 is no longer supported) Modified: trunk/README.txt ============================================================================== --- trunk/README.txt (original) +++ trunk/README.txt Tue Aug 21 00:45:23 2007 @@ -74,11 +74,12 @@ the correct width. 5. If a Graphic-Forms application is launched from within SLIME with - SBCL as the backend (which is currently single-threaded on Win32), - further SLIME commands will be 'pipelined' until the Graphic-Forms - main message loop exits. If/when SBCL gains multi-threading support - on Win32, then the Graphic-Forms library code will be updated to - launch a separate thread, as is currently done for Allegro and LispWorks. + CLISP or SBCL as the backend (both of which are single-threaded on + Win32), further SLIME commands will be 'pipelined' until the + Graphic-Forms main message loop exits. If/when these implementations + gain multi-threading support on Win32, then the Graphic-Forms library + code will be updated to launch a separate thread, as is currently done + for Allegro and LispWorks. How To Configure and Build Modified: trunk/docs/website/index.html ============================================================================== --- trunk/docs/website/index.html (original) +++ trunk/docs/website/index.html Tue Aug 21 00:45:23 2007 @@ -47,7 +47,7 @@ <p>The supported Lisp implementations are: <ul> - <li><a href="http://franz.com/">Allegro CL 8.0</a> or later</li> + <li><a href="http://franz.com/">Allegro CL 8.0</a></li> <li><a href="http://clisp.cons.org/">CLISP 2.40</a> or later</li> <li><a href="http://www.lispworks.com/">LispWorks 5.0.1</a></li> <li><a href="http://www.sbcl.org/">SBCL 1.0.5</a> or later</li> Modified: trunk/src/tests/uitoolkit/widget-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/widget-tester.lisp (original) +++ trunk/src/tests/uitoolkit/widget-tester.lisp Tue Aug 21 00:45:23 2007 @@ -218,6 +218,7 @@ (format nil "~d" (gfw:thumb-position thing))) (defun populate-slider-test-panel () + (setf (gfw:text *widget-tester-win*) "Widget Tester (Sliders)") (let* ((layout1 (make-instance 'gfw:flow-layout :style '(:vertical) :spacing 4)) (layout2 (make-instance 'gfw:flow-layout :style '(:horizontal) :margins 4 :spacing 4)) (layout3 (make-instance 'gfw:flow-layout :style '(:horizontal) :margins 4 :spacing 4)) @@ -268,6 +269,7 @@ outer-panel)) (defun populate-progress-test-panel () + (setf (gfw:text *widget-tester-win*) "Widget Tester (Progress Bar)") (let* ((layout1 (make-instance 'gfw:border-layout :margins 4 :spacing 4)) (layout2 (make-instance 'gfw:flow-layout :margins 4)) (outer-panel (make-instance 'tester-panel :parent *widget-tester-win* Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Tue Aug 21 00:45:23 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; windlg.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 @@ -138,7 +138,10 @@ (defmethod gfw:event-close ((disp dialog-events) (dlg gfw:dialog)) (call-next-method) - (gfs:dispose dlg)) + (let ((ownerp (gfw:owner dlg))) + (gfs:dispose dlg) + (unless ownerp + (gfw:shutdown 0)))) (defclass edit-control-events (gfw:event-dispatcher) ()) @@ -154,8 +157,8 @@ (defmethod gfw:event-modify ((disp edit-control-events) (ctrl gfw:edit)) (format t "modified: ~a...~%" (truncate-text (gfw:text ctrl)))) -(defun open-dlg (title style) - (let* ((dlg (make-instance 'gfw:dialog :owner *main-win* +(defun open-dlg (title style parent) + (let* ((dlg (make-instance 'gfw:dialog :owner parent :dispatcher (make-instance 'dialog-events) :layout (make-instance 'gfw:flow-layout :margins 8 @@ -208,14 +211,20 @@ (ok-btn (make-instance 'gfw:button :callback (lambda (disp btn) (declare (ignore disp btn)) - (gfs:dispose dlg)) + (let ((ownerp (gfw:owner dlg))) + (gfs:dispose dlg) + (unless ownerp + (gfw:shutdown 0)))) :style '(:default-button) :text "OK" :parent btn-panel)) (cancel-btn (make-instance 'gfw:button :callback (lambda (disp btn) (declare (ignore disp btn)) - (gfs:dispose dlg)) + (let ((ownerp (gfw:owner dlg))) + (gfs:dispose dlg) + (unless ownerp + (gfw:shutdown 0)))) :style '(:cancel-button) :text "Cancel" :parent btn-panel))) @@ -224,17 +233,18 @@ (setf (gfw:text name-edit) "" (gfw:text pw-edit) "" (gfw:text desc-edit) "") - (gfw:center-on-owner dlg) + (if parent + (gfw:center-on-owner dlg)) (gfw:show dlg t) dlg)) (defun open-modal-dlg (disp item) (declare (ignore disp item)) - (open-dlg "Modal" '(:owner-modal))) + (open-dlg "Modal" '(:owner-modal) *main-win*)) (defun open-modeless-dlg (disp item) (declare (ignore disp item)) - (open-dlg "Modeless" '(:modeless))) + (open-dlg "Modeless" '(:modeless) *main-win*)) (defun windlg-internal () (let ((menubar nil)) @@ -260,3 +270,9 @@ (defun windlg () (gfw:startup "Window/Dialog Tester" #'windlg-internal)) + +(defun standalone-dialog-internal () + (open-dlg "Standalone Dialog" '(:modeless) nil)) + +(defun standalone-dialog () + (gfw:startup "Standalone Dialog Test" #'standalone-dialog-internal)) Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Tue Aug 21 00:45:23 2007 @@ -200,7 +200,7 @@ ;; owner of the dialog; it would cause the desktop to become ;; disabled. ;; - (if (cffi:pointer-eq (gfs:handle owner) (gfs::get-desktop-window)) + (if (and owner (cffi:pointer-eq (gfs:handle owner) (gfs::get-desktop-window))) (setf owner nil)) (push :keyboard-navigation (style-of self)) ;; FIXME: check if owner is actually a top-level or dialog, and if not,

1 0

[graphic-forms-cvs] r475 - trunk/src
by junrue＠common-lisp.net 20 Aug '07

20 Aug '07

Author: junrue Date: Sun Aug 19 23:51:52 2007 New Revision: 475 Modified: trunk/src/packages.lisp Log: make sure step and step-increments are exported from gfw Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Sun Aug 19 23:51:52 2007 @@ -587,7 +587,9 @@ #:spacing-of #:startup #:status-bar-of + #:step #:step-increment + #:step-increments #:style-of #:sub-menu #:text

1 0

[graphic-forms-cvs] r473 - in trunk: . docs/manual
by junrue＠common-lisp.net 13 Aug '07

13 Aug '07

Author: junrue Date: Mon Aug 13 01:52:39 2007 New Revision: 473 Modified: trunk/README.txt trunk/docs/manual/README.txt trunk/docs/manual/introduction.xml Log: miscellaneous doc updates Modified: trunk/README.txt ============================================================================== --- trunk/README.txt (original) +++ trunk/README.txt Mon Aug 13 01:52:39 2007 @@ -73,16 +73,12 @@ compute height from that. The gfg:text-extent function does return the correct width. -5. The implementation of GFW:COMPUTE-SIZE for GFW:FLOW-LAYOUT does not - account for non-negative values for width or height hints when the - :WRAP style is specified. Several of the flow-layout unit tests - are currently failing because of this problem. - -6. If a Graphic-Forms application is launched from within SLIME with +5. If a Graphic-Forms application is launched from within SLIME with SBCL as the backend (which is currently single-threaded on Win32), further SLIME commands will be 'pipelined' until the Graphic-Forms - main message loop exits. The best workaround is to use the REPL - from a command prompt window. + main message loop exits. If/when SBCL gains multi-threading support + on Win32, then the Graphic-Forms library code will be updated to + launch a separate thread, as is currently done for Allegro and LispWorks. How To Configure and Build @@ -91,6 +87,9 @@ NOTE: in a future release, this library will be packaged for delivery via asdf-install. +NOTE: the following steps are only suggestions provided as a default +procedure for people new to Graphic-Forms or Common Lisp. + 1. [OPTIONAL] Install ImageMagick 6.2.6.5-Q16 (note in particular that it is the Q16 version that is needed, not the Q8 version). The default installation directory is "c:/Program Files/ImageMagick-6.2.6-Q16/". Modified: trunk/docs/manual/README.txt ============================================================================== --- trunk/docs/manual/README.txt (original) +++ trunk/docs/manual/README.txt Mon Aug 13 01:52:39 2007 @@ -1,52 +1,52 @@ - -The Programming Reference source consists of XML-based source files, -some of which are DocBook files and others which are transformed -into DocBook, along with custom XSLT and CSS files, and a catalog -file for resolving URIs. Several utilities comprise the translation -process from sources into HTML Help (CHM) format. - -Before anything else, you should install a version of GNU Make -for Windows, since the docs build process is managed with a -makefile. Just install MSYS or Cygwin, if you haven't already. - -Next, you will need a version of xsltproc and its dependencies. The -version of xsltproc that I have had success using is available from: - - http://www.zlatkovic.com/libxml.en.html - -Download and install the following packages: - - - libxslt-1.1.17.win32.zip - - libxml2-2.6.26.win32.zip - - iconv-1.9.2.win32.zip - - zlib-1.2.3.win32.zip - -Note: I did not have success with libxslt from GnuWin32 so I would not -recommend using that version. - -Third, you will need the hhc.exe command-line compiler from the -HTML Help Workshop, available here: - - http://go.microsoft.com/fwlink/?LinkId=14188 - -Make sure that your PATH is updated so that the executables and DLLs -obtained from downloading all of those packages can be found. - -In order to translate from DocBook into HTML Help source and then into -a CHM file, open a command prompt and cd into the docs/manual -subdirectory underneath where you installed the Graphic-Forms source. - -Modify the URI values in catalog.xml to suit your particular -environment, then run make on Makefile. A file named -graphic-forms-<version>.chm is created in the current directory. -<version> is the version of Graphic-Forms. Double-click on the -CHM file and start enjoying the Programming Reference :-) - - -More information about configuring DocBook and xsltproc, as well -as a quick tutorial on the whole process, see these links: - - http://www.pnotepad.org/devlog/archives/000173.html - http://www.codeproject.com/winhelp/docbook_howto.asp - -[the end] + +The Programming Reference source consists of XML-based source files, +some of which are DocBook files and others which are transformed +into DocBook, along with custom XSLT and CSS files, and a catalog +file for resolving URIs. Several utilities comprise the translation +process from sources into HTML Help (CHM) format. + +Before anything else, you should install a version of GNU Make +for Windows, since the docs build process is managed with a +makefile. Just install MSYS or Cygwin, if you haven't already. + +Next, you will need a version of xsltproc and its dependencies. The +version of xsltproc that I have had success using is available from: + + http://www.zlatkovic.com/libxml.en.html + +Download and install the following packages: + + - libxslt-1.1.17.win32.zip + - libxml2-2.6.26.win32.zip + - iconv-1.9.2.win32.zip + - zlib-1.2.3.win32.zip + +Note: I did not have success with libxslt from GnuWin32 so I would not +recommend using that version. + +Third, you will need the hhc.exe command-line compiler from the +HTML Help Workshop, available here: + + http://go.microsoft.com/fwlink/?LinkId=14188 + +Make sure that your PATH is updated so that the executables and DLLs +obtained from downloading all of those packages can be found. + +In order to translate from DocBook into HTML Help source and then into +a CHM file, open a command prompt and cd into the docs/manual +subdirectory underneath where you installed the Graphic-Forms source. + +Modify the URI values in catalog.xml to suit your particular +environment, then run make on Makefile. A file named +graphic-forms-<version>.chm is created in the current directory. +<version> is the version of Graphic-Forms. Double-click on the +CHM file and start enjoying the Programming Reference :-) + + +More information about configuring DocBook and xsltproc, as well +as a quick tutorial on the whole process, see these links: + + http://www.pnotepad.org/devlog/archives/000173.html + http://www.codeproject.com/winhelp/docbook_howto.asp + +[the end] Modified: trunk/docs/manual/introduction.xml ============================================================================== --- trunk/docs/manual/introduction.xml (original) +++ trunk/docs/manual/introduction.xml Mon Aug 13 01:52:39 2007 @@ -1,188 +1,179 @@ - -<chapter id="introduction"> - <title>Introduction</title> - <indexterm><primary>Introduction</primary></indexterm> - - <bridgehead renderas="sect2">Background</bridgehead> - <para role="normal"> - Graphic-Forms is a user interface library implemented in Common Lisp - focusing on the Windows platform. Graphic-Forms is licensed under the - terms of the BSD License. The goal is to provide a Common Lisp-based - toolkit for developing GUI applications on Windows. GUI features are - encapsulated by a thin abstraction layer offering a Lisp-friendly - programming interface. The library can be extended via Common Lisp - bindings for system APIs. - </para> - <para role="normal"> - Why implement another UI toolkit? I believe that there is still room - for improvement in this area, especially where declarative and dynamic - approaches are concerned. Also, there are relatively few Windows GUI - programming resources for Common Lisp. Long-term goals for this project - may include implementing an application framework on top of the toolkit, - a rapid UI development language, a UI design tool, or some combination - thereof. - </para> - <para role="normal"> - The remainder of this chapter provides basic information for programmers - that want to use Graphic-Forms in their projects as well as contributors. - </para> - <para role="normal"> - <emphasis role="bold">Caution:</emphasis> The information provided in this - manual is subject to change. The author and contributors reserve the right - to make API changes unless and until the interfaces are deemed stable, at - which time a policy for backwards compatibility will be published. - </para> - - <bridgehead renderas="sect2">Project Website</bridgehead> - <para role="normal"> - <ulink url="http://common-lisp.net/project/graphic-forms/"/> - </para> - - <section> - <title>Prerequisites</title> - <bridgehead renderas="sect2">Supported Common Lisp Implementations</bridgehead> - <itemizedlist mark="bullet" spacing="compact"> - <listitem>Allegro CL 8.0</listitem> - <listitem>CLISP 2.40 or later</listitem> - <listitem>LispWorks 4.4.6</listitem> - <listitem> - SBCL 1.0.5 or later - <footnote> - <para role="small"> - a small patch to enable the stdcall calling convention for callbacks - is temporarily bundled with Graphic-Forms, see - <filename>src/external-libraries/sbcl-callback-patch/</filename> - </para> - </footnote> - </listitem> - </itemizedlist> - - <bridgehead renderas="sect2">Supported Windows Versions</bridgehead> - <itemizedlist mark="bullet" spacing="compact"> - <listitem>XP SP2</listitem> - <listitem> - Vista - <footnote> - <para role="small"> - testing on RC1 is in-progress - </para> - </footnote> - </listitem> - </itemizedlist> - - - <variablelist><title>Required Libraries (downloaded separately)</title> - <varlistentry> - <term><productname>ASDF</productname></term> - <listitem> - <ulink url="http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf"/> - <para role="normal"> - Note that ASDF is bundled with Allegro CL and SBCL. - </para> - </listitem> - </varlistentry> - <varlistentry> - <term><productname>CFFI</productname></term> - <listitem> - <ulink url="http://common-lisp.net/project/cffi"/> - <para role="normal" /> - </listitem> - </varlistentry> - <varlistentry> - <term><productname>Closer to MOP</productname></term> - <term><productname>lw-compat</productname></term> - <listitem> - <ulink url="http://common-lisp.net/project/closer/downloads.html"/> - <para role="normal" /> - </listitem> - </varlistentry> - </variablelist> - - <variablelist><title>Required Libraries (bundled with Graphic-Forms)</title> - <varlistentry> - <term><productname>Practical Common Lisp Chapter08 and Chapter24</productname></term> - <listitem> - <ulink url="http://www.gigamonkeys.com/book/practicals-1.0.3.tar.gz"/> - <para role="normal" /> - </listitem> - </varlistentry> - <varlistentry> - <term><productname>lisp-unit</productname></term> - <listitem> - <ulink url="http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html"/> - <para role="normal" /> - </listitem> - </varlistentry> - </variablelist> - - <variablelist><title>Optional Libraries (downloaded separately)</title> - <varlistentry> - <term><productname>ImageMagick</productname></term> - <listitem> - <ulink url="http://imagemagick.org/script/binary-releases.php#windows"/> - <para role="normal"> - Install the Q16 version and push the keyword symbol - <filename>:load-imagemagick-plugin</filename> onto - <emphasis>*features*</emphasis> before executing ASDF. - </para> - </listitem> - </varlistentry> - </variablelist> - - <bridgehead renderas="sect2">Building the Library</bridgehead> - <para role="normal"> - Please see the <filename>README.txt</filename> file included in the - distribution for instructions on how to load the ASDF system, run - unit-tests, and demo programs. - </para> - </section> - - <section> - <title>Support and Feedback</title> - <variablelist><title>Mailing Lists</title> - <varlistentry> - <term><productname>Announcements</productname></term> - <listitem> - <ulink url="http://www.common-lisp.net/mailman/listinfo/graphic-forms-announce"/> - <para/> - </listitem> - </varlistentry> - <varlistentry> - <term><productname>Developers</productname></term> - <listitem> - <ulink url="http://www.common-lisp.net/mailman/listinfo/graphic-forms-devel"/> - <para/> - </listitem> - </varlistentry> - <varlistentry> - <term><productname>Source control</productname></term> - <listitem> - <ulink url="http://www.common-lisp.net/mailman/listinfo/graphic-forms-cvs"/> - <para/> - </listitem> - </varlistentry> - </variablelist> - - <variablelist><title>Bug Reports and Patches</title> - <varlistentry> - <term><productname>Bug reports</productname></term> - <listitem> - <ulink url="http://sourceforge.net/tracker/?group_id=163034&atid=826145"/> - <para/> - </listitem> - </varlistentry> - <varlistentry> - <term><productname>Patch submissions</productname></term> - <listitem> - <ulink url="http://sourceforge.net/tracker/?group_id=163034&atid=826147"/> - <para/> - </listitem> - </varlistentry> - </variablelist> - </section> - -</chapter> + +<chapter id="introduction"> + <title>Introduction</title> + <indexterm><primary>Introduction</primary></indexterm> + + <bridgehead renderas="sect2">Background</bridgehead> + <para role="normal"> + Graphic-Forms is a user interface library implemented in Common Lisp + focusing on the Windows platform. Graphic-Forms is licensed under the + terms of the BSD License. The goal is to provide a Common Lisp-based + toolkit for developing GUI applications on Windows. GUI features are + encapsulated by a thin abstraction layer offering a Lisp-friendly + programming interface. The library can be extended via Common Lisp + bindings for system APIs. + </para> + <para role="normal"> + Why implement another UI toolkit? I believe that there is still room + for improvement in this area, especially where declarative and dynamic + approaches are concerned. Also, there are relatively few Windows GUI + programming resources for Common Lisp. Long-term goals for this project + may include implementing an application framework on top of the toolkit, + a rapid UI development language, a UI design tool, or some combination + thereof. + </para> + <para role="normal"> + The remainder of this chapter provides basic information for programmers + that want to use Graphic-Forms in their projects as well as contributors. + </para> + <para role="normal"> + <emphasis role="bold">Caution:</emphasis> The information provided in this + manual is subject to change. The author and contributors reserve the right + to make API changes unless and until the interfaces are deemed stable, at + which time a policy for backwards compatibility will be published. + </para> + + <bridgehead renderas="sect2">Project Website</bridgehead> + <para role="normal"> + <ulink url="http://common-lisp.net/project/graphic-forms/"/> + </para> + + <section> + <title>Prerequisites</title> + <bridgehead renderas="sect2">Supported Common Lisp Implementations</bridgehead> + <itemizedlist mark="bullet" spacing="compact"> + <listitem>Allegro CL 8.0</listitem> + <listitem>CLISP 2.40 or later</listitem> + <listitem>LispWorks 5.0.1</listitem> + <listitem> + SBCL 1.0.5 or later + <footnote> + <para role="small"> + a small patch to enable the stdcall calling convention for callbacks + is temporarily bundled with Graphic-Forms, see + <filename>src/external-libraries/sbcl-callback-patch/</filename> + </para> + </footnote> + </listitem> + </itemizedlist> + + <bridgehead renderas="sect2">Supported Windows Versions</bridgehead> + <itemizedlist mark="bullet" spacing="compact"> + <listitem>XP SP2</listitem> + </itemizedlist> + + <variablelist><title>Required Libraries (downloaded separately)</title> + <varlistentry> + <term><productname>ASDF</productname></term> + <listitem> + <ulink url="http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf"/> + <para role="normal"> + Note that ASDF is bundled with Allegro CL and SBCL. + </para> + </listitem> + </varlistentry> + <varlistentry> + <term><productname>CFFI</productname></term> + <listitem> + <ulink url="http://common-lisp.net/project/cffi"/> + <para role="normal" /> + </listitem> + </varlistentry> + <varlistentry> + <term><productname>Closer to MOP</productname></term> + <term><productname>lw-compat</productname></term> + <listitem> + <ulink url="http://common-lisp.net/project/closer/downloads.html"/> + <para role="normal" /> + </listitem> + </varlistentry> + </variablelist> + + <variablelist><title>Required Libraries (bundled with Graphic-Forms)</title> + <varlistentry> + <term><productname>Practical Common Lisp Chapter08 and Chapter24</productname></term> + <listitem> + <ulink url="http://www.gigamonkeys.com/book/practicals-1.0.3.tar.gz"/> + <para role="normal" /> + </listitem> + </varlistentry> + <varlistentry> + <term><productname>lisp-unit</productname></term> + <listitem> + <ulink url="http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html"/> + <para role="normal" /> + </listitem> + </varlistentry> + </variablelist> + + <variablelist><title>Optional Libraries (downloaded separately)</title> + <varlistentry> + <term><productname>ImageMagick</productname></term> + <listitem> + <ulink url="http://imagemagick.org/script/binary-releases.php#windows"/> + <para role="normal"> + Install the Q16 version and push the keyword symbol + <filename>:load-imagemagick-plugin</filename> onto + <emphasis>*features*</emphasis> before executing ASDF. + </para> + </listitem> + </varlistentry> + </variablelist> + + <bridgehead renderas="sect2">Building the Library</bridgehead> + <para role="normal"> + Please see the <filename>README.txt</filename> file included in the + distribution for instructions on how to load the ASDF system, run + unit-tests, and demo programs. + </para> + </section> + + <section> + <title>Support and Feedback</title> + <variablelist><title>Mailing Lists</title> + <varlistentry> + <term><productname>Announcements</productname></term> + <listitem> + <ulink url="http://www.common-lisp.net/mailman/listinfo/graphic-forms-announce"/> + <para/> + </listitem> + </varlistentry> + <varlistentry> + <term><productname>Developers</productname></term> + <listitem> + <ulink url="http://www.common-lisp.net/mailman/listinfo/graphic-forms-devel"/> + <para/> + </listitem> + </varlistentry> + <varlistentry> + <term><productname>Source control</productname></term> + <listitem> + <ulink url="http://www.common-lisp.net/mailman/listinfo/graphic-forms-cvs"/> + <para/> + </listitem> + </varlistentry> + </variablelist> + + <variablelist><title>Bug Reports and Patches</title> + <varlistentry> + <term><productname>Bug reports</productname></term> + <listitem> + <ulink url="http://sourceforge.net/tracker/?group_id=163034&atid=826145"/> + <para/> + </listitem> + </varlistentry> + <varlistentry> + <term><productname>Patch submissions</productname></term> + <listitem> + <ulink url="http://sourceforge.net/tracker/?group_id=163034&atid=826147"/> + <para/> + </listitem> + </varlistentry> + </variablelist> + </section> + +</chapter>

1 0

[graphic-forms-cvs] r471 - in trunk/src: tests/uitoolkit uitoolkit/widgets
by junrue＠common-lisp.net 13 Aug '07

13 Aug '07

Author: junrue Date: Mon Aug 13 01:09:25 2007 New Revision: 471 Modified: trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp trunk/src/uitoolkit/widgets/flow-layout.lisp trunk/src/uitoolkit/widgets/layout-generics.lisp trunk/src/uitoolkit/widgets/layout.lisp trunk/src/uitoolkit/widgets/window.lisp Log: fixed longstanding regression in calculation of wrapping extents; fixed flow layout unit tests Modified: trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp ============================================================================== --- trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp (original) +++ trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp Mon Aug 13 01:09:25 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; flow-layout-unit-tests.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 @@ -59,7 +59,7 @@ #'make-flow-layout *flow-uniform-kids* '(:horizontal :wrap)) (define-layout-test flow-layout-test4 - -1 25 20 20 + -1 25 40 20 nil '((0 0 20 10) (0 10 20 10) (20 0 20 10)) #'make-flow-layout *flow-uniform-kids* '(:vertical :wrap)) @@ -89,13 +89,13 @@ #'make-flow-layout *flow-uniform-kids* '(:vertical) 4) (define-layout-test flow-layout-test9 - 45 18 0 0 + 45 18 44 24 nil '((0 0 20 10) (24 0 20 10) (0 14 20 10)) #'make-flow-layout *flow-uniform-kids* '(:horizontal :wrap) 4) (define-layout-test flow-layout-test10 - 30 25 0 0 + 30 25 44 24 nil '((0 0 20 10) (0 14 20 10) (24 0 20 10)) #'make-flow-layout *flow-uniform-kids* '(:vertical :wrap) 4) Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/flow-layout.lisp (original) +++ trunk/src/uitoolkit/widgets/flow-layout.lisp Mon Aug 13 01:09:25 2007 @@ -34,24 +34,38 @@ (in-package :graphic-forms.uitoolkit.widgets) ;;; -;;; helper functions +;;; This implementation attempts to maximize code re-use by handling both +;;; possible orientations with the same logic. Hence the terminology is a +;;; little confusing. Here is a quick primer: +;;; +;;; primary axis -- the axis parallel to the layout's orientation +;;; +;;; secondary axis -- the axis orthogonal to the layout's orientation +;;; +;;; distance -- offset from one point to the next along the primary axis +;;; +;;; extent -- offset from one point to the next along the secondary axis ;;; (defstruct flow-data - (hint 0) - (kid-sizes nil) - (distance-total 0) - (max-distance 0) - (extent-total 0) - (max-extent 0) - (next-coord 0) - (wrap-coord 0) - (spacing 0) - (distance-fn nil) - (extent-fn nil) - (limit-margin-fn nil) - (start-margin-fn nil) - (current nil)) + (hint 0) ; the width or height hint passed to the layout manager + (kid-sizes nil) ; list of pairs of child widgets and their sizes + (distance-total 0) ; total (un-wrapped) widget size in primary axis + (max-distance 0) ; maximum widget size in primary axis + (max-extent 0) ; maximum widget size in secondary axis + (last-wrap-max-extent 0) ; maximum widget size in secondary axis for previous wrap + (next-coord 0) ; position in primary axis where next widget goes + (wrap-coord 0) ; position in secondary axis where next widget wraps to + (spacing 0) ; layout's spacing attribute + (distance-fn nil) ; either #'gfs:size-width or #'gfs:size-height + (extent-fn nil) ; opposite of distance-fn + (limit-margin-fn nil) ; either #'bottom-margin-of or #'right-margin-of + (start-margin-fn nil) ; either #'top-margin-of or #'left-margin-of + (current nil)) ; flow data list + +;;; +;;; helper functions +;;; (defun init-flow-data (layout visible items width-hint height-hint) (let ((state (if (find :vertical (style-of layout)) @@ -78,7 +92,6 @@ (dist (funcall (flow-data-distance-fn state) size)) (extent (funcall (flow-data-extent-fn state) size))) (incf (flow-data-distance-total state) dist) - (incf (flow-data-extent-total state) extent) (if (< (flow-data-max-distance state) dist) (setf (flow-data-max-distance state) dist)) (if (< (flow-data-max-extent state) extent) @@ -98,12 +111,15 @@ (let ((curr-flow (flow-data-current state))) (setf (flow-data-current state) nil) (setf (flow-data-next-coord state) (funcall (flow-data-start-margin-fn state) layout)) - (incf (flow-data-wrap-coord state) (+ (flow-data-max-extent state) (flow-data-spacing state))) + (incf (flow-data-wrap-coord state) (+ (flow-data-last-wrap-max-extent state) + (flow-data-spacing state))) + (setf (flow-data-last-wrap-max-extent state) 0) (reverse curr-flow))) (defun new-flow-element (state layout kid kid-size) (let ((pnt (gfs:make-point)) - (vertical (find :vertical (style-of layout)))) + (vertical (find :vertical (style-of layout))) + (extent (funcall (flow-data-extent-fn state) kid-size))) (if vertical (setf (gfs:point-x pnt) (flow-data-wrap-coord state) (gfs:point-y pnt) (flow-data-next-coord state)) @@ -111,6 +127,8 @@ (gfs:point-y pnt) (flow-data-wrap-coord state))) (incf (flow-data-next-coord state) (+ (funcall (flow-data-distance-fn state) kid-size) (flow-data-spacing state))) + (if (> extent (flow-data-last-wrap-max-extent state)) + (setf (flow-data-last-wrap-max-extent state) extent)) (cons kid (gfs:make-rectangle :size kid-size :location pnt)))) ;;; @@ -118,36 +136,12 @@ ;;; (defmethod compute-size ((self flow-layout) (container layout-managed) width-hint height-hint) - (cleanup-disposed-items self) - (let ((kid-count (length (data-of self))) - (horz-margin-total (+ (left-margin-of self) (right-margin-of self))) - (vert-margin-total (+ (top-margin-of self) (bottom-margin-of self))) - (vertical (find :vertical (style-of self))) - (horizontal (find :horizontal (style-of self)))) - (let ((spacing-total (* (spacing-of self) (1- kid-count))) - (state (init-flow-data self - (visible-p container) - (data-of self) - (if vertical width-hint -1) - (if vertical -1 height-hint)))) - (if (find :normalize (style-of self)) - (setf (flow-data-distance-total state) (* (flow-data-max-distance state) kid-count))) - (cond - (horizontal - (gfs:make-size :width (+ (flow-data-distance-total state) - horz-margin-total - spacing-total) - :height (+ (flow-data-max-extent state) - vert-margin-total))) - (vertical - (gfs:make-size :width (+ (flow-data-max-extent state) - horz-margin-total) - :height (+ (flow-data-distance-total state) - vert-margin-total - spacing-total))) - (t - (error 'gfs:toolkit-error - :detail (format nil "unrecognized flow layout style: ~a" (style-of self)))))))) + (let ((data (compute-layout self container width-hint height-hint))) + (gfs:size (layout-bounds data + (list (left-margin-of self) + (top-margin-of self) + (right-margin-of self) + (bottom-margin-of self)))))) (defmethod compute-layout ((self flow-layout) (container layout-managed) width-hint height-hint) (cleanup-disposed-items self) Modified: trunk/src/uitoolkit/widgets/layout-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layout-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/layout-generics.lisp Mon Aug 13 01:09:25 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; layout-generics.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/layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layout.lisp (original) +++ trunk/src/uitoolkit/widgets/layout.lisp Mon Aug 13 01:09:25 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; layout.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 @@ -127,6 +127,22 @@ (unless (gfs:null-handle-p hdwp) (gfs::end-defer-window-pos hdwp)))) +(defun layout-bounds (children margins) + (multiple-value-bind (min-x min-y max-x max-y) + (loop for entry in children + for location = (gfs:location (cdr entry)) + for size = (gfs:size (cdr entry)) + minimizing (gfs:point-x location) into min-x + minimizing (gfs:point-y location) into min-y + maximizing (+ (gfs:point-x location) (gfs:size-width size)) into max-x + maximizing (+ (gfs:point-y location) (gfs:size-height size)) into max-y + finally (return (values min-x min-y max-x max-y))) + (let ((location (gfs:make-point :x (- min-x (first margins)) + :y (- min-y (second margins)))) + (size (gfs:make-size :width (+ max-x (third margins)) + :height (+ max-y (fourth margins))))) + (gfs:make-rectangle :location location :size size)))) + ;;; ;;; methods ;;; @@ -162,6 +178,4 @@ (defmethod perform ((self layout-manager) (container layout-managed) width-hint height-hint) (if (layout-p container) (arrange-hwnds (compute-layout self container width-hint height-hint) - (lambda (item) - (declare (ignore item)) - +window-pos-flags+)))) + (constantly +window-pos-flags+)))) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Mon Aug 13 01:09:25 2007 @@ -181,7 +181,7 @@ (defmethod gfg:background-color ((self window)) (let ((hwnd (gfs:handle self)) (color nil)) - (if (string= (get-window-class-name self) *toplevel-erasebkgnd-window-classname*) + (if (string= (get-window-class-name hwnd) *toplevel-erasebkgnd-window-classname*) (setf color (gfg:rgb->color (gfs::get-sys-color gfs::+color-appworkspace+))) (setf color (gfg:rgb->color (gfs::get-class-long hwnd gfs::+gclp-hbrbackground+)))) color))

1 0

[graphic-forms-cvs] r470 - in trunk: docs/manual src/uitoolkit/system src/uitoolkit/widgets
by junrue＠common-lisp.net 10 Aug '07

10 Aug '07

Author: junrue Date: Fri Aug 10 00:48:34 2007 New Revision: 470 Modified: trunk/docs/manual/Makefile trunk/docs/manual/symbols.xsl trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/display.lisp Log: revised GFW:OBTAIN-PRIMARY-DISPLAY based on Raymon Chen blog entry; minor fixes to ref manual source and makefile Modified: trunk/docs/manual/Makefile ============================================================================== --- trunk/docs/manual/Makefile (original) +++ trunk/docs/manual/Makefile Fri Aug 10 00:48:34 2007 @@ -12,7 +12,8 @@ catalog.xml glossary.xml graphic-forms.xml image-data-plugins.xml \ introduction.xml legal.xml protocols.xml miscellaneous-topics.xml -COMMON-DEPS = symbols.xsl packages.xsl clhs-table.xml win32-api-table.xml +COMMON-DEPS = symbols.xsl packages.xsl clhs-table.xml win32-api-table.xml \ + packages.xml GFC-PKG-DEPS = gfc-class-symbols-tmp.xml gfc-function-symbols-tmp.xml gfc-macro-symbols-tmp.xml Modified: trunk/docs/manual/symbols.xsl ============================================================================== --- trunk/docs/manual/symbols.xsl (original) +++ trunk/docs/manual/symbols.xsl Fri Aug 10 00:48:34 2007 @@ -111,7 +111,7 @@ </xsl:when> <xsl:otherwise> <xsl:message terminate="yes"> - <xsl:text>gf-data.xsl: could not find argument </xsl:text><xsl:value-of select="$index - 1"/> + <xsl:text>symbols.xsl: could not find argument </xsl:text><xsl:value-of select="$index - 1"/> </xsl:message> </xsl:otherwise> </xsl:choose> Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Fri Aug 10 00:48:34 2007 @@ -499,6 +499,13 @@ (langid WORD)) (defcfun + ("MonitorFromPoint" monitor-from-point) + HANDLE + (pntx LONG) + (pnty LONG) + (flags DWORD)) + +(defcfun ("MonitorFromWindow" monitor-from-window) HANDLE (hwnd HANDLE) Modified: trunk/src/uitoolkit/widgets/display.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/display.lisp (original) +++ trunk/src/uitoolkit/widgets/display.lisp Fri Aug 10 00:48:34 2007 @@ -52,7 +52,7 @@ (error 'gfs:win32-warning :detail "get-monitor-info failed")) (push (= (logand gfs::flags gfs::+monitorinfoof-primary+) gfs::+monitorinfoof-primary+) info) (let ((str-ptr (cffi:foreign-slot-pointer mi-ptr 'gfs::monitorinfoex 'gfs::device))) - (push (cffi:foreign-string-to-lisp str-ptr :count (1- gfs::+cchdevicename+)) info)) + (push (cffi:foreign-string-to-lisp str-ptr (1- gfs::+cchdevicename+)) info)) (let ((rect-ptr (cffi:foreign-slot-pointer mi-ptr 'gfs::monitorinfoex 'gfs::monitor))) (cffi:with-foreign-slots ((gfs::left gfs::top gfs::right gfs::bottom) rect-ptr gfs::rect) @@ -88,8 +88,14 @@ (push (make-instance 'display :handle hmonitor) (display-visitor-results (thread-context)))))) +(declaim (inline obtain-primary-display)) (defun obtain-primary-display () - (find-if #'primary-p (obtain-displays))) + ;; In http://blogs.msdn.com/oldnewthing/archive/2007/08/09/4300545.aspx + ;; Raymond Chen recommends the following technique for obtaining the + ;; primary display. + ;; + (make-instance 'display + :handle (gfs::monitor-from-point 0 0 gfs::+monitor-defaulttoprimary+))) (cffi:defcallback (top-level-window-visitor :cconv :stdcall) gfs::BOOL ((hwnd :pointer) (lparam gfs::LPARAM))

1 0

[graphic-forms-cvs] r469 - trunk/src/tests/uitoolkit
by junrue＠common-lisp.net 09 Jul '07

09 Jul '07

Author: junrue Date: Mon Jul 9 00:17:21 2007 New Revision: 469 Modified: trunk/src/tests/uitoolkit/event-tester.lisp Log: revised event-tester menu creation to test GFW:DEFMENU2 and GFW:MAKE-MENU Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Mon Jul 9 00:17:21 2007 @@ -289,22 +289,24 @@ (setf *event-counter* 0) (let ((echo-md (make-instance 'event-tester-echo-dispatcher)) (exit-md (make-instance 'event-tester-exit-dispatcher)) - (menubar nil)) + (menu-factory nil)) (setf *event-tester-window* (make-instance 'gfw:top-level :dispatcher (make-instance 'event-tester-window-events) :style '(:workspace :horizontal-scrollbar :vertical-scrollbar))) (initialize-scrollbars) - (setf menubar (gfw:defmenu ((:item "&File" :callback #'manage-file-menu - :submenu ((:item "Timer" :callback #'manage-timer) - (:item "" :separator) - (:item "E&xit" :dispatcher exit-md))) - (:item "&Test Menu" :dispatcher echo-md - :submenu ((:item "&Checked Item" :checked :dispatcher echo-md) - (:item "&Submenu" :dispatcher echo-md - :submenu ((:item "&Item A" :dispatcher echo-md :disabled) - (:item "&Item B" :dispatcher echo-md))))) - (:item "&Help" :dispatcher echo-md - :submenu ((:item "&About" :dispatcher echo-md)))))) - (setf (gfw:menu-bar *event-tester-window*) menubar) + (setf menu-factory + (gfw:defmenu2 :name 'event-tester-menu + :menu ((:item "&File" :callback #'manage-file-menu + :submenu ((:item "Timer" :callback #'manage-timer) + (:item "" :separator) + (:item "E&xit" :dispatcher exit-md))) + (:item "&Test Menu" :dispatcher echo-md + :submenu ((:item "&Checked Item" :checked :dispatcher echo-md) + (:item "&Submenu" :dispatcher echo-md + :submenu ((:item "&Item A" :dispatcher echo-md :disabled) + (:item "&Item B" :dispatcher echo-md))))) + (:item "&Help" :dispatcher echo-md + :submenu ((:item "&About" :dispatcher echo-md)))))) + (setf (gfw:menu-bar *event-tester-window*) (gfw:make-menu 'event-tester-menu)) (setf (gfw:image *event-tester-window*) (make-instance 'gfg:icon-bundle :file (merge-pathnames "default.ico"))) (gfw:show *event-tester-window* t)))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

graphic-forms-cvs