packages feed

wx 0.90.1.0 → 0.91.0.0

raw patch · 18 files changed

+5124/−5124 lines, 18 filesdep ~wxcoresetup-changed

Dependency ranges changed: wxcore

Files

Setup.lhs view
@@ -1,4 +1,4 @@-#!/usr/bin/env runhaskell--> import Distribution.Simple-> main = defaultMain+#!/usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
license.txt view
@@ -1,573 +1,573 @@------------------------------------------------------------------------                        PREAMBLE--The wxHaskell libraries are distributed under the wxWindows library -license. The documentation is subject to the wxWidgets documentation -license.--See "http://www.wxwidgets.org/newlicen.htm" for the legal description -of the license, which is also included in this document.--The wxWindows library licence is essentially the L-GPL (Library General -Public Licence), with an exception stating that derived works in binary -form may be distributed on the user's own terms. This means that it is -possible to create commercial software with this library without paying -royalties or disclosing source code. This is a solution that satisfies -those who wish to produce GPL'ed software using wxHaskell, and also -those producing proprietary software.--This library is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the wxWidgets -library license for more details.--------------------------------------------------------------------------                       WXWINDOWS LIBRARY LICENCE-     TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION-  -  This library is free software; you can redistribute it and/or modify it-  under the terms of the GNU Library General Public Licence as published by-  the Free Software Foundation; either version 2 of the Licence, or (at-  your option) any later version.-  -  This library is distributed in the hope that it will be useful, but-  WITHOUT ANY WARRANTY; without even the implied warranty of-  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library-  General Public Licence for more details.--  You should have received a copy of the GNU Library General Public Licence-  along with this software, usually in a file named COPYING.LIB.  If not,-  write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,-  Boston, MA 02111-1307 USA.--  EXCEPTION NOTICE--  1. As a special exception, the copyright holders of this library give-  permission for additional uses of the text contained in this release of-  the library as licenced under the wxWindows Library Licence, applying-  either version 3 of the Licence, or (at your option) any later version of-  the Licence as published by the copyright holders of version 3 of the-  Licence document.--  2. The exception is that you may use, copy, link, modify and distribute-  under the user's own terms, binary object code versions of works based-  on the Library.--  3. If you copy code from files distributed under the terms of the GNU-  General Public Licence or the GNU Library General Public Licence into a-  copy of this library, as this licence permits, the exception does not-  apply to the code that you add in this way.  To avoid misleading anyone as-  to the status of such modified files, you must delete this exception-  notice from such code and/or adjust the licensing conditions notice-  accordingly.--  4. If you write modifications of your own for this library, it is your-  choice whether to permit this exception to apply to your modifications. -  If you do not wish that, you must delete the exception notice from such-  code and/or adjust the licensing conditions notice accordingly.--------------------------------------------------------------------------  GNU LESSER GENERAL PUBLIC LICENSE-       Version 2.1, February 1999-- Copyright (C) 1991, 1999 Free Software Foundation, Inc.-     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.--[This is the first released version of the Lesser GPL.  It also counts- as the successor of the GNU Library Public License, version 2, hence- the version number 2.1.]--    Preamble--  The licenses for most software are designed to take away your-freedom to share and change it.  By contrast, the GNU General Public-Licenses are intended to guarantee your freedom to share and change-free software--to make sure the software is free for all its users.--  This license, the Lesser General Public License, applies to some-specially designated software packages--typically libraries--of the-Free Software Foundation and other authors who decide to use it.  You-can use it too, but we suggest you first think carefully about whether-this license or the ordinary General Public License is the better-strategy to use in any particular case, based on the explanations below.--  When we speak of free software, we are referring to freedom of use,-not price.  Our General Public Licenses are designed to make sure that-you have the freedom to distribute copies of free software (and charge-for this service if you wish); that you receive source code or can get-it if you want it; that you can change the software and use pieces of-it in new free programs; and that you are informed that you can do-these things.--  To protect your rights, we need to make restrictions that forbid-distributors to deny you these rights or to ask you to surrender these-rights.  These restrictions translate to certain responsibilities for-you if you distribute copies of the library or if you modify it.--  For example, if you distribute copies of the library, whether gratis-or for a fee, you must give the recipients all the rights that we gave-you.  You must make sure that they, too, receive or can get the source-code.  If you link other code with the library, you must provide-complete object files to the recipients, so that they can relink them-with the library after making changes to the library and recompiling-it.  And you must show them these terms so they know their rights.--  We protect your rights with a two-step method: (1) we copyright the-library, and (2) we offer you this license, which gives you legal-permission to copy, distribute and/or modify the library.--  To protect each distributor, we want to make it very clear that-there is no warranty for the free library.  Also, if the library is-modified by someone else and passed on, the recipients should know-that what they have is not the original version, so that the original-author's reputation will not be affected by problems that might be-introduced by others.--  Finally, software patents pose a constant threat to the existence of-any free program.  We wish to make sure that a company cannot-effectively restrict the users of a free program by obtaining a-restrictive license from a patent holder.  Therefore, we insist that-any patent license obtained for a version of the library must be-consistent with the full freedom of use specified in this license.--  Most GNU software, including some libraries, is covered by the-ordinary GNU General Public License.  This license, the GNU Lesser-General Public License, applies to certain designated libraries, and-is quite different from the ordinary General Public License.  We use-this license for certain libraries in order to permit linking those-libraries into non-free programs.--  When a program is linked with a library, whether statically or using-a shared library, the combination of the two is legally speaking a-combined work, a derivative of the original library.  The ordinary-General Public License therefore permits such linking only if the-entire combination fits its criteria of freedom.  The Lesser General-Public License permits more lax criteria for linking other code with-the library.--  We call this license the "Lesser" General Public License because it-does Less to protect the user's freedom than the ordinary General-Public License.  It also provides other free software developers Less-of an advantage over competing non-free programs.  These disadvantages-are the reason we use the ordinary General Public License for many-libraries.  However, the Lesser license provides advantages in certain-special circumstances.--  For example, on rare occasions, there may be a special need to-encourage the widest possible use of a certain library, so that it becomes-a de-facto standard.  To achieve this, non-free programs must be-allowed to use the library.  A more frequent case is that a free-library does the same job as widely used non-free libraries.  In this-case, there is little to gain by limiting the free library to free-software only, so we use the Lesser General Public License.--  In other cases, permission to use a particular library in non-free-programs enables a greater number of people to use a large body of-free software.  For example, permission to use the GNU C Library in-non-free programs enables many more people to use the whole GNU-operating system, as well as its variant, the GNU/Linux operating-system.--  Although the Lesser General Public License is Less protective of the-users' freedom, it does ensure that the user of a program that is-linked with the Library has the freedom and the wherewithal to run-that program using a modified version of the Library.--  The precise terms and conditions for copying, distribution and-modification follow.  Pay close attention to the difference between a-"work based on the library" and a "work that uses the library".  The-former contains code derived from the library, whereas the latter must-be combined with the library in order to run.--  GNU LESSER GENERAL PUBLIC LICENSE-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION--  0. This License Agreement applies to any software library or other-program which contains a notice placed by the copyright holder or-other authorized party saying it may be distributed under the terms of-this Lesser General Public License (also called "this License").-Each licensee is addressed as "you".--  A "library" means a collection of software functions and/or data-prepared so as to be conveniently linked with application programs-(which use some of those functions and data) to form executables.--  The "Library", below, refers to any such software library or work-which has been distributed under these terms.  A "work based on the-Library" means either the Library or any derivative work under-copyright law: that is to say, a work containing the Library or a-portion of it, either verbatim or with modifications and/or translated-straightforwardly into another language.  (Hereinafter, translation is-included without limitation in the term "modification".)--  "Source code" for a work means the preferred form of the work for-making modifications to it.  For a library, complete source code means-all the source code for all modules it contains, plus any associated-interface definition files, plus the scripts used to control compilation-and installation of the library.--  Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope.  The act of-running a program using the Library is not restricted, and output from-such a program is covered only if its contents constitute a work based-on the Library (independent of the use of the Library in a tool for-writing it).  Whether that is true depends on what the Library does-and what the program that uses the Library does.-  -  1. You may copy and distribute verbatim copies of the Library's-complete source code as you receive it, in any medium, provided that-you conspicuously and appropriately publish on each copy an-appropriate copyright notice and disclaimer of warranty; keep intact-all the notices that refer to this License and to the absence of any-warranty; and distribute a copy of this License along with the-Library.--  You may charge a fee for the physical act of transferring a copy,-and you may at your option offer warranty protection in exchange for a-fee.--  2. You may modify your copy or copies of the Library or any portion-of it, thus forming a work based on the Library, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:--    a) The modified work must itself be a software library.--    b) You must cause the files modified to carry prominent notices-    stating that you changed the files and the date of any change.--    c) You must cause the whole of the work to be licensed at no-    charge to all third parties under the terms of this License.--    d) If a facility in the modified Library refers to a function or a-    table of data to be supplied by an application program that uses-    the facility, other than as an argument passed when the facility-    is invoked, then you must make a good faith effort to ensure that,-    in the event an application does not supply such function or-    table, the facility still operates, and performs whatever part of-    its purpose remains meaningful.--    (For example, a function in a library to compute square roots has-    a purpose that is entirely well-defined independent of the-    application.  Therefore, Subsection 2d requires that any-    application-supplied function or table used by this function must-    be optional: if the application does not supply it, the square-    root function must still compute square roots.)--These requirements apply to the modified work as a whole.  If-identifiable sections of that work are not derived from the Library,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works.  But when you-distribute the same sections as part of a whole which is a work based-on the Library, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote-it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Library.--In addition, mere aggregation of another work not based on the Library-with the Library (or with a work based on the Library) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.--  3. You may opt to apply the terms of the ordinary GNU General Public-License instead of this License to a given copy of the Library.  To do-this, you must alter all the notices that refer to this License, so-that they refer to the ordinary GNU General Public License, version 2,-instead of to this License.  (If a newer version than version 2 of the-ordinary GNU General Public License has appeared, then you can specify-that version instead if you wish.)  Do not make any other change in-these notices.--  Once this change is made in a given copy, it is irreversible for-that copy, so the ordinary GNU General Public License applies to all-subsequent copies and derivative works made from that copy.--  This option is useful when you wish to copy part of the code of-the Library into a program that is not a library.--  4. You may copy and distribute the Library (or a portion or-derivative of it, under Section 2) in object code or executable form-under the terms of Sections 1 and 2 above provided that you accompany-it with the complete corresponding machine-readable source code, which-must be distributed under the terms of Sections 1 and 2 above on a-medium customarily used for software interchange.--  If distribution of object code is made by offering access to copy-from a designated place, then offering equivalent access to copy the-source code from the same place satisfies the requirement to-distribute the source code, even though third parties are not-compelled to copy the source along with the object code.--  5. A program that contains no derivative of any portion of the-Library, but is designed to work with the Library by being compiled or-linked with it, is called a "work that uses the Library".  Such a-work, in isolation, is not a derivative work of the Library, and-therefore falls outside the scope of this License.--  However, linking a "work that uses the Library" with the Library-creates an executable that is a derivative of the Library (because it-contains portions of the Library), rather than a "work that uses the-library".  The executable is therefore covered by this License.-Section 6 states terms for distribution of such executables.--  When a "work that uses the Library" uses material from a header file-that is part of the Library, the object code for the work may be a-derivative work of the Library even though the source code is not.-Whether this is true is especially significant if the work can be-linked without the Library, or if the work is itself a library.  The-threshold for this to be true is not precisely defined by law.--  If such an object file uses only numerical parameters, data-structure layouts and accessors, and small macros and small inline-functions (ten lines or less in length), then the use of the object-file is unrestricted, regardless of whether it is legally a derivative-work.  (Executables containing this object code plus portions of the-Library will still fall under Section 6.)--  Otherwise, if the work is a derivative of the Library, you may-distribute the object code for the work under the terms of Section 6.-Any executables containing that work also fall under Section 6,-whether or not they are linked directly with the Library itself.--  6. As an exception to the Sections above, you may also combine or-link a "work that uses the Library" with the Library to produce a-work containing portions of the Library, and distribute that work-under terms of your choice, provided that the terms permit-modification of the work for the customer's own use and reverse-engineering for debugging such modifications.--  You must give prominent notice with each copy of the work that the-Library is used in it and that the Library and its use are covered by-this License.  You must supply a copy of this License.  If the work-during execution displays copyright notices, you must include the-copyright notice for the Library among them, as well as a reference-directing the user to the copy of this License.  Also, you must do one-of these things:--    a) Accompany the work with the complete corresponding-    machine-readable source code for the Library including whatever-    changes were used in the work (which must be distributed under-    Sections 1 and 2 above); and, if the work is an executable linked-    with the Library, with the complete machine-readable "work that-    uses the Library", as object code and/or source code, so that the-    user can modify the Library and then relink to produce a modified-    executable containing the modified Library.  (It is understood-    that the user who changes the contents of definitions files in the-    Library will not necessarily be able to recompile the application-    to use the modified definitions.)--    b) Use a suitable shared library mechanism for linking with the-    Library.  A suitable mechanism is one that (1) uses at run time a-    copy of the library already present on the user's computer system,-    rather than copying library functions into the executable, and (2)-    will operate properly with a modified version of the library, if-    the user installs one, as long as the modified version is-    interface-compatible with the version that the work was made with.--    c) Accompany the work with a written offer, valid for at-    least three years, to give the same user the materials-    specified in Subsection 6a, above, for a charge no more-    than the cost of performing this distribution.--    d) If distribution of the work is made by offering access to copy-    from a designated place, offer equivalent access to copy the above-    specified materials from the same place.--    e) Verify that the user has already received a copy of these-    materials or that you have already sent this user a copy.--  For an executable, the required form of the "work that uses the-Library" must include any data and utility programs needed for-reproducing the executable from it.  However, as a special exception,-the materials to be distributed need not include anything that is-normally distributed (in either source or binary form) with the major-components (compiler, kernel, and so on) of the operating system on-which the executable runs, unless that component itself accompanies-the executable.--  It may happen that this requirement contradicts the license-restrictions of other proprietary libraries that do not normally-accompany the operating system.  Such a contradiction means you cannot-use both them and the Library together in an executable that you-distribute.--  7. You may place library facilities that are a work based on the-Library side-by-side in a single library together with other library-facilities not covered by this License, and distribute such a combined-library, provided that the separate distribution of the work based on-the Library and of the other library facilities is otherwise-permitted, and provided that you do these two things:--    a) Accompany the combined library with a copy of the same work-    based on the Library, uncombined with any other library-    facilities.  This must be distributed under the terms of the-    Sections above.--    b) Give prominent notice with the combined library of the fact-    that part of it is a work based on the Library, and explaining-    where to find the accompanying uncombined form of the same work.--  8. You may not copy, modify, sublicense, link with, or distribute-the Library except as expressly provided under this License.  Any-attempt otherwise to copy, modify, sublicense, link with, or-distribute the Library is void, and will automatically terminate your-rights under this License.  However, parties who have received copies,-or rights, from you under this License will not have their licenses-terminated so long as such parties remain in full compliance.--  9. You are not required to accept this License, since you have not-signed it.  However, nothing else grants you permission to modify or-distribute the Library or its derivative works.  These actions are-prohibited by law if you do not accept this License.  Therefore, by-modifying or distributing the Library (or any work based on the-Library), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Library or works based on it.--  10. Each time you redistribute the Library (or any work based on the-Library), the recipient automatically receives a license from the-original licensor to copy, distribute, link with or modify the Library-subject to these terms and conditions.  You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties with-this License.--  11. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License.  If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Library at all.  For example, if a patent-license would not permit royalty-free redistribution of the Library by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Library.--If any portion of this section is held invalid or unenforceable under any-particular circumstance, the balance of the section is intended to apply,-and the section as a whole is intended to apply in other circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system which is-implemented by public license practices.  Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.--  12. If the distribution and/or use of the Library is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Library under this License may add-an explicit geographical distribution limitation excluding those countries,-so that distribution is permitted only in or among countries not thus-excluded.  In such case, this License incorporates the limitation as if-written in the body of this License.--  13. The Free Software Foundation may publish revised and/or new-versions of the Lesser General Public License from time to time.-Such new versions will be similar in spirit to the present version,-but may differ in detail to address new problems or concerns.--Each version is given a distinguishing version number.  If the Library-specifies a version number of this License which applies to it and-"any later version", you have the option of following the terms and-conditions either of that version or of any later version published by-the Free Software Foundation.  If the Library does not specify a-license version number, you may choose any version ever published by-the Free Software Foundation.--  14. If you wish to incorporate parts of the Library into other free-programs whose distribution conditions are incompatible with these,-write to the author to ask for permission.  For software which is-copyrighted by the Free Software Foundation, write to the Free-Software Foundation; we sometimes make exceptions for this.  Our-decision will be guided by the two goals of preserving the free status-of all derivatives of our free software and of promoting the sharing-and reuse of software generally.--    NO WARRANTY--  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE-LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.--  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH-DAMAGES.--     END OF TERMS AND CONDITIONS--           How to Apply These Terms to Your New Libraries--  If you develop a new library, and you want it to be of the greatest-possible use to the public, we recommend making it free software that-everyone can redistribute and change.  You can do so by permitting-redistribution under these terms (or, alternatively, under the terms of the-ordinary General Public License).--  To apply these terms, attach the following notices to the library.  It is-safest to attach them to the start of each source file to most effectively-convey the exclusion of warranty; and each file should have at least the-"copyright" line and a pointer to where the full notice is found.--    <one line to give the library's name and a brief idea of what it does.>-    Copyright (C) <year>  <name of author>--    This library is free software; you can redistribute it and/or-    modify it under the terms of the GNU Lesser General Public-    License as published by the Free Software Foundation; either-    version 2.1 of the License, or (at your option) any later version.--    This library is distributed in the hope that it will be useful,-    but WITHOUT ANY WARRANTY; without even the implied warranty of-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU-    Lesser General Public License for more details.--    You should have received a copy of the GNU Lesser General Public-    License along with this library; if not, write to the Free Software-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA--Also add information on how to contact you by electronic and paper mail.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a "copyright disclaimer" for the library, if-necessary.  Here is a sample; alter the names:--  Yoyodyne, Inc., hereby disclaims all copyright interest in the-  library `Frob' (a library for tweaking knobs) written by James Random Hacker.--  <signature of Ty Coon>, 1 April 1990-  Ty Coon, President of Vice-+----------------------------------------------------------------------
+                        PREAMBLE
+
+The wxHaskell libraries are distributed under the wxWindows library 
+license. The documentation is subject to the wxWidgets documentation 
+license.
+
+See "http://www.wxwidgets.org/newlicen.htm" for the legal description 
+of the license, which is also included in this document.
+
+The wxWindows library licence is essentially the L-GPL (Library General 
+Public Licence), with an exception stating that derived works in binary 
+form may be distributed on the user's own terms. This means that it is 
+possible to create commercial software with this library without paying 
+royalties or disclosing source code. This is a solution that satisfies 
+those who wish to produce GPL'ed software using wxHaskell, and also 
+those producing proprietary software.
+
+This library is distributed in the hope that it will be useful, but 
+WITHOUT ANY WARRANTY; without even the implied warranty of 
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the wxWidgets 
+library license for more details.
+
+
+----------------------------------------------------------------------
+                       WXWINDOWS LIBRARY LICENCE
+     TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+  
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public Licence as published by
+  the Free Software Foundation; either version 2 of the Licence, or (at
+  your option) any later version.
+  
+  This library is distributed in the hope that it will be useful, but
+  WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library
+  General Public Licence for more details.
+
+  You should have received a copy of the GNU Library General Public Licence
+  along with this software, usually in a file named COPYING.LIB.  If not,
+  write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+  Boston, MA 02111-1307 USA.
+
+  EXCEPTION NOTICE
+
+  1. As a special exception, the copyright holders of this library give
+  permission for additional uses of the text contained in this release of
+  the library as licenced under the wxWindows Library Licence, applying
+  either version 3 of the Licence, or (at your option) any later version of
+  the Licence as published by the copyright holders of version 3 of the
+  Licence document.
+
+  2. The exception is that you may use, copy, link, modify and distribute
+  under the user's own terms, binary object code versions of works based
+  on the Library.
+
+  3. If you copy code from files distributed under the terms of the GNU
+  General Public Licence or the GNU Library General Public Licence into a
+  copy of this library, as this licence permits, the exception does not
+  apply to the code that you add in this way.  To avoid misleading anyone as
+  to the status of such modified files, you must delete this exception
+  notice from such code and/or adjust the licensing conditions notice
+  accordingly.
+
+  4. If you write modifications of your own for this library, it is your
+  choice whether to permit this exception to apply to your modifications. 
+  If you do not wish that, you must delete the exception notice from such
+  code and/or adjust the licensing conditions notice accordingly.
+
+
+----------------------------------------------------------------------
+  GNU LESSER GENERAL PUBLIC LICENSE
+       Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it.  You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+
+  When we speak of free software, we are referring to freedom of use,
+not price.  Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+  To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights.  These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  To protect each distributor, we want to make it very clear that
+there is no warranty for the free library.  Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+  Finally, software patents pose a constant threat to the existence of
+any free program.  We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder.  Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+  Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License.  This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License.  We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+  When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library.  The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom.  The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+  We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License.  It also provides other free software developers Less
+of an advantage over competing non-free programs.  These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries.  However, the Lesser license provides advantages in certain
+special circumstances.
+
+  For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard.  To achieve this, non-free programs must be
+allowed to use the library.  A more frequent case is that a free
+library does the same job as widely used non-free libraries.  In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+  In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software.  For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+  Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+  GNU LESSER GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Use a suitable shared library mechanism for linking with the
+    Library.  A suitable mechanism is one that (1) uses at run time a
+    copy of the library already present on the user's computer system,
+    rather than copying library functions into the executable, and (2)
+    will operate properly with a modified version of the library, if
+    the user installs one, as long as the modified version is
+    interface-compatible with the version that the work was made with.
+
+    c) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    d) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    e) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+     END OF TERMS AND CONDITIONS
+
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
 That's all there is to it!
src/Graphics/UI/WX.hs view
@@ -1,60 +1,60 @@----------------------------------------------------------------------------------{-| Module      :  WX-    Copyright   :  (c) Daan Leijen 2003-    License     :  wxWindows--    Maintainer  :  wxhaskell-devel@lists.sourceforge.net-    Stability   :  provisional-    Portability :  portable--The WX module just re-exports functionality from helper modules and-defines the 'start' function.--The WX library provides a /haskellized/ interface to the raw wxWidgets-functionality provided by the "Graphics.UI.WXCore" library.--}----------------------------------------------------------------------------------module Graphics.UI.WX-  ( -- * Functions-    start-    -- * Modules-  , module Graphics.UI.WX.Types-  , module Graphics.UI.WX.Attributes-  , module Graphics.UI.WX.Classes-  , module Graphics.UI.WX.Variable-  , module Graphics.UI.WX.Layout-  , module Graphics.UI.WX.Events--  , module Graphics.UI.WX.Window-  , module Graphics.UI.WX.Frame-  , module Graphics.UI.WX.Timer-  , module Graphics.UI.WX.Media-  , module Graphics.UI.WX.Menu-  , module Graphics.UI.WX.Controls-  , module Graphics.UI.WX.Dialogs-  , module Graphics.UI.WX.Draw-  ) where--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Variable-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Events--import Graphics.UI.WX.Window-import Graphics.UI.WX.Frame-import Graphics.UI.WX.Timer-import Graphics.UI.WX.Media-import Graphics.UI.WX.Menu--import Graphics.UI.WX.Controls-import Graphics.UI.WX.Dialogs-import Graphics.UI.WX.Draw--import Graphics.UI.WXCore---- | 'start' runs the GUI.-start :: IO a -> IO ()-start io-  = run (unitIO io)+--------------------------------------------------------------------------------
+{-| Module      :  WX
+    Copyright   :  (c) Daan Leijen 2003
+    License     :  wxWindows
+
+    Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+    Stability   :  provisional
+    Portability :  portable
+
+The WX module just re-exports functionality from helper modules and
+defines the 'start' function.
+
+The WX library provides a /haskellized/ interface to the raw wxWidgets
+functionality provided by the "Graphics.UI.WXCore" library.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX
+  ( -- * Functions
+    start
+    -- * Modules
+  , module Graphics.UI.WX.Types
+  , module Graphics.UI.WX.Attributes
+  , module Graphics.UI.WX.Classes
+  , module Graphics.UI.WX.Variable
+  , module Graphics.UI.WX.Layout
+  , module Graphics.UI.WX.Events
+
+  , module Graphics.UI.WX.Window
+  , module Graphics.UI.WX.Frame
+  , module Graphics.UI.WX.Timer
+  , module Graphics.UI.WX.Media
+  , module Graphics.UI.WX.Menu
+  , module Graphics.UI.WX.Controls
+  , module Graphics.UI.WX.Dialogs
+  , module Graphics.UI.WX.Draw
+  ) where
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Variable
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Events
+
+import Graphics.UI.WX.Window
+import Graphics.UI.WX.Frame
+import Graphics.UI.WX.Timer
+import Graphics.UI.WX.Media
+import Graphics.UI.WX.Menu
+
+import Graphics.UI.WX.Controls
+import Graphics.UI.WX.Dialogs
+import Graphics.UI.WX.Draw
+
+import Graphics.UI.WXCore
+
+-- | 'start' runs the GUI.
+start :: IO a -> IO ()
+start io
+  = run (unitIO io)
src/Graphics/UI/WX/Attributes.hs view
@@ -1,356 +1,356 @@-{-# LANGUAGE ExistentialQuantification #-}----------------------------------------------------------------------------------{-| Module      :  Attributes-    Copyright   :  (c) Daan Leijen 2003-    License     :  wxWindows--    Maintainer  :  wxhaskell-devel@lists.sourceforge.net-    Stability   :  provisional-    Portability :  portable---Widgets @w@ can have attributes of type @a@ represented by the type 'Attr' @w a@.-An example of an attribute is 'Graphics.UI.WX.Classes.text' with type:--> text :: Attr (Window a) String--This means that any object derived from 'Window' has a 'Graphics.UI.WX.Classes.text' attribute of type 'String'.-An attribute can be read with the 'get' function:--> get w title           :: IO String--When an attribute is associated with a value, we call it a /property/ of type 'Prop' @w@.-Properties are constructed by assigning a value to an attribute with the (':=') constructor:--> text := "hello world"      :: Prop (Window a)--A list of properties can be set with the 'set' function:--> set w [text := "Hi"]   :: IO ()--The (':~') constructor is used to transform an attribute value with an update function.-For example, the 'interval' on a timer can be doubled with the following expression.--> set timer [interval :~ (*2)]--The functions 'get', 'set', (':='), and (':~') are polymorphic and work for all widgets, but-the @text@ attribute just works for windows. Many attributes work for different kind-of objects and are organised into type classes. Actually, the real type of the-'Graphics.UI.WX.Classes.text' attribute is:--> Textual w => Attr w String--and 'Window' derived objects are part of this class:--> instance Textual (Window a)--But also menus and status fields:--> instance Textual (Menu a)-> instance Textual (StatusField)--Sometimes, it is convenient to also get a reference to the object itself when setting-a property. The operators ('::=') and ('::~') provide this reference.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Attributes-    (-    -- * Attributes-      Attr, Prop((:=),(:~),(::=),(::~)), ReadAttr, WriteAttr, CreateAttr-    , get, set, swap-    , mapAttr, mapAttrW---    -- * Internal--    -- ** Attributes-    , newAttr, readAttr, writeAttr, nullAttr, constAttr, makeAttr-    -    -- ** Reflection-    , attrName, propName, containsProperty-    -    -- ** Reflective attributes-    , reflectiveAttr, createAttr, withProperty, findProperty-    , withStyleProperty, withStylePropertyNot--    -- *** Filter-    , PropValue(..)-    , filterProperty --    -- ** Cast-    , castAttr, castProp, castProps-    ) where--import Graphics.UI.WX.Types-import Data.Dynamic--infixr 0 :=,:~,::=,::~---- | A property of a widget @w@ is an attribute that--- is already associated with a value. .-data Prop w     = forall a. Attr w a := a         -- ^ Assign a value to an attribute.-                | forall a. Attr w a :~ (a -> a)  -- ^ Apply an update function to an attribute.-                | forall a. Attr w a ::= (w -> a) -- ^ Assign a value to an attribute with the widget as argument.-                | forall a. Attr w a ::~ (w -> a -> a) -- ^ Apply an update function to an attribute with the widget as an argument.---- For debugging purposes-instance Show a => Show (Prop a) where-  show ((Attr string _ _ _ _) :=  _) = "Attr \"" ++ string ++ "\" _ _ _ _ :=  _"-  show ((Attr string _ _ _ _) :~  _) = "Attr \"" ++ string ++ "\" _ _ _ _ :~  _"-  show ((Attr string _ _ _ _) ::= _) = "Attr \"" ++ string ++ "\" _ _ _ _ ::= _"-  show ((Attr string _ _ _ _) ::~ _) = "Attr \"" ++ string ++ "\" _ _ _ _ ::~ _"----- | An attribute that should be specified at creation time. Just for documentation purposes.-type CreateAttr w a = Attr w a---- | A read-only attribute. Just for documentation purposes.-type ReadAttr w a = Attr w a---- | A write-only attribute. Just for documentation purposes.-type WriteAttr w a = Attr w a---- | Widgets @w@ can have attributes of type @a@.-data Attr w a   = Attr String (Maybe (a -> Dynamic, Dynamic -> Maybe a))  -- name, dynamic conversion-                              (w -> IO a) (w -> a -> IO ())               -- getter setter -                              (w -> (a -> a) -> IO a)                     -- updater      ---- For debugging purposes-instance Show a => Show (Attr w a) where-  show (Attr string _ _ _ _) =-    "Attr \"" ++ string ++ "\" _ _ _ _"----- | Cast attributes.-castAttr :: (v -> w) -> Attr w a -> Attr v a-castAttr coerce (Attr name mbdyn getter setter upd)-  = Attr name mbdyn (\v -> getter (coerce v)) (\v x -> (setter (coerce v) x))-                    (\v f -> upd (coerce v) f) ---- | Cast properties-castProp :: (v -> w) -> Prop w -> Prop v-castProp coerce prop-  = case prop of-      (attr := x)   -> (castAttr coerce attr) := x-      (attr :~ f)   -> (castAttr coerce attr) :~ f-      (attr ::= f)  -> (castAttr coerce attr) ::= (\v -> f (coerce v))-      (attr ::~ f)  -> (castAttr coerce attr) ::~ (\v x -> f (coerce v) x)---- | Cast a list of properties.-castProps :: (v -> w) -> [Prop w] -> [Prop v]-castProps coerce props-  = map (castProp coerce) props---- | Create a /reflective/ attribute with a specified name: value can possibly--- retrieved using 'getPropValue'. Note: the use of this function is discouraged--- as it leads to non-compositional code.-reflectiveAttr :: Typeable a => String -> (w -> IO a) -> (w -> a -> IO ()) -> Attr w a-reflectiveAttr name getter setter-  = Attr name (Just (toDyn, fromDynamic)) getter setter updater -  where-    updater w f   = do x <- getter w; setter w (f x); return x---- | Create a /reflective/ attribute with a specified name: value can possibly--- retrieved using 'getPropValue'. Note: the use of this function is discouraged--- as it leads to non-compositional code.-createAttr :: Typeable a => String -> (w -> IO a) -> (w -> a -> IO ()) -> CreateAttr w a-createAttr name getter setter-  = reflectiveAttr name getter setter---- | Create a new attribute with a specified name, getter, setter, and updater function.-makeAttr :: String -> (w -> IO a) -> (w -> a -> IO ()) -> (w -> (a -> a) -> IO a) -> Attr w a-makeAttr name getter setter updater-  = Attr name Nothing getter setter updater ----- | Create a new attribute with a specified name, getter and setter function.-newAttr :: String -> (w -> IO a) -> (w -> a -> IO ()) -> Attr w a-newAttr name getter setter-  = makeAttr name getter setter updater -  where-    updater w f   = do x <- getter w; setter w (f x); return x----- | Define a read-only attribute.-readAttr :: String -> (w -> IO a) -> ReadAttr w a-readAttr name getter-  = newAttr name getter (\w x -> ioError (userError ("attribute '" ++ name ++ "' is read-only.")))---- | Define a write-only attribute.-writeAttr :: String -> (w -> a -> IO ()) -> WriteAttr w a-writeAttr name setter-  = newAttr name (\w -> ioError (userError ("attribute '" ++ name ++ "' is write-only."))) setter---- | A dummy attribute.-nullAttr :: String -> WriteAttr w a-nullAttr name-  = writeAttr name (\w x -> return ())---- | A constant attribute.-constAttr :: Typeable a => String -> a -> Attr w a-constAttr name x-  = newAttr name (\w -> return x) (\w x -> return ())----- | (@mapAttr get set attr@) maps an attribute of @Attr w a@ to--- @Attr w b@ where (@get :: a -> b@) is used when the attribute is--- requested and (@set :: a -> b -> a@) is applied to current--- value when the attribute is set.-mapAttr :: (a -> b) -> (a -> b -> a) -> Attr w a -> Attr w b-mapAttr get set (Attr name reflect getter setter updater)-    = Attr name Nothing-                (\w   -> do a <- getter w; return (get a))-                (\w b -> do a <- getter w; setter w (set a b))-                (\w f -> do a <- updater w (\a -> set a (f (get a))); return (get a)) ---- | (@mapAttrW conv attr@) maps an attribute of @Attr w a@ to--- @Attr v a@ where (@conv :: v -> w@) is used to convert a widget--- @v@ into a widget of type @w@.-mapAttrW :: (v -> w) -> Attr w a -> Attr v a-mapAttrW f attr-  = castAttr f attr---- | Get the value of an attribute------ > t <- get w text----get :: w -> Attr w a -> IO a-get w (Attr name reflect getter setter updater)-  = getter w---- | Set a list of properties.------ > set w [text := "Hi"]----set :: w -> [Prop w] -> IO ()-set w props-  = mapM_ setprop props-  where-    setprop ((Attr name reflect getter setter updater) := x)-      = setter w x-    setprop ((Attr name reflect getter setter updater) :~ f)-      = do updater w f; return ()-    setprop ((Attr name reflect getter setter updater) ::= f)-      = setter w (f w)-    setprop ((Attr name reflect getter setter updater) ::~ f)-      = do updater w (f w); return ()---- | Set the value of an attribute and return the old value.-swap :: w -> Attr w a -> a -> IO a-swap w (Attr name reflect getter setter updater) x-  = updater w (const x)---- | Retrieve the name of an attribute-attrName :: Attr w a -> String-attrName (Attr name _ _ _ _)-  = name---- | Retrieve the name of a property.-propName :: Prop w -> String-propName (attr := x)    = attrName attr-propName (attr :~ f)    = attrName attr-propName (attr ::= f)   = attrName attr-propName (attr ::~ f)   = attrName attr----- | Is a certain property in a list of properties?-containsProperty :: Attr w a -> [Prop w] -> Bool-containsProperty attr props-  = containsPropName (attrName attr) props---- | Is a certain property in a list of properties?-containsPropName :: String -> [Prop w] -> Bool-containsPropName name props-  = any (\p -> propName p == name) props----- | Property value: used when retrieving a property from a list.-data PropValue a  = PropValue  a-                  | PropModify (a -> a)-                  | PropNone--instance Show a => Show (PropValue a) where-  show (PropValue x)  = "PropValue " ++ show x-  show (PropModify f) = "PropModify"-  show (PropNone)     = "PropNone"---- | Retrieve the value of a property and the list with the property removed.-filterProperty :: Typeable a => Attr w a -> [Prop w] -> (PropValue a, [Prop w])-filterProperty (Attr name _ _ _ _) props-  = walk [] PropNone props-  where-    -- Daan: oh, how a simple thing like properties can result into this... ;-)-    walk :: Typeable a => [Prop w] -> PropValue a -> [Prop w] -> (PropValue a, [Prop w])-    walk acc res props-      = case props of-          -- Property setter found.-          (((Attr attr (Just (todyn,fromdyn)) _ _ _) := x):rest)  | name == attr-              -> case fromDynamic (todyn x) of-                   Just x  -> walk acc (PropValue x) rest-                   Nothing -> walk acc res props-                   -          -- Property modifier found.-          (((Attr attr (Just (todyn,fromdyn)) _ _ _) :~ f):rest)  | name == attr-              -> let dynf x = case fromdyn (toDyn x) of-                                Just xx -> case fromDynamic (todyn (f xx)) of-                                             Just y  -> y-                                             Nothing -> x  -- identity-                                Nothing -> x -- identity-                 in case res of-                      PropValue x  -> walk acc (PropValue (dynf x)) rest-                      PropModify g -> walk acc (PropModify (dynf . g)) rest-                      PropNone     -> walk acc (PropModify dynf) rest--          -- Property found, but with the wrong arguments-          (((Attr attr _ _ _ _) := _):rest)   | name == attr  -> stop-          (((Attr attr _ _ _ _) :~ _):rest)   | name == attr  -> stop-          (((Attr attr _ _ _ _) ::= _):rest)  | name == attr  -> stop-          (((Attr attr _ _ _ _) ::~ _):rest)  | name == attr  -> stop--          -- Defaults-          (prop:rest)-              -> walk (prop:acc) res rest-          []  -> stop-       where-        stop  = (res, reverse acc ++ props)-  -               --- | Try to find a property value and call the contination function with that value--- and the property list witht the searched property removed. If the property is not--- found, use the default value and the unchanged property list.-withProperty :: Typeable a => Attr w a -> a -> (a -> [Prop w] -> b) -> [Prop w] -> b-withProperty attr def cont props-  = case filterProperty attr props of-      (PropValue x, ps)  -> cont x ps-      (PropModify f, ps) -> cont (f def) ps-      (PropNone, ps)     -> cont def ps---- | Try to find a property value. Return |Nothing| if not found at all.-findProperty :: Typeable a => Attr w a -> a -> [Prop w] -> Maybe (a,[Prop w])-findProperty attr def props-  = case filterProperty attr props of-      (PropValue x, ps)  -> Just (x,ps)-      (PropModify f, ps) -> Just (f def,ps)-      (PropNone, ps)     -> Nothing------ | Transform the properties based on a style property.-withStyleProperty :: Attr w Bool -> Style -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-withStyleProperty prop flag -  = withStylePropertyEx prop (bitsSet flag) (\isSet style -> if isSet then (style .+. flag) else (style .-. flag)) ---- | Transform the properties based on a style property. The flag is interpreted negatively, i.e. |True|--- removes the bit instead of setting it.-withStylePropertyNot :: Attr w Bool -> Style -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-withStylePropertyNot prop flag -  = withStylePropertyEx prop (not . bitsSet flag) (\isSet style -> if isSet then (style .-. flag) else (style .+. flag)) ----- | Transform the properties based on a style property.-withStylePropertyEx :: Attr w Bool -> (Style -> Bool) -> (Bool -> Style -> Style) -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-withStylePropertyEx prop def transform cont props style-  = case filterProperty prop props of-      (PropValue x, ps)  -> cont ps (transform x style) -      (PropModify f, ps) -> cont ps (transform (f (def style)) style)-      (PropNone, ps)     -> cont ps style+{-# LANGUAGE ExistentialQuantification #-}
+--------------------------------------------------------------------------------
+{-| Module      :  Attributes
+    Copyright   :  (c) Daan Leijen 2003
+    License     :  wxWindows
+
+    Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+    Stability   :  provisional
+    Portability :  portable
+
+
+Widgets @w@ can have attributes of type @a@ represented by the type 'Attr' @w a@.
+An example of an attribute is 'Graphics.UI.WX.Classes.text' with type:
+
+> text :: Attr (Window a) String
+
+This means that any object derived from 'Window' has a 'Graphics.UI.WX.Classes.text' attribute of type 'String'.
+An attribute can be read with the 'get' function:
+
+> get w title           :: IO String
+
+When an attribute is associated with a value, we call it a /property/ of type 'Prop' @w@.
+Properties are constructed by assigning a value to an attribute with the (':=') constructor:
+
+> text := "hello world"      :: Prop (Window a)
+
+A list of properties can be set with the 'set' function:
+
+> set w [text := "Hi"]   :: IO ()
+
+The (':~') constructor is used to transform an attribute value with an update function.
+For example, the 'interval' on a timer can be doubled with the following expression.
+
+> set timer [interval :~ (*2)]
+
+The functions 'get', 'set', (':='), and (':~') are polymorphic and work for all widgets, but
+the @text@ attribute just works for windows. Many attributes work for different kind
+of objects and are organised into type classes. Actually, the real type of the
+'Graphics.UI.WX.Classes.text' attribute is:
+
+> Textual w => Attr w String
+
+and 'Window' derived objects are part of this class:
+
+> instance Textual (Window a)
+
+But also menus and status fields:
+
+> instance Textual (Menu a)
+> instance Textual (StatusField)
+
+Sometimes, it is convenient to also get a reference to the object itself when setting
+a property. The operators ('::=') and ('::~') provide this reference.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Attributes
+    (
+    -- * Attributes
+      Attr, Prop((:=),(:~),(::=),(::~)), ReadAttr, WriteAttr, CreateAttr
+    , get, set, swap
+    , mapAttr, mapAttrW
+
+
+    -- * Internal
+
+    -- ** Attributes
+    , newAttr, readAttr, writeAttr, nullAttr, constAttr, makeAttr
+    
+    -- ** Reflection
+    , attrName, propName, containsProperty
+    
+    -- ** Reflective attributes
+    , reflectiveAttr, createAttr, withProperty, findProperty
+    , withStyleProperty, withStylePropertyNot
+
+    -- *** Filter
+    , PropValue(..)
+    , filterProperty 
+
+    -- ** Cast
+    , castAttr, castProp, castProps
+    ) where
+
+import Graphics.UI.WX.Types
+import Data.Dynamic
+
+infixr 0 :=,:~,::=,::~
+
+-- | A property of a widget @w@ is an attribute that
+-- is already associated with a value. .
+data Prop w     = forall a. Attr w a := a         -- ^ Assign a value to an attribute.
+                | forall a. Attr w a :~ (a -> a)  -- ^ Apply an update function to an attribute.
+                | forall a. Attr w a ::= (w -> a) -- ^ Assign a value to an attribute with the widget as argument.
+                | forall a. Attr w a ::~ (w -> a -> a) -- ^ Apply an update function to an attribute with the widget as an argument.
+
+-- For debugging purposes
+instance Show a => Show (Prop a) where
+  show ((Attr string _ _ _ _) :=  _) = "Attr \"" ++ string ++ "\" _ _ _ _ :=  _"
+  show ((Attr string _ _ _ _) :~  _) = "Attr \"" ++ string ++ "\" _ _ _ _ :~  _"
+  show ((Attr string _ _ _ _) ::= _) = "Attr \"" ++ string ++ "\" _ _ _ _ ::= _"
+  show ((Attr string _ _ _ _) ::~ _) = "Attr \"" ++ string ++ "\" _ _ _ _ ::~ _"
+
+
+-- | An attribute that should be specified at creation time. Just for documentation purposes.
+type CreateAttr w a = Attr w a
+
+-- | A read-only attribute. Just for documentation purposes.
+type ReadAttr w a = Attr w a
+
+-- | A write-only attribute. Just for documentation purposes.
+type WriteAttr w a = Attr w a
+
+-- | Widgets @w@ can have attributes of type @a@.
+data Attr w a   = Attr String (Maybe (a -> Dynamic, Dynamic -> Maybe a))  -- name, dynamic conversion
+                              (w -> IO a) (w -> a -> IO ())               -- getter setter 
+                              (w -> (a -> a) -> IO a)                     -- updater      
+
+-- For debugging purposes
+instance Show a => Show (Attr w a) where
+  show (Attr string _ _ _ _) =
+    "Attr \"" ++ string ++ "\" _ _ _ _"
+
+
+-- | Cast attributes.
+castAttr :: (v -> w) -> Attr w a -> Attr v a
+castAttr coerce (Attr name mbdyn getter setter upd)
+  = Attr name mbdyn (\v -> getter (coerce v)) (\v x -> (setter (coerce v) x))
+                    (\v f -> upd (coerce v) f) 
+
+-- | Cast properties
+castProp :: (v -> w) -> Prop w -> Prop v
+castProp coerce prop
+  = case prop of
+      (attr := x)   -> (castAttr coerce attr) := x
+      (attr :~ f)   -> (castAttr coerce attr) :~ f
+      (attr ::= f)  -> (castAttr coerce attr) ::= (\v -> f (coerce v))
+      (attr ::~ f)  -> (castAttr coerce attr) ::~ (\v x -> f (coerce v) x)
+
+-- | Cast a list of properties.
+castProps :: (v -> w) -> [Prop w] -> [Prop v]
+castProps coerce props
+  = map (castProp coerce) props
+
+-- | Create a /reflective/ attribute with a specified name: value can possibly
+-- retrieved using 'getPropValue'. Note: the use of this function is discouraged
+-- as it leads to non-compositional code.
+reflectiveAttr :: Typeable a => String -> (w -> IO a) -> (w -> a -> IO ()) -> Attr w a
+reflectiveAttr name getter setter
+  = Attr name (Just (toDyn, fromDynamic)) getter setter updater 
+  where
+    updater w f   = do x <- getter w; setter w (f x); return x
+
+-- | Create a /reflective/ attribute with a specified name: value can possibly
+-- retrieved using 'getPropValue'. Note: the use of this function is discouraged
+-- as it leads to non-compositional code.
+createAttr :: Typeable a => String -> (w -> IO a) -> (w -> a -> IO ()) -> CreateAttr w a
+createAttr name getter setter
+  = reflectiveAttr name getter setter
+
+-- | Create a new attribute with a specified name, getter, setter, and updater function.
+makeAttr :: String -> (w -> IO a) -> (w -> a -> IO ()) -> (w -> (a -> a) -> IO a) -> Attr w a
+makeAttr name getter setter updater
+  = Attr name Nothing getter setter updater 
+
+
+-- | Create a new attribute with a specified name, getter and setter function.
+newAttr :: String -> (w -> IO a) -> (w -> a -> IO ()) -> Attr w a
+newAttr name getter setter
+  = makeAttr name getter setter updater 
+  where
+    updater w f   = do x <- getter w; setter w (f x); return x
+
+
+-- | Define a read-only attribute.
+readAttr :: String -> (w -> IO a) -> ReadAttr w a
+readAttr name getter
+  = newAttr name getter (\w x -> ioError (userError ("attribute '" ++ name ++ "' is read-only.")))
+
+-- | Define a write-only attribute.
+writeAttr :: String -> (w -> a -> IO ()) -> WriteAttr w a
+writeAttr name setter
+  = newAttr name (\w -> ioError (userError ("attribute '" ++ name ++ "' is write-only."))) setter
+
+-- | A dummy attribute.
+nullAttr :: String -> WriteAttr w a
+nullAttr name
+  = writeAttr name (\w x -> return ())
+
+-- | A constant attribute.
+constAttr :: Typeable a => String -> a -> Attr w a
+constAttr name x
+  = newAttr name (\w -> return x) (\w x -> return ())
+
+
+-- | (@mapAttr get set attr@) maps an attribute of @Attr w a@ to
+-- @Attr w b@ where (@get :: a -> b@) is used when the attribute is
+-- requested and (@set :: a -> b -> a@) is applied to current
+-- value when the attribute is set.
+mapAttr :: (a -> b) -> (a -> b -> a) -> Attr w a -> Attr w b
+mapAttr get set (Attr name reflect getter setter updater)
+    = Attr name Nothing
+                (\w   -> do a <- getter w; return (get a))
+                (\w b -> do a <- getter w; setter w (set a b))
+                (\w f -> do a <- updater w (\a -> set a (f (get a))); return (get a)) 
+
+-- | (@mapAttrW conv attr@) maps an attribute of @Attr w a@ to
+-- @Attr v a@ where (@conv :: v -> w@) is used to convert a widget
+-- @v@ into a widget of type @w@.
+mapAttrW :: (v -> w) -> Attr w a -> Attr v a
+mapAttrW f attr
+  = castAttr f attr
+
+-- | Get the value of an attribute
+--
+-- > t <- get w text
+--
+get :: w -> Attr w a -> IO a
+get w (Attr name reflect getter setter updater)
+  = getter w
+
+-- | Set a list of properties.
+--
+-- > set w [text := "Hi"]
+--
+set :: w -> [Prop w] -> IO ()
+set w props
+  = mapM_ setprop props
+  where
+    setprop ((Attr name reflect getter setter updater) := x)
+      = setter w x
+    setprop ((Attr name reflect getter setter updater) :~ f)
+      = do updater w f; return ()
+    setprop ((Attr name reflect getter setter updater) ::= f)
+      = setter w (f w)
+    setprop ((Attr name reflect getter setter updater) ::~ f)
+      = do updater w (f w); return ()
+
+-- | Set the value of an attribute and return the old value.
+swap :: w -> Attr w a -> a -> IO a
+swap w (Attr name reflect getter setter updater) x
+  = updater w (const x)
+
+-- | Retrieve the name of an attribute
+attrName :: Attr w a -> String
+attrName (Attr name _ _ _ _)
+  = name
+
+-- | Retrieve the name of a property.
+propName :: Prop w -> String
+propName (attr := x)    = attrName attr
+propName (attr :~ f)    = attrName attr
+propName (attr ::= f)   = attrName attr
+propName (attr ::~ f)   = attrName attr
+
+
+-- | Is a certain property in a list of properties?
+containsProperty :: Attr w a -> [Prop w] -> Bool
+containsProperty attr props
+  = containsPropName (attrName attr) props
+
+-- | Is a certain property in a list of properties?
+containsPropName :: String -> [Prop w] -> Bool
+containsPropName name props
+  = any (\p -> propName p == name) props
+
+
+-- | Property value: used when retrieving a property from a list.
+data PropValue a  = PropValue  a
+                  | PropModify (a -> a)
+                  | PropNone
+
+instance Show a => Show (PropValue a) where
+  show (PropValue x)  = "PropValue " ++ show x
+  show (PropModify f) = "PropModify"
+  show (PropNone)     = "PropNone"
+
+-- | Retrieve the value of a property and the list with the property removed.
+filterProperty :: Typeable a => Attr w a -> [Prop w] -> (PropValue a, [Prop w])
+filterProperty (Attr name _ _ _ _) props
+  = walk [] PropNone props
+  where
+    -- Daan: oh, how a simple thing like properties can result into this... ;-)
+    walk :: Typeable a => [Prop w] -> PropValue a -> [Prop w] -> (PropValue a, [Prop w])
+    walk acc res props
+      = case props of
+          -- Property setter found.
+          (((Attr attr (Just (todyn,fromdyn)) _ _ _) := x):rest)  | name == attr
+              -> case fromDynamic (todyn x) of
+                   Just x  -> walk acc (PropValue x) rest
+                   Nothing -> walk acc res props
+                   
+          -- Property modifier found.
+          (((Attr attr (Just (todyn,fromdyn)) _ _ _) :~ f):rest)  | name == attr
+              -> let dynf x = case fromdyn (toDyn x) of
+                                Just xx -> case fromDynamic (todyn (f xx)) of
+                                             Just y  -> y
+                                             Nothing -> x  -- identity
+                                Nothing -> x -- identity
+                 in case res of
+                      PropValue x  -> walk acc (PropValue (dynf x)) rest
+                      PropModify g -> walk acc (PropModify (dynf . g)) rest
+                      PropNone     -> walk acc (PropModify dynf) rest
+
+          -- Property found, but with the wrong arguments
+          (((Attr attr _ _ _ _) := _):rest)   | name == attr  -> stop
+          (((Attr attr _ _ _ _) :~ _):rest)   | name == attr  -> stop
+          (((Attr attr _ _ _ _) ::= _):rest)  | name == attr  -> stop
+          (((Attr attr _ _ _ _) ::~ _):rest)  | name == attr  -> stop
+
+          -- Defaults
+          (prop:rest)
+              -> walk (prop:acc) res rest
+          []  -> stop
+       where
+        stop  = (res, reverse acc ++ props)
+  
+               
+-- | Try to find a property value and call the contination function with that value
+-- and the property list witht the searched property removed. If the property is not
+-- found, use the default value and the unchanged property list.
+withProperty :: Typeable a => Attr w a -> a -> (a -> [Prop w] -> b) -> [Prop w] -> b
+withProperty attr def cont props
+  = case filterProperty attr props of
+      (PropValue x, ps)  -> cont x ps
+      (PropModify f, ps) -> cont (f def) ps
+      (PropNone, ps)     -> cont def ps
+
+-- | Try to find a property value. Return |Nothing| if not found at all.
+findProperty :: Typeable a => Attr w a -> a -> [Prop w] -> Maybe (a,[Prop w])
+findProperty attr def props
+  = case filterProperty attr props of
+      (PropValue x, ps)  -> Just (x,ps)
+      (PropModify f, ps) -> Just (f def,ps)
+      (PropNone, ps)     -> Nothing
+
+
+
+-- | Transform the properties based on a style property.
+withStyleProperty :: Attr w Bool -> Style -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+withStyleProperty prop flag 
+  = withStylePropertyEx prop (bitsSet flag) (\isSet style -> if isSet then (style .+. flag) else (style .-. flag)) 
+
+-- | Transform the properties based on a style property. The flag is interpreted negatively, i.e. |True|
+-- removes the bit instead of setting it.
+withStylePropertyNot :: Attr w Bool -> Style -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+withStylePropertyNot prop flag 
+  = withStylePropertyEx prop (not . bitsSet flag) (\isSet style -> if isSet then (style .-. flag) else (style .+. flag)) 
+
+
+-- | Transform the properties based on a style property.
+withStylePropertyEx :: Attr w Bool -> (Style -> Bool) -> (Bool -> Style -> Style) -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+withStylePropertyEx prop def transform cont props style
+  = case filterProperty prop props of
+      (PropValue x, ps)  -> cont ps (transform x style) 
+      (PropModify f, ps) -> cont ps (transform (f (def style)) style)
+      (PropNone, ps)     -> cont ps style
src/Graphics/UI/WX/Classes.hs view
@@ -1,388 +1,388 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, DeriveDataTypeable, ScopedTypeVariables #-}----------------------------------------------------------------------------------{-| Module      :  Classes-    Copyright   :  (c) Daan Leijen 2003-    License     :  wxWindows--    Maintainer  :  wxhaskell-devel@lists.sourceforge.net-    Stability   :  provisional-    Portability :  portable--This modules defines attributes common to many widgets and-organizes them into Haskell classes. Look at the instance definitions-to see what kind of widgets support the attributes. -    -Sometimes it is-hard to find what attributes a certain widget supports since the instance-definitions might be on some class higher in the hierarchy. For example,-many instances are defined for 'Window' @a@ -- this means that all-those attributes are applicable to any kind of 'Window', i.e. frames,-buttons, panels etc. However, these attributes will not be explicitly-listed at the type definitions of those classes.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Classes-    ( -      -- * Data types-      Border(..)--      -- * Text-    , Textual(text,appendText)-    , Literate(font ,fontFamily, fontFace, fontSize, fontWeight, fontUnderline, fontShape-              ,textColor,textBgcolor)-      -- * Rendering-    , Dimensions(..)-    , Colored(..)-    , Visible(..)-    , Bordered(..)-      -- * Hierarchy-    , Child(..)-    , Parent(..)-    , Closeable(..)-      -- * Containers-    , Selection( selection )-    , Selections( selections )-    , Items( itemCount, item, items, itemAppend, itemDelete, itemsDelete )-      -- * Misc.-    , Able( enabled ) -- , enable-    , Help( help )-    , Tipped( tooltip )-    , Identity( identity )-    , Styled( style )-    , Framed( resizeable, maximizeable, minimizeable, closeable )-    , Checkable( checkable, checked )-    , Dockable( dockable )-    , Pictured( picture )-    , Valued( value )-    , Sized( size )-    , HasDefault( unsafeDefaultItem, defaultButton )-    ) where--import Data.Dynamic-import Graphics.UI.WXCore--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout----- | Widgets with a label or text field.-class Textual w where-  -- | The text of a widget. It is interpreted differently for-  -- for different widgets, for example, the title of a frame or the content of a-  -- static text control.-  text       :: Attr w String-  appendText :: w -> String -> IO ()--  appendText w s-    = set w [text :~ (++s)]----- | Widgets with a picture.-class Pictured w where-  -- | The image of a widget.-  picture :: Attr w FilePath----- | Widgets with a font.-class Literate w where-  -- | The font of the widget.-  font       :: Attr w FontStyle--  -- | The font size.-  fontSize   :: Attr w Int--  -- | The font weight.-  fontWeight :: Attr w FontWeight--  -- | The font family.-  fontFamily :: Attr w FontFamily--  -- | The font style.-  fontShape  :: Attr w FontShape--  -- | The font /face/: determines a platform dependent font.-  fontFace   :: Attr w String--  -- | Is the font underlined?-  fontUnderline :: Attr w Bool--  -- | Text color.-  textColor  :: Attr w Color--  -- | Text background color-  textBgcolor:: Attr w Color --  fontSize      = mapAttr _fontSize   (\finfo x -> finfo{ _fontSize = x }) font-  fontWeight    = mapAttr _fontWeight (\finfo x -> finfo{ _fontWeight = x }) font-  fontFamily    = mapAttr _fontFamily (\finfo x -> finfo{ _fontFamily = x }) font-  fontShape     = mapAttr _fontShape  (\finfo x -> finfo{ _fontShape  = x }) font-  fontFace      = mapAttr _fontFace   (\finfo x -> finfo{ _fontFace = x }) font-  fontUnderline = mapAttr _fontUnderline (\finfo x -> finfo{ _fontUnderline = x }) font--  ---- | Widgets that have a size.-class Dimensions w where-  -- | The outer size of a widget (in pixels).-  outerSize :: Attr w Size-  -- | The (relative) position of a widget.-  position  :: Attr w Point-  -- | The occupied area.-  area      :: Attr w Rect-  -- | The preferred size of a widget.-  bestSize  :: ReadAttr w Size-  -- | The area available for client use (i.e. without the border etc).-  clientSize :: Attr w Size-  -- | The virtual size of a widget (ie. the total scrolling area)-  virtualSize :: Attr w Size--  -- defaults-  outerSize-    = mapAttr rectSize (\r sz -> rect (rectTopLeft r) sz) area-  position-      = mapAttr rectTopLeft (\r pt -> rect pt (rectSize r)) area-  area-    = newAttr "area" getArea setArea-    where-      getArea w-        = do sz <- get w outerSize-             pt <- get w position-             return (rect pt sz)-      setArea w rect-        = set w [outerSize := rectSize rect, position := rectTopLeft rect]--  clientSize-    = outerSize-  bestSize-    = outerSize-  virtualSize-    = clientSize--class Colored w where-  -- | The background color.-  bgcolor    :: Attr w Color-  -- | The (foreground) color-  color      :: Attr w Color--  bgcolor-    = nullAttr "bgcolor"-  color-    = nullAttr "color"---- | Visible widgets.-class Visible w where-  -- | Is the widget visible?-  visible    :: Attr w Bool-  -- | Refresh the widget explicitly.-  refresh    :: w -> IO ()--  -- | Should the widget be fully repainted on resize? This attribute only-  -- has effect when set at creation. If 'False', you will have to repaint-  -- the new window area manually at a resize, but flickering caused by-  -- background redraws can be prevented in this way. ('False' by default)-  fullRepaintOnResize :: Attr w Bool-  fullRepaintOnResize-    = nullAttr "fullRepaintOnResize"--  -- defaults-  visible-    = nullAttr "visible"-  refresh w-    = return ()---- | Parent widgets.-class Parent w where-  -- | Get the child widgets of a window.-  children :: ReadAttr w [Window ()]-  children = nullAttr "window"--  -- | Reduce flicker by not redrawing the background under child controls.-  -- This attribute has to be set at creation time. ('True' by default)-  clipChildren :: Attr w Bool-  clipChildren-    = nullAttr "clipChildren"----- | Window borders-data Border = BorderSimple    -- ^ Displays a thin border around the window.  -            | BorderDouble    -- ^ Displays a double border. Windows only.  -            | BorderSunken    -- ^ Displays a sunken border.  -            | BorderRaised    -- ^ Displays a raised border.-            | BorderStatic    -- ^ Displays a border suitable for a static control. Windows only -            | BorderNone      -- ^ No border-            deriving (Eq,Show,Read,Typeable)--instance BitMask Border where-  assocBitMask-    = [(BorderSimple, wxBORDER)-      ,(BorderDouble, wxDOUBLE_BORDER)-      ,(BorderSunken, wxSUNKEN_BORDER)-      ,(BorderRaised, wxRAISED_BORDER)-      ,(BorderStatic, wxSTATIC_BORDER)-      ,(BorderNone,   0)]----- | Widgets with a border.-class Bordered w where-  -- | Specify the border of a widget.-  border :: Attr w Border-  border = nullAttr "border"----- | Widgets that are part of a hierarchical order.-class Child w where-  -- | The parent widget.-  parent :: ReadAttr w (Window ())--  -- defaults-  parent-    = readAttr "parent" (\w -> return objectNull)----- | Widgets that can be closed.-class Closeable w where-  -- | Close the widget.-  close  :: w -> IO ()---- | Widgets that have a system frame around them.-class Framed w where-  -- | Make the widget user resizeable? This attribute must be set at creation time.-  resizeable :: Attr w Bool-  resizeable  = nullAttr "resizeable"--  -- | Can the widget be minimized? This attribute must be set at creation time.-  minimizeable :: Attr w Bool-  minimizeable  = nullAttr "minimizeable"--  -- | Can the widget be maximized? This attribute must be set at creation time-  -- and is normally used together with 'resizeable'.-  maximizeable :: Attr w Bool-  maximizeable  = nullAttr "maximizeable"--  -- | Can the widget be closed by the user? This attribute must be set at creation time.-  closeable :: Attr w Bool-  closeable  = nullAttr "closeable"----- | Widgets that can be enabled or disabled.-class Able w where-  -- | Enable, or disable, the widget.-  enabled :: Attr w Bool--{-# DEPRECATED enable "Use enabled instead" #-}--- | Deprecated: use 'enabled' instead-enable :: Able w => Attr w Bool-enable = enabled---- | Widgets with help text.-class Help w where-  -- | Short help text, normally displayed in the status bar or popup balloon.-  help :: Attr w String---- | Checkable widgets-class Checkable w where-  -- | Is the widget checkable?-  checkable :: Attr w Bool-  -- | Is the widget checked?-  checked   :: Attr w Bool---- | The identity determines the wxWidgets ID of a widget.-class Identity w where-  -- | The identity determines the wxWidgets ID of a widget.-  identity :: Attr w Int----- | The style is a bitmask that determines various properties of a widget.-class Styled w where-  -- | The windows style.-  style :: Attr w Int---- | Dockable widgets.-class Dockable w where-  -- | Is the widget dockable?-  dockable :: Attr w Bool---- | Widgets that have a tooltip-class Tipped w where-  -- | The tooltip information-  tooltip :: Attr w String---- | Widgets with a single selection (radio group or listbox)-class Selection w where-  -- | The current selection as a zero-based index.-  -- Certain widgets return -1 when no item is selected.-  selection :: Attr w Int---- | Widget with zero or more selections (multi select list boxes)-class Selections w where-  -- | The currently selected items in zero-based indices.-  selections :: Attr w [Int]----- | Widgets containing certain items (like strings in a listbox)-class Items w a | w -> a where-  -- | Number of items.-  itemCount  :: ReadAttr w Int-  -- | All the items as a list. This attribute might not be writable for some widgets (like radioboxes)-  items  :: Attr w [a]-  -- | An item by zero-based index.-  item   :: Int -> Attr w a-  -- | Delete an item. Only valid for writeable items.-  itemDelete :: w -> Int -> IO ()-  -- | Delete all items. Only valid for writeable items.-  itemsDelete :: w -> IO ()-  -- | Append an item. Only valid for writeable items.-  itemAppend :: w -> a -> IO ()--  items-    = newAttr "items" getter setter-    where-      getter :: w -> IO [a]-      getter w-        = do n <- get w itemCount-             mapM (\i -> get w (item i)) [0..n-1]--      setter :: w -> [a] -> IO ()-      setter w xs-        = do itemsDelete w-             mapM_ (\x -> itemAppend w x) xs--  itemAppend w x-    = do xs <- get w items-         set w [items := xs ++ [x]]--  itemsDelete w-    = do count <- get w itemCount -         sequence_ (replicate count (itemDelete w 0))--{---------------------------------------------------------------------------  Values---------------------------------------------------------------------------}  --- | Items with a value.-class Valued w where-  -- | The value of an object.-  value :: Attr (w a) a--{---------------------------------------------------------------------------  Size---------------------------------------------------------------------------}  --- | Sized objects (like bitmaps)-class Sized w where-  -- | The size of an object. (is 'outerSize' for 'Dimensions' widgets).-  size :: Attr w Size--{---------------------------------------------------------------------------  HasDefault---------------------------------------------------------------------------}  --- | Objects which activate a 'Window' by default keypress-class HasDefault w where-  -- | Define a default item as any type deriving from 'Window'. Great care-  --   is required when using this option as you will have to cast the item-  --   to/from Window() using 'objectCast'. -  --   For the common use case where the window in question is a 'Button', -  --   please use 'defaultButton' as it is typesafe.-  unsafeDefaultItem :: Attr w (Window ())-  -- | Define the default button for a 'TopLevelWindow'. This is recommended-  --   for most use cases as the most common default control is a 'Button'.-  defaultButton :: Attr w (Button ())+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, DeriveDataTypeable, ScopedTypeVariables #-}
+--------------------------------------------------------------------------------
+{-| Module      :  Classes
+    Copyright   :  (c) Daan Leijen 2003
+    License     :  wxWindows
+
+    Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+    Stability   :  provisional
+    Portability :  portable
+
+This modules defines attributes common to many widgets and
+organizes them into Haskell classes. Look at the instance definitions
+to see what kind of widgets support the attributes. 
+    
+Sometimes it is
+hard to find what attributes a certain widget supports since the instance
+definitions might be on some class higher in the hierarchy. For example,
+many instances are defined for 'Window' @a@ -- this means that all
+those attributes are applicable to any kind of 'Window', i.e. frames,
+buttons, panels etc. However, these attributes will not be explicitly
+listed at the type definitions of those classes.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Classes
+    ( 
+      -- * Data types
+      Border(..)
+
+      -- * Text
+    , Textual(text,appendText)
+    , Literate(font ,fontFamily, fontFace, fontSize, fontWeight, fontUnderline, fontShape
+              ,textColor,textBgcolor)
+      -- * Rendering
+    , Dimensions(..)
+    , Colored(..)
+    , Visible(..)
+    , Bordered(..)
+      -- * Hierarchy
+    , Child(..)
+    , Parent(..)
+    , Closeable(..)
+      -- * Containers
+    , Selection( selection )
+    , Selections( selections )
+    , Items( itemCount, item, items, itemAppend, itemDelete, itemsDelete )
+      -- * Misc.
+    , Able( enabled ) -- , enable
+    , Help( help )
+    , Tipped( tooltip )
+    , Identity( identity )
+    , Styled( style )
+    , Framed( resizeable, maximizeable, minimizeable, closeable )
+    , Checkable( checkable, checked )
+    , Dockable( dockable )
+    , Pictured( picture )
+    , Valued( value )
+    , Sized( size )
+    , HasDefault( unsafeDefaultItem, defaultButton )
+    ) where
+
+import Data.Dynamic
+import Graphics.UI.WXCore
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+
+
+-- | Widgets with a label or text field.
+class Textual w where
+  -- | The text of a widget. It is interpreted differently for
+  -- for different widgets, for example, the title of a frame or the content of a
+  -- static text control.
+  text       :: Attr w String
+  appendText :: w -> String -> IO ()
+
+  appendText w s
+    = set w [text :~ (++s)]
+
+
+-- | Widgets with a picture.
+class Pictured w where
+  -- | The image of a widget.
+  picture :: Attr w FilePath
+
+
+-- | Widgets with a font.
+class Literate w where
+  -- | The font of the widget.
+  font       :: Attr w FontStyle
+
+  -- | The font size.
+  fontSize   :: Attr w Int
+
+  -- | The font weight.
+  fontWeight :: Attr w FontWeight
+
+  -- | The font family.
+  fontFamily :: Attr w FontFamily
+
+  -- | The font style.
+  fontShape  :: Attr w FontShape
+
+  -- | The font /face/: determines a platform dependent font.
+  fontFace   :: Attr w String
+
+  -- | Is the font underlined?
+  fontUnderline :: Attr w Bool
+
+  -- | Text color.
+  textColor  :: Attr w Color
+
+  -- | Text background color
+  textBgcolor:: Attr w Color 
+
+  fontSize      = mapAttr _fontSize   (\finfo x -> finfo{ _fontSize = x }) font
+  fontWeight    = mapAttr _fontWeight (\finfo x -> finfo{ _fontWeight = x }) font
+  fontFamily    = mapAttr _fontFamily (\finfo x -> finfo{ _fontFamily = x }) font
+  fontShape     = mapAttr _fontShape  (\finfo x -> finfo{ _fontShape  = x }) font
+  fontFace      = mapAttr _fontFace   (\finfo x -> finfo{ _fontFace = x }) font
+  fontUnderline = mapAttr _fontUnderline (\finfo x -> finfo{ _fontUnderline = x }) font
+
+  
+
+-- | Widgets that have a size.
+class Dimensions w where
+  -- | The outer size of a widget (in pixels).
+  outerSize :: Attr w Size
+  -- | The (relative) position of a widget.
+  position  :: Attr w Point
+  -- | The occupied area.
+  area      :: Attr w Rect
+  -- | The preferred size of a widget.
+  bestSize  :: ReadAttr w Size
+  -- | The area available for client use (i.e. without the border etc).
+  clientSize :: Attr w Size
+  -- | The virtual size of a widget (ie. the total scrolling area)
+  virtualSize :: Attr w Size
+
+  -- defaults
+  outerSize
+    = mapAttr rectSize (\r sz -> rect (rectTopLeft r) sz) area
+  position
+      = mapAttr rectTopLeft (\r pt -> rect pt (rectSize r)) area
+  area
+    = newAttr "area" getArea setArea
+    where
+      getArea w
+        = do sz <- get w outerSize
+             pt <- get w position
+             return (rect pt sz)
+      setArea w rect
+        = set w [outerSize := rectSize rect, position := rectTopLeft rect]
+
+  clientSize
+    = outerSize
+  bestSize
+    = outerSize
+  virtualSize
+    = clientSize
+
+class Colored w where
+  -- | The background color.
+  bgcolor    :: Attr w Color
+  -- | The (foreground) color
+  color      :: Attr w Color
+
+  bgcolor
+    = nullAttr "bgcolor"
+  color
+    = nullAttr "color"
+
+-- | Visible widgets.
+class Visible w where
+  -- | Is the widget visible?
+  visible    :: Attr w Bool
+  -- | Refresh the widget explicitly.
+  refresh    :: w -> IO ()
+
+  -- | Should the widget be fully repainted on resize? This attribute only
+  -- has effect when set at creation. If 'False', you will have to repaint
+  -- the new window area manually at a resize, but flickering caused by
+  -- background redraws can be prevented in this way. ('False' by default)
+  fullRepaintOnResize :: Attr w Bool
+  fullRepaintOnResize
+    = nullAttr "fullRepaintOnResize"
+
+  -- defaults
+  visible
+    = nullAttr "visible"
+  refresh w
+    = return ()
+
+-- | Parent widgets.
+class Parent w where
+  -- | Get the child widgets of a window.
+  children :: ReadAttr w [Window ()]
+  children = nullAttr "window"
+
+  -- | Reduce flicker by not redrawing the background under child controls.
+  -- This attribute has to be set at creation time. ('True' by default)
+  clipChildren :: Attr w Bool
+  clipChildren
+    = nullAttr "clipChildren"
+
+
+-- | Window borders
+data Border = BorderSimple    -- ^ Displays a thin border around the window.  
+            | BorderDouble    -- ^ Displays a double border. Windows only.  
+            | BorderSunken    -- ^ Displays a sunken border.  
+            | BorderRaised    -- ^ Displays a raised border.
+            | BorderStatic    -- ^ Displays a border suitable for a static control. Windows only 
+            | BorderNone      -- ^ No border
+            deriving (Eq,Show,Read,Typeable)
+
+instance BitMask Border where
+  assocBitMask
+    = [(BorderSimple, wxBORDER)
+      ,(BorderDouble, wxBORDER_THEME)
+      ,(BorderSunken, wxBORDER_SUNKEN)
+      ,(BorderRaised, wxBORDER_RAISED)
+      ,(BorderStatic, wxBORDER_STATIC)
+      ,(BorderNone,   0)]
+
+
+-- | Widgets with a border.
+class Bordered w where
+  -- | Specify the border of a widget.
+  border :: Attr w Border
+  border = nullAttr "border"
+
+
+-- | Widgets that are part of a hierarchical order.
+class Child w where
+  -- | The parent widget.
+  parent :: ReadAttr w (Window ())
+
+  -- defaults
+  parent
+    = readAttr "parent" (\w -> return objectNull)
+
+
+-- | Widgets that can be closed.
+class Closeable w where
+  -- | Close the widget.
+  close  :: w -> IO ()
+
+-- | Widgets that have a system frame around them.
+class Framed w where
+  -- | Make the widget user resizeable? This attribute must be set at creation time.
+  resizeable :: Attr w Bool
+  resizeable  = nullAttr "resizeable"
+
+  -- | Can the widget be minimized? This attribute must be set at creation time.
+  minimizeable :: Attr w Bool
+  minimizeable  = nullAttr "minimizeable"
+
+  -- | Can the widget be maximized? This attribute must be set at creation time
+  -- and is normally used together with 'resizeable'.
+  maximizeable :: Attr w Bool
+  maximizeable  = nullAttr "maximizeable"
+
+  -- | Can the widget be closed by the user? This attribute must be set at creation time.
+  closeable :: Attr w Bool
+  closeable  = nullAttr "closeable"
+
+
+-- | Widgets that can be enabled or disabled.
+class Able w where
+  -- | Enable, or disable, the widget.
+  enabled :: Attr w Bool
+
+{-# DEPRECATED enable "Use enabled instead" #-}
+-- | Deprecated: use 'enabled' instead
+enable :: Able w => Attr w Bool
+enable = enabled
+
+-- | Widgets with help text.
+class Help w where
+  -- | Short help text, normally displayed in the status bar or popup balloon.
+  help :: Attr w String
+
+-- | Checkable widgets
+class Checkable w where
+  -- | Is the widget checkable?
+  checkable :: Attr w Bool
+  -- | Is the widget checked?
+  checked   :: Attr w Bool
+
+-- | The identity determines the wxWidgets ID of a widget.
+class Identity w where
+  -- | The identity determines the wxWidgets ID of a widget.
+  identity :: Attr w Int
+
+
+-- | The style is a bitmask that determines various properties of a widget.
+class Styled w where
+  -- | The windows style.
+  style :: Attr w Int
+
+-- | Dockable widgets.
+class Dockable w where
+  -- | Is the widget dockable?
+  dockable :: Attr w Bool
+
+-- | Widgets that have a tooltip
+class Tipped w where
+  -- | The tooltip information
+  tooltip :: Attr w String
+
+-- | Widgets with a single selection (radio group or listbox)
+class Selection w where
+  -- | The current selection as a zero-based index.
+  -- Certain widgets return -1 when no item is selected.
+  selection :: Attr w Int
+
+-- | Widget with zero or more selections (multi select list boxes)
+class Selections w where
+  -- | The currently selected items in zero-based indices.
+  selections :: Attr w [Int]
+
+
+-- | Widgets containing certain items (like strings in a listbox)
+class Items w a | w -> a where
+  -- | Number of items.
+  itemCount  :: ReadAttr w Int
+  -- | All the items as a list. This attribute might not be writable for some widgets (like radioboxes)
+  items  :: Attr w [a]
+  -- | An item by zero-based index.
+  item   :: Int -> Attr w a
+  -- | Delete an item. Only valid for writeable items.
+  itemDelete :: w -> Int -> IO ()
+  -- | Delete all items. Only valid for writeable items.
+  itemsDelete :: w -> IO ()
+  -- | Append an item. Only valid for writeable items.
+  itemAppend :: w -> a -> IO ()
+
+  items
+    = newAttr "items" getter setter
+    where
+      getter :: w -> IO [a]
+      getter w
+        = do n <- get w itemCount
+             mapM (\i -> get w (item i)) [0..n-1]
+
+      setter :: w -> [a] -> IO ()
+      setter w xs
+        = do itemsDelete w
+             mapM_ (\x -> itemAppend w x) xs
+
+  itemAppend w x
+    = do xs <- get w items
+         set w [items := xs ++ [x]]
+
+  itemsDelete w
+    = do count <- get w itemCount 
+         sequence_ (replicate count (itemDelete w 0))
+
+{--------------------------------------------------------------------------
+  Values
+--------------------------------------------------------------------------}  
+-- | Items with a value.
+class Valued w where
+  -- | The value of an object.
+  value :: Attr (w a) a
+
+{--------------------------------------------------------------------------
+  Size
+--------------------------------------------------------------------------}  
+-- | Sized objects (like bitmaps)
+class Sized w where
+  -- | The size of an object. (is 'outerSize' for 'Dimensions' widgets).
+  size :: Attr w Size
+
+{--------------------------------------------------------------------------
+  HasDefault
+--------------------------------------------------------------------------}  
+-- | Objects which activate a 'Window' by default keypress
+class HasDefault w where
+  -- | Define a default item as any type deriving from 'Window'. Great care
+  --   is required when using this option as you will have to cast the item
+  --   to/from Window() using 'objectCast'. 
+  --   For the common use case where the window in question is a 'Button', 
+  --   please use 'defaultButton' as it is typesafe.
+  unsafeDefaultItem :: Attr w (Window ())
+  -- | Define the default button for a 'TopLevelWindow'. This is recommended
+  --   for most use cases as the most common default control is a 'Button'.
+  defaultButton :: Attr w (Button ())
src/Graphics/UI/WX/Controls.hs view
@@ -1,1377 +1,1377 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}----------------------------------------------------------------------------------{-| Module      :  Controls-    Copyright   :  (c) Daan Leijen 2003-                   (c) Shelarcy (shelarcy@gmail.com) 2006-    License     :  wxWindows--    Maintainer  :  wxhaskell-devel@lists.sourceforge.net-    Stability   :  provisional-    Portability :  portable--Defines common GUI controls.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Controls-    ( -- * Classes-        Align(..), Aligned, alignment-      , Wrap(..), Wrapped, wrap-      , Sorted, sorted-      -- * Containers-      , Panel, panel, panelEx-      , Notebook, notebook-      , focusOn-      -- * Controls-      -- ** Button-      , Button, button, buttonEx, smallButton, buttonRes-      , BitmapButton, bitmapButton, bitmapButtonRes-      -- ** Text entry-      , TextCtrl, entry, textEntry, textCtrl, textCtrlRich, textCtrlEx-      , textCtrlRes, processEnter, processTab-      -- ** CheckBox-      , CheckBox, checkBox, checkBoxRes-      -- ** Choice-      , Choice, choice, choiceEx, choiceRes-      -- ** ComboBox-      , ComboBox, comboBox, comboBoxEx, comboBoxRes-      -- ** ListBox-      , ListBox, SingleListBox, MultiListBox-      , singleListBox, singleListBoxRes, multiListBox, multiListBoxRes-      -- ** RadioBox-      , RadioBox, radioBox, radioBoxRes-      -- ** Spin Control-      , SpinCtrl, spinCtrl, spinCtrlRes-      -- ** Slider-      , Slider, hslider, vslider, sliderEx, sliderRes-      -- ** Gauge-      , Gauge, hgauge, vgauge, gaugeEx, gaugeRes-      -- ** ToggleButton-      , ToggleButton, BitmapToggleButton-      , toggleButton, bitmapToggleButton-      -- ** Tree control-      , TreeCtrl, treeCtrl, treeCtrlEx, treeEvent, treeCtrlRes-      -- ** List control-      , ListCtrl, listCtrl, listCtrlEx, listCtrlRes, listCtrlSetColumnWidths, listEvent, columns-      , ListView(..), listViewLayout, listViewSetHandler, listViewSelectHandle, listViewSetItems, listViewGetItems, listViewAddItem, listView-      -- ** Static text-      , StaticText, staticText, staticTextRes-      -- ** SplitterWindow-      , SplitterWindow, splitterWindow-      -- ** ImageList-      , ImageList, imageList, imageListFromFiles-      -- ** MediaCtrl-      , MediaCtrlBackend(..), MediaCtrl, mediaCtrl, mediaCtrlWithBackend, mediaCtrlEx-      -- ** StyledTextCtrl-      , StyledTextCtrl, stcEvent, styledTextCtrl, styledTextCtrlEx-      -- ** PropertyGrid-      , PropertyGrid, propertyGrid, propertyGridEvent-    ) where--import Graphics.UI.WXCore hiding (Event)--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Events-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Media (Media(..))-import Graphics.UI.WX.Variable (variable)-import Graphics.UI.WX.Window--import Control.Monad (forM_)-import Data.Dynamic  -- for "alignment"-import System.Info (os)---defaultStyle-  = wxCLIP_CHILDREN -- .+. wxNO_FULL_REPAINT_ON_RESIZE---- | Create a 'Panel', a window that is normally used as a container for--- controls. It has a standard background and maintains standard keyboard--- navigation (ie. /Tab/ moves through the controls).------ Note: 'defaultButton' attibute is removed. Set 'defaultButton' to parent--- 'Frame' or 'Dialog' instead of this control now. This is an incompatible--- change to support wxWidgets 2.8.x.------ * Attributes: 'focusOn'------ * Instances: 'Form' -- 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled',---             'Textual', 'Literate', 'Reactive', 'Paint'-panel :: Window a -> [Prop (Panel ())] -> IO (Panel ())-panel parent props-  = panelEx parent (wxTAB_TRAVERSAL .+. defaultStyle) props----- | Create a 'Panel' with a specific style.------ Note: 'defaultButton' attibute is removed. Set 'defaultButton' to parent--- 'Frame' or 'Dialog' instead of this control now. This is an incompatible--- change to support wxWidgets 2.8.x.------ * Attributes: 'focusOn'------ * Instances: 'Form' -- 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled',---             'Textual', 'Literate', 'Reactive', 'Paint'-panelEx :: Window a -> Style -> [Prop (Panel ())] -> IO (Panel ())-panelEx parent style props-  = feed2 props style $-    initialContainer $ \id rect -> \props flags  ->-    do p <- panelCreate parent id rect flags-       windowSetFocus p-       set p props-       return p--instance Form (Panel a) where-  layout-    = writeAttr "layout" windowSetLayout---- | Set the initial focus on this control.-focusOn :: Window a -> IO ()-focusOn w-  = windowSetFocus w----- | Create a 'Notebook'. Layout is managed with the 'tabs' combinator.------ * Instances: 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled',---             'Textual', 'Literate', 'Reactive', 'Paint'-notebook :: Window a -> [Prop (Notebook ())] -> IO (Notebook ())-notebook parent props-  = feed2 props defaultStyle $-    initialContainer $ \id rect -> \props flags ->-    do nb <- notebookCreate parent id rect flags-       set nb props-       return nb--{---------------------------------------------------------------------------------  Button---------------------------------------------------------------------------------}---- | Create a standard push button.------ * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----button :: Window a -> [Prop (Button ())] -> IO (Button ())-button parent props-  = buttonEx parent 0 props---- | Create a minimially sized push button.--------- * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----smallButton :: Window a -> [Prop (Button ())] -> IO (Button ())-smallButton parent props-  = buttonEx parent wxBU_EXACTFIT props----- | Create a standard push button with the given flags.------ * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----buttonEx :: Window a -> Style -> [Prop (Button ())] -> IO (Button ())-buttonEx parent stl props-  = feed2 props stl $-    initialWindow $ \id rect ->-    initialText   $ \txt -> \props flags ->-    do b <- buttonCreate parent id txt rect flags-       set b props-       return b---- | Complete the construction of a push button instance which has been loaded---   from a resource file.------ * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----buttonRes :: Window a -> String -> [Prop (Button ())] -> IO (Button ())-buttonRes parent name props =-    do b <- xmlResourceGetButton parent name-       set b props-       return b--instance Commanding (Button a) where-  command  = newEvent "command" buttonGetOnCommand buttonOnCommand---- | Create a bitmap button. Use the 'picture' attribute to set the--- bitmap.------ * Instances: 'Commanding', 'Pictured' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----bitmapButton :: Window a -> [Prop (BitmapButton ())] -> IO (BitmapButton ())-bitmapButton parent props-  = feed2 props wxBU_AUTODRAW $-    initialWindow $ \id rect -> \props flags ->-    do bb <- bitmapButtonCreate parent id nullBitmap rect flags-       set bb props-       windowReLayout bb-       return bb---- | Complete the construction of a bitmap button instance which has been loaded---   from a resource file.------ * Instances: 'Commanding', 'Pictured' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----bitmapButtonRes :: Window a -> String -> [Prop (BitmapButton ())] -> IO (BitmapButton ())-bitmapButtonRes parent name props =-    do b <- xmlResourceGetBitmapButton parent name-       set b props-       return b--instance Pictured (BitmapButton a) where-  picture-    = writeAttr "picture" setter-    where-      setter w fname-        = do fpath <- getAbsoluteFilePath fname-             withBitmapFromFile fpath (bitmapButtonSetBitmapLabel w)---{---------------------------------------------------------------------------------  Text entry---------------------------------------------------------------------------------}--- | Alignment.-data Align   = AlignLeft | AlignRight | AlignCentre-             deriving (Eq,Show,Read,Typeable)---- | Wrap mode.-data Wrap    = WrapNone   -- ^ No wrapping (and show a horizontal scrollbar).-             | WrapLine   -- ^ Wrap lines that are too long at any position.-             | WrapWord   -- ^ Wrap lines that are too long at word boundaries.-             deriving (Eq,Show,Read,Typeable)--instance BitMask Align where-  assocBitMask-    = [(AlignCentre,wxALIGN_CENTRE_HORIZONTAL)-      ,(AlignRight, wxALIGN_RIGHT)-      ,(AlignLeft,  wxALIGN_LEFT)]--instance BitMask Wrap where-  assocBitMask-    = [(WrapNone, wxHSCROLL)-      ,(WrapLine, wxTE_LINEWRAP)-      ,(WrapWord, wxTE_WORDWRAP)]----- | Widgets that can have aligned content.--- Note: this property is not--- used to set the alignment of a widget itself -- See "Graphics.UI.WXCore.Layout"--- for more information about layout.-class Aligned w where-  -- | Set the alignment of the content. Due to wxWidgets constrictions,-  -- this property has to be set at creation time.-  alignment :: CreateAttr w Align--initialAlignment :: Aligned w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-initialAlignment cont props style-  = case filterProperty alignment props of-      (PropValue x, ps)  -> cont ps (setBitMask x style)-      (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)-      (PropNone, ps)     -> cont ps style---instance Aligned (TextCtrl a) where-  alignment-    = reflectiveAttr "alignment" getter setter-    where-      getter w-        = do st <- get w style-             return (fromBitMask st)--      setter w align-        = set w [style :~ setBitMask align ]---- | Widgets that have wrappable content.-class Wrapped w where-  -- | Set the wrap mode of a widget.-  wrap :: CreateAttr w Wrap--initialWrap cont props style-  = case filterProperty wrap props of-      (PropValue x, ps)  -> cont ps (setBitMask x style)-      (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)-      (PropNone, ps)     -> cont ps style--instance Wrapped (TextCtrl a) where-  wrap-    = reflectiveAttr "wrap" getter setter-    where-      getter w-        = do st <- get w style-             return (fromBitMask st)--      setter w mode-        = set w [style :~ setBitMask mode]----{--instance Able (TextCtrl a) where-  enabled-    = newAttr "enabled" textCtrlIsEditable textCtrlSetEditable--}---- Workaround for Unexpected TextCtrl behaviour (https://github.com/jodonoghue/wxHaskell/issues/1#issuecomment-5202439)--- Problem arises from the fact that wxTE_RICH is needed only on Windows platforms, but is essential there. However, on--- wxMac > 2.9, wxTE_RICH seems not to be ignored as the documentation claims.-getRichTE =  if (os == "mingw32") || (os == "win32")-             then wxTE_RICH-             else 0--getRichTE2 = if (os == "mingw32") || (os == "win32")-             then wxTE_RICH2-             else 0---- | Create a single-line text entry control. Note: 'alignment' has to--- be set at creation time (or the entry has default alignment (=left) ).--- This is an alias for textEntry------ * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----entry :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())-entry parent props-  = textCtrlEx parent getRichTE props---- | Create a single-line text entry control. Note: 'alignment' has to--- be set at creation time (or the entry has default alignment (=left) ).------ * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----textEntry :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())-textEntry parent props-  = textCtrlEx parent getRichTE props---- | Create a multi-line text control. Note: the 'wrap' and 'alignment'--- have to be set at creation time or the default to 'WrapNone' and 'AlignLeft' respectively.------ * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----textCtrl :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())-textCtrl parent props-  = textCtrlEx parent (wxTE_MULTILINE .+. getRichTE) props----- | Create a multi-line text rich-text control with a certain wrap mode--- Enables font and color settings on windows, while being equal to 'textCtrl'--- on other platforms. Note: the 'wrap' and 'alignment'--- have to be set at creation time or the default to 'WrapNone' and 'AlignLeft' respectively.------ * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----textCtrlRich :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())-textCtrlRich parent props-  = textCtrlEx parent (wxTE_MULTILINE .+. getRichTE2) props---- | Create a generic text control given a certain style.------ * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----textCtrlEx :: Window a -> Style -> [Prop (TextCtrl ())] -> IO (TextCtrl ())-textCtrlEx parent stl props-  = feed2 props stl $-    initialWindow    $ \id rect ->-    initialText      $ \txt ->-    initialWrap      $-    initialAlignment $ \props flags ->-    do e <- textCtrlCreate parent id txt rect flags-       set e props-       return e---- | Complete the construction of a text control instance which has been loaded---   from a resource file.------ * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----textCtrlRes :: Window a -> String -> [Prop (TextCtrl ())] -> IO (TextCtrl ())-textCtrlRes parent name props =-    do t <- xmlResourceGetTextCtrl parent name-       set t props-       return t--instance Commanding (TextCtrl a) where-  command = newEvent "command" textCtrlGetOnTextEnter textCtrlOnTextEnter---- | Process @enter@ key events, used in a 'comboBox' or 'textCtrl' and--- catched using a 'on' 'command' handler.--- (otherwise pressing @Enter@ is either processed--- internally by the control or used for navigation between dialog controls).-processEnter :: Styled w => Attr w Bool-processEnter-  = newAttr "processEnter" getter setter-  where-    getter w-      = do s <- get w style-           return (bitsSet wxTE_PROCESS_ENTER s)-    setter w p-      = set w [style :~ \stl -> stl .+. wxTE_PROCESS_ENTER]----- | Process @tab@ key events, used in a 'comboBox' or 'textCtrl'.--- (otherwise pressing @Tab@ is either processed--- internally by the control or used for navigation between dialog controls).-processTab :: Styled w => Attr w Bool-processTab-  = newAttr "processTab" getter setter-  where-    getter w-      = do s <- get w style-           return (bitsSet wxTE_PROCESS_TAB s)-    setter w p-      = set w [style :~ \stl -> stl .+. wxTE_PROCESS_TAB]---{---------------------------------------------------------------------------------  Static text---------------------------------------------------------------------------------}--- | Create static text label, see also 'label'.-staticText :: Window a -> [Prop (StaticText ())] -> IO (StaticText ())-staticText parent props-  = feed2 props 0 $-    initialWindow $ \id rect ->-    initialText   $ \txt -> \props flags ->-    do t <- staticTextCreate parent id txt rect flags {- (wxALIGN_LEFT + wxST_NO_AUTORESIZE) -}-       set t props-       return t---- | Complete the construction of a static text label instance which has been loaded---   from a resource file.-staticTextRes :: Window a -> String -> [Prop (StaticText ())] -> IO (StaticText ())-staticTextRes parent name props =-    do t <- xmlResourceGetStaticText parent name-       set t props-       return t--{---------------------------------------------------------------------------------  Check box---------------------------------------------------------------------------------}-instance Commanding (CheckBox a) where-  command = newEvent "command" checkBoxGetOnCommand checkBoxOnCommand--instance Checkable (CheckBox a) where-  checkable-    = enabled--  checked-    = newAttr "checked" checkBoxGetValue checkBoxSetValue---- | Create a new checkbox.------ * Instances: 'Commanding','Checkable' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----checkBox :: Window a -> [Prop (CheckBox ())] -> IO (CheckBox ())-checkBox parent props-  = feed2 props 0 $-    initialWindow $ \id rect ->-    initialText   $ \txt -> \props flags ->-    do c <- checkBoxCreate parent id txt rect flags-       set c props-       return c---- | Complete the construction of a check box instance which has been loaded---   from a resource file.------ * Instances: 'Commanding','Checkable' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----checkBoxRes :: Window a -> String -> [Prop (CheckBox ())] -> IO (CheckBox ())-checkBoxRes parent name props =-    do c <- xmlResourceGetCheckBox parent name-       set c props-       return c--{---------------------------------------------------------------------------------  Choice---------------------------------------------------------------------------------}--- | Widgets that have sorted contents.-class Sorted w where-  -- | Is the content of the widget sorted?-  sorted :: CreateAttr w Bool--instance Sorted (Choice a) where-  sorted-    = createAttr "sorted" getter setter-    where-      getter w-        = do st <- get w style-             return (bitsSet wxCB_SORT st)-      setter w sort-        = set w [style :~ \st -> if sort then st .+. wxCB_SORT else st .-. wxCB_SORT]--initialSorted :: Sorted w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-initialSorted-  = withStyleProperty sorted wxCB_SORT---instance Selecting (Choice ()) where-  select = newEvent "select" choiceGetOnCommand choiceOnCommand--instance Selection (Choice ()) where-  selection-    = newAttr "selection" choiceGetSelection choiceSetSelection---instance Items (Choice a) String where-  itemCount-    = readAttr "itemCount" choiceGetCount--  item i-    = newAttr "item" (\w -> choiceGetString w i) (\w x -> choiceSetString w i x)--  itemAppend w x-    = choiceAppend w x--  itemDelete w i-    = choiceDelete w i----- | Create a choice item to select a one of a list of strings.------ * Instances: 'Sorted', 'Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----choice :: Window a -> [Prop (Choice ())] -> IO (Choice ())-choice parent props-  = choiceEx parent 0 props----- | Create a choice item, given a set of style flags, to select a one of a list of strings------ * Instances: 'Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----choiceEx :: Window a -> Style -> [Prop (Choice ())] -> IO (Choice ())-choiceEx parent flags props-  = feed2 props flags $-    initialWindow $ \id rect ->-    initialSorted $ \props flags ->-    do c <- choiceCreate parent id rect [] flags-       set c props-       return c---- | Complete the construction of a choice instance which has been loaded---   from a resource file.-choiceRes :: Window a -> String -> [Prop (Choice ())] -> IO (Choice ())-choiceRes parent name props =-    do c <- xmlResourceGetChoice parent name-       set c props-       return c--{---------------------------------------------------------------------------------  ComboBox---------------------------------------------------------------------------------}-instance Commanding (ComboBox a) where-  command-    = newEvent "command" comboBoxGetOnTextEnter comboBoxOnTextEnter--instance Selecting (ComboBox a) where-  select-    = newEvent "select" comboBoxGetOnCommand comboBoxOnCommand--instance Selection (ComboBox a) where-  selection-    = newAttr "selection" comboBoxGetSelection comboBoxSetSelection----- implemented by choice-{--instance Items (ComboBox a) String where-  itemCount-    = readAttr "itemCount" comboBoxGetCount--  item i-    = readAttr "item" (\w -> comboBoxGetString w i) -- (\w x -> comboBoxSetString w i x)--  itemAppend w x-    = comboBoxAppend w x--  itemDelete w i-    = comboBoxDelete w i--}---- | Create a new combo box.------ * Instances: 'Selecting', 'Commanding','Selection','Items' -- 'Textual', 'Literate', 'Dimensions',---              'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.------ A 'command' event is triggered when the @enter@ key is pressed and when--- 'processEnter' has been set to 'True'.-comboBox :: Window a -> [Prop (ComboBox ())] -> IO (ComboBox ())-comboBox parent props-  = comboBoxEx parent (wxCB_DROPDOWN) props----- | Create a new combo box with a given set of flags.------ * Instances: 'Selecting', 'Commanding','Selection','Items' -- 'Textual', 'Literate', 'Dimensions',---              'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.------ A 'command' event is triggered when the @enter@ key is pressed and when--- 'processEnter' has been set to 'True'.-comboBoxEx :: Window a -> Style -> [Prop (ComboBox ())] -> IO (ComboBox ())-comboBoxEx parent flags props-  = feed2 props flags $-    initialWindow $ \id rect ->-    initialText   $ \txt ->-    initialSorted $ \props flags ->-    do cb <- comboBoxCreate parent id txt rect [] flags-       set cb props-       return cb---- | Complete the construction of a combo box instance which has been loaded---   from a resource file.-comboBoxRes :: Window a -> String -> [Prop (ComboBox ())] -> IO (ComboBox ())-comboBoxRes parent name props =-    do c <- xmlResourceGetComboBox parent name-       set c props-       return c--{---------------------------------------------------------------------------------  ListBox---------------------------------------------------------------------------------}-instance Sorted (ListBox a) where-  sorted-    = createAttr "sorted" getter setter-    where-      getter w-        = do st <- get w style-             return (bitsSet wxLB_SORT st)-      setter w sort-        = set w [style :~ \st -> if sort then st .+. wxLB_SORT else st .-. wxLB_SORT]----instance Selecting (ListBox a) where-  select-    = newEvent "select" listBoxGetOnCommand listBoxOnCommand--instance Items (ListBox a) String where-  itemCount-    = readAttr "itemCount" listBoxGetCount--  item i-    = newAttr "item" (\w -> listBoxGetString w i) (\w x -> listBoxSetString w i x)--  itemAppend w x-    = listBoxAppend w x--  itemDelete w i-    = listBoxDelete w i---- | Pointer to single selection list boxes, deriving from 'ListBox'.-type SingleListBox a  = ListBox (CSingleListBox a)---- | Abstract type of the 'SingleListBox' class.-data CSingleListBox a = CSingleListBox--instance Selection (SingleListBox a) where-  selection-    = newAttr "selection" listBoxGetSelection (\w x -> listBoxSetSelection w x True)----- | Pointer to multiple selection list boxes, deriving from 'ListBox'.-type MultiListBox a   = ListBox (CMultiListBox a)---- | Abstract type of the 'MultiListBox' class.-data CMultiListBox a  = CMultiListBox           --instance Selections (MultiListBox a) where-  selections-    = newAttr "selections" listBoxGetSelectionList setter-    where-      setter w is =-        do oldSelection <- listBoxGetSelectionList w-           sequence_ [ listBoxSetSelection w i False -- deselect old selections-                     | i <- oldSelection-                     , i `notElem` is -- but not the ones in the new selection-                     ]-           mapM_ (\i -> listBoxSetSelection w i True) is----- | Create a single selection list box.------ * Instances: 'Sorted','Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----singleListBox :: Window a -> [Prop (SingleListBox ())] -> IO (SingleListBox ())-singleListBox parent props-  = feed2 props (wxLB_SINGLE .+. wxHSCROLL .+. wxLB_NEEDED_SB) $-    initialWindow $ \id rect ->-    initialSorted $ \props flags ->-    do lb <- listBoxCreate parent id rect [] flags-       let sl = (objectCast lb :: SingleListBox ())-       set sl props-       return sl---- | Complete the construction of a single list box instance which has been loaded---   from a resource file.-singleListBoxRes :: Window a -> String -> [Prop (SingleListBox ())] -> IO (SingleListBox ())-singleListBoxRes parent name props =-    do l <- xmlResourceGetListBox parent name-       let sl = (objectCast l :: SingleListBox())-       set sl props-       return sl---- | Create a multi selection list box.-------- * Instances: 'Sorted', 'Selecting','Selections','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----multiListBox :: Window a -> [Prop (MultiListBox ())] -> IO (MultiListBox ())-multiListBox parent props-  = feed2 props (wxLB_EXTENDED .+. wxHSCROLL .+. wxLB_NEEDED_SB) $-    initialWindow $ \id rect ->-    initialSorted $ \props flags ->-    do lb <- listBoxCreate parent id rect [] flags-       let ml = (objectCast lb :: MultiListBox ())-       set ml props-       return ml---- | Complete the construction of a single list box instance which has been loaded---   from a resource file.-multiListBoxRes :: Window a -> String -> [Prop (MultiListBox ())] -> IO (MultiListBox ())-multiListBoxRes parent name props =-    do l <- xmlResourceGetListBox parent name-       let ml = (objectCast l :: MultiListBox())-       set ml props-       return ml--{---------------------------------------------------------------------------------  RadioBox---------------------------------------------------------------------------------}-instance Selecting (RadioBox a) where-  select-    = newEvent "select" radioBoxGetOnCommand radioBoxOnCommand--instance Selection (RadioBox a) where-  selection-    = newAttr "selection" radioBoxGetSelection radioBoxSetSelection--instance Items (RadioBox a) String where-  itemCount-    = readAttr "itemCount" radioBoxNumber--  item i-    = newAttr "item" (\r -> radioBoxGetItemLabel r i) (\r s -> radioBoxSetItemLabel r i s)--  itemAppend-    = error "Controls.itemAppend: you can not append items to a radiobox"--  itemDelete-    = error "Controls.itemDelete: you can not delete items of a radiobox"----- | Create a new radio button group with an initial orientation and a list of--- labels. Use 'selection' to get the currently selected item.------ * Instances: 'Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----radioBox :: Window a -> Orientation -> [String] -> [Prop (RadioBox ())] -> IO (RadioBox ())-radioBox parent direction labels props-  = feed2 props (if (direction==Horizontal) then wxRA_SPECIFY_ROWS else wxRA_SPECIFY_COLS) $-    initialWindow $ \id rect ->-    initialText   $ \title -> \props flags ->-    do r <- radioBoxCreate parent id title rect labels 1 flags-       set r props-       return r---- | Complete the construction of a radio box instance which has been loaded---   from a resource file.-radioBoxRes :: Window a -> String -> [Prop (RadioBox ())] -> IO (RadioBox ())-radioBoxRes parent name props =-    do rb <- xmlResourceGetRadioBox parent name-       set rb props-       return rb--{---------------------------------------------------------------------------------  Gauge---------------------------------------------------------------------------------}--- | Create a horizontal gauge with a specified integer range (max value).--- The 'selection' attribute determines the position of the gauge.------ * Instances: 'Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----hgauge :: Window a -> Int -> [Prop (Gauge ())] -> IO (Gauge ())-hgauge parent range props-  = gaugeEx parent range (wxHORIZONTAL .+. wxGA_SMOOTH) props---- | Create a vertical gauge with a specified integer range (max value).--- The 'selection' attribute determines the position of the gauge.------ * Instances: 'Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----vgauge :: Window a -> Int -> [Prop (Gauge ())] -> IO (Gauge ())-vgauge parent range props-  = gaugeEx parent range (wxVERTICAL .+. wxGA_SMOOTH) props---- | Create a gauge control.--- The 'selection' attribute determines the position of the gauge.------ * Instances: 'Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----gaugeEx :: Window a -> Int -> Style -> [Prop (Gauge ())] -> IO (Gauge ())-gaugeEx parent range style props-  = do g <- gaugeCreate parent idAny range rectNull style-       set g props-       return g---- | Complete the construction of a gauge instance which has been loaded---   from a resource file.-gaugeRes :: Window a -> String -> [Prop (Gauge ())] -> IO (Gauge ())-gaugeRes parent name props =-    do g <- xmlResourceGetGauge parent name-       set g props-       return g--instance Selection (Gauge a) where-  selection-    = newAttr "selection" getter setter-    where-      getter g-        = do i  <- gaugeGetValue g-             hi <- gaugeGetRange g-             return (max 0 (min hi i))--      setter g i-        = do hi <- gaugeGetRange g-             gaugeSetValue g (max 0 (min hi i))--{---------------------------------------------------------------------------------  Slider---------------------------------------------------------------------------------}-instance Commanding (Slider a) where-  command = newEvent "command" sliderGetOnCommand sliderOnCommand---- | Create a horizontal slider with a specified minimum and maximum. Set--- the 'Bool' argument to 'True' to show labels (minimumn, maximum, and--- current value). The 'selection' attribute gives the current value.------ * Instances: 'Commanding','Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----hslider :: Window a -> Bool -> Int -> Int -> [Prop (Slider ())] -> IO (Slider ())-hslider parent showLabels min max props-  = sliderEx parent min max (wxHORIZONTAL .+. (if showLabels then wxSL_LABELS else 0)) props---- | Create a vertical slider with a specified minimum and maximum. Set--- the 'Bool' argument to 'True' to show labels (minimumn, maximum, and--- current value). The 'selection' attribute gives the current value.------ * Instances: 'Commanding','Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----vslider :: Window a -> Bool -> Int -> Int -> [Prop (Slider ())] -> IO (Slider ())-vslider parent showLabels min max props-  = sliderEx parent min max (wxVERTICAL .+. (if showLabels then wxSL_LABELS else 0)) props---- | Create a slider with a specified minimum and maximum. The--- 'selection' attribute gives the current value.------ * Instances: 'Commanding','Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----sliderEx :: Window a -> Int -> Int -> Style -> [Prop (Slider ())] -> IO (Slider ())-sliderEx parent min max style props-  = do s <- sliderCreate parent style min min max rectNull style-       set s props-       return s---- | Complete the construction of a slider instance which has been loaded---   from a resource file.-sliderRes :: Window a -> String -> [Prop (Slider ())] -> IO (Slider ())-sliderRes parent name props =-    do s <- xmlResourceGetSlider parent name-       set s props-       return s--instance Selection (Slider a) where-  selection-    = newAttr "selection" getter setter-    where-      getter s-        = do i  <- sliderGetValue s-             lo <- sliderGetMin s-             hi <- sliderGetMax s-             return (max lo (min hi i))--      setter s i-        = do lo <- sliderGetMin s-             hi <- sliderGetMax s-             sliderSetValue s (max lo (min hi i))---{---------------------------------------------------------------------------------  SpinCtrl---------------------------------------------------------------------------------}--- | Create a spin control: a text field with up\/down buttons. The value ('selection')--- is always between a specified minimum and maximum.------ * Instances: 'Selection', 'Selecting' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', ---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----spinCtrl :: Window a -> Int -> Int -> [Prop (SpinCtrl ())] -> IO (SpinCtrl ())-spinCtrl parent lo hi props-  = feed2 props wxSP_ARROW_KEYS $-    initialWindow $ \id rect ->-    initialText   $ \txt -> \props flags ->-    do sc <- spinCtrlCreate parent id txt rect flags (min lo hi) (max lo hi) lo-       set sc props-       return sc---- | Complete the construction of a spin control instance which has been loaded---   from a resource file.-spinCtrlRes :: Window a -> String -> [Prop (SpinCtrl ())] -> IO (SpinCtrl ())-spinCtrlRes parent name props =-    do s <- xmlResourceGetSpinCtrl parent name-       set s props-       return s---instance Selection (SpinCtrl a) where-  selection-    = newAttr "selection" getter setter-    where-      getter sc-        = do i  <- spinCtrlGetValue sc-             lo <- spinCtrlGetMin sc-             hi <- spinCtrlGetMax sc-             return (max lo (min hi i))--      setter sc i-        = do lo <- spinCtrlGetMin sc-             hi <- spinCtrlGetMax sc-             spinCtrlSetValue sc (max lo (min hi i))---instance Selecting (SpinCtrl a) where-  select -    = newEvent "select" spinCtrlGetOnCommand spinCtrlOnCommand--{---------------------------------------------------------------------------------  ToggleButton---------------------------------------------------------------------------------}--- | Create a toggle button. ------ * Instances: 'Commanding', 'Checkable',  -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----toggleButton :: Window a -> [Prop (ToggleButton ())] -> IO (ToggleButton ())-toggleButton parent props-  = feed2 props defaultStyle $-    initialWindow $ \id rect -> \props flags ->-    do bb <- toggleButtonCreate parent id "" rect flags-       set bb props-       return bb--instance Commanding (ToggleButton a) where-  command  = newEvent "command" toggleButtonGetOnCommand toggleButtonOnCommand--instance Checkable (ToggleButton a) where-  checkable = enabled -  checked   = newAttr "checked" toggleButtonGetValue toggleButtonSetValue---- | Create a bitmap toggle button. Use the 'picture' attribute to set the--- bitmap.------ * Instances: 'Commanding', 'Pictured' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----bitmapToggleButton :: Window a -> [Prop (BitmapToggleButton ())] -> IO (BitmapToggleButton ())-bitmapToggleButton parent props-  = feed2 props defaultStyle $-    initialWindow $ \id rect -> \props flags ->-    do img <- imageCreateFromPixels (Size 1 1) [black]-       bm  <- bitmapCreateFromImage img (-1)-       bb  <- bitmapToggleButtonCreate parent id bm rect flags-       set bb props-       return bb--instance Pictured (BitmapToggleButton a) where-  picture-    = writeAttr "picture" setter-    where-      setter w fname-        = do fpath <- getAbsoluteFilePath fname-             withBitmapFromFile fpath (bitmapToggleButtonSetBitmapLabel w)---{---------------------------------------------------------------------------------  TreeCtrl---------------------------------------------------------------------------------}--- | Tree control events.-treeEvent :: Event (TreeCtrl a) (EventTree -> IO ())-treeEvent-  = newEvent "treeEvent" treeCtrlGetOnTreeEvent treeCtrlOnTreeEvent---- | Create a single-selection tree control with buttons (i.e. + and - signs).------ * Attributes: 'treeEvent'------ * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----treeCtrl :: Window a -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())-treeCtrl parent props-  = treeCtrlEx parent (wxTR_HAS_BUTTONS .+. defaultStyle) props---- | Create a tree control.------ * Attributes: 'treeEvent'------ * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----treeCtrlEx :: Window a -> Style -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())-treeCtrlEx parent style props-  = feed2 props style $-    initialContainer $ \id rect -> \props flags ->-    do t <- treeCtrlCreate2 parent id rect flags-       set t props-       return t---- | Complete the construction of a tree control instance which has been loaded---   from a resource file.-treeCtrlRes :: Window a -> String -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())-treeCtrlRes parent name props =-    do t <- xmlResourceGetTreeCtrl parent name-       set t props-       return t--{---------------------------------------------------------------------------------  ListCtrl---------------------------------------------------------------------------------}-instance Items (ListCtrl a) [String] where-  itemCount-    = readAttr "itemCount" listCtrlGetItemCount--  item i-    = newAttr "item" getter setter-    where-      getter l-        = bracket listItemCreate-                  listItemDelete-                  (\li -> do count <- listCtrlGetColumnCount l-                             mapM (\column -> do listItemSetColumn li (column-1)-                                                 listItemSetId li i-                                                 listItemSetMask li wxLIST_MASK_TEXT-                                                 listCtrlGetItem l li-                                                 listItemGetText li) [1..count])---      setter l texts-        = do count <- listCtrlGetItemCount l-             when (i == count) (do listCtrlInsertItemWithLabel l i (show i) (-1); return ())-             mapM_ (\(column,txt) -> listCtrlSetItem l i column txt (-1)) (zip [0..] texts)--  itemAppend l texts-    = do count <- listCtrlGetItemCount l-         listCtrlInsertItemWithLabel l count (show count) (-1)-         mapM_ (\(column,txt) -> listCtrlSetItem l count column txt (-1)) (zip [0..] texts)--  itemDelete l i-    = do listCtrlDeleteItem l i-         return ()--  itemsDelete l-    = do listCtrlDeleteAllItems l-         return ()---- | The @columns@ attribute controls the columns in a report-view list control.-columns :: Attr (ListCtrl a) [(String,Align,Int)]-columns-  = newAttr "columns" getter setter-  where-    setter l xs-      = do n <- listCtrlGetColumnCount l-           mapM_ (\c -> listCtrlDeleteColumn l 0) (reverse [1..n])-           mapM_ (insertColumn l) (zip [0..] xs)-      where-        insertColumn l (idx,(name,align,width))-          = let alignment = case align of-                              AlignRight -> wxLIST_FORMAT_RIGHT-                              AlignCentre-> wxLIST_FORMAT_CENTER-                              other      -> wxLIST_FORMAT_LEFT-            in listCtrlInsertColumn l idx name alignment width--    getter l-      = do n <- listCtrlGetColumnCount l-           mapM (getColumn l) [0..n]-      where-        getColumn l idx-          = bracket (listCtrlGetColumn2 l idx)-                    (listItemDelete)-                    (\item -> do name      <- listItemGetText item-                                 alignment <- listItemGetAlign item-                                 width     <- listItemGetWidth item-                                 let align | alignment == wxLIST_FORMAT_RIGHT  = AlignRight-                                           | alignment == wxLIST_FORMAT_CENTER = AlignCentre-                                           | otherwise                         = AlignLeft-                                 return (name,align,width)-                    )------ | List control events.-listEvent :: Event (ListCtrl a) (EventList -> IO ())-listEvent-  = newEvent "listEvent" listCtrlGetOnListEvent listCtrlOnListEvent---- | Create a report-style list control.------ * Attributes: 'listEvent', 'columns'------ * Instances: 'Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----listCtrl :: Window a -> [Prop (ListCtrl ())] -> IO (ListCtrl ())-listCtrl parent props-  = listCtrlEx parent (wxLC_REPORT .+. defaultStyle) props---- | Create a list control.------ * Attributes: 'listEvent', 'columns'------ * Instances: 'Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----listCtrlEx :: Window a -> Style -> [Prop (ListCtrl ())] -> IO (ListCtrl ())-listCtrlEx parent style props-  = feed2 props style $-    initialContainer $ \id rect -> \props flags ->-    do l <- listCtrlCreate parent id rect flags-       set l props-       return l---- | Complete the construction of a list control instance which has been loaded---   from a resource file.-listCtrlRes :: Window a -> String -> [Prop (ListCtrl ())] -> IO (ListCtrl ())-listCtrlRes parent name props =-    do l <- xmlResourceGetListCtrl parent name-       set l props-       return l---- TODO: figure out how to set a resize handler in addition to the--- default one. this will allow us to expand as needed upon resize--- events.-listCtrlSetColumnWidths :: ListCtrl () -> Int -> IO ()-listCtrlSetColumnWidths ctrl w = do---  size <- (realToFrac.sizeW) `fmap` get ctrl clientSize-  cols <- listCtrlGetColumnCount ctrl---  let w = 65 --ceiling $ size / realToFrac cols-  forM_ [0 .. cols - 1] $ \i -> listCtrlSetColumnWidth ctrl i w---- | A small wrapper over WX's ListCtrl, allowing us to keep the data---   we're representing as well as its string form (shown to the user as---   rows).-data ListView a = ListView {-  listViewCtrl  :: ListCtrl (),-  listViewItems :: Var [a],-  listViewToRow :: a -> [String]-}--listViewLayout :: ListView a -> Layout-listViewLayout = fill . widget . listViewCtrl--listViewSetHandler :: ListView a -> (EventList -> IO ()) -> IO ()-listViewSetHandler list handler =-  set (listViewCtrl list) [on listEvent := handler]--listViewSelectHandle :: ListView a -> (Maybe a -> IO ()) -> EventList -> IO ()-listViewSelectHandle _    _   (ListItemActivated (-1)) = propagateEvent-listViewSelectHandle list end (ListItemActivated   n ) = end . Just =<< (!! n) `fmap` listViewGetItems list-listViewSelectHandle _    _   _                        = propagateEvent--listViewSetItems :: ListView a -> [a] -> IO ()-listViewSetItems list its = do-  set (listViewItems list) [value := its]-  set (listViewCtrl list)  [items := map (listViewToRow list) its]--listViewGetItems :: ListView a -> IO [a]-listViewGetItems list = get (listViewItems list) value--listViewAddItem :: ListView a -> a -> IO ()-listViewAddItem list it = do-  its <- (it:) `fmap` get (listViewItems list) value-  listViewSetItems list its--listViewSetColumnWidths :: ListView a -> Int -> IO ()-listViewSetColumnWidths list w = do-  listCtrlSetColumnWidths (listViewCtrl list) w--listView :: Window b -> [String] -> (a -> [String]) -> IO (ListView a)-listView parent cols toRow = do-  ctrl <- listCtrl parent [columns := map (\n -> (n, AlignLeft, -1)) cols]-  var  <- variable [value := []]-  return $ ListView ctrl var toRow--{---------------------------------------------------------------------------------  SplitterWindow---------------------------------------------------------------------------------}--- | Create a splitter window.------ * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----splitterWindow :: Window a -> [Prop (SplitterWindow ())] -> IO (SplitterWindow ())-splitterWindow parent props-  = feed2 props (defaultStyle .+. wxSP_LIVE_UPDATE) $-    initialContainer $ \id rect -> \props flags ->-    do s <- splitterWindowCreate parent id rect flags-       set s props-       return s--{---------------------------------------------------------------------------------  ImageList---------------------------------------------------------------------------------}--- | Create an empty image list that will contain images of the desired size.-imageList :: Size -> IO (ImageList ())-imageList size-  = imageListCreate size True 10---- | Create an image list containing the images in the supplied file name list--- that will be scaled towards the desired size.-imageListFromFiles :: Size -> [FilePath] -> IO (ImageList ())-imageListFromFiles size files-  = do images <- imageListCreate size True (length files)-       imageListAddIconsFromFiles images size files-       return images--{---------------------------------------------------------------------------------  MediaCtrl---------------------------------------------------------------------------------}---- | Optional back-end for your MediaCtrl.---   If you want to know more about back-end, you must see wxWidgets' Document.---   <http://www.wxwidgets.org/manuals/stable/wx_wxmediactrl.html#choosingbackendwxmediactrl>-data MediaCtrlBackend =-      DirectShow            -- ^ Use ActiveMovie\/DirectShow. Default back-end on Windows.-    | MediaControlInterface -- ^ Use Media Command Interface. Windows Only.-    | WindowsMediaPlayer10  -- ^ Use Windows Media Player 10. Windows Only. Require to use wxWidgets 2.8.x.-    | QuickTime             -- ^ Use QuickTime. Mac Only. -    | GStreamer             -- ^ Use GStreamer. Unix Only. Require GStreamer and GStreamer Support.-    | DefaultBackend        -- ^ Use default back-end on your platform.-   deriving (Eq,Show)--fromMediaCtrlBackend :: MediaCtrlBackend -> String-fromMediaCtrlBackend back-  = case back of-      DirectShow            -> wxMEDIABACKEND_DIRECTSHOW-      MediaControlInterface -> wxMEDIABACKEND_MCI-      WindowsMediaPlayer10  -> wxMEDIABACKEND_WMP10-      QuickTime             -> wxMEDIABACKEND_QUICKTIME-      GStreamer             -> wxMEDIABACKEND_GSTREAMER-      DefaultBackend        -> ""---- FIXME: Change wxDirect to Support STRING type in Eiffel file (*.e)--- instead of write definition directory here.-wxMEDIABACKEND_DIRECTSHOW = "wxAMMediaBackend"-wxMEDIABACKEND_MCI = "wxMCIMediaBackend"-wxMEDIABACKEND_WMP10 = "wxWMP10MediaBackend"-wxMEDIABACKEND_QUICKTIME = "wxQTMediaBackend"-wxMEDIABACKEND_GSTREAMER = "wxGStreamerMediaBackend"--mediaCtrl :: Window a -> [Prop (MediaCtrl ())] -> IO (MediaCtrl ())-mediaCtrl parent props-  = mediaCtrlEx parent defaultStyle DefaultBackend props---- | Create MediaCtrl with choosing back-end. This is useful to select back-end on--- Windows. But if you don't want to cause any effect to other platforms, you must--- use wxToolkit or #ifdef macro to choose correct function for platforms.--- For example,------ > import Graphics.UI.WXCore.Defines--- > ...--- >   m <- case wxToolkit of--- >          WxMSW -> mediaCtrlWithBackend f MediaControlInterface []--- >          _     -> mediaCtrl f []------ or------ > #ifdef mingw32_HOST_OS || mingw32_TARGET_OS--- >   m <-  mediaCtrlWithBackend f MediaControlInterface []--- > #else--- >   m <-  mediaCtrl f []--- > #endif----mediaCtrlWithBackend :: Window a -> MediaCtrlBackend -> [Prop (MediaCtrl ())] -> IO (MediaCtrl ())-mediaCtrlWithBackend parent back props-  = mediaCtrlEx parent defaultStyle back props--mediaCtrlEx :: Window a -> Style -> MediaCtrlBackend -> [Prop (MediaCtrl ())] -> IO (MediaCtrl ())-mediaCtrlEx parent style back props-  = feed2 props style $-    initialContainer $ \id rect -> \props flags ->-    do s <- mediaCtrlCreate parent id "" rect style (fromMediaCtrlBackend back) ""-       set s props-       return s--instance Media (MediaCtrl a) where-  play media = unitIO (mediaCtrlPlay media)-  stop media = unitIO (mediaCtrlStop media)--{---------------------------------------------------------------------------------  wxStyledTextCtrl---------------------------------------------------------------------------------}--stcEvent :: Event (StyledTextCtrl ()) (EventSTC -> IO ())-stcEvent-  = newEvent "stcEvent" stcGetOnSTCEvent stcOnSTCEvent---styledTextCtrl :: Window a -> [Prop (StyledTextCtrl ())] -> IO (StyledTextCtrl ())-styledTextCtrl parent props-  = styledTextCtrlEx parent defaultStyle props--styledTextCtrlEx :: Window a -> Style -> [Prop (StyledTextCtrl ())] -> IO (StyledTextCtrl ())-styledTextCtrlEx parent style props-  = feed2 props style $-    initialContainer $ \id rect -> \props flags ->-    do s <- styledTextCtrlCreate parent id "" rect style-       set s props-       return s--{---------------------------------------------------------------------------------  PropertyGrid---------------------------------------------------------------------------------}---- | PropertyGrid control events.-propertyGridEvent :: Event (PropertyGrid a) (EventPropertyGrid -> IO ())-propertyGridEvent-  = newEvent "propertyGridEvent" propertyGridGetOnPropertyGridEvent propertyGridOnPropertyGridEvent---- | Create a property grid.------ * Attributes: 'propertyGridEvent',------ * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----propertyGrid :: Window a -> [Prop (PropertyGrid ())] -> IO (PropertyGrid ())-propertyGrid parent props-  = feed2 props wxPG_DEFAULT_STYLE $-    initialContainer $ \id rect -> \props flags ->-    do l <- propertyGridCreate parent id rect flags-       set l props-       return l-+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
+--------------------------------------------------------------------------------
+{-| Module      :  Controls
+    Copyright   :  (c) Daan Leijen 2003
+                   (c) Shelarcy (shelarcy@gmail.com) 2006
+    License     :  wxWindows
+
+    Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+    Stability   :  provisional
+    Portability :  portable
+
+Defines common GUI controls.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Controls
+    ( -- * Classes
+        Align(..), Aligned, alignment
+      , Wrap(..), Wrapped, wrap
+      , Sorted, sorted
+      -- * Containers
+      , Panel, panel, panelEx
+      , Notebook, notebook
+      , focusOn
+      -- * Controls
+      -- ** Button
+      , Button, button, buttonEx, smallButton, buttonRes
+      , BitmapButton, bitmapButton, bitmapButtonRes
+      -- ** Text entry
+      , TextCtrl, entry, textEntry, textCtrl, textCtrlRich, textCtrlEx
+      , textCtrlRes, processEnter, processTab
+      -- ** CheckBox
+      , CheckBox, checkBox, checkBoxRes
+      -- ** Choice
+      , Choice, choice, choiceEx, choiceRes
+      -- ** ComboBox
+      , ComboBox, comboBox, comboBoxEx, comboBoxRes
+      -- ** ListBox
+      , ListBox, SingleListBox, MultiListBox
+      , singleListBox, singleListBoxRes, multiListBox, multiListBoxRes
+      -- ** RadioBox
+      , RadioBox, radioBox, radioBoxRes
+      -- ** Spin Control
+      , SpinCtrl, spinCtrl, spinCtrlRes
+      -- ** Slider
+      , Slider, hslider, vslider, sliderEx, sliderRes
+      -- ** Gauge
+      , Gauge, hgauge, vgauge, gaugeEx, gaugeRes
+      -- ** ToggleButton
+      , ToggleButton, BitmapToggleButton
+      , toggleButton, bitmapToggleButton
+      -- ** Tree control
+      , TreeCtrl, treeCtrl, treeCtrlEx, treeEvent, treeCtrlRes
+      -- ** List control
+      , ListCtrl, listCtrl, listCtrlEx, listCtrlRes, listCtrlSetColumnWidths, listEvent, columns
+      , ListView(..), listViewLayout, listViewSetHandler, listViewSelectHandle, listViewSetItems, listViewGetItems, listViewAddItem, listView
+      -- ** Static text
+      , StaticText, staticText, staticTextRes
+      -- ** SplitterWindow
+      , SplitterWindow, splitterWindow
+      -- ** ImageList
+      , ImageList, imageList, imageListFromFiles
+      -- ** MediaCtrl
+      , MediaCtrlBackend(..), MediaCtrl, mediaCtrl, mediaCtrlWithBackend, mediaCtrlEx
+      -- ** StyledTextCtrl
+      , StyledTextCtrl, stcEvent, styledTextCtrl, styledTextCtrlEx
+      -- ** PropertyGrid
+      , PropertyGrid, propertyGrid, propertyGridEvent
+    ) where
+
+import Graphics.UI.WXCore hiding (Event)
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Events
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Media (Media(..))
+import Graphics.UI.WX.Variable (variable)
+import Graphics.UI.WX.Window
+
+import Control.Monad (forM_)
+import Data.Dynamic  -- for "alignment"
+import System.Info (os)
+
+
+defaultStyle
+  = wxCLIP_CHILDREN -- .+. wxNO_FULL_REPAINT_ON_RESIZE
+
+-- | Create a 'Panel', a window that is normally used as a container for
+-- controls. It has a standard background and maintains standard keyboard
+-- navigation (ie. /Tab/ moves through the controls).
+--
+-- Note: 'defaultButton' attibute is removed. Set 'defaultButton' to parent
+-- 'Frame' or 'Dialog' instead of this control now. This is an incompatible
+-- change to support wxWidgets 2.8.x.
+--
+-- * Attributes: 'focusOn'
+--
+-- * Instances: 'Form' -- 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled',
+--             'Textual', 'Literate', 'Reactive', 'Paint'
+panel :: Window a -> [Prop (Panel ())] -> IO (Panel ())
+panel parent props
+  = panelEx parent (wxTAB_TRAVERSAL .+. defaultStyle) props
+
+
+-- | Create a 'Panel' with a specific style.
+--
+-- Note: 'defaultButton' attibute is removed. Set 'defaultButton' to parent
+-- 'Frame' or 'Dialog' instead of this control now. This is an incompatible
+-- change to support wxWidgets 2.8.x.
+--
+-- * Attributes: 'focusOn'
+--
+-- * Instances: 'Form' -- 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled',
+--             'Textual', 'Literate', 'Reactive', 'Paint'
+panelEx :: Window a -> Style -> [Prop (Panel ())] -> IO (Panel ())
+panelEx parent style props
+  = feed2 props style $
+    initialContainer $ \id rect -> \props flags  ->
+    do p <- panelCreate parent id rect flags
+       windowSetFocus p
+       set p props
+       return p
+
+instance Form (Panel a) where
+  layout
+    = writeAttr "layout" windowSetLayout
+
+-- | Set the initial focus on this control.
+focusOn :: Window a -> IO ()
+focusOn w
+  = windowSetFocus w
+
+
+-- | Create a 'Notebook'. Layout is managed with the 'tabs' combinator.
+--
+-- * Instances: 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled',
+--             'Textual', 'Literate', 'Reactive', 'Paint'
+notebook :: Window a -> [Prop (Notebook ())] -> IO (Notebook ())
+notebook parent props
+  = feed2 props defaultStyle $
+    initialContainer $ \id rect -> \props flags ->
+    do nb <- notebookCreate parent id rect flags
+       set nb props
+       return nb
+
+{--------------------------------------------------------------------------------
+  Button
+--------------------------------------------------------------------------------}
+
+-- | Create a standard push button.
+--
+-- * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+button :: Window a -> [Prop (Button ())] -> IO (Button ())
+button parent props
+  = buttonEx parent 0 props
+
+-- | Create a minimially sized push button.
+--
+--
+-- * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+smallButton :: Window a -> [Prop (Button ())] -> IO (Button ())
+smallButton parent props
+  = buttonEx parent wxBU_EXACTFIT props
+
+
+-- | Create a standard push button with the given flags.
+--
+-- * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+buttonEx :: Window a -> Style -> [Prop (Button ())] -> IO (Button ())
+buttonEx parent stl props
+  = feed2 props stl $
+    initialWindow $ \id rect ->
+    initialText   $ \txt -> \props flags ->
+    do b <- buttonCreate parent id txt rect flags
+       set b props
+       return b
+
+-- | Complete the construction of a push button instance which has been loaded
+--   from a resource file.
+--
+-- * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+buttonRes :: Window a -> String -> [Prop (Button ())] -> IO (Button ())
+buttonRes parent name props =
+    do b <- xmlResourceGetButton parent name
+       set b props
+       return b
+
+instance Commanding (Button a) where
+  command  = newEvent "command" buttonGetOnCommand buttonOnCommand
+
+-- | Create a bitmap button. Use the 'picture' attribute to set the
+-- bitmap.
+--
+-- * Instances: 'Commanding', 'Pictured' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+bitmapButton :: Window a -> [Prop (BitmapButton ())] -> IO (BitmapButton ())
+bitmapButton parent props
+  = feed2 props 0 $
+    initialWindow $ \id rect -> \props flags ->
+    do bb <- bitmapButtonCreate parent id nullBitmap rect flags
+       set bb props
+       windowReLayout bb
+       return bb
+
+-- | Complete the construction of a bitmap button instance which has been loaded
+--   from a resource file.
+--
+-- * Instances: 'Commanding', 'Pictured' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+bitmapButtonRes :: Window a -> String -> [Prop (BitmapButton ())] -> IO (BitmapButton ())
+bitmapButtonRes parent name props =
+    do b <- xmlResourceGetBitmapButton parent name
+       set b props
+       return b
+
+instance Pictured (BitmapButton a) where
+  picture
+    = writeAttr "picture" setter
+    where
+      setter w fname
+        = do fpath <- getAbsoluteFilePath fname
+             withBitmapFromFile fpath (bitmapButtonSetBitmapLabel w)
+
+
+{--------------------------------------------------------------------------------
+  Text entry
+--------------------------------------------------------------------------------}
+-- | Alignment.
+data Align   = AlignLeft | AlignRight | AlignCentre
+             deriving (Eq,Show,Read,Typeable)
+
+-- | Wrap mode.
+data Wrap    = WrapNone   -- ^ No wrapping (and show a horizontal scrollbar).
+             | WrapLine   -- ^ Wrap lines that are too long at any position.
+             | WrapWord   -- ^ Wrap lines that are too long at word boundaries.
+             deriving (Eq,Show,Read,Typeable)
+
+instance BitMask Align where
+  assocBitMask
+    = [(AlignCentre,wxALIGN_CENTRE_HORIZONTAL)
+      ,(AlignRight, wxALIGN_RIGHT)
+      ,(AlignLeft,  wxALIGN_LEFT)]
+
+instance BitMask Wrap where
+  assocBitMask
+    = [(WrapNone, wxHSCROLL)
+      ,(WrapLine, wxTE_CHARWRAP)
+      ,(WrapWord, wxTE_WORDWRAP)]
+
+
+-- | Widgets that can have aligned content.
+-- Note: this property is not
+-- used to set the alignment of a widget itself -- See "Graphics.UI.WXCore.Layout"
+-- for more information about layout.
+class Aligned w where
+  -- | Set the alignment of the content. Due to wxWidgets constrictions,
+  -- this property has to be set at creation time.
+  alignment :: CreateAttr w Align
+
+initialAlignment :: Aligned w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialAlignment cont props style
+  = case filterProperty alignment props of
+      (PropValue x, ps)  -> cont ps (setBitMask x style)
+      (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)
+      (PropNone, ps)     -> cont ps style
+
+
+instance Aligned (TextCtrl a) where
+  alignment
+    = reflectiveAttr "alignment" getter setter
+    where
+      getter w
+        = do st <- get w style
+             return (fromBitMask st)
+
+      setter w align
+        = set w [style :~ setBitMask align ]
+
+-- | Widgets that have wrappable content.
+class Wrapped w where
+  -- | Set the wrap mode of a widget.
+  wrap :: CreateAttr w Wrap
+
+initialWrap cont props style
+  = case filterProperty wrap props of
+      (PropValue x, ps)  -> cont ps (setBitMask x style)
+      (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)
+      (PropNone, ps)     -> cont ps style
+
+instance Wrapped (TextCtrl a) where
+  wrap
+    = reflectiveAttr "wrap" getter setter
+    where
+      getter w
+        = do st <- get w style
+             return (fromBitMask st)
+
+      setter w mode
+        = set w [style :~ setBitMask mode]
+
+
+
+{-
+instance Able (TextCtrl a) where
+  enabled
+    = newAttr "enabled" textCtrlIsEditable textCtrlSetEditable
+-}
+
+-- Workaround for Unexpected TextCtrl behaviour (https://github.com/jodonoghue/wxHaskell/issues/1#issuecomment-5202439)
+-- Problem arises from the fact that wxTE_RICH is needed only on Windows platforms, but is essential there. However, on
+-- wxMac > 2.9, wxTE_RICH seems not to be ignored as the documentation claims.
+getRichTE =  if (os == "mingw32") || (os == "win32")
+             then wxTE_RICH
+             else 0
+
+getRichTE2 = if (os == "mingw32") || (os == "win32")
+             then wxTE_RICH2
+             else 0
+
+-- | Create a single-line text entry control. Note: 'alignment' has to
+-- be set at creation time (or the entry has default alignment (=left) ).
+-- This is an alias for textEntry
+--
+-- * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+entry :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
+entry parent props
+  = textCtrlEx parent getRichTE props
+
+-- | Create a single-line text entry control. Note: 'alignment' has to
+-- be set at creation time (or the entry has default alignment (=left) ).
+--
+-- * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+textEntry :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
+textEntry parent props
+  = textCtrlEx parent getRichTE props
+
+-- | Create a multi-line text control. Note: the 'wrap' and 'alignment'
+-- have to be set at creation time or the default to 'WrapNone' and 'AlignLeft' respectively.
+--
+-- * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+textCtrl :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
+textCtrl parent props
+  = textCtrlEx parent (wxTE_MULTILINE .+. getRichTE) props
+
+
+-- | Create a multi-line text rich-text control with a certain wrap mode
+-- Enables font and color settings on windows, while being equal to 'textCtrl'
+-- on other platforms. Note: the 'wrap' and 'alignment'
+-- have to be set at creation time or the default to 'WrapNone' and 'AlignLeft' respectively.
+--
+-- * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+textCtrlRich :: Window a -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
+textCtrlRich parent props
+  = textCtrlEx parent (wxTE_MULTILINE .+. getRichTE2) props
+
+-- | Create a generic text control given a certain style.
+--
+-- * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+textCtrlEx :: Window a -> Style -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
+textCtrlEx parent stl props
+  = feed2 props stl $
+    initialWindow    $ \id rect ->
+    initialText      $ \txt ->
+    initialWrap      $
+    initialAlignment $ \props flags ->
+    do e <- textCtrlCreate parent id txt rect flags
+       set e props
+       return e
+
+-- | Complete the construction of a text control instance which has been loaded
+--   from a resource file.
+--
+-- * Instances: 'Wrap', 'Aligned', 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+textCtrlRes :: Window a -> String -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
+textCtrlRes parent name props =
+    do t <- xmlResourceGetTextCtrl parent name
+       set t props
+       return t
+
+instance Commanding (TextCtrl a) where
+  command = newEvent "command" textCtrlGetOnTextEnter textCtrlOnTextEnter
+
+-- | Process @enter@ key events, used in a 'comboBox' or 'textCtrl' and
+-- catched using a 'on' 'command' handler.
+-- (otherwise pressing @Enter@ is either processed
+-- internally by the control or used for navigation between dialog controls).
+processEnter :: Styled w => Attr w Bool
+processEnter
+  = newAttr "processEnter" getter setter
+  where
+    getter w
+      = do s <- get w style
+           return (bitsSet wxTE_PROCESS_ENTER s)
+    setter w p
+      = set w [style :~ \stl -> stl .+. wxTE_PROCESS_ENTER]
+
+
+-- | Process @tab@ key events, used in a 'comboBox' or 'textCtrl'.
+-- (otherwise pressing @Tab@ is either processed
+-- internally by the control or used for navigation between dialog controls).
+processTab :: Styled w => Attr w Bool
+processTab
+  = newAttr "processTab" getter setter
+  where
+    getter w
+      = do s <- get w style
+           return (bitsSet wxTE_PROCESS_TAB s)
+    setter w p
+      = set w [style :~ \stl -> stl .+. wxTE_PROCESS_TAB]
+
+
+{--------------------------------------------------------------------------------
+  Static text
+--------------------------------------------------------------------------------}
+-- | Create static text label, see also 'label'.
+staticText :: Window a -> [Prop (StaticText ())] -> IO (StaticText ())
+staticText parent props
+  = feed2 props 0 $
+    initialWindow $ \id rect ->
+    initialText   $ \txt -> \props flags ->
+    do t <- staticTextCreate parent id txt rect flags {- (wxALIGN_LEFT + wxST_NO_AUTORESIZE) -}
+       set t props
+       return t
+
+-- | Complete the construction of a static text label instance which has been loaded
+--   from a resource file.
+staticTextRes :: Window a -> String -> [Prop (StaticText ())] -> IO (StaticText ())
+staticTextRes parent name props =
+    do t <- xmlResourceGetStaticText parent name
+       set t props
+       return t
+
+{--------------------------------------------------------------------------------
+  Check box
+--------------------------------------------------------------------------------}
+instance Commanding (CheckBox a) where
+  command = newEvent "command" checkBoxGetOnCommand checkBoxOnCommand
+
+instance Checkable (CheckBox a) where
+  checkable
+    = enabled
+
+  checked
+    = newAttr "checked" checkBoxGetValue checkBoxSetValue
+
+-- | Create a new checkbox.
+--
+-- * Instances: 'Commanding','Checkable' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+checkBox :: Window a -> [Prop (CheckBox ())] -> IO (CheckBox ())
+checkBox parent props
+  = feed2 props 0 $
+    initialWindow $ \id rect ->
+    initialText   $ \txt -> \props flags ->
+    do c <- checkBoxCreate parent id txt rect flags
+       set c props
+       return c
+
+-- | Complete the construction of a check box instance which has been loaded
+--   from a resource file.
+--
+-- * Instances: 'Commanding','Checkable' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+checkBoxRes :: Window a -> String -> [Prop (CheckBox ())] -> IO (CheckBox ())
+checkBoxRes parent name props =
+    do c <- xmlResourceGetCheckBox parent name
+       set c props
+       return c
+
+{--------------------------------------------------------------------------------
+  Choice
+--------------------------------------------------------------------------------}
+-- | Widgets that have sorted contents.
+class Sorted w where
+  -- | Is the content of the widget sorted?
+  sorted :: CreateAttr w Bool
+
+instance Sorted (Choice a) where
+  sorted
+    = createAttr "sorted" getter setter
+    where
+      getter w
+        = do st <- get w style
+             return (bitsSet wxCB_SORT st)
+      setter w sort
+        = set w [style :~ \st -> if sort then st .+. wxCB_SORT else st .-. wxCB_SORT]
+
+initialSorted :: Sorted w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialSorted
+  = withStyleProperty sorted wxCB_SORT
+
+
+instance Selecting (Choice ()) where
+  select = newEvent "select" choiceGetOnCommand choiceOnCommand
+
+instance Selection (Choice ()) where
+  selection
+    = newAttr "selection" choiceGetSelection choiceSetSelection
+
+
+instance Items (Choice a) String where
+  itemCount
+    = readAttr "itemCount" choiceGetCount
+
+  item i
+    = newAttr "item" (\w -> choiceGetString w i) (\w x -> choiceSetString w i x)
+
+  itemAppend w x
+    = choiceAppend w x
+
+  itemDelete w i
+    = choiceDelete w i
+
+
+-- | Create a choice item to select a one of a list of strings.
+--
+-- * Instances: 'Sorted', 'Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+choice :: Window a -> [Prop (Choice ())] -> IO (Choice ())
+choice parent props
+  = choiceEx parent 0 props
+
+
+-- | Create a choice item, given a set of style flags, to select a one of a list of strings
+--
+-- * Instances: 'Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+choiceEx :: Window a -> Style -> [Prop (Choice ())] -> IO (Choice ())
+choiceEx parent flags props
+  = feed2 props flags $
+    initialWindow $ \id rect ->
+    initialSorted $ \props flags ->
+    do c <- choiceCreate parent id rect [] flags
+       set c props
+       return c
+
+-- | Complete the construction of a choice instance which has been loaded
+--   from a resource file.
+choiceRes :: Window a -> String -> [Prop (Choice ())] -> IO (Choice ())
+choiceRes parent name props =
+    do c <- xmlResourceGetChoice parent name
+       set c props
+       return c
+
+{--------------------------------------------------------------------------------
+  ComboBox
+--------------------------------------------------------------------------------}
+instance Commanding (ComboBox a) where
+  command
+    = newEvent "command" comboBoxGetOnTextEnter comboBoxOnTextEnter
+
+instance Selecting (ComboBox a) where
+  select
+    = newEvent "select" comboBoxGetOnCommand comboBoxOnCommand
+
+instance Selection (ComboBox a) where
+  selection
+    = newAttr "selection" comboBoxGetSelection comboBoxSetSelection
+
+
+-- implemented by choice
+{-
+instance Items (ComboBox a) String where
+  itemCount
+    = readAttr "itemCount" comboBoxGetCount
+
+  item i
+    = readAttr "item" (\w -> comboBoxGetString w i) -- (\w x -> comboBoxSetString w i x)
+
+  itemAppend w x
+    = comboBoxAppend w x
+
+  itemDelete w i
+    = comboBoxDelete w i
+-}
+
+-- | Create a new combo box.
+--
+-- * Instances: 'Selecting', 'Commanding','Selection','Items' -- 'Textual', 'Literate', 'Dimensions',
+--              'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+-- A 'command' event is triggered when the @enter@ key is pressed and when
+-- 'processEnter' has been set to 'True'.
+comboBox :: Window a -> [Prop (ComboBox ())] -> IO (ComboBox ())
+comboBox parent props
+  = comboBoxEx parent (wxCB_DROPDOWN) props
+
+
+-- | Create a new combo box with a given set of flags.
+--
+-- * Instances: 'Selecting', 'Commanding','Selection','Items' -- 'Textual', 'Literate', 'Dimensions',
+--              'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+-- A 'command' event is triggered when the @enter@ key is pressed and when
+-- 'processEnter' has been set to 'True'.
+comboBoxEx :: Window a -> Style -> [Prop (ComboBox ())] -> IO (ComboBox ())
+comboBoxEx parent flags props
+  = feed2 props flags $
+    initialWindow $ \id rect ->
+    initialText   $ \txt ->
+    initialSorted $ \props flags ->
+    do cb <- comboBoxCreate parent id txt rect [] flags
+       set cb props
+       return cb
+
+-- | Complete the construction of a combo box instance which has been loaded
+--   from a resource file.
+comboBoxRes :: Window a -> String -> [Prop (ComboBox ())] -> IO (ComboBox ())
+comboBoxRes parent name props =
+    do c <- xmlResourceGetComboBox parent name
+       set c props
+       return c
+
+{--------------------------------------------------------------------------------
+  ListBox
+--------------------------------------------------------------------------------}
+instance Sorted (ListBox a) where
+  sorted
+    = createAttr "sorted" getter setter
+    where
+      getter w
+        = do st <- get w style
+             return (bitsSet wxLB_SORT st)
+      setter w sort
+        = set w [style :~ \st -> if sort then st .+. wxLB_SORT else st .-. wxLB_SORT]
+
+
+
+instance Selecting (ListBox a) where
+  select
+    = newEvent "select" listBoxGetOnCommand listBoxOnCommand
+
+instance Items (ListBox a) String where
+  itemCount
+    = readAttr "itemCount" listBoxGetCount
+
+  item i
+    = newAttr "item" (\w -> listBoxGetString w i) (\w x -> listBoxSetString w i x)
+
+  itemAppend w x
+    = listBoxAppend w x
+
+  itemDelete w i
+    = listBoxDelete w i
+
+-- | Pointer to single selection list boxes, deriving from 'ListBox'.
+type SingleListBox a  = ListBox (CSingleListBox a)
+
+-- | Abstract type of the 'SingleListBox' class.
+data CSingleListBox a = CSingleListBox
+
+instance Selection (SingleListBox a) where
+  selection
+    = newAttr "selection" listBoxGetSelection (\w x -> listBoxSetSelection w x True)
+
+
+-- | Pointer to multiple selection list boxes, deriving from 'ListBox'.
+type MultiListBox a   = ListBox (CMultiListBox a)
+
+-- | Abstract type of the 'MultiListBox' class.
+data CMultiListBox a  = CMultiListBox           
+
+instance Selections (MultiListBox a) where
+  selections
+    = newAttr "selections" listBoxGetSelectionList setter
+    where
+      setter w is =
+        do oldSelection <- listBoxGetSelectionList w
+           sequence_ [ listBoxSetSelection w i False -- deselect old selections
+                     | i <- oldSelection
+                     , i `notElem` is -- but not the ones in the new selection
+                     ]
+           mapM_ (\i -> listBoxSetSelection w i True) is
+
+
+-- | Create a single selection list box.
+--
+-- * Instances: 'Sorted','Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+singleListBox :: Window a -> [Prop (SingleListBox ())] -> IO (SingleListBox ())
+singleListBox parent props
+  = feed2 props (wxLB_SINGLE .+. wxHSCROLL .+. wxLB_NEEDED_SB) $
+    initialWindow $ \id rect ->
+    initialSorted $ \props flags ->
+    do lb <- listBoxCreate parent id rect [] flags
+       let sl = (objectCast lb :: SingleListBox ())
+       set sl props
+       return sl
+
+-- | Complete the construction of a single list box instance which has been loaded
+--   from a resource file.
+singleListBoxRes :: Window a -> String -> [Prop (SingleListBox ())] -> IO (SingleListBox ())
+singleListBoxRes parent name props =
+    do l <- xmlResourceGetListBox parent name
+       let sl = (objectCast l :: SingleListBox())
+       set sl props
+       return sl
+
+-- | Create a multi selection list box.
+----
+-- * Instances: 'Sorted', 'Selecting','Selections','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+multiListBox :: Window a -> [Prop (MultiListBox ())] -> IO (MultiListBox ())
+multiListBox parent props
+  = feed2 props (wxLB_EXTENDED .+. wxHSCROLL .+. wxLB_NEEDED_SB) $
+    initialWindow $ \id rect ->
+    initialSorted $ \props flags ->
+    do lb <- listBoxCreate parent id rect [] flags
+       let ml = (objectCast lb :: MultiListBox ())
+       set ml props
+       return ml
+
+-- | Complete the construction of a single list box instance which has been loaded
+--   from a resource file.
+multiListBoxRes :: Window a -> String -> [Prop (MultiListBox ())] -> IO (MultiListBox ())
+multiListBoxRes parent name props =
+    do l <- xmlResourceGetListBox parent name
+       let ml = (objectCast l :: MultiListBox())
+       set ml props
+       return ml
+
+{--------------------------------------------------------------------------------
+  RadioBox
+--------------------------------------------------------------------------------}
+instance Selecting (RadioBox a) where
+  select
+    = newEvent "select" radioBoxGetOnCommand radioBoxOnCommand
+
+instance Selection (RadioBox a) where
+  selection
+    = newAttr "selection" radioBoxGetSelection radioBoxSetSelection
+
+instance Items (RadioBox a) String where
+  itemCount
+    = readAttr "itemCount" radioBoxNumber
+
+  item i
+    = newAttr "item" (\r -> radioBoxGetItemLabel r i) (\r s -> radioBoxSetItemLabel r i s)
+
+  itemAppend
+    = error "Controls.itemAppend: you can not append items to a radiobox"
+
+  itemDelete
+    = error "Controls.itemDelete: you can not delete items of a radiobox"
+
+
+-- | Create a new radio button group with an initial orientation and a list of
+-- labels. Use 'selection' to get the currently selected item.
+--
+-- * Instances: 'Selecting','Selection','Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+radioBox :: Window a -> Orientation -> [String] -> [Prop (RadioBox ())] -> IO (RadioBox ())
+radioBox parent direction labels props
+  = feed2 props (if (direction==Horizontal) then wxRA_SPECIFY_ROWS else wxRA_SPECIFY_COLS) $
+    initialWindow $ \id rect ->
+    initialText   $ \title -> \props flags ->
+    do r <- radioBoxCreate parent id title rect labels 1 flags
+       set r props
+       return r
+
+-- | Complete the construction of a radio box instance which has been loaded
+--   from a resource file.
+radioBoxRes :: Window a -> String -> [Prop (RadioBox ())] -> IO (RadioBox ())
+radioBoxRes parent name props =
+    do rb <- xmlResourceGetRadioBox parent name
+       set rb props
+       return rb
+
+{--------------------------------------------------------------------------------
+  Gauge
+--------------------------------------------------------------------------------}
+-- | Create a horizontal gauge with a specified integer range (max value).
+-- The 'selection' attribute determines the position of the gauge.
+--
+-- * Instances: 'Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+hgauge :: Window a -> Int -> [Prop (Gauge ())] -> IO (Gauge ())
+hgauge parent range props
+  = gaugeEx parent range (wxHORIZONTAL .+. wxGA_SMOOTH) props
+
+-- | Create a vertical gauge with a specified integer range (max value).
+-- The 'selection' attribute determines the position of the gauge.
+--
+-- * Instances: 'Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+vgauge :: Window a -> Int -> [Prop (Gauge ())] -> IO (Gauge ())
+vgauge parent range props
+  = gaugeEx parent range (wxVERTICAL .+. wxGA_SMOOTH) props
+
+-- | Create a gauge control.
+-- The 'selection' attribute determines the position of the gauge.
+--
+-- * Instances: 'Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+gaugeEx :: Window a -> Int -> Style -> [Prop (Gauge ())] -> IO (Gauge ())
+gaugeEx parent range style props
+  = do g <- gaugeCreate parent idAny range rectNull style
+       set g props
+       return g
+
+-- | Complete the construction of a gauge instance which has been loaded
+--   from a resource file.
+gaugeRes :: Window a -> String -> [Prop (Gauge ())] -> IO (Gauge ())
+gaugeRes parent name props =
+    do g <- xmlResourceGetGauge parent name
+       set g props
+       return g
+
+instance Selection (Gauge a) where
+  selection
+    = newAttr "selection" getter setter
+    where
+      getter g
+        = do i  <- gaugeGetValue g
+             hi <- gaugeGetRange g
+             return (max 0 (min hi i))
+
+      setter g i
+        = do hi <- gaugeGetRange g
+             gaugeSetValue g (max 0 (min hi i))
+
+{--------------------------------------------------------------------------------
+  Slider
+--------------------------------------------------------------------------------}
+instance Commanding (Slider a) where
+  command = newEvent "command" sliderGetOnCommand sliderOnCommand
+
+-- | Create a horizontal slider with a specified minimum and maximum. Set
+-- the 'Bool' argument to 'True' to show labels (minimumn, maximum, and
+-- current value). The 'selection' attribute gives the current value.
+--
+-- * Instances: 'Commanding','Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+hslider :: Window a -> Bool -> Int -> Int -> [Prop (Slider ())] -> IO (Slider ())
+hslider parent showLabels min max props
+  = sliderEx parent min max (wxHORIZONTAL .+. (if showLabels then wxSL_LABELS else 0)) props
+
+-- | Create a vertical slider with a specified minimum and maximum. Set
+-- the 'Bool' argument to 'True' to show labels (minimumn, maximum, and
+-- current value). The 'selection' attribute gives the current value.
+--
+-- * Instances: 'Commanding','Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+vslider :: Window a -> Bool -> Int -> Int -> [Prop (Slider ())] -> IO (Slider ())
+vslider parent showLabels min max props
+  = sliderEx parent min max (wxVERTICAL .+. (if showLabels then wxSL_LABELS else 0)) props
+
+-- | Create a slider with a specified minimum and maximum. The
+-- 'selection' attribute gives the current value.
+--
+-- * Instances: 'Commanding','Selection' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+sliderEx :: Window a -> Int -> Int -> Style -> [Prop (Slider ())] -> IO (Slider ())
+sliderEx parent min max style props
+  = do s <- sliderCreate parent style min min max rectNull style
+       set s props
+       return s
+
+-- | Complete the construction of a slider instance which has been loaded
+--   from a resource file.
+sliderRes :: Window a -> String -> [Prop (Slider ())] -> IO (Slider ())
+sliderRes parent name props =
+    do s <- xmlResourceGetSlider parent name
+       set s props
+       return s
+
+instance Selection (Slider a) where
+  selection
+    = newAttr "selection" getter setter
+    where
+      getter s
+        = do i  <- sliderGetValue s
+             lo <- sliderGetMin s
+             hi <- sliderGetMax s
+             return (max lo (min hi i))
+
+      setter s i
+        = do lo <- sliderGetMin s
+             hi <- sliderGetMax s
+             sliderSetValue s (max lo (min hi i))
+
+
+{--------------------------------------------------------------------------------
+  SpinCtrl
+--------------------------------------------------------------------------------}
+-- | Create a spin control: a text field with up\/down buttons. The value ('selection')
+-- is always between a specified minimum and maximum.
+--
+-- * Instances: 'Selection', 'Selecting' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', 
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+spinCtrl :: Window a -> Int -> Int -> [Prop (SpinCtrl ())] -> IO (SpinCtrl ())
+spinCtrl parent lo hi props
+  = feed2 props wxSP_ARROW_KEYS $
+    initialWindow $ \id rect ->
+    initialText   $ \txt -> \props flags ->
+    do sc <- spinCtrlCreate parent id txt rect flags (min lo hi) (max lo hi) lo
+       set sc props
+       return sc
+
+-- | Complete the construction of a spin control instance which has been loaded
+--   from a resource file.
+spinCtrlRes :: Window a -> String -> [Prop (SpinCtrl ())] -> IO (SpinCtrl ())
+spinCtrlRes parent name props =
+    do s <- xmlResourceGetSpinCtrl parent name
+       set s props
+       return s
+
+
+instance Selection (SpinCtrl a) where
+  selection
+    = newAttr "selection" getter setter
+    where
+      getter sc
+        = do i  <- spinCtrlGetValue sc
+             lo <- spinCtrlGetMin sc
+             hi <- spinCtrlGetMax sc
+             return (max lo (min hi i))
+
+      setter sc i
+        = do lo <- spinCtrlGetMin sc
+             hi <- spinCtrlGetMax sc
+             spinCtrlSetValue sc (max lo (min hi i))
+
+
+instance Selecting (SpinCtrl a) where
+  select 
+    = newEvent "select" spinCtrlGetOnCommand spinCtrlOnCommand
+
+{--------------------------------------------------------------------------------
+  ToggleButton
+--------------------------------------------------------------------------------}
+-- | Create a toggle button. 
+--
+-- * Instances: 'Commanding', 'Checkable',  -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+toggleButton :: Window a -> [Prop (ToggleButton ())] -> IO (ToggleButton ())
+toggleButton parent props
+  = feed2 props defaultStyle $
+    initialWindow $ \id rect -> \props flags ->
+    do bb <- toggleButtonCreate parent id "" rect flags
+       set bb props
+       return bb
+
+instance Commanding (ToggleButton a) where
+  command  = newEvent "command" toggleButtonGetOnCommand toggleButtonOnCommand
+
+instance Checkable (ToggleButton a) where
+  checkable = enabled 
+  checked   = newAttr "checked" toggleButtonGetValue toggleButtonSetValue
+
+-- | Create a bitmap toggle button. Use the 'picture' attribute to set the
+-- bitmap.
+--
+-- * Instances: 'Commanding', 'Pictured' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+bitmapToggleButton :: Window a -> [Prop (BitmapToggleButton ())] -> IO (BitmapToggleButton ())
+bitmapToggleButton parent props
+  = feed2 props defaultStyle $
+    initialWindow $ \id rect -> \props flags ->
+    do img <- imageCreateFromPixels (Size 1 1) [black]
+       bm  <- bitmapCreateFromImage img (-1)
+       bb  <- bitmapToggleButtonCreate parent id bm rect flags
+       set bb props
+       return bb
+
+instance Pictured (BitmapToggleButton a) where
+  picture
+    = writeAttr "picture" setter
+    where
+      setter w fname
+        = do fpath <- getAbsoluteFilePath fname
+             withBitmapFromFile fpath (bitmapToggleButtonSetBitmapLabel w)
+
+
+{--------------------------------------------------------------------------------
+  TreeCtrl
+--------------------------------------------------------------------------------}
+-- | Tree control events.
+treeEvent :: Event (TreeCtrl a) (EventTree -> IO ())
+treeEvent
+  = newEvent "treeEvent" treeCtrlGetOnTreeEvent treeCtrlOnTreeEvent
+
+-- | Create a single-selection tree control with buttons (i.e. + and - signs).
+--
+-- * Attributes: 'treeEvent'
+--
+-- * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+treeCtrl :: Window a -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())
+treeCtrl parent props
+  = treeCtrlEx parent (wxTR_HAS_BUTTONS .+. defaultStyle) props
+
+-- | Create a tree control.
+--
+-- * Attributes: 'treeEvent'
+--
+-- * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+treeCtrlEx :: Window a -> Style -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())
+treeCtrlEx parent style props
+  = feed2 props style $
+    initialContainer $ \id rect -> \props flags ->
+    do t <- treeCtrlCreate2 parent id rect flags
+       set t props
+       return t
+
+-- | Complete the construction of a tree control instance which has been loaded
+--   from a resource file.
+treeCtrlRes :: Window a -> String -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())
+treeCtrlRes parent name props =
+    do t <- xmlResourceGetTreeCtrl parent name
+       set t props
+       return t
+
+{--------------------------------------------------------------------------------
+  ListCtrl
+--------------------------------------------------------------------------------}
+instance Items (ListCtrl a) [String] where
+  itemCount
+    = readAttr "itemCount" listCtrlGetItemCount
+
+  item i
+    = newAttr "item" getter setter
+    where
+      getter l
+        = bracket listItemCreate
+                  listItemDelete
+                  (\li -> do count <- listCtrlGetColumnCount l
+                             mapM (\column -> do listItemSetColumn li (column-1)
+                                                 listItemSetId li i
+                                                 listItemSetMask li wxLIST_MASK_TEXT
+                                                 listCtrlGetItem l li
+                                                 listItemGetText li) [1..count])
+
+
+      setter l texts
+        = do count <- listCtrlGetItemCount l
+             when (i == count) (do listCtrlInsertItemWithLabel l i (show i) (-1); return ())
+             mapM_ (\(column,txt) -> listCtrlSetItem l i column txt (-1)) (zip [0..] texts)
+
+  itemAppend l texts
+    = do count <- listCtrlGetItemCount l
+         listCtrlInsertItemWithLabel l count (show count) (-1)
+         mapM_ (\(column,txt) -> listCtrlSetItem l count column txt (-1)) (zip [0..] texts)
+
+  itemDelete l i
+    = do listCtrlDeleteItem l i
+         return ()
+
+  itemsDelete l
+    = do listCtrlDeleteAllItems l
+         return ()
+
+-- | The @columns@ attribute controls the columns in a report-view list control.
+columns :: Attr (ListCtrl a) [(String,Align,Int)]
+columns
+  = newAttr "columns" getter setter
+  where
+    setter l xs
+      = do n <- listCtrlGetColumnCount l
+           mapM_ (\c -> listCtrlDeleteColumn l 0) (reverse [1..n])
+           mapM_ (insertColumn l) (zip [0..] xs)
+      where
+        insertColumn l (idx,(name,align,width))
+          = let alignment = case align of
+                              AlignRight -> wxLIST_FORMAT_RIGHT
+                              AlignCentre-> wxLIST_FORMAT_CENTER
+                              other      -> wxLIST_FORMAT_LEFT
+            in listCtrlInsertColumn l idx name alignment width
+
+    getter l
+      = do n <- listCtrlGetColumnCount l
+           mapM (getColumn l) [0..n]
+      where
+        getColumn l idx
+          = bracket (listCtrlGetColumn2 l idx)
+                    (listItemDelete)
+                    (\item -> do name      <- listItemGetText item
+                                 alignment <- listItemGetAlign item
+                                 width     <- listItemGetWidth item
+                                 let align | alignment == wxLIST_FORMAT_RIGHT  = AlignRight
+                                           | alignment == wxLIST_FORMAT_CENTER = AlignCentre
+                                           | otherwise                         = AlignLeft
+                                 return (name,align,width)
+                    )
+
+
+
+-- | List control events.
+listEvent :: Event (ListCtrl a) (EventList -> IO ())
+listEvent
+  = newEvent "listEvent" listCtrlGetOnListEvent listCtrlOnListEvent
+
+-- | Create a report-style list control.
+--
+-- * Attributes: 'listEvent', 'columns'
+--
+-- * Instances: 'Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+listCtrl :: Window a -> [Prop (ListCtrl ())] -> IO (ListCtrl ())
+listCtrl parent props
+  = listCtrlEx parent (wxLC_REPORT .+. defaultStyle) props
+
+-- | Create a list control.
+--
+-- * Attributes: 'listEvent', 'columns'
+--
+-- * Instances: 'Items' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+listCtrlEx :: Window a -> Style -> [Prop (ListCtrl ())] -> IO (ListCtrl ())
+listCtrlEx parent style props
+  = feed2 props style $
+    initialContainer $ \id rect -> \props flags ->
+    do l <- listCtrlCreate parent id rect flags
+       set l props
+       return l
+
+-- | Complete the construction of a list control instance which has been loaded
+--   from a resource file.
+listCtrlRes :: Window a -> String -> [Prop (ListCtrl ())] -> IO (ListCtrl ())
+listCtrlRes parent name props =
+    do l <- xmlResourceGetListCtrl parent name
+       set l props
+       return l
+
+-- TODO: figure out how to set a resize handler in addition to the
+-- default one. this will allow us to expand as needed upon resize
+-- events.
+listCtrlSetColumnWidths :: ListCtrl () -> Int -> IO ()
+listCtrlSetColumnWidths ctrl w = do
+--  size <- (realToFrac.sizeW) `fmap` get ctrl clientSize
+  cols <- listCtrlGetColumnCount ctrl
+--  let w = 65 --ceiling $ size / realToFrac cols
+  forM_ [0 .. cols - 1] $ \i -> listCtrlSetColumnWidth ctrl i w
+
+-- | A small wrapper over WX's ListCtrl, allowing us to keep the data
+--   we're representing as well as its string form (shown to the user as
+--   rows).
+data ListView a = ListView {
+  listViewCtrl  :: ListCtrl (),
+  listViewItems :: Var [a],
+  listViewToRow :: a -> [String]
+}
+
+listViewLayout :: ListView a -> Layout
+listViewLayout = fill . widget . listViewCtrl
+
+listViewSetHandler :: ListView a -> (EventList -> IO ()) -> IO ()
+listViewSetHandler list handler =
+  set (listViewCtrl list) [on listEvent := handler]
+
+listViewSelectHandle :: ListView a -> (Maybe a -> IO ()) -> EventList -> IO ()
+listViewSelectHandle _    _   (ListItemActivated (-1)) = propagateEvent
+listViewSelectHandle list end (ListItemActivated   n ) = end . Just =<< (!! n) `fmap` listViewGetItems list
+listViewSelectHandle _    _   _                        = propagateEvent
+
+listViewSetItems :: ListView a -> [a] -> IO ()
+listViewSetItems list its = do
+  set (listViewItems list) [value := its]
+  set (listViewCtrl list)  [items := map (listViewToRow list) its]
+
+listViewGetItems :: ListView a -> IO [a]
+listViewGetItems list = get (listViewItems list) value
+
+listViewAddItem :: ListView a -> a -> IO ()
+listViewAddItem list it = do
+  its <- (it:) `fmap` get (listViewItems list) value
+  listViewSetItems list its
+
+listViewSetColumnWidths :: ListView a -> Int -> IO ()
+listViewSetColumnWidths list w = do
+  listCtrlSetColumnWidths (listViewCtrl list) w
+
+listView :: Window b -> [String] -> (a -> [String]) -> IO (ListView a)
+listView parent cols toRow = do
+  ctrl <- listCtrl parent [columns := map (\n -> (n, AlignLeft, -1)) cols]
+  var  <- variable [value := []]
+  return $ ListView ctrl var toRow
+
+{--------------------------------------------------------------------------------
+  SplitterWindow
+--------------------------------------------------------------------------------}
+-- | Create a splitter window.
+--
+-- * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+splitterWindow :: Window a -> [Prop (SplitterWindow ())] -> IO (SplitterWindow ())
+splitterWindow parent props
+  = feed2 props (defaultStyle .+. wxSP_LIVE_UPDATE) $
+    initialContainer $ \id rect -> \props flags ->
+    do s <- splitterWindowCreate parent id rect flags
+       set s props
+       return s
+
+{--------------------------------------------------------------------------------
+  ImageList
+--------------------------------------------------------------------------------}
+-- | Create an empty image list that will contain images of the desired size.
+imageList :: Size -> IO (ImageList ())
+imageList size
+  = imageListCreate size True 10
+
+-- | Create an image list containing the images in the supplied file name list
+-- that will be scaled towards the desired size.
+imageListFromFiles :: Size -> [FilePath] -> IO (ImageList ())
+imageListFromFiles size files
+  = do images <- imageListCreate size True (length files)
+       imageListAddIconsFromFiles images size files
+       return images
+
+{--------------------------------------------------------------------------------
+  MediaCtrl
+--------------------------------------------------------------------------------}
+
+-- | Optional back-end for your MediaCtrl.
+--   If you want to know more about back-end, you must see wxWidgets' Document.
+--   <http://www.wxwidgets.org/manuals/stable/wx_wxmediactrl.html#choosingbackendwxmediactrl>
+data MediaCtrlBackend =
+      DirectShow            -- ^ Use ActiveMovie\/DirectShow. Default back-end on Windows.
+    | MediaControlInterface -- ^ Use Media Command Interface. Windows Only.
+    | WindowsMediaPlayer10  -- ^ Use Windows Media Player 10. Windows Only. Require to use wxWidgets 2.8.x.
+    | QuickTime             -- ^ Use QuickTime. Mac Only. 
+    | GStreamer             -- ^ Use GStreamer. Unix Only. Require GStreamer and GStreamer Support.
+    | DefaultBackend        -- ^ Use default back-end on your platform.
+   deriving (Eq,Show)
+
+fromMediaCtrlBackend :: MediaCtrlBackend -> String
+fromMediaCtrlBackend back
+  = case back of
+      DirectShow            -> wxMEDIABACKEND_DIRECTSHOW
+      MediaControlInterface -> wxMEDIABACKEND_MCI
+      WindowsMediaPlayer10  -> wxMEDIABACKEND_WMP10
+      QuickTime             -> wxMEDIABACKEND_QUICKTIME
+      GStreamer             -> wxMEDIABACKEND_GSTREAMER
+      DefaultBackend        -> ""
+
+-- FIXME: Change wxDirect to Support STRING type in Eiffel file (*.e)
+-- instead of write definition directory here.
+wxMEDIABACKEND_DIRECTSHOW = "wxAMMediaBackend"
+wxMEDIABACKEND_MCI = "wxMCIMediaBackend"
+wxMEDIABACKEND_WMP10 = "wxWMP10MediaBackend"
+wxMEDIABACKEND_QUICKTIME = "wxQTMediaBackend"
+wxMEDIABACKEND_GSTREAMER = "wxGStreamerMediaBackend"
+
+mediaCtrl :: Window a -> [Prop (MediaCtrl ())] -> IO (MediaCtrl ())
+mediaCtrl parent props
+  = mediaCtrlEx parent defaultStyle DefaultBackend props
+
+-- | Create MediaCtrl with choosing back-end. This is useful to select back-end on
+-- Windows. But if you don't want to cause any effect to other platforms, you must
+-- use wxToolkit or #ifdef macro to choose correct function for platforms.
+-- For example,
+--
+-- > import Graphics.UI.WXCore.Defines
+-- > ...
+-- >   m <- case wxToolkit of
+-- >          WxMSW -> mediaCtrlWithBackend f MediaControlInterface []
+-- >          _     -> mediaCtrl f []
+--
+-- or
+--
+-- > #ifdef mingw32_HOST_OS || mingw32_TARGET_OS
+-- >   m <-  mediaCtrlWithBackend f MediaControlInterface []
+-- > #else
+-- >   m <-  mediaCtrl f []
+-- > #endif
+--
+mediaCtrlWithBackend :: Window a -> MediaCtrlBackend -> [Prop (MediaCtrl ())] -> IO (MediaCtrl ())
+mediaCtrlWithBackend parent back props
+  = mediaCtrlEx parent defaultStyle back props
+
+mediaCtrlEx :: Window a -> Style -> MediaCtrlBackend -> [Prop (MediaCtrl ())] -> IO (MediaCtrl ())
+mediaCtrlEx parent style back props
+  = feed2 props style $
+    initialContainer $ \id rect -> \props flags ->
+    do s <- mediaCtrlCreate parent id "" rect style (fromMediaCtrlBackend back) ""
+       set s props
+       return s
+
+instance Media (MediaCtrl a) where
+  play media = unitIO (mediaCtrlPlay media)
+  stop media = unitIO (mediaCtrlStop media)
+
+{--------------------------------------------------------------------------------
+  wxStyledTextCtrl
+--------------------------------------------------------------------------------}
+
+stcEvent :: Event (StyledTextCtrl ()) (EventSTC -> IO ())
+stcEvent
+  = newEvent "stcEvent" stcGetOnSTCEvent stcOnSTCEvent
+
+
+styledTextCtrl :: Window a -> [Prop (StyledTextCtrl ())] -> IO (StyledTextCtrl ())
+styledTextCtrl parent props
+  = styledTextCtrlEx parent defaultStyle props
+
+styledTextCtrlEx :: Window a -> Style -> [Prop (StyledTextCtrl ())] -> IO (StyledTextCtrl ())
+styledTextCtrlEx parent style props
+  = feed2 props style $
+    initialContainer $ \id rect -> \props flags ->
+    do s <- styledTextCtrlCreate parent id "" rect style
+       set s props
+       return s
+
+{--------------------------------------------------------------------------------
+  PropertyGrid
+--------------------------------------------------------------------------------}
+
+-- | PropertyGrid control events.
+propertyGridEvent :: Event (PropertyGrid a) (EventPropertyGrid -> IO ())
+propertyGridEvent
+  = newEvent "propertyGridEvent" propertyGridGetOnPropertyGridEvent propertyGridOnPropertyGridEvent
+
+-- | Create a property grid.
+--
+-- * Attributes: 'propertyGridEvent',
+--
+-- * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+propertyGrid :: Window a -> [Prop (PropertyGrid ())] -> IO (PropertyGrid ())
+propertyGrid parent props
+  = feed2 props wxPG_DEFAULT_STYLE $
+    initialContainer $ \id rect -> \props flags ->
+    do l <- propertyGridCreate parent id rect flags
+       set l props
+       return l
+
src/Graphics/UI/WX/Dialogs.hs view
@@ -1,82 +1,82 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}----------------------------------------------------------------------------------{-| Module      :  Dialogs-    Copyright   :  (c) Daan Leijen 2003-    License     :  wxWindows--    Maintainer  :  wxhaskell-devel@lists.sourceforge.net-    Stability   :  provisional-    Portability :  portable--Defines common dialogs.--* Instances: 'Form', 'Framed' -- -             'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', -             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Dialogs-    ( -- * Generic dialogs-      Dialog, dialog, showModal-     -- * Messages-    , errorDialog, warningDialog, infoDialog-    , confirmDialog, proceedDialog-      -- * Files-    , fileOpenDialog, filesOpenDialog-    , fileSaveDialog-    , dirOpenDialog-      -- * Misc.-    , fontDialog-    , colorDialog-    , passwordDialog-    , textDialog-    , numberDialog-      -- * Primitive-    , dialogEx-    ) where--import Graphics.UI.WXCore--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Window-import Graphics.UI.WX.Events  -- just for haddock-import Graphics.UI.WX.Frame  --instance Form (Dialog a) where-  layout-    = writeAttr "layout" windowSetLayout---- | Create a dialog window. Use 'showModal' for a modal dialog. Use--- the 'visible' property to show\/hide a modeless dialog.-dialog :: Window a -> [Prop (Dialog ())] -> IO (Dialog ())-dialog parent props-  = dialogEx parent (dialogDefaultStyle {- .+. wxNO_FULL_REPAINT_ON_RESIZE -}) props---- | Create a dialog window with a certain style.-dialogEx :: Window a -> Style -> [Prop (Dialog ())] -> IO (Dialog ())-dialogEx parent style props-  = feed2 props style $-    initialFrame $ \id rect txt -> \props flags -> -    do d <- dialogCreate parent id txt rect flags-       set d props-       return d---- | Show a modal dialog. Take a function as argument that takes a function itself--- as argument that can be used to end the modal dialog. The argument of this function--- is returned as the result of the dialog. The result is 'Nothing' when the dialog--- is dismissed via the system menu.------ > d   <- dialog w [text := "Demo"]--- > ok  <- button d [text := "Ok"]--- > ...--- > result <- showModal d (\stop -> set ok [on command := stop (Just 42)])----showModal :: Dialog b -> ((Maybe a -> IO ()) -> IO ()) -> IO (Maybe a)-showModal dialog f-  = do ret <- varCreate Nothing-       f (\x -> do{ varSet ret x; dialogEndModal dialog 0} )-       dialogShowModal dialog-       varGet ret+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+--------------------------------------------------------------------------------
+{-| Module      :  Dialogs
+    Copyright   :  (c) Daan Leijen 2003
+    License     :  wxWindows
+
+    Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+    Stability   :  provisional
+    Portability :  portable
+
+Defines common dialogs.
+
+* Instances: 'Form', 'Framed' -- 
+             'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', 
+             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Dialogs
+    ( -- * Generic dialogs
+      Dialog, dialog, showModal
+     -- * Messages
+    , errorDialog, warningDialog, infoDialog
+    , confirmDialog, proceedDialog
+      -- * Files
+    , fileOpenDialog, filesOpenDialog
+    , fileSaveDialog
+    , dirOpenDialog
+      -- * Misc.
+    , fontDialog
+    , colorDialog
+    , passwordDialog
+    , textDialog
+    , numberDialog
+      -- * Primitive
+    , dialogEx
+    ) where
+
+import Graphics.UI.WXCore
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Window
+import Graphics.UI.WX.Events  -- just for haddock
+import Graphics.UI.WX.Frame  
+
+instance Form (Dialog a) where
+  layout
+    = writeAttr "layout" windowSetLayout
+
+-- | Create a dialog window. Use 'showModal' for a modal dialog. Use
+-- the 'visible' property to show\/hide a modeless dialog.
+dialog :: Window a -> [Prop (Dialog ())] -> IO (Dialog ())
+dialog parent props
+  = dialogEx parent (dialogDefaultStyle {- .+. wxNO_FULL_REPAINT_ON_RESIZE -}) props
+
+-- | Create a dialog window with a certain style.
+dialogEx :: Window a -> Style -> [Prop (Dialog ())] -> IO (Dialog ())
+dialogEx parent style props
+  = feed2 props style $
+    initialFrame $ \id rect txt -> \props flags -> 
+    do d <- dialogCreate parent id txt rect flags
+       set d props
+       return d
+
+-- | Show a modal dialog. Take a function as argument that takes a function itself
+-- as argument that can be used to end the modal dialog. The argument of this function
+-- is returned as the result of the dialog. The result is 'Nothing' when the dialog
+-- is dismissed via the system menu.
+--
+-- > d   <- dialog w [text := "Demo"]
+-- > ok  <- button d [text := "Ok"]
+-- > ...
+-- > result <- showModal d (\stop -> set ok [on command := stop (Just 42)])
+--
+showModal :: Dialog b -> ((Maybe a -> IO ()) -> IO ()) -> IO (Maybe a)
+showModal dialog f
+  = do ret <- varCreate Nothing
+       f (\x -> do{ varSet ret x; dialogEndModal dialog 0} )
+       dialogShowModal dialog
+       varGet ret
src/Graphics/UI/WX/Draw.hs view
@@ -1,219 +1,219 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}----------------------------------------------------------------------------------{-|	Module      :  Draw-	Copyright   :  (c) Daan Leijen 2003-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Drawing.--A /Device Context/ or 'DC', is an instance of 'Drawn', 'Brushed',-'Literate', and 'Colored'.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Draw-    ( -    -- * Classes-      Drawn, pen, penKind, penWidth, penCap, penJoin, penColor-    , Brushed, brush, brushKind, brushColor-    -- * Types-    , DC, Bitmap-      -- * Drawing-    , circle, arc, ellipse, ellipticArc-    , line, polyline, polygon-    , drawPoint, drawRect, roundedRect-    , drawText, rotatedText, drawBitmap, drawImage-    -- * Internal-    , dcWith, dcClear-    ) where--import Graphics.UI.WXCore---import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Window----{------------------------------------------------------------------------------------------------------------------------------------------------------------------}-class Drawn w where-  pen       :: Attr w PenStyle-  penKind   :: Attr w PenKind  -  penWidth  :: Attr w Int-  penCap    :: Attr w CapStyle-  penJoin   :: Attr w JoinStyle-  penColor  :: Attr w Color--class Brushed w where-  brush      :: Attr w BrushStyle-  brushKind  :: Attr w BrushKind-  brushColor :: Attr w Color--instance Drawn (DC a) where-  pen-    = newAttr "pen" dcGetPenStyle dcSetPenStyle-  -  penKind-      = mapAttr _penKind (\pstyle x -> pstyle{ _penKind = x }) pen--  penWidth-    = mapAttr _penWidth (\pstyle x -> pstyle{ _penWidth = x }) pen--  penCap-    = mapAttr _penCap (\pstyle x -> pstyle{ _penCap = x }) pen-  -  penJoin-    = mapAttr _penJoin (\pstyle x -> pstyle{ _penJoin = x }) pen--  penColor-    = mapAttr _penColor (\pstyle color -> pstyle{ _penColor = color }) pen--instance Brushed (DC a) where-  brush-    = newAttr "brush" dcGetBrushStyle dcSetBrushStyle--  brushKind-    = mapAttr _brushKind (\bstyle x -> bstyle{ _brushKind = x }) brush--  brushColor-    = mapAttr _brushColor (\bstyle color -> bstyle{ _brushColor = color }) brush--instance Literate (DC a) where-  font-    = newAttr "font" dcGetFontStyle dcSetFontStyle--  textColor-    = newAttr "textcolor" dcGetTextForeground dcSetTextForeground--  textBgcolor-    = newAttr "textbgcolor" dcGetTextBackground dcSetTextForeground--instance Colored (DC a) where-  color-    = newAttr "color" (\dc -> get dc penColor) (\dc c -> set dc [penColor := c, textColor := c])--  bgcolor-    = newAttr "bgcolor" (\dc -> get dc brushColor) (\dc c -> set dc [brushColor := c, textBgcolor := c])----- Save pen/font/brush efficiently.-dcWith :: DC a -> [Prop (DC a)] -> IO b -> IO b-dcWith dc props io-  | null props = io-  | otherwise  = dcEncapsulate dc (do set dc props; io)---- | Draw a circle given a center point and radius.-circle :: DC a -> Point -> Int -> [Prop (DC a)] -> IO ()-circle dc center radius props-  = dcWith dc props (dcDrawCircle dc center radius)---- | Draw an arc of a circle. Takes the center of the circle, --- its radius and a starting and ending point relative to the--- three-o\'clock position. Angles are in degrees and positive--- values denote a counter clockwise motion. If the angles are--- equal, an entire circle is drawn.-arc :: DC a -> Point -> Int -> Double -> Double -> [Prop (DC a)] -> IO ()-arc dc center radius start end props-  = ellipticArc dc bounds start end props-  where-    bounds -      = rect (pt (pointX center - radius) (pointY center - radius)) (sz (2*radius) (2*radius))-{--  = dcWith dc props (dcDrawArc dc center (point start) (point end) )-  where-    point angle-      = let radians = (2*pi*angle)/360-            x       = px center + round (cos radians * fromIntegral radius)-            y       = py center - round (sin radians * fromIntegral radius)-        in (pt x y)--}---- | Draw an ellipse, bounded by a certain rectangle.-ellipse :: DC a -> Rect -> [Prop (DC a)] -> IO ()-ellipse dc rect props-  = dcWith dc props (dcDrawEllipse dc rect)---- | Draw an elliptic arc. Takes the bounding rectangle, --- and a starting and ending point relative to the--- three-o\'clock position from the center of the rectangle. --- Angles are in degrees and positive--- values denote a counter clockwise motion. If the angles are--- equal, an entire ellipse is drawn.-ellipticArc :: DC a -> Rect -> Double -> Double -> [Prop (DC a)] -> IO ()-ellipticArc dc rect start end props-  = dcWith dc props (dcDrawEllipticArc dc rect start end)---- | Draw a line.-line :: DC a -> Point -> Point -> [Prop (DC a)] -> IO ()-line dc start end props-  = dcWith dc props (dcDrawLine dc start end)---- | Draw a polyline.-polyline :: DC a -> [Point] -> [Prop (DC a)] -> IO ()-polyline dc points props-  = dcWith dc props (drawLines dc points)---- | Draw a polygon. The polygon is filled with the odd-even rule.--- Note that the polygon is automatically closed.-polygon :: DC a -> [Point] -> [Prop (DC a)] -> IO ()-polygon dc points props-  = dcWith dc props (drawPolygon dc points)----- | Draw a single point. -drawPoint :: DC a -> Point -> [Prop (DC a)] -> IO ()-drawPoint dc center props-  = dcWith dc props (dcDrawPoint dc center)---- | Draw a rectangle.-drawRect :: DC a -> Rect -> [Prop (DC a)] -> IO ()-drawRect dc rect props-  = dcWith dc props (dcDrawRectangle dc rect)---- | Draw a rectangle with rounded corners. The corners are--- quarter circles with the given radius.--- If radius is positive, the value is assumed to be the radius of the rounded corner. --- If radius is negative, the absolute value is assumed to be the proportion of the smallest --- dimension of the rectangle. This means that the corner can be a sensible size relative to --- the size of the rectangle, and also avoids the strange effects X produces when the corners --- are too big for the rectangle.-roundedRect :: DC a -> Rect -> Double -> [Prop (DC a)] -> IO ()-roundedRect dc rect radius props-  = dcWith dc props (dcDrawRoundedRectangle dc rect radius)---- | Draw text.-drawText :: DC a -> String -> Point -> [Prop (DC a)] -> IO ()-drawText dc text point props-  = dcWith dc props (dcDrawText dc text point)---- | Draw rotated text. Takes an angle in degrees relative to the--- three-o\'clock position.-rotatedText :: DC a -> String -> Point -> Double -> [Prop (DC a)] -> IO ()-rotatedText dc text point angle props-  = dcWith dc props (dcDrawRotatedText dc text point angle)---- | Draw a bitmap. Takes a bitmap, a point and a boolean--- that is 'True' when the bitmap is drawn with a transparency mask.-drawBitmap :: DC a -> Bitmap () -> Point -> Bool -> [Prop (DC a)] -> IO ()-drawBitmap dc bitmap point transparent props-  = if bitmap == nullBitmap || objectIsNull bitmap -     then return ()-     else do ok <- bitmapIsOk bitmap-             if not ok -              then return ()-              else dcWith dc props (dcDrawBitmap dc bitmap point transparent)---- | Draw an image. -drawImage :: DC a -> Image b -> Point -> [Prop (DC a)] -> IO ()-drawImage dc image pt props-  = do bm <- bitmapCreateFromImage image (-1)-       drawBitmap dc bm pt False props+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+--------------------------------------------------------------------------------
+{-|	Module      :  Draw
+	Copyright   :  (c) Daan Leijen 2003
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Drawing.
+
+A /Device Context/ or 'DC', is an instance of 'Drawn', 'Brushed',
+'Literate', and 'Colored'.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Draw
+    ( 
+    -- * Classes
+      Drawn, pen, penKind, penWidth, penCap, penJoin, penColor
+    , Brushed, brush, brushKind, brushColor
+    -- * Types
+    , DC, Bitmap
+      -- * Drawing
+    , circle, arc, ellipse, ellipticArc
+    , line, polyline, polygon
+    , drawPoint, drawRect, roundedRect
+    , drawText, rotatedText, drawBitmap, drawImage
+    -- * Internal
+    , dcWith, dcClear
+    ) where
+
+import Graphics.UI.WXCore
+
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Window
+
+
+
+{--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------}
+class Drawn w where
+  pen       :: Attr w PenStyle
+  penKind   :: Attr w PenKind  
+  penWidth  :: Attr w Int
+  penCap    :: Attr w CapStyle
+  penJoin   :: Attr w JoinStyle
+  penColor  :: Attr w Color
+
+class Brushed w where
+  brush      :: Attr w BrushStyle
+  brushKind  :: Attr w BrushKind
+  brushColor :: Attr w Color
+
+instance Drawn (DC a) where
+  pen
+    = newAttr "pen" dcGetPenStyle dcSetPenStyle
+  
+  penKind
+      = mapAttr _penKind (\pstyle x -> pstyle{ _penKind = x }) pen
+
+  penWidth
+    = mapAttr _penWidth (\pstyle x -> pstyle{ _penWidth = x }) pen
+
+  penCap
+    = mapAttr _penCap (\pstyle x -> pstyle{ _penCap = x }) pen
+  
+  penJoin
+    = mapAttr _penJoin (\pstyle x -> pstyle{ _penJoin = x }) pen
+
+  penColor
+    = mapAttr _penColor (\pstyle color -> pstyle{ _penColor = color }) pen
+
+instance Brushed (DC a) where
+  brush
+    = newAttr "brush" dcGetBrushStyle dcSetBrushStyle
+
+  brushKind
+    = mapAttr _brushKind (\bstyle x -> bstyle{ _brushKind = x }) brush
+
+  brushColor
+    = mapAttr _brushColor (\bstyle color -> bstyle{ _brushColor = color }) brush
+
+instance Literate (DC a) where
+  font
+    = newAttr "font" dcGetFontStyle dcSetFontStyle
+
+  textColor
+    = newAttr "textcolor" dcGetTextForeground dcSetTextForeground
+
+  textBgcolor
+    = newAttr "textbgcolor" dcGetTextBackground dcSetTextForeground
+
+instance Colored (DC a) where
+  color
+    = newAttr "color" (\dc -> get dc penColor) (\dc c -> set dc [penColor := c, textColor := c])
+
+  bgcolor
+    = newAttr "bgcolor" (\dc -> get dc brushColor) (\dc c -> set dc [brushColor := c, textBgcolor := c])
+
+
+-- Save pen/font/brush efficiently.
+dcWith :: DC a -> [Prop (DC a)] -> IO b -> IO b
+dcWith dc props io
+  | null props = io
+  | otherwise  = dcEncapsulate dc (do set dc props; io)
+
+-- | Draw a circle given a center point and radius.
+circle :: DC a -> Point -> Int -> [Prop (DC a)] -> IO ()
+circle dc center radius props
+  = dcWith dc props (dcDrawCircle dc center radius)
+
+-- | Draw an arc of a circle. Takes the center of the circle, 
+-- its radius and a starting and ending point relative to the
+-- three-o\'clock position. Angles are in degrees and positive
+-- values denote a counter clockwise motion. If the angles are
+-- equal, an entire circle is drawn.
+arc :: DC a -> Point -> Int -> Double -> Double -> [Prop (DC a)] -> IO ()
+arc dc center radius start end props
+  = ellipticArc dc bounds start end props
+  where
+    bounds 
+      = rect (pt (pointX center - radius) (pointY center - radius)) (sz (2*radius) (2*radius))
+{-
+  = dcWith dc props (dcDrawArc dc center (point start) (point end) )
+  where
+    point angle
+      = let radians = (2*pi*angle)/360
+            x       = px center + round (cos radians * fromIntegral radius)
+            y       = py center - round (sin radians * fromIntegral radius)
+        in (pt x y)
+-}
+
+-- | Draw an ellipse, bounded by a certain rectangle.
+ellipse :: DC a -> Rect -> [Prop (DC a)] -> IO ()
+ellipse dc rect props
+  = dcWith dc props (dcDrawEllipse dc rect)
+
+-- | Draw an elliptic arc. Takes the bounding rectangle, 
+-- and a starting and ending point relative to the
+-- three-o\'clock position from the center of the rectangle. 
+-- Angles are in degrees and positive
+-- values denote a counter clockwise motion. If the angles are
+-- equal, an entire ellipse is drawn.
+ellipticArc :: DC a -> Rect -> Double -> Double -> [Prop (DC a)] -> IO ()
+ellipticArc dc rect start end props
+  = dcWith dc props (dcDrawEllipticArc dc rect start end)
+
+-- | Draw a line.
+line :: DC a -> Point -> Point -> [Prop (DC a)] -> IO ()
+line dc start end props
+  = dcWith dc props (dcDrawLine dc start end)
+
+-- | Draw a polyline.
+polyline :: DC a -> [Point] -> [Prop (DC a)] -> IO ()
+polyline dc points props
+  = dcWith dc props (drawLines dc points)
+
+-- | Draw a polygon. The polygon is filled with the odd-even rule.
+-- Note that the polygon is automatically closed.
+polygon :: DC a -> [Point] -> [Prop (DC a)] -> IO ()
+polygon dc points props
+  = dcWith dc props (drawPolygon dc points)
+
+
+-- | Draw a single point. 
+drawPoint :: DC a -> Point -> [Prop (DC a)] -> IO ()
+drawPoint dc center props
+  = dcWith dc props (dcDrawPoint dc center)
+
+-- | Draw a rectangle.
+drawRect :: DC a -> Rect -> [Prop (DC a)] -> IO ()
+drawRect dc rect props
+  = dcWith dc props (dcDrawRectangle dc rect)
+
+-- | Draw a rectangle with rounded corners. The corners are
+-- quarter circles with the given radius.
+-- If radius is positive, the value is assumed to be the radius of the rounded corner. 
+-- If radius is negative, the absolute value is assumed to be the proportion of the smallest 
+-- dimension of the rectangle. This means that the corner can be a sensible size relative to 
+-- the size of the rectangle, and also avoids the strange effects X produces when the corners 
+-- are too big for the rectangle.
+roundedRect :: DC a -> Rect -> Double -> [Prop (DC a)] -> IO ()
+roundedRect dc rect radius props
+  = dcWith dc props (dcDrawRoundedRectangle dc rect radius)
+
+-- | Draw text.
+drawText :: DC a -> String -> Point -> [Prop (DC a)] -> IO ()
+drawText dc text point props
+  = dcWith dc props (dcDrawText dc text point)
+
+-- | Draw rotated text. Takes an angle in degrees relative to the
+-- three-o\'clock position.
+rotatedText :: DC a -> String -> Point -> Double -> [Prop (DC a)] -> IO ()
+rotatedText dc text point angle props
+  = dcWith dc props (dcDrawRotatedText dc text point angle)
+
+-- | Draw a bitmap. Takes a bitmap, a point and a boolean
+-- that is 'True' when the bitmap is drawn with a transparency mask.
+drawBitmap :: DC a -> Bitmap () -> Point -> Bool -> [Prop (DC a)] -> IO ()
+drawBitmap dc bitmap point transparent props
+  = if bitmap == nullBitmap || objectIsNull bitmap 
+     then return ()
+     else do ok <- bitmapIsOk bitmap
+             if not ok 
+              then return ()
+              else dcWith dc props (dcDrawBitmap dc bitmap point transparent)
+
+-- | Draw an image. 
+drawImage :: DC a -> Image b -> Point -> [Prop (DC a)] -> IO ()
+drawImage dc image pt props
+  = do bm <- bitmapCreateFromImage image (-1)
+       drawBitmap dc bm pt False props
        bitmapDelete bm
src/Graphics/UI/WX/Events.hs view
@@ -1,334 +1,334 @@-----------------------------------------------------------------------------------{-|	Module      :  Events-	Copyright   :  (c) Daan Leijen 2003-	               (c) Shelarcy (shelarcy@gmail.com) 2006-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Define event handling. Events are parametrised by the widget that can-correspond to a certain event and the type of the event handler.-For example, the 'resize' event has type:--> Reactive w => Event w (IO ())--This means that all widgets in the 'Reactive' class can respond to-'resize' events. (and since 'Window' is an instance of this class, this-means that basically all visible widgets are reactive).--An @Event w a@ can be transformed into an attribute of type 'Attr' @w a@-using the 'on' function.--> do f <- frame [text := "test"]->    set f [on resize := set f [text := "resizing"]]--For convenience, the 'mouse' and 'keyboard' have a serie of /event filters/:-'click', 'drag', 'enterKey', 'charKey', etc. These filters are write-only-and do not overwrite any previous mouse or keyboard handler but all stay-active at the same time. However, all filter will be overwritten again-when 'mouse' or 'keyboard' is set again. For example, the following program-makes sense:--> set w [on click := ..., on drag := ...]--But in the following program, only the handler for 'mouse' will be called:--> set w [on click := ..., on mouse := ...]--If you want to set the 'mouse' later but retain the old event filters,-you can first read the current 'mouse' handler and call it in the -new handler (and the same for the 'keyboard' of course). This implemenation-technique is used to implement event filters themselves and is also-very useful when setting an event handler for a 'closing' event:--> set w [on closing :~ \previous -> do{ ...; previous }]--Note that you should call 'propagateEvent' (or 'Graphics.UI.WXCore.Events.skipCurrentEvent') whenever-you do not process the event yourself in an event handler. This propagates-the event to the parent event handlers and give them a chance to-handle the event in an appropiate way. This gives another elegant way to install-a 'closing' event handler:--> set w [on closing := do{ ...; propagateEvent }]--}----------------------------------------------------------------------------------module Graphics.UI.WX.Events-            ( -- * Event-               Event-             , on-             , mapEvent-             , propagateEvent-             -- * Basic events-             -- ** Selecting-             , Selecting, select-             -- ** Commanding-             , Commanding, command-             -- ** Reactive-             , Reactive-             , mouse, keyboard-             , closing, idle, resize, focus, activate-             , Paint-             , paint, paintRaw, repaint-             -- * Event filters-             -- ** Mouse filters-             , enter, leave, motion, drag-             , click, unclick, doubleClick-             , clickRight, unclickRight-             -- * Keyboard event filters-             , anyKey, key, charKey-             , enterKey,tabKey,escKey,helpKey-             , delKey,homeKey,endKey-             , pgupKey,pgdownKey-             , downKey,upKey,leftKey,rightKey-             , rebind-            -- * Types-            -- ** Modifiers-            , Modifiers(..)-            , showModifiers-            , noneDown, justShift, justAlt, justControl, justMeta, isNoneDown-            , isNoShiftAltControlDown--            -- ** Mouse events-            , EventMouse (..)-            , showMouse-            , mousePos, mouseModifiers--            -- ** Calender event-            , EventCalendar(..)-            , calendarEvent--            -- ** Keyboard events-            , EventKey (..), Key(..)-            , keyKey, keyModifiers, keyPos-            , showKey, showKeyModifiers-             -- * Internal-             , newEvent-            ) where--import Graphics.UI.WXCore hiding (Event)--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes--{---------------------------------------------------------------------   Basic events---------------------------------------------------------------------}--- | An event for a widget @w@ that expects an event handler of type @a@.-data Event w a  = Event (Attr w a)---- | Transform an event to an attribute.-on :: Event w a -> Attr w a-on (Event attr)-  = attr---- | Change the event type.-mapEvent :: (a -> b) -> (a -> b -> a) -> Event w a -> Event w b-mapEvent get set (Event attr)-  = Event (mapAttr get set attr)--{---------------------------------------------------------------------   Event classes---------------------------------------------------------------------}--- | 'Selecting' widgets fire a 'select' event when an item is selected.-class Selecting w where-  -- | A 'select' event is fired when an item is selected.-  select :: Event w (IO ())---- | 'Commanding' widgets fire a 'command' event.-class Commanding w where-  -- | A commanding event, for example a button press.-  command :: Event w (IO ())---- | 'Reactive' widgets are almost all visible widgets on the screen.-class Reactive w where-  mouse     :: Event w (EventMouse -> IO ())-  keyboard  :: Event w (EventKey -> IO ())--  closing   :: Event w (IO ())-  idle      :: Event w (IO Bool)-  resize    :: Event w (IO ())-  focus     :: Event w (Bool -> IO ())-  activate  :: Event w (Bool -> IO ())---- | 'Paint' widgets can serve as a canvas.--- /Note:/ it is illegal to use both a 'paint' and 'paintRaw'--- event handler at the same widget.-class Paint w where-  -- | Paint double buffered to a device context. The context is always-  -- cleared before drawing. Takes the current view rectangle (adjusted-  -- for scrolling) as an argument.-  paint     :: Event w (DC () -> Rect -> IO ())-  -- | Paint directly to the on-screen device context. Takes the current-  -- view rectangle and a list of dirty rectangles as arguments.\-  paintRaw  :: Event w (DC () -> Rect -> [Rect] -> IO ())-  -- | Emit a paint event to the specified widget.-  repaint   :: w -> IO ()---{---------------------------------------------------------------------   Mouse event filters---------------------------------------------------------------------}-click :: Reactive w => Event w (Point -> IO ())-click-  = mouseFilter "click" filter-  where-    filter (MouseLeftDown point mod)  = isNoShiftAltControlDown mod-    filter other                      = False--unclick :: Reactive w => Event w (Point -> IO ())-unclick-  = mouseFilter "unclick" filter-  where-    filter (MouseLeftUp point mod)  = isNoShiftAltControlDown mod-    filter other                    = False--doubleClick :: Reactive w => Event w (Point -> IO ())-doubleClick-  = mouseFilter "doubleClick" filter-  where-    filter (MouseLeftDClick point mod) = isNoShiftAltControlDown mod-    filter other                       = False--drag :: Reactive w => Event w (Point -> IO ())-drag-  = mouseFilter "drag" filter-  where-    filter (MouseLeftDrag point mod)  = isNoShiftAltControlDown mod-    filter other                      = False--motion :: Reactive w => Event w (Point -> IO ())-motion-  = mouseFilter "motion" filter-  where-    filter (MouseMotion point mod)  = isNoShiftAltControlDown mod-    filter other                    = False--clickRight :: Reactive w => Event w (Point -> IO ())-clickRight-  = mouseFilter "clickRight" filter-  where-    filter (MouseRightDown point mod)  = isNoShiftAltControlDown mod-    filter other                       = False--unclickRight :: Reactive w => Event w (Point -> IO ())-unclickRight-  = mouseFilter "unclickRight" filter-  where-    filter (MouseRightUp point mod)  = isNoShiftAltControlDown mod-    filter other                     = False--enter :: Reactive w => Event w (Point -> IO ())-enter-  = mouseFilter "enter" filter-  where-    filter (MouseEnter point mod)  = True-    filter other                   = False--leave :: Reactive w => Event w (Point -> IO ())-leave-  = mouseFilter "leave" filter-  where-    filter (MouseLeave point mod)  = True-    filter other                   = False--mouseFilter :: Reactive w => String -> (EventMouse -> Bool) -> Event w (Point -> IO ())-mouseFilter name filter-  = mapEvent get set mouse-  where-    get prev x-      = ioError (userError ("WX.Events: the " ++ name ++ " event is write-only."))--    set prev new mouseEvent-      = if (filter mouseEvent) -         then new (mousePos mouseEvent)-         else prev mouseEvent--{---------------------------------------------------------------------  Keyboard filter events---------------------------------------------------------------------}-rebind :: Event w (IO ()) -> Event w (IO ())-rebind event-  = mapEvent get set event-  where-    get prev-      = prev--    set new prev-      = new--enterKey,tabKey,escKey,helpKey,delKey,homeKey,endKey :: Reactive w => Event w (IO ())-pgupKey,pgdownKey,downKey,upKey,leftKey,rightKey :: Reactive w => Event w (IO ())-enterKey  = key KeyReturn-tabKey    = key KeyTab-escKey    = key KeyEscape-helpKey   = key KeyHelp-delKey    = key KeyDelete-homeKey   = key KeyHome-endKey    = key KeyEnd-pgupKey   = key KeyPageUp-pgdownKey = key KeyPageDown-downKey   = key KeyDown-upKey     = key KeyUp-leftKey   = key KeyLeft-rightKey  = key KeyRight--charKey :: Reactive w => Char -> Event w (IO ())-charKey c-  = key (KeyChar c)--key :: Reactive w => Key -> Event w (IO ())-key k-  = keyboardFilter "key" filter-  where-    filter (EventKey x mod pt)  = k==x---anyKey :: Reactive w => Event w (Key -> IO ())-anyKey-  = keyboardFilter1 "anyKey" (const True)---keyboardFilter :: Reactive w => String -> (EventKey -> Bool) -> Event w (IO ())-keyboardFilter name filter-  = mapEvent get set keyboard-  where-    get prev-      = ioError (userError ("WX.Events: the " ++ name ++ " event is write-only."))--    set prev new keyboardEvent-      = do when (filter keyboardEvent) new-           prev keyboardEvent--keyboardFilter1 :: Reactive w => String -> (EventKey -> Bool) -> Event w (Key -> IO ())-keyboardFilter1 name filter-  = mapEvent get set keyboard-  where-    get prev key-      = ioError (userError ("WX.Events: the " ++ name ++ " event is write-only."))--    set prev new keyboardEvent-      = if (filter keyboardEvent) -         then new (keyKey keyboardEvent)-         else prev keyboardEvent---{---------------------------------------------------------------------   Calender event filters---------------------------------------------------------------------}-calendarEvent :: Event (CalendarCtrl a) (EventCalendar -> IO ())-calendarEvent-  = newEvent "calendarEvent" calendarCtrlGetOnCalEvent calendarCtrlOnCalEvent---{---------------------------------------------------------------------   Generic event creators--------------------------------------------------------------------}--- | Create a new event from a get and set function.-newEvent :: String -> (w -> IO a) -> (w -> a -> IO ()) -> Event w a-newEvent name getter setter+
+--------------------------------------------------------------------------------
+{-|	Module      :  Events
+	Copyright   :  (c) Daan Leijen 2003
+	               (c) Shelarcy (shelarcy@gmail.com) 2006
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Define event handling. Events are parametrised by the widget that can
+correspond to a certain event and the type of the event handler.
+For example, the 'resize' event has type:
+
+> Reactive w => Event w (IO ())
+
+This means that all widgets in the 'Reactive' class can respond to
+'resize' events. (and since 'Window' is an instance of this class, this
+means that basically all visible widgets are reactive).
+
+An @Event w a@ can be transformed into an attribute of type 'Attr' @w a@
+using the 'on' function.
+
+> do f <- frame [text := "test"]
+>    set f [on resize := set f [text := "resizing"]]
+
+For convenience, the 'mouse' and 'keyboard' have a serie of /event filters/:
+'click', 'drag', 'enterKey', 'charKey', etc. These filters are write-only
+and do not overwrite any previous mouse or keyboard handler but all stay
+active at the same time. However, all filter will be overwritten again
+when 'mouse' or 'keyboard' is set again. For example, the following program
+makes sense:
+
+> set w [on click := ..., on drag := ...]
+
+But in the following program, only the handler for 'mouse' will be called:
+
+> set w [on click := ..., on mouse := ...]
+
+If you want to set the 'mouse' later but retain the old event filters,
+you can first read the current 'mouse' handler and call it in the 
+new handler (and the same for the 'keyboard' of course). This implemenation
+technique is used to implement event filters themselves and is also
+very useful when setting an event handler for a 'closing' event:
+
+> set w [on closing :~ \previous -> do{ ...; previous }]
+
+Note that you should call 'propagateEvent' (or 'Graphics.UI.WXCore.Events.skipCurrentEvent') whenever
+you do not process the event yourself in an event handler. This propagates
+the event to the parent event handlers and give them a chance to
+handle the event in an appropiate way. This gives another elegant way to install
+a 'closing' event handler:
+
+> set w [on closing := do{ ...; propagateEvent }]
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Events
+            ( -- * Event
+               Event
+             , on
+             , mapEvent
+             , propagateEvent
+             -- * Basic events
+             -- ** Selecting
+             , Selecting, select
+             -- ** Commanding
+             , Commanding, command
+             -- ** Reactive
+             , Reactive
+             , mouse, keyboard
+             , closing, idle, resize, focus, activate
+             , Paint
+             , paint, paintRaw, repaint
+             -- * Event filters
+             -- ** Mouse filters
+             , enter, leave, motion, drag
+             , click, unclick, doubleClick
+             , clickRight, unclickRight
+             -- * Keyboard event filters
+             , anyKey, key, charKey
+             , enterKey,tabKey,escKey,helpKey
+             , delKey,homeKey,endKey
+             , pgupKey,pgdownKey
+             , downKey,upKey,leftKey,rightKey
+             , rebind
+            -- * Types
+            -- ** Modifiers
+            , Modifiers(..)
+            , showModifiers
+            , noneDown, justShift, justAlt, justControl, justMeta, isNoneDown
+            , isNoShiftAltControlDown
+
+            -- ** Mouse events
+            , EventMouse (..)
+            , showMouse
+            , mousePos, mouseModifiers
+
+            -- ** Calender event
+            , EventCalendar(..)
+            , calendarEvent
+
+            -- ** Keyboard events
+            , EventKey (..), Key(..)
+            , keyKey, keyModifiers, keyPos
+            , showKey, showKeyModifiers
+             -- * Internal
+             , newEvent
+            ) where
+
+import Graphics.UI.WXCore hiding (Event)
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+
+{--------------------------------------------------------------------
+   Basic events
+--------------------------------------------------------------------}
+-- | An event for a widget @w@ that expects an event handler of type @a@.
+data Event w a  = Event (Attr w a)
+
+-- | Transform an event to an attribute.
+on :: Event w a -> Attr w a
+on (Event attr)
+  = attr
+
+-- | Change the event type.
+mapEvent :: (a -> b) -> (a -> b -> a) -> Event w a -> Event w b
+mapEvent get set (Event attr)
+  = Event (mapAttr get set attr)
+
+{--------------------------------------------------------------------
+   Event classes
+--------------------------------------------------------------------}
+-- | 'Selecting' widgets fire a 'select' event when an item is selected.
+class Selecting w where
+  -- | A 'select' event is fired when an item is selected.
+  select :: Event w (IO ())
+
+-- | 'Commanding' widgets fire a 'command' event.
+class Commanding w where
+  -- | A commanding event, for example a button press.
+  command :: Event w (IO ())
+
+-- | 'Reactive' widgets are almost all visible widgets on the screen.
+class Reactive w where
+  mouse     :: Event w (EventMouse -> IO ())
+  keyboard  :: Event w (EventKey -> IO ())
+
+  closing   :: Event w (IO ())
+  idle      :: Event w (IO Bool)
+  resize    :: Event w (IO ())
+  focus     :: Event w (Bool -> IO ())
+  activate  :: Event w (Bool -> IO ())
+
+-- | 'Paint' widgets can serve as a canvas.
+-- /Note:/ it is illegal to use both a 'paint' and 'paintRaw'
+-- event handler at the same widget.
+class Paint w where
+  -- | Paint double buffered to a device context. The context is always
+  -- cleared before drawing. Takes the current view rectangle (adjusted
+  -- for scrolling) as an argument.
+  paint     :: Event w (DC () -> Rect -> IO ())
+  -- | Paint directly to the on-screen device context. Takes the current
+  -- view rectangle and a list of dirty rectangles as arguments.\
+  paintRaw  :: Event w (DC () -> Rect -> [Rect] -> IO ())
+  -- | Emit a paint event to the specified widget.
+  repaint   :: w -> IO ()
+
+
+{--------------------------------------------------------------------
+   Mouse event filters
+--------------------------------------------------------------------}
+click :: Reactive w => Event w (Point -> IO ())
+click
+  = mouseFilter "click" filter
+  where
+    filter (MouseLeftDown point mod)  = isNoShiftAltControlDown mod
+    filter other                      = False
+
+unclick :: Reactive w => Event w (Point -> IO ())
+unclick
+  = mouseFilter "unclick" filter
+  where
+    filter (MouseLeftUp point mod)  = isNoShiftAltControlDown mod
+    filter other                    = False
+
+doubleClick :: Reactive w => Event w (Point -> IO ())
+doubleClick
+  = mouseFilter "doubleClick" filter
+  where
+    filter (MouseLeftDClick point mod) = isNoShiftAltControlDown mod
+    filter other                       = False
+
+drag :: Reactive w => Event w (Point -> IO ())
+drag
+  = mouseFilter "drag" filter
+  where
+    filter (MouseLeftDrag point mod)  = isNoShiftAltControlDown mod
+    filter other                      = False
+
+motion :: Reactive w => Event w (Point -> IO ())
+motion
+  = mouseFilter "motion" filter
+  where
+    filter (MouseMotion point mod)  = isNoShiftAltControlDown mod
+    filter other                    = False
+
+clickRight :: Reactive w => Event w (Point -> IO ())
+clickRight
+  = mouseFilter "clickRight" filter
+  where
+    filter (MouseRightDown point mod)  = isNoShiftAltControlDown mod
+    filter other                       = False
+
+unclickRight :: Reactive w => Event w (Point -> IO ())
+unclickRight
+  = mouseFilter "unclickRight" filter
+  where
+    filter (MouseRightUp point mod)  = isNoShiftAltControlDown mod
+    filter other                     = False
+
+enter :: Reactive w => Event w (Point -> IO ())
+enter
+  = mouseFilter "enter" filter
+  where
+    filter (MouseEnter point mod)  = True
+    filter other                   = False
+
+leave :: Reactive w => Event w (Point -> IO ())
+leave
+  = mouseFilter "leave" filter
+  where
+    filter (MouseLeave point mod)  = True
+    filter other                   = False
+
+mouseFilter :: Reactive w => String -> (EventMouse -> Bool) -> Event w (Point -> IO ())
+mouseFilter name filter
+  = mapEvent get set mouse
+  where
+    get prev x
+      = ioError (userError ("WX.Events: the " ++ name ++ " event is write-only."))
+
+    set prev new mouseEvent
+      = if (filter mouseEvent) 
+         then new (mousePos mouseEvent)
+         else prev mouseEvent
+
+{--------------------------------------------------------------------
+  Keyboard filter events
+--------------------------------------------------------------------}
+rebind :: Event w (IO ()) -> Event w (IO ())
+rebind event
+  = mapEvent get set event
+  where
+    get prev
+      = prev
+
+    set new prev
+      = new
+
+enterKey,tabKey,escKey,helpKey,delKey,homeKey,endKey :: Reactive w => Event w (IO ())
+pgupKey,pgdownKey,downKey,upKey,leftKey,rightKey :: Reactive w => Event w (IO ())
+enterKey  = key KeyReturn
+tabKey    = key KeyTab
+escKey    = key KeyEscape
+helpKey   = key KeyHelp
+delKey    = key KeyDelete
+homeKey   = key KeyHome
+endKey    = key KeyEnd
+pgupKey   = key KeyPageUp
+pgdownKey = key KeyPageDown
+downKey   = key KeyDown
+upKey     = key KeyUp
+leftKey   = key KeyLeft
+rightKey  = key KeyRight
+
+charKey :: Reactive w => Char -> Event w (IO ())
+charKey c
+  = key (KeyChar c)
+
+key :: Reactive w => Key -> Event w (IO ())
+key k
+  = keyboardFilter "key" filter
+  where
+    filter (EventKey x mod pt)  = k==x
+
+
+anyKey :: Reactive w => Event w (Key -> IO ())
+anyKey
+  = keyboardFilter1 "anyKey" (const True)
+
+
+keyboardFilter :: Reactive w => String -> (EventKey -> Bool) -> Event w (IO ())
+keyboardFilter name filter
+  = mapEvent get set keyboard
+  where
+    get prev
+      = ioError (userError ("WX.Events: the " ++ name ++ " event is write-only."))
+
+    set prev new keyboardEvent
+      = do when (filter keyboardEvent) new
+           prev keyboardEvent
+
+keyboardFilter1 :: Reactive w => String -> (EventKey -> Bool) -> Event w (Key -> IO ())
+keyboardFilter1 name filter
+  = mapEvent get set keyboard
+  where
+    get prev key
+      = ioError (userError ("WX.Events: the " ++ name ++ " event is write-only."))
+
+    set prev new keyboardEvent
+      = if (filter keyboardEvent) 
+         then new (keyKey keyboardEvent)
+         else prev keyboardEvent
+
+
+{--------------------------------------------------------------------
+   Calender event filters
+--------------------------------------------------------------------}
+calendarEvent :: Event (CalendarCtrl a) (EventCalendar -> IO ())
+calendarEvent
+  = newEvent "calendarEvent" calendarCtrlGetOnCalEvent calendarCtrlOnCalEvent
+
+
+{--------------------------------------------------------------------
+   Generic event creators
+-------------------------------------------------------------------}
+-- | Create a new event from a get and set function.
+newEvent :: String -> (w -> IO a) -> (w -> a -> IO ()) -> Event w a
+newEvent name getter setter
   = Event (newAttr name getter setter)
src/Graphics/UI/WX/Frame.hs view
@@ -1,179 +1,179 @@-----------------------------------------------------------------------------------{-|	Module      :  Frame-	Copyright   :  (c) Daan Leijen 2003-	               (c) Jeremy O'Donoghue 2007-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Frames.-    -* Instances: 'Form', 'Closeable', 'Framed' ---             'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',-             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint',-             'HasDefault'.-             ---}----------------------------------------------------------------------------------module Graphics.UI.WX.Frame-    ( -- * Frames-      Frame, frame, frameFixed, frameTool, frameEx-    , frameLoadRes, frameLoadChildRes-    , initialFrame-      -- * MDI Frames-    , MDIParentFrame, MDIChildFrame-    , mdiParentFrame, mdiChildFrame-    , mdiParentFrameEx, mdiChildFrameEx-     -- ** Operations-    , activeChild, activateNext, activatePrevious, arrangeIcons-    , cascade, tile-    -- * Internal-    ) where--import Graphics.UI.WXCore--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Window-import Graphics.UI.WX.TopLevelWindow-import Graphics.UI.WX.Events--defaultStyle -  = frameDefaultStyle -- .+. wxTAB_TRAVERSAL -- .+. wxNO_FULL_REPAINT_ON_RESIZE---- | Create a top-level frame window.-frame :: [Prop (Frame ())]  -> IO (Frame ())-frame props-  = frameEx defaultStyle props objectNull---- | Create a top-level frame window that is not resizeable.-frameFixed :: [Prop (Frame ())]  -> IO (Frame ())-frameFixed props-  = frameEx (defaultStyle .-. wxMAXIMIZE_BOX .-. wxRESIZE_BORDER)  props objectNull---- | Create a tool window; floats on the parent and has a small caption.-frameTool :: [Prop (Frame ())]  -> Window a -> IO (Frame ())-frameTool props parent-  = frameEx (defaultStyle .-. wxFRAME_TOOL_WINDOW .-. wxFRAME_FLOAT_ON_PARENT)  props parent----- | Create a top-level frame window in a custom style.-frameEx :: Style -> [Prop (Frame ())]  -> Window a -> IO (Frame ())-frameEx style props parent-  = feed2 props style $-    initialFrame $ \id rect txt -> \props style ->-    do f <- frameCreate parent id txt rect style-       let initProps = (if (containsProperty visible props)-                        then [] else [visible := True]) ++-                       (if (containsProperty bgcolor props)-                        then [] else [bgcolor := colorSystem Color3DFace])-       set f initProps-       set f props-       return f-     --- | Complete the construction of a top level frame which has been loaded---   from a resource file.-frameLoadRes :: FilePath -> String -> [Prop (Frame ())] -> IO (Frame ())-frameLoadRes rc name props = -    frameLoadChildRes objectNull rc name props---- | Complete the construction of a frame whcih is the child of some---   existing parent window.-frameLoadChildRes :: Window a -> FilePath -> String -> [Prop (Frame ())] -> IO (Frame ())-frameLoadChildRes parent rc name props =-    do res <- xmlResourceCreateFromFile rc wxXRC_USE_LOCALE-       f   <- xmlResourceLoadFrame res parent name-       set f props-       return f---- | initial Frame flags-initialFrame :: (Id -> Rect -> String -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a-initialFrame cont -  = initialContainer    $ \id rect ->-    initialText         $ \txt ->-    initialResizeable   $-    initialMinimizeable $-    initialMaximizeable $-    initialCloseable    $-    initialClipChildren $-    initialFullRepaintOnResize $ -    cont id rect txt -             --{---------------------------------------------------------------------------  MDI frames---------------------------------------------------------------------------}--- | Create an MDI parent frame.-mdiParentFrame :: [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())-mdiParentFrame props-  = mdiParentFrameEx objectNull defaultStyle props----- | Create an MDI parent frame with a custom style.-mdiParentFrameEx :: Window a -> Style -> [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())-mdiParentFrameEx parent stl props-  = feed2 props stl $-    initialFrame $ \id rect txt -> \props stl ->-    do f <- mdiParentFrameCreate parent id txt rect stl-       let initProps = (if (containsProperty visible props)-                        then [] else [visible := True]) ++-                       (if (containsProperty bgcolor props)-                        then [] else [bgcolor := colorSystem Color3DFace])-       set f initProps-       set f props-       return f----- | Create a MDI child frame.-mdiChildFrame :: MDIParentFrame a -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())-mdiChildFrame parent props-  = mdiChildFrameEx parent defaultStyle props---- | Create a MDI child frame with a custom style.-mdiChildFrameEx :: MDIParentFrame a -> Style -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())-mdiChildFrameEx parent stl props-  = feed2 props stl $-    initialFrame $ \id rect txt -> \props stl ->-    do f <- mdiChildFrameCreate parent id txt rect stl-       let initProps = (if (containsProperty visible props)-                         then [] else [visible := True]) ++-                       (if (containsProperty bgcolor props)-                         then [] else [bgcolor := colorSystem Color3DFace])-       set f initProps-       set f props-       return f-  ----- | Return the active child frame ('objectIsNull' when no child is active)-activeChild :: ReadAttr (MDIParentFrame a) (MDIChildFrame ())-activeChild = readAttr "activeChild" mdiParentFrameGetActiveChild---- | Activate the next child frame.-activateNext :: MDIParentFrame a -> IO ()-activateNext  = mdiParentFrameActivateNext---- | Activate the previous child frame-activatePrevious :: MDIParentFrame a -> IO ()-activatePrevious  = mdiParentFrameActivatePrevious---- | Arrange iconized mdi child frames.-arrangeIcons :: MDIParentFrame a -> IO ()-arrangeIcons = mdiParentFrameArrangeIcons---- | Cascade the child frames.-cascade :: MDIParentFrame a -> IO ()-cascade = mdiParentFrameCascade ---- | Tile the child frames-tile :: MDIParentFrame a -> IO ()-tile = mdiParentFrameTile--- +
+--------------------------------------------------------------------------------
+{-|	Module      :  Frame
+	Copyright   :  (c) Daan Leijen 2003
+	               (c) Jeremy O'Donoghue 2007
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Frames.
+    
+* Instances: 'Form', 'Closeable', 'Framed' --
+             'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
+             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint',
+             'HasDefault'.
+             
+
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Frame
+    ( -- * Frames
+      Frame, frame, frameFixed, frameTool, frameEx
+    , frameLoadRes, frameLoadChildRes
+    , initialFrame
+      -- * MDI Frames
+    , MDIParentFrame, MDIChildFrame
+    , mdiParentFrame, mdiChildFrame
+    , mdiParentFrameEx, mdiChildFrameEx
+     -- ** Operations
+    , activeChild, activateNext, activatePrevious, arrangeIcons
+    , cascade, tile
+    -- * Internal
+    ) where
+
+import Graphics.UI.WXCore
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Window
+import Graphics.UI.WX.TopLevelWindow
+import Graphics.UI.WX.Events
+
+defaultStyle 
+  = frameDefaultStyle -- .+. wxTAB_TRAVERSAL -- .+. wxNO_FULL_REPAINT_ON_RESIZE
+
+-- | Create a top-level frame window.
+frame :: [Prop (Frame ())]  -> IO (Frame ())
+frame props
+  = frameEx defaultStyle props objectNull
+
+-- | Create a top-level frame window that is not resizeable.
+frameFixed :: [Prop (Frame ())]  -> IO (Frame ())
+frameFixed props
+  = frameEx (defaultStyle .-. wxMAXIMIZE_BOX .-. wxRESIZE_BORDER)  props objectNull
+
+-- | Create a tool window; floats on the parent and has a small caption.
+frameTool :: [Prop (Frame ())]  -> Window a -> IO (Frame ())
+frameTool props parent
+  = frameEx (defaultStyle .-. wxFRAME_TOOL_WINDOW .-. wxFRAME_FLOAT_ON_PARENT)  props parent
+
+
+-- | Create a top-level frame window in a custom style.
+frameEx :: Style -> [Prop (Frame ())]  -> Window a -> IO (Frame ())
+frameEx style props parent
+  = feed2 props style $
+    initialFrame $ \id rect txt -> \props style ->
+    do f <- frameCreate parent id txt rect style
+       let initProps = (if (containsProperty visible props)
+                        then [] else [visible := True]) ++
+                       (if (containsProperty bgcolor props)
+                        then [] else [bgcolor := colorSystem Color3DFace])
+       set f initProps
+       set f props
+       return f
+     
+-- | Complete the construction of a top level frame which has been loaded
+--   from a resource file.
+frameLoadRes :: FilePath -> String -> [Prop (Frame ())] -> IO (Frame ())
+frameLoadRes rc name props = 
+    frameLoadChildRes objectNull rc name props
+
+-- | Complete the construction of a frame whcih is the child of some
+--   existing parent window.
+frameLoadChildRes :: Window a -> FilePath -> String -> [Prop (Frame ())] -> IO (Frame ())
+frameLoadChildRes parent rc name props =
+    do res <- xmlResourceCreateFromFile rc wxXRC_USE_LOCALE
+       f   <- xmlResourceLoadFrame res parent name
+       set f props
+       return f
+
+-- | initial Frame flags
+initialFrame :: (Id -> Rect -> String -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialFrame cont 
+  = initialContainer    $ \id rect ->
+    initialText         $ \txt ->
+    initialResizeable   $
+    initialMinimizeable $
+    initialMaximizeable $
+    initialCloseable    $
+    initialClipChildren $
+    initialFullRepaintOnResize $ 
+    cont id rect txt 
+             
+
+{--------------------------------------------------------------------------
+  MDI frames
+--------------------------------------------------------------------------}
+-- | Create an MDI parent frame.
+mdiParentFrame :: [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())
+mdiParentFrame props
+  = mdiParentFrameEx objectNull defaultStyle props
+
+
+-- | Create an MDI parent frame with a custom style.
+mdiParentFrameEx :: Window a -> Style -> [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())
+mdiParentFrameEx parent stl props
+  = feed2 props stl $
+    initialFrame $ \id rect txt -> \props stl ->
+    do f <- mdiParentFrameCreate parent id txt rect stl
+       let initProps = (if (containsProperty visible props)
+                        then [] else [visible := True]) ++
+                       (if (containsProperty bgcolor props)
+                        then [] else [bgcolor := colorSystem Color3DFace])
+       set f initProps
+       set f props
+       return f
+
+
+-- | Create a MDI child frame.
+mdiChildFrame :: MDIParentFrame a -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())
+mdiChildFrame parent props
+  = mdiChildFrameEx parent defaultStyle props
+
+-- | Create a MDI child frame with a custom style.
+mdiChildFrameEx :: MDIParentFrame a -> Style -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())
+mdiChildFrameEx parent stl props
+  = feed2 props stl $
+    initialFrame $ \id rect txt -> \props stl ->
+    do f <- mdiChildFrameCreate parent id txt rect stl
+       let initProps = (if (containsProperty visible props)
+                         then [] else [visible := True]) ++
+                       (if (containsProperty bgcolor props)
+                         then [] else [bgcolor := colorSystem Color3DFace])
+       set f initProps
+       set f props
+       return f
+  
+
+
+-- | Return the active child frame ('objectIsNull' when no child is active)
+activeChild :: ReadAttr (MDIParentFrame a) (MDIChildFrame ())
+activeChild = readAttr "activeChild" mdiParentFrameGetActiveChild
+
+-- | Activate the next child frame.
+activateNext :: MDIParentFrame a -> IO ()
+activateNext  = mdiParentFrameActivateNext
+
+-- | Activate the previous child frame
+activatePrevious :: MDIParentFrame a -> IO ()
+activatePrevious  = mdiParentFrameActivatePrevious
+
+-- | Arrange iconized mdi child frames.
+arrangeIcons :: MDIParentFrame a -> IO ()
+arrangeIcons = mdiParentFrameArrangeIcons
+
+-- | Cascade the child frames.
+cascade :: MDIParentFrame a -> IO ()
+cascade = mdiParentFrameCascade 
+
+-- | Tile the child frames
+tile :: MDIParentFrame a -> IO ()
+tile = mdiParentFrameTile
+
+
+
src/Graphics/UI/WX/Layout.hs view
@@ -1,43 +1,43 @@--------------------------------------------------------------------------------------------{-|	Module      :  Layout-	Copyright   :  (c) Daan Leijen 2003-	License     :  BSD-style--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Just re-exports functionality of "Graphics.UI.WXCore.Layout". See that module-for a description of layout combinators. --Any object in the 'Form' class has a 'layout' attribute to specify the -layout. Here is a short example:--> do f <- frame [text := "layout demo"]->    q <- button f [text := "quit", on command := close f]->    set f [layout := margin 10 $->                     floatCentre $->                     column 5 [label "hi",widget q]]---}-------------------------------------------------------------------------------------------module Graphics.UI.WX.Layout-             (-             -- * Classes-               Form, layout-             -- * Layout-             , module Graphics.UI.WXCore.Layout-             ) where--import Graphics.UI.WXCore.Layout-import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes--{------------------------------------------------------------------------------------------------------------------------------------------}--- | Forms can contain other widgets.-class Form w where-  -- | Set the layout of the child widgets.+
+-----------------------------------------------------------------------------------------
+{-|	Module      :  Layout
+	Copyright   :  (c) Daan Leijen 2003
+	License     :  BSD-style
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Just re-exports functionality of "Graphics.UI.WXCore.Layout". See that module
+for a description of layout combinators. 
+
+Any object in the 'Form' class has a 'layout' attribute to specify the 
+layout. Here is a short example:
+
+> do f <- frame [text := "layout demo"]
+>    q <- button f [text := "quit", on command := close f]
+>    set f [layout := margin 10 $
+>                     floatCentre $
+>                     column 5 [label "hi",widget q]]
+
+-}
+-----------------------------------------------------------------------------------------
+module Graphics.UI.WX.Layout
+             (
+             -- * Classes
+               Form, layout
+             -- * Layout
+             , module Graphics.UI.WXCore.Layout
+             ) where
+
+import Graphics.UI.WXCore.Layout
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+
+{--------------------------------------------------------------------
+
+--------------------------------------------------------------------}
+-- | Forms can contain other widgets.
+class Form w where
+  -- | Set the layout of the child widgets.
   layout :: Attr w Layout
src/Graphics/UI/WX/Media.hs view
@@ -1,106 +1,106 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}----------------------------------------------------------------------------------{-|	Module      :  Media-	Copyright   :  (c) Daan Leijen 2003-	               (c) shelarcy 2007-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Images, Media, Sounds, and action!--}----------------------------------------------------------------------------------module Graphics.UI.WX.Media-            ( -- * Media-              Media(..)-            -              -- * Sound-            , sound, playLoop, playWait-              -- * Images-            , image, imageCreateFromFile, imageCreateFromPixels, imageGetPixels-            , imageCreateFromPixelArray, imageGetPixelArray-            -              -- * Bitmaps-            , bitmap, bitmapCreateFromFile, bitmapFromImage-            ) where--import System.IO.Unsafe( unsafePerformIO )-import Graphics.UI.WXCore -import Graphics.UI.WX.Types( Var, varGet, varSet, varCreate )-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Classes--{---------------------------------------------------------------------  Bitmaps---------------------------------------------------------------------}--- | Return a managed bitmap object. Bitmaps are abstract images used--- for drawing to a device context. The file path should point to--- a valid bitmap file, normally a @.ico@, @.bmp@, @.xpm@, or @.png@,--- but any file format supported by |Image| is correctly loaded.------ Instances: 'Sized'.-bitmap :: FilePath -> Bitmap ()-bitmap fname-  = unsafePerformIO $ bitmapCreateFromFile fname--instance Sized (Bitmap a) where-  size  = newAttr "size" bitmapGetSize bitmapSetSize---- | Create a bitmap from an image with the same color depth.-bitmapFromImage :: Image a -> IO (Bitmap ())-bitmapFromImage image-  = bitmapCreateFromImage image (-1)--{---------------------------------------------------------------------  Images---------------------------------------------------------------------}--- | Return a managed image. Images are platform independent representations--- of pictures, using an array of rgb pixels. See "Graphics.UI.WXCore.Image" for--- lowlevel pixel manipulation. The file path should point to--- a valid image file, like @.jpg@, @.bmp@, @.xpm@, or @.png@, for example.------ Instances: 'Sized'.-image :: FilePath -> Image ()-image fname-  = unsafePerformIO $ imageCreateFromFile fname--instance Sized (Image a) where-  size  = newAttr "size" imageGetSize imageRescale--{---------------------------------------------------------------------  Media---------------------------------------------------------------------}--- | Abstract layer between 'MediaCtrl' and 'Sound'. This class intends to--- avoid breaking backward-compatibility.-class Media w where-  -- | If use this method with 'Sound', play a sound fragment asynchronously.-  -- If use this method with 'MediaCtrl', play media that is loaded by-  -- 'mediaCtrlLoad'.-  play  :: w -> IO ()-  stop  :: w -> IO ()--{---------------------------------------------------------------------  Sounds---------------------------------------------------------------------}--- | Return a managed sound object. The file path points to --- a valid sound file, normally a @.wav@.-sound :: FilePath -> Sound ()-sound fname -  = unsafePerformIO $ soundCreate fname False--instance Media (Sound a) where-  play sound = unitIO (soundPlay sound wxSOUND_ASYNC)-  stop = soundStop---- | Play a sound fragment repeatedly (and asynchronously).-playLoop :: Sound a -> IO ()-playLoop sound-  = unitIO (soundPlay sound $ wxSOUND_ASYNC .+. wxSOUND_LOOP)---- | Play a sound fragment synchronously (i.e. wait till completion).-playWait :: Sound a -> IO ()-playWait sound-  = unitIO (soundPlay sound wxSOUND_SYNC)-+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+--------------------------------------------------------------------------------
+{-|	Module      :  Media
+	Copyright   :  (c) Daan Leijen 2003
+	               (c) shelarcy 2007
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Images, Media, Sounds, and action!
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Media
+            ( -- * Media
+              Media(..)
+            
+              -- * Sound
+            , sound, playLoop, playWait
+              -- * Images
+            , image, imageCreateFromFile, imageCreateFromPixels, imageGetPixels
+            , imageCreateFromPixelArray, imageGetPixelArray
+            
+              -- * Bitmaps
+            , bitmap, bitmapCreateFromFile, bitmapFromImage
+            ) where
+
+import System.IO.Unsafe( unsafePerformIO )
+import Graphics.UI.WXCore 
+import Graphics.UI.WX.Types( Var, varGet, varSet, varCreate )
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Classes
+
+{--------------------------------------------------------------------
+  Bitmaps
+--------------------------------------------------------------------}
+-- | Return a managed bitmap object. Bitmaps are abstract images used
+-- for drawing to a device context. The file path should point to
+-- a valid bitmap file, normally a @.ico@, @.bmp@, @.xpm@, or @.png@,
+-- but any file format supported by |Image| is correctly loaded.
+--
+-- Instances: 'Sized'.
+bitmap :: FilePath -> Bitmap ()
+bitmap fname
+  = unsafePerformIO $ bitmapCreateFromFile fname
+
+instance Sized (Bitmap a) where
+  size  = newAttr "size" bitmapGetSize bitmapSetSize
+
+-- | Create a bitmap from an image with the same color depth.
+bitmapFromImage :: Image a -> IO (Bitmap ())
+bitmapFromImage image
+  = bitmapCreateFromImage image (-1)
+
+{--------------------------------------------------------------------
+  Images
+--------------------------------------------------------------------}
+-- | Return a managed image. Images are platform independent representations
+-- of pictures, using an array of rgb pixels. See "Graphics.UI.WXCore.Image" for
+-- lowlevel pixel manipulation. The file path should point to
+-- a valid image file, like @.jpg@, @.bmp@, @.xpm@, or @.png@, for example.
+--
+-- Instances: 'Sized'.
+image :: FilePath -> Image ()
+image fname
+  = unsafePerformIO $ imageCreateFromFile fname
+
+instance Sized (Image a) where
+  size  = newAttr "size" imageGetSize imageRescale
+
+{--------------------------------------------------------------------
+  Media
+--------------------------------------------------------------------}
+-- | Abstract layer between 'MediaCtrl' and 'Sound'. This class intends to
+-- avoid breaking backward-compatibility.
+class Media w where
+  -- | If use this method with 'Sound', play a sound fragment asynchronously.
+  -- If use this method with 'MediaCtrl', play media that is loaded by
+  -- 'mediaCtrlLoad'.
+  play  :: w -> IO ()
+  stop  :: w -> IO ()
+
+{--------------------------------------------------------------------
+  Sounds
+--------------------------------------------------------------------}
+-- | Return a managed sound object. The file path points to 
+-- a valid sound file, normally a @.wav@.
+sound :: FilePath -> Sound ()
+sound fname 
+  = unsafePerformIO $ soundCreate fname False
+
+instance Media (Sound a) where
+  play sound = unitIO (soundPlay sound wxSOUND_ASYNC)
+  stop = soundStop
+
+-- | Play a sound fragment repeatedly (and asynchronously).
+playLoop :: Sound a -> IO ()
+playLoop sound
+  = unitIO (soundPlay sound $ wxSOUND_ASYNC .+. wxSOUND_LOOP)
+
+-- | Play a sound fragment synchronously (i.e. wait till completion).
+playWait :: Sound a -> IO ()
+playWait sound
+  = unitIO (soundPlay sound wxSOUND_SYNC)
+
src/Graphics/UI/WX/Menu.hs view
@@ -1,661 +1,661 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}----------------------------------------------------------------------------------{-|	Module      :  Menu-	Copyright   :  (c) Daan Leijen 2003-	               (c) Shelarcy (shelarcy@gmail.com) 2006-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Defines Menus, toolbars, and statusbars.-    -The function 'menuPane' is used to create a menu-that can contain 'menuItem's. Menu items can contain event handlers-using ('on' 'command'), but they can also be set, using the 'menu'-function, on a frame or (mdi) window so that the menu command is handled-in the context of the active window instead of the context of the-entire application. --> do frame  <- frame    [text := "Demo"]->    file   <- menuPane [text := "&File"]->    mclose <- menuItem file [text := "&Close\tCtrl+C", help := "Close the document"] ->    set frame [menuBar          := [file] ->              ,on (menu mclose) := ...] ---}----------------------------------------------------------------------------------module Graphics.UI.WX.Menu-    ( -- * Menu-      -- ** Menu containers-      MenuBar, Menu, menuBar, menuPopup, menuPane, menuHelp-    , menuRes, menuBarLoadRes-    -- ** Menu events-    , menu, menuId-      -- ** Menu items-    , MenuItem, menuItem, menuQuit, menuAbout, menuItemEx-    , menuItemOnCommandRes, menuLine, menuSub, menuRadioItem-    -- * Tool bar-    , ToolBar, toolBar, toolBarEx-    , ToolBarItem, toolMenu, toolMenuFromBitmap, toolItem, toolControl, tool-    -- * Status bar-    , StatusField, statusBar, statusField, statusWidth-    -- * Deprecated-    , menuList, menubar, statusbar-    ) where--import Data.Char( toUpper )-import Data.List( partition, intersperse )-import System.IO.Unsafe (unsafePerformIO)-import Foreign.Ptr( nullPtr )-import Graphics.UI.WXCore hiding (Event)--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Events---{---------------------------------------------------------------------------------  Menubar---------------------------------------------------------------------------------}-{-# DEPRECATED menubar "Use menuBar instead" #-}--- | /Deprecated/: use 'menuBar'.-menubar :: WriteAttr (Frame a) [Menu ()]-menubar-  = menuBar---- | Set the menu bar of a frame.-menuBar :: WriteAttr (Frame a) [Menu ()]-menuBar-  = writeAttr "menubar" setter-  where-    setter frame menus-      = do mb <- menuBarCreate wxMB_DOCKABLE-           mapM_ (append mb) menus-           frameSetMenuBar frame mb-           -- set delayed menu handlers on the frame-           mapM_ (evtHandlerSetAndResetMenuCommands frame) menus-           -- work around menu bug in wxMac 2.5.1-           vis <- windowIsShown frame-           if (vis && wxToolkit == WxMac && (div wxVersion 100) >= 25)-            then do windowHide frame-                    windowShow frame-                    return ()-            else return ()--    append mb menu-      = do title <- menuGetTitle menu-           menuSetTitle menu ""-           menuBarAppend mb menu title---- | Retrieve a menu bar instance which has been constructed by loading---   a resource file for a given top level window.-menuBarLoadRes :: Window a -> FilePath -> String -> IO (MenuBar ())-menuBarLoadRes parent rc name =-    do-      res <- xmlResourceCreateFromFile rc wxXRC_USE_LOCALE-      m   <- xmlResourceLoadMenuBar res parent name-      return m---- | Show a popup menu for a certain window.-menuPopup :: Menu b -> Point -> Window a -> IO ()-menuPopup menu pt parent-  = do windowPopupMenu parent menu pt-       return ()--{---------------------------------------------------------------------------------  Menu---------------------------------------------------------------------------------}-{-# DEPRECATED menuList "Use menuPane instead" #-}--- | /Deprecated/: use 'menuPane'.-menuList :: [Prop (Menu ())] -> IO (Menu ())-menuList -  = menuPane ---- | Create a new menu with a certain title (corresponds with 'text' attribute).------ * Instances: 'Textual'----menuPane :: [Prop (Menu ())] -> IO (Menu ())-menuPane props-  = do m <- menuCreate "" wxMENU_TEAROFF-       set m props-       return m---- | Append a /help/ menu item (@"&Help"@). On some platforms,--- the /help/ menu is handled specially-menuHelp :: [Prop (Menu ())] -> IO (Menu ())-menuHelp props-  = menuPane ([text := "&Help"] ++ props)---- | Complete the construction of a menu which has been loaded---   from a resource file.--- | Get a menu by name from a menu loaded from a resource file, ---   given the frame which owns the menu. You---   can directly set properties on the item as part of the call, which---   enables simple connection of event handlers (e.g. on command).-menuRes :: Window a -> String -> [Prop (Menu ())] -> IO (Menu ())-menuRes parent menu_name props =-    do-      menu <- xmlResourceGetMenu parent menu_name-      set menu props-      return menu--instance Textual (Menu a) where-  text-    = newAttr "text" menuGetTitle menuSetTitle--{---------------------------------------------------------------------------------  Menu items---------------------------------------------------------------------------------}--- | Create a submenu item.-menuSub :: Menu b -> Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuSub parent menu props-  = do id <- idCreate-       label <- case (findProperty text "" props) of -                  Just (txt,_) -> return txt-                  Nothing      -> do title <- menuGetTitle menu-                                     if (null title) -                                      then return "<empty>"-                                      else return title                  -       menuSetTitle menu ""           -- remove title on submenus-       menuAppendSub parent id label menu ""-       menuPropagateEvtHandlers menu  -- move the evtHandlers to the parent-       item <- menuFindItem parent id-       set item props-       return item---- | Add a menu seperator.-menuLine :: Menu a -> IO ()-menuLine menu-  = menuAppendSeparator menu----- | Append a menu item. The label can contain--- menu accellerators by using an ampersand. It can also contain keyboard accellerators--- after a tab (@'\\t'@) character.------ > menuItem menu [text := "&Open\tCtrl+O", help := "Opens an existing document"] ------ You can create a checkable menu item by setting 'checkable' to 'True' in the--- properties of a menu item.------ Note: on GTK, it is required to set the 'text' attribute immediately at creation time.------ * Events: 'menu', 'menuId'------ * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.----menuItem :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuItem menu props-  = do let kind = case (findProperty checkable False props) of-                    Just (True,_) -> wxITEM_CHECK-                    _             -> wxITEM_NORMAL-       menuItemKind menu kind props                     ---- | Append a radio menu item. These items are 'checkable' by default.--- A sequence of radio menu items form automatically a group. --- A different kind of menu item, like  a 'menuLine', terminates the group.--- Note: one sometimes has to set the first selected radio item --- specifically after setting the "menubar" property, or otherwise the--- radio item bullet is not displayed on windows.--- See 'menuItem' for other properties of menu radio items.-menuRadioItem :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuRadioItem menu props-  = menuItemKind menu wxITEM_RADIO ([checked := True] ++ props)--menuItemKind menu kind props-  = do id <- idCreate-       let label = case (findProperty text "" props) of -                     Nothing      -> "<empty>"-                     Just (txt,_) -> txt-       menuItemEx menu id label kind props-       ----- | Append an /about/ menu item (@"&About..."@). On some platforms,--- the /about/ menu is handled specially.------ * Events: 'menu', 'menuId'------ * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.----menuAbout :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuAbout menu props-  = menuItemId menu wxID_ABOUT "&About..." props---- | Append an /quit/ menu item (@"&Quit\tCtrl+Q"@). On some platforms,--- the /quit/ menu is handled specially------ * Events: 'menu', 'menuId'------ * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.----menuQuit :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuQuit menu props-  = menuItemId menu wxID_EXIT "&Quit\tCtrl+Q" props---- | Append a menu item with a specific id and label.------ * Events: 'menu', 'menuId'------ * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.----menuItemId :: Menu a -> Id -> String -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuItemId menu id label props-  = menuItemEx menu id label wxITEM_NORMAL props---- | Append a menu item with a specific id, label, and kind (like 'wxITEM_CHECK').------ * Events: 'menu', 'menuId'------ * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.----menuItemEx :: Menu a -> Id -> String -> Int -> [Prop (MenuItem ())] -> IO (MenuItem ())-menuItemEx menu id label kind props-  = do if (kind == wxITEM_RADIO)-        then menuAppendRadioItem menu id label ""-        else menuAppend menu id label "" (kind == wxITEM_CHECK)-       item <- menuFindItem menu id-       set item props-       return item--instance Able (MenuItem a) where-  enabled = newAttr "enabled" menuItemIsEnabled menuItemEnable--instance Textual (MenuItem a) where-  text-    = reflectiveAttr "text" menuItemGetText menuItemSetText--instance Help (MenuItem a) where-  help  = newAttr "help" menuItemGetHelp menuItemSetHelp--instance Checkable (MenuItem a) where-  checkable = reflectiveAttr "checkable" menuItemIsCheckable (\m c -> menuItemSetCheckable m c)-  checked   = newAttr "checked"   menuItemIsChecked menuItemCheck--instance Identity (MenuItem a) where-  identity  = newAttr "identity" menuItemGetId menuItemSetId--{---------------------------------------------------------------------------------  Events---------------------------------------------------------------------------------}--- | React to menu events.-menu :: MenuItem a -> Event (Window w) (IO ())-menu item-  = let id = unsafePerformIO (get item identity)-    in  menuId id---- | React to a menu event based on identity.-menuId :: Id -> Event (Window w) (IO ())-menuId id-  = newEvent "menu" (\w -> evtHandlerGetOnMenuCommand w id) (\w h -> evtHandlerOnMenuCommand w id h)-              -{---------------------------------------------------------------------------------  Menu commands:--  Ok, we would like to set command handlers in two ways:-  1) As an "on command" on the menu item itself. -  2) With an "on (menu xxx)" on a window. --  Unfortunately, wxWidgets does not support method (1) for menus that are-  part of a menubar and assumes they are set on using (2) on the associated-  frame. We can't tell whether a menu is part of a menubar or popup menu until-  the user sets it. Thus we both set the event handlers always directly on the-  top level menu (this is good enough for popup menus) and we maintain -  a list of menu item id's and associated event handler as client data on the-  top level menu. When the menu is set as part of a menu bar, we install the-  handlers on the associated frame.---------------------------------------------------------------------------------}-instance Commanding (MenuItem a) where-  command-    = newEvent "command" menuItemGetOnCommand menuItemOnCommand--menuItemGetOnCommand :: MenuItem a -> IO (IO ())-menuItemGetOnCommand item -  = do id      <- get item identity-       topmenu <- menuItemGetTopMenu item-       evtHandlerGetOnMenuCommand topmenu id--menuItemOnCommand :: MenuItem a -> IO () -> IO ()-menuItemOnCommand item io-  = do id      <- get item identity-       topmenu <- menuItemGetTopMenu item-       -- always set it on the menu itself (has only effect on popup menus)-       evtHandlerOnMenuCommand topmenu id io-       -- update the Haskell event handler list for delayed frame installation-       menuUpdateEvtHandlers topmenu (insert id io)-       -- and set it directly on the frame if already instantiated. -       frame   <- menuGetFrame topmenu-       when (not (objectIsNull frame)) (evtHandlerOnMenuCommand frame id io)-  where-    insert key val []         = [(key,val)]-    insert key val ((k,v):xs) | key == k  = (key,val):xs-                              | otherwise = (k,v):insert key val xs---- | When setting event handlers on menu items which have been loaded from---   XRC resource files, properties cannot be used as the menu item---   instances are opaque to wxHaskell.------   This function offers a convenient way to attach menu item event---   handlers, given the identity of the window which owns the menu containing---   the menu item, and the name of the menu item--menuItemOnCommandRes :: Window a -> String -> IO () -> IO ()-menuItemOnCommandRes win item_name handler =-    do-      res     <- xmlResourceGet-      item_id <- xmlResourceGetXRCID res item_name-      evtHandlerOnMenuCommand win item_id handler---- Propagate the (delayed) event handlers of a submenu to the parent menu.--- This is necessary for event handlers set on menu items in a submenu that--- was not yet assigned to a parent menu.-menuPropagateEvtHandlers :: Menu a -> IO ()-menuPropagateEvtHandlers menu-  = do parent   <- menuGetTopMenu menu-       handlers <- menuGetEvtHandlers menu-       menuSetEvtHandlers menu []-       menuSetEvtHandlers parent handlers---- Get associated frame of a menu in a menubar. Returns NULL for popup and sub menus.-menuGetFrame :: Menu a -> IO (Frame ())-menuGetFrame menu-  = do menubar <- menuGetMenuBar menu-       if (objectIsNull menubar) -        then return objectNull-        else menuBarGetFrame menubar---- Get top level menu of a menu item (never null)-menuItemGetTopMenu :: MenuItem a -> IO (Menu ())-menuItemGetTopMenu item-  = do menu <- menuItemGetMenu item-       menuGetTopMenu menu---- Get the top level menu of a possible sub menu -menuGetTopMenu :: Menu a -> IO (Menu ())-menuGetTopMenu menu-  = do parent <- menuGetParent menu-       if (objectIsNull parent)-        then return (downcastMenu menu)-        else menuGetTopMenu parent---- Set all menu event handlers on a certain window (EvtHandler)-evtHandlerSetAndResetMenuCommands :: EvtHandler a -> Menu b -> IO ()-evtHandlerSetAndResetMenuCommands evtHandler menu-  = do handlers <- menuGetEvtHandlers menu-       menuSetEvtHandlers menu []-       mapM_ (\(id,io) -> evtHandlerOnMenuCommand evtHandler id io) handlers---- Update the menu event handler list.-menuUpdateEvtHandlers menu f-  = do hs <- menuGetEvtHandlers menu-       menuSetEvtHandlers menu (f hs)--menuGetEvtHandlers :: Menu a -> IO [(Id,IO ())]-menuGetEvtHandlers menu -  = do mbHandlers <- unsafeEvtHandlerGetClientData menu-       case mbHandlers of-         Nothing -> return []-         Just hs -> return hs--menuSetEvtHandlers :: Menu a -> [(Id,IO ())] -> IO ()-menuSetEvtHandlers menu hs-  = evtHandlerSetClientData menu (return ()) hs ---{---------------------------------------------------------------------------------  Toolbar---------------------------------------------------------------------------------}--- | Create a toolbar window with a divider and text labels.--- Normally, you can use 'toolMenu' to add tools in the toolbar--- that behave like normal menu items.------ >  tbar   <- toolBar f []--- >  toolMenu tbar open  "Open"  "open.png"  []--- >  toolMenu tbar about "About" "about.png" []----toolBar :: Frame a -> [Prop (ToolBar ())] -> IO (ToolBar ())-toolBar parent props-  = toolBarEx parent True True props---- | Create a toolbar window. The second argument specifies whether text labels--- should be shown, and the third argument whether a divider line is present--- above the toolbar.-toolBarEx :: Frame a -> Bool -> Bool -> [Prop (ToolBar ())] -> IO (ToolBar ())-toolBarEx parent showText showDivider props-  = do let style = ( wxTB_DOCKABLE .+. wxTB_FLAT-                   .+. (if showText then wxTB_TEXT else 0)-                   .+. (if showDivider then 0 else wxTB_NODIVIDER)-                   )-       t <- toolBarCreate parent idAny rectNull style-       frameSetToolBar parent t-       {--       t <- frameCreateToolBar parent style -       -}-       set t props-       return t---- | A tool in a toolbar.------ * Events: 'tool'------ * Instances: 'Able', 'Help', 'Tipped', 'Checkable', 'Identity', 'Commanding'.----data ToolBarItem  = ToolBarItem (ToolBar ()) Id Bool--instance Able ToolBarItem  where-  enabled -    = newAttr "enabled" getter setter-    where-      getter (ToolBarItem toolbar id isToggle)-        = toolBarGetToolEnabled toolbar id--      setter (ToolBarItem toolbar id isToggle) enable-        = toolBarEnableTool toolbar id enable-         --instance Tipped ToolBarItem where-  tooltip -    = newAttr "tooltip" getter setter-    where-      getter (ToolBarItem toolbar id isToggle)-        = toolBarGetToolShortHelp toolbar id--      setter (ToolBarItem toolbar id isToggle) txt-        = toolBarSetToolShortHelp toolbar id txt-         -instance Help ToolBarItem  where-  help  -    = newAttr "help" getter setter-    where-      getter (ToolBarItem toolbar id isToggle)-        = toolBarGetToolLongHelp toolbar id--      setter (ToolBarItem toolbar id isToggle) txt-        = toolBarSetToolLongHelp toolbar id txt-         --instance Checkable ToolBarItem where-  checkable -    = readAttr "checkable" getter-    where-      getter (ToolBarItem toolbar id isToggle)-        = return isToggle--  checked   -    = newAttr "checked"  getter setter-    where-      getter (ToolBarItem toolbar id isToggle)-        = toolBarGetToolState toolbar id--      setter (ToolBarItem toolbar id isToggle) toggle-        = toolBarToggleTool toolbar id toggle-         --instance Identity ToolBarItem where-  identity  -    = readAttr "identity" getter-    where-      getter (ToolBarItem toolbar id isToggle)-        = return id---instance Commanding ToolBarItem where-  command-    = newEvent "command" getter setter-    where-      getter (ToolBarItem toolbar id isToggle)-        = evtHandlerGetOnMenuCommand toolbar id--      setter (ToolBarItem toolbar id isToggle) io-        = evtHandlerOnMenuCommand toolbar id io---- | React on tool event. (normally handled by 'menu' though, so only use this--- for orphan toolbar items).-tool :: ToolBarItem -> Event (Window w) (IO ())-tool (ToolBarItem toolbar id isToggle)-  = newEvent "tool" getter setter-  where-    getter w-      = evtHandlerGetOnMenuCommand w id-    setter w io-      = evtHandlerOnMenuCommand w id io---- | Create a tool bar item based on a menu. Takes a a relevant menu--- item, a label and an image file (bmp, png, gif, ico, etc.) as arguments. The image--- file is normally 16x15 pixels.--- The toolbar item will fire the relevant menu items just as if the menu has been selected.--- Checkable menus will give a checkable toolbar item. Beware though that checkable tools--- normally require a specific @on command@ handler to keep them synchronised with the --- corresponding menu item.-toolMenu :: ToolBar a -> MenuItem a -> String -> FilePath -> [Prop ToolBarItem] -> IO ToolBarItem-toolMenu toolbar menuitem label bitmapPath props-  = withBitmapFromFile bitmapPath $ \bitmap ->-      toolMenuFromBitmap toolbar menuitem label bitmap props---- | This is a generalized version of 'toolMenu' function. You can specify 'Bitmap' that is--- loaded from any other place instead of using 'FilePath' directly.-toolMenuFromBitmap :: ToolBar a -> MenuItem a -> String -> Bitmap b -> [Prop ToolBarItem] -> IO ToolBarItem-toolMenuFromBitmap toolbar menuitem label bitmap props-  = do isToggle <- get menuitem checkable-       id       <- get menuitem identity-       lhelp    <- get menuitem help-       shelp    <- get menuitem help-       toolBarAddTool2 toolbar id label bitmap nullBitmap -                       (if isToggle then wxITEM_CHECK else wxITEM_NORMAL)-                       shelp lhelp-       let t = ToolBarItem (downcastToolBar toolbar) id isToggle-       set t props-       toolBarRealize toolbar-       return t---- | Create an /orphan/ toolbar item that is unassociated with a menu. Takes a --- label, a flag that is 'True' when the item is 'checkable' and a path to an image--- (bmp, png, gif, ico, etc.) as arguments.-toolItem :: ToolBar a -> String -> Bool -> FilePath -> [Prop ToolBarItem] -> IO ToolBarItem-toolItem toolbar label isCheckable bitmapPath props-  = withBitmapFromFile bitmapPath $ \bitmap ->-    do id <- idCreate-       toolBarAddTool2 toolbar id label bitmap nullBitmap -                            (if isCheckable then wxITEM_CHECK else wxITEM_NORMAL)-                            "" ""-       let t = ToolBarItem (downcastToolBar toolbar) id isCheckable-       set t props-       toolBarRealize toolbar-       return t---- | Add an arbitrary control to a toolbar (typically a 'ComboBox'). The control--- must be created with the toolbar as the parent.-toolControl :: ToolBar a -> Control b -> IO ()-toolControl toolbar control-  = do toolBarAddControl toolbar control-       return ()-   --{---------------------------------------------------------------------------------  Statusbar---------------------------------------------------------------------------------}--- | A field in a status bar.------ * Instances: 'Textual'--- -data StatusField  = SF (Var Int) (Var (StatusBar ())) (Var Int) (Var String)---- | The status width attribute determines the width of a status bar field.--- A negative width makes the field stretchable. The width than determines--- the amount of stretch in relation to other fields. The default--- status width is @-1@, ie. all fields stretch evenly.------ Here is an example of a status bar--- with three fields, where the last field is 50 pixels wide, the first takes--- 66% of the remaining space and the second field 33%.------ > field1 <- statusField [statusWidth := -2]--- > field2 <- statusField [text := "hi"]--- > field3 <- statusField [statusWidth := 50]--- > set frame [statusBar := [field1,field2,field3]] ----statusWidth :: Attr StatusField Int-statusWidth -  = newAttr "statusWidth" getter setter-  where-    getter (SF vwidth _ _ _)-      = varGet vwidth--    setter (SF vwidth _ _ _) w-      = varSet vwidth w---- | Create a status field.-statusField :: [Prop StatusField] -> IO StatusField-statusField props-  = do vwidth<- varCreate (-1)-       vsbar <- varCreate objectNull-       vidx  <- varCreate (-1)-       vtext <- varCreate ""-       let sf = SF vwidth vsbar vidx vtext-       set sf props-       return sf---instance Textual StatusField where-  text-    = newAttr "text" get set-    where-      get (SF _ vsbar vidx vtext)-        = varGet vtext--      set (SF _ vsbar vidx vtext)  text-        = do varSet vtext text-             idx <- varGet vidx-             if (idx >= 0)-              then do sbar <- varGet vsbar-                      statusBarSetStatusText sbar text idx-              else return ()----{-# DEPRECATED statusbar "Use statusBar instead" #-}--- | /Deprecated/: use 'statusBar'. -statusbar :: WriteAttr (Frame a) [StatusField]-statusbar-  = statusBar---- | Specify the statusbar of a frame.-statusBar :: WriteAttr (Frame a) [StatusField]-statusBar-  = writeAttr "statusbar" set-  where-    set f fields-      = do ws <- mapM (\field -> get field statusWidth) fields-           sb <- statusBarCreateFields f ws-           mapM_ (setsb sb) (zip [0..] fields )--    setsb sb (idx,SF _ vsbar vidx vtext)-      = do varSet vsbar sb-           varSet vidx idx-           text <- varGet vtext-           statusBarSetStatusText sb text idx -- initialize+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+--------------------------------------------------------------------------------
+{-|	Module      :  Menu
+	Copyright   :  (c) Daan Leijen 2003
+	               (c) Shelarcy (shelarcy@gmail.com) 2006
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Defines Menus, toolbars, and statusbars.
+    
+The function 'menuPane' is used to create a menu
+that can contain 'menuItem's. Menu items can contain event handlers
+using ('on' 'command'), but they can also be set, using the 'menu'
+function, on a frame or (mdi) window so that the menu command is handled
+in the context of the active window instead of the context of the
+entire application. 
+
+> do frame  <- frame    [text := "Demo"]
+>    file   <- menuPane [text := "&File"]
+>    mclose <- menuItem file [text := "&Close\tCtrl+C", help := "Close the document"] 
+>    set frame [menuBar          := [file] 
+>              ,on (menu mclose) := ...] 
+
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Menu
+    ( -- * Menu
+      -- ** Menu containers
+      MenuBar, Menu, menuBar, menuPopup, menuPane, menuHelp
+    , menuRes, menuBarLoadRes
+    -- ** Menu events
+    , menu, menuId
+      -- ** Menu items
+    , MenuItem, menuItem, menuQuit, menuAbout, menuItemEx
+    , menuItemOnCommandRes, menuLine, menuSub, menuRadioItem
+    -- * Tool bar
+    , ToolBar, toolBar, toolBarEx
+    , ToolBarItem, toolMenu, toolMenuFromBitmap, toolItem, toolControl, tool
+    -- * Status bar
+    , StatusField, statusBar, statusField, statusWidth
+    -- * Deprecated
+    , menuList, menubar, statusbar
+    ) where
+
+import Data.Char( toUpper )
+import Data.List( partition, intersperse )
+import System.IO.Unsafe (unsafePerformIO)
+import Foreign.Ptr( nullPtr )
+import Graphics.UI.WXCore hiding (Event)
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Events
+
+
+{--------------------------------------------------------------------------------
+  Menubar
+--------------------------------------------------------------------------------}
+{-# DEPRECATED menubar "Use menuBar instead" #-}
+-- | /Deprecated/: use 'menuBar'.
+menubar :: WriteAttr (Frame a) [Menu ()]
+menubar
+  = menuBar
+
+-- | Set the menu bar of a frame.
+menuBar :: WriteAttr (Frame a) [Menu ()]
+menuBar
+  = writeAttr "menubar" setter
+  where
+    setter frame menus
+      = do mb <- menuBarCreate wxMB_DOCKABLE
+           mapM_ (append mb) menus
+           frameSetMenuBar frame mb
+           -- set delayed menu handlers on the frame
+           mapM_ (evtHandlerSetAndResetMenuCommands frame) menus
+           -- work around menu bug in wxMac 2.5.1
+           vis <- windowIsShown frame
+           if (vis && wxToolkit == WxMac && (div wxVersion 100) >= 25)
+            then do windowHide frame
+                    windowShow frame
+                    return ()
+            else return ()
+
+    append mb menu
+      = do title <- menuGetTitle menu
+           menuSetTitle menu ""
+           menuBarAppend mb menu title
+
+-- | Retrieve a menu bar instance which has been constructed by loading
+--   a resource file for a given top level window.
+menuBarLoadRes :: Window a -> FilePath -> String -> IO (MenuBar ())
+menuBarLoadRes parent rc name =
+    do
+      res <- xmlResourceCreateFromFile rc wxXRC_USE_LOCALE
+      m   <- xmlResourceLoadMenuBar res parent name
+      return m
+
+-- | Show a popup menu for a certain window.
+menuPopup :: Menu b -> Point -> Window a -> IO ()
+menuPopup menu pt parent
+  = do windowPopupMenu parent menu pt
+       return ()
+
+{--------------------------------------------------------------------------------
+  Menu
+--------------------------------------------------------------------------------}
+{-# DEPRECATED menuList "Use menuPane instead" #-}
+-- | /Deprecated/: use 'menuPane'.
+menuList :: [Prop (Menu ())] -> IO (Menu ())
+menuList 
+  = menuPane 
+
+-- | Create a new menu with a certain title (corresponds with 'text' attribute).
+--
+-- * Instances: 'Textual'
+--
+menuPane :: [Prop (Menu ())] -> IO (Menu ())
+menuPane props
+  = do m <- menuCreate "" wxMENU_TEAROFF
+       set m props
+       return m
+
+-- | Append a /help/ menu item (@"&Help"@). On some platforms,
+-- the /help/ menu is handled specially
+menuHelp :: [Prop (Menu ())] -> IO (Menu ())
+menuHelp props
+  = menuPane ([text := "&Help"] ++ props)
+
+-- | Complete the construction of a menu which has been loaded
+--   from a resource file.
+-- | Get a menu by name from a menu loaded from a resource file, 
+--   given the frame which owns the menu. You
+--   can directly set properties on the item as part of the call, which
+--   enables simple connection of event handlers (e.g. on command).
+menuRes :: Window a -> String -> [Prop (Menu ())] -> IO (Menu ())
+menuRes parent menu_name props =
+    do
+      menu <- xmlResourceGetMenu parent menu_name
+      set menu props
+      return menu
+
+instance Textual (Menu a) where
+  text
+    = newAttr "text" menuGetTitle menuSetTitle
+
+{--------------------------------------------------------------------------------
+  Menu items
+--------------------------------------------------------------------------------}
+-- | Create a submenu item.
+menuSub :: Menu b -> Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuSub parent menu props
+  = do id <- idCreate
+       label <- case (findProperty text "" props) of 
+                  Just (txt,_) -> return txt
+                  Nothing      -> do title <- menuGetTitle menu
+                                     if (null title) 
+                                      then return "<empty>"
+                                      else return title                  
+       menuSetTitle menu ""           -- remove title on submenus
+       menuAppendSub parent id label menu ""
+       menuPropagateEvtHandlers menu  -- move the evtHandlers to the parent
+       item <- menuFindItem parent id
+       set item props
+       return item
+
+-- | Add a menu seperator.
+menuLine :: Menu a -> IO ()
+menuLine menu
+  = menuAppendSeparator menu
+
+
+-- | Append a menu item. The label can contain
+-- menu accellerators by using an ampersand. It can also contain keyboard accellerators
+-- after a tab (@'\\t'@) character.
+--
+-- > menuItem menu [text := "&Open\tCtrl+O", help := "Opens an existing document"] 
+--
+-- You can create a checkable menu item by setting 'checkable' to 'True' in the
+-- properties of a menu item.
+--
+-- Note: on GTK, it is required to set the 'text' attribute immediately at creation time.
+--
+-- * Events: 'menu', 'menuId'
+--
+-- * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.
+--
+menuItem :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuItem menu props
+  = do let kind = case (findProperty checkable False props) of
+                    Just (True,_) -> wxITEM_CHECK
+                    _             -> wxITEM_NORMAL
+       menuItemKind menu kind props                     
+
+-- | Append a radio menu item. These items are 'checkable' by default.
+-- A sequence of radio menu items form automatically a group. 
+-- A different kind of menu item, like  a 'menuLine', terminates the group.
+-- Note: one sometimes has to set the first selected radio item 
+-- specifically after setting the "menubar" property, or otherwise the
+-- radio item bullet is not displayed on windows.
+-- See 'menuItem' for other properties of menu radio items.
+menuRadioItem :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuRadioItem menu props
+  = menuItemKind menu wxITEM_RADIO ([checked := True] ++ props)
+
+menuItemKind menu kind props
+  = do id <- idCreate
+       let label = case (findProperty text "" props) of 
+                     Nothing      -> "<empty>"
+                     Just (txt,_) -> txt
+       menuItemEx menu id label kind props
+       
+
+
+-- | Append an /about/ menu item (@"&About..."@). On some platforms,
+-- the /about/ menu is handled specially.
+--
+-- * Events: 'menu', 'menuId'
+--
+-- * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.
+--
+menuAbout :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuAbout menu props
+  = menuItemId menu wxID_ABOUT "&About..." props
+
+-- | Append an /quit/ menu item (@"&Quit\tCtrl+Q"@). On some platforms,
+-- the /quit/ menu is handled specially
+--
+-- * Events: 'menu', 'menuId'
+--
+-- * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.
+--
+menuQuit :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuQuit menu props
+  = menuItemId menu wxID_EXIT "&Quit\tCtrl+Q" props
+
+-- | Append a menu item with a specific id and label.
+--
+-- * Events: 'menu', 'menuId'
+--
+-- * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.
+--
+menuItemId :: Menu a -> Id -> String -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuItemId menu id label props
+  = menuItemEx menu id label wxITEM_NORMAL props
+
+-- | Append a menu item with a specific id, label, and kind (like 'wxITEM_CHECK').
+--
+-- * Events: 'menu', 'menuId'
+--
+-- * Instances: 'Textual', 'Able', 'Help', 'Checkable', 'Identity', 'Commanding'.
+--
+menuItemEx :: Menu a -> Id -> String -> Int -> [Prop (MenuItem ())] -> IO (MenuItem ())
+menuItemEx menu id label kind props
+  = do if (kind == wxITEM_RADIO)
+        then menuAppendRadioItem menu id label ""
+        else menuAppend menu id label "" (kind == wxITEM_CHECK)
+       item <- menuFindItem menu id
+       set item props
+       return item
+
+instance Able (MenuItem a) where
+  enabled = newAttr "enabled" menuItemIsEnabled menuItemEnable
+
+instance Textual (MenuItem a) where
+  text
+    = reflectiveAttr "text" menuItemGetItemLabel menuItemSetItemLabel
+
+instance Help (MenuItem a) where
+  help  = newAttr "help" menuItemGetHelp menuItemSetHelp
+
+instance Checkable (MenuItem a) where
+  checkable = reflectiveAttr "checkable" menuItemIsCheckable (\m c -> menuItemSetCheckable m c)
+  checked   = newAttr "checked"   menuItemIsChecked menuItemCheck
+
+instance Identity (MenuItem a) where
+  identity  = newAttr "identity" menuItemGetId menuItemSetId
+
+{--------------------------------------------------------------------------------
+  Events
+--------------------------------------------------------------------------------}
+-- | React to menu events.
+menu :: MenuItem a -> Event (Window w) (IO ())
+menu item
+  = let id = unsafePerformIO (get item identity)
+    in  menuId id
+
+-- | React to a menu event based on identity.
+menuId :: Id -> Event (Window w) (IO ())
+menuId id
+  = newEvent "menu" (\w -> evtHandlerGetOnMenuCommand w id) (\w h -> evtHandlerOnMenuCommand w id h)
+              
+{--------------------------------------------------------------------------------
+  Menu commands:
+
+  Ok, we would like to set command handlers in two ways:
+  1) As an "on command" on the menu item itself. 
+  2) With an "on (menu xxx)" on a window. 
+
+  Unfortunately, wxWidgets does not support method (1) for menus that are
+  part of a menubar and assumes they are set on using (2) on the associated
+  frame. We can't tell whether a menu is part of a menubar or popup menu until
+  the user sets it. Thus we both set the event handlers always directly on the
+  top level menu (this is good enough for popup menus) and we maintain 
+  a list of menu item id's and associated event handler as client data on the
+  top level menu. When the menu is set as part of a menu bar, we install the
+  handlers on the associated frame.
+--------------------------------------------------------------------------------}
+instance Commanding (MenuItem a) where
+  command
+    = newEvent "command" menuItemGetOnCommand menuItemOnCommand
+
+menuItemGetOnCommand :: MenuItem a -> IO (IO ())
+menuItemGetOnCommand item 
+  = do id      <- get item identity
+       topmenu <- menuItemGetTopMenu item
+       evtHandlerGetOnMenuCommand topmenu id
+
+menuItemOnCommand :: MenuItem a -> IO () -> IO ()
+menuItemOnCommand item io
+  = do id      <- get item identity
+       topmenu <- menuItemGetTopMenu item
+       -- always set it on the menu itself (has only effect on popup menus)
+       evtHandlerOnMenuCommand topmenu id io
+       -- update the Haskell event handler list for delayed frame installation
+       menuUpdateEvtHandlers topmenu (insert id io)
+       -- and set it directly on the frame if already instantiated. 
+       frame   <- menuGetFrame topmenu
+       when (not (objectIsNull frame)) (evtHandlerOnMenuCommand frame id io)
+  where
+    insert key val []         = [(key,val)]
+    insert key val ((k,v):xs) | key == k  = (key,val):xs
+                              | otherwise = (k,v):insert key val xs
+
+-- | When setting event handlers on menu items which have been loaded from
+--   XRC resource files, properties cannot be used as the menu item
+--   instances are opaque to wxHaskell.
+--
+--   This function offers a convenient way to attach menu item event
+--   handlers, given the identity of the window which owns the menu containing
+--   the menu item, and the name of the menu item
+
+menuItemOnCommandRes :: Window a -> String -> IO () -> IO ()
+menuItemOnCommandRes win item_name handler =
+    do
+      res     <- xmlResourceGet
+      item_id <- xmlResourceGetXRCID res item_name
+      evtHandlerOnMenuCommand win item_id handler
+
+-- Propagate the (delayed) event handlers of a submenu to the parent menu.
+-- This is necessary for event handlers set on menu items in a submenu that
+-- was not yet assigned to a parent menu.
+menuPropagateEvtHandlers :: Menu a -> IO ()
+menuPropagateEvtHandlers menu
+  = do parent   <- menuGetTopMenu menu
+       handlers <- menuGetEvtHandlers menu
+       menuSetEvtHandlers menu []
+       menuSetEvtHandlers parent handlers
+
+-- Get associated frame of a menu in a menubar. Returns NULL for popup and sub menus.
+menuGetFrame :: Menu a -> IO (Frame ())
+menuGetFrame menu
+  = do menubar <- menuGetMenuBar menu
+       if (objectIsNull menubar) 
+        then return objectNull
+        else menuBarGetFrame menubar
+
+-- Get top level menu of a menu item (never null)
+menuItemGetTopMenu :: MenuItem a -> IO (Menu ())
+menuItemGetTopMenu item
+  = do menu <- menuItemGetMenu item
+       menuGetTopMenu menu
+
+-- Get the top level menu of a possible sub menu 
+menuGetTopMenu :: Menu a -> IO (Menu ())
+menuGetTopMenu menu
+  = do parent <- menuGetParent menu
+       if (objectIsNull parent)
+        then return (downcastMenu menu)
+        else menuGetTopMenu parent
+
+-- Set all menu event handlers on a certain window (EvtHandler)
+evtHandlerSetAndResetMenuCommands :: EvtHandler a -> Menu b -> IO ()
+evtHandlerSetAndResetMenuCommands evtHandler menu
+  = do handlers <- menuGetEvtHandlers menu
+       menuSetEvtHandlers menu []
+       mapM_ (\(id,io) -> evtHandlerOnMenuCommand evtHandler id io) handlers
+
+-- Update the menu event handler list.
+menuUpdateEvtHandlers menu f
+  = do hs <- menuGetEvtHandlers menu
+       menuSetEvtHandlers menu (f hs)
+
+menuGetEvtHandlers :: Menu a -> IO [(Id,IO ())]
+menuGetEvtHandlers menu 
+  = do mbHandlers <- unsafeEvtHandlerGetClientData menu
+       case mbHandlers of
+         Nothing -> return []
+         Just hs -> return hs
+
+menuSetEvtHandlers :: Menu a -> [(Id,IO ())] -> IO ()
+menuSetEvtHandlers menu hs
+  = evtHandlerSetClientData menu (return ()) hs 
+
+
+{--------------------------------------------------------------------------------
+  Toolbar
+--------------------------------------------------------------------------------}
+-- | Create a toolbar window with a divider and text labels.
+-- Normally, you can use 'toolMenu' to add tools in the toolbar
+-- that behave like normal menu items.
+--
+-- >  tbar   <- toolBar f []
+-- >  toolMenu tbar open  "Open"  "open.png"  []
+-- >  toolMenu tbar about "About" "about.png" []
+--
+toolBar :: Frame a -> [Prop (ToolBar ())] -> IO (ToolBar ())
+toolBar parent props
+  = toolBarEx parent True True props
+
+-- | Create a toolbar window. The second argument specifies whether text labels
+-- should be shown, and the third argument whether a divider line is present
+-- above the toolbar.
+toolBarEx :: Frame a -> Bool -> Bool -> [Prop (ToolBar ())] -> IO (ToolBar ())
+toolBarEx parent showText showDivider props
+  = do let style = ( wxTB_DOCKABLE .+. wxTB_FLAT
+                   .+. (if showText then wxTB_TEXT else 0)
+                   .+. (if showDivider then 0 else wxTB_NODIVIDER)
+                   )
+       t <- toolBarCreate parent idAny rectNull style
+       frameSetToolBar parent t
+       {-
+       t <- frameCreateToolBar parent style 
+       -}
+       set t props
+       return t
+
+-- | A tool in a toolbar.
+--
+-- * Events: 'tool'
+--
+-- * Instances: 'Able', 'Help', 'Tipped', 'Checkable', 'Identity', 'Commanding'.
+--
+data ToolBarItem  = ToolBarItem (ToolBar ()) Id Bool
+
+instance Able ToolBarItem  where
+  enabled 
+    = newAttr "enabled" getter setter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = toolBarGetToolEnabled toolbar id
+
+      setter (ToolBarItem toolbar id isToggle) enable
+        = toolBarEnableTool toolbar id enable
+         
+
+instance Tipped ToolBarItem where
+  tooltip 
+    = newAttr "tooltip" getter setter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = toolBarGetToolShortHelp toolbar id
+
+      setter (ToolBarItem toolbar id isToggle) txt
+        = toolBarSetToolShortHelp toolbar id txt
+         
+instance Help ToolBarItem  where
+  help  
+    = newAttr "help" getter setter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = toolBarGetToolLongHelp toolbar id
+
+      setter (ToolBarItem toolbar id isToggle) txt
+        = toolBarSetToolLongHelp toolbar id txt
+         
+
+instance Checkable ToolBarItem where
+  checkable 
+    = readAttr "checkable" getter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = return isToggle
+
+  checked   
+    = newAttr "checked"  getter setter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = toolBarGetToolState toolbar id
+
+      setter (ToolBarItem toolbar id isToggle) toggle
+        = toolBarToggleTool toolbar id toggle
+         
+
+instance Identity ToolBarItem where
+  identity  
+    = readAttr "identity" getter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = return id
+
+
+instance Commanding ToolBarItem where
+  command
+    = newEvent "command" getter setter
+    where
+      getter (ToolBarItem toolbar id isToggle)
+        = evtHandlerGetOnMenuCommand toolbar id
+
+      setter (ToolBarItem toolbar id isToggle) io
+        = evtHandlerOnMenuCommand toolbar id io
+
+-- | React on tool event. (normally handled by 'menu' though, so only use this
+-- for orphan toolbar items).
+tool :: ToolBarItem -> Event (Window w) (IO ())
+tool (ToolBarItem toolbar id isToggle)
+  = newEvent "tool" getter setter
+  where
+    getter w
+      = evtHandlerGetOnMenuCommand w id
+    setter w io
+      = evtHandlerOnMenuCommand w id io
+
+-- | Create a tool bar item based on a menu. Takes a a relevant menu
+-- item, a label and an image file (bmp, png, gif, ico, etc.) as arguments. The image
+-- file is normally 16x15 pixels.
+-- The toolbar item will fire the relevant menu items just as if the menu has been selected.
+-- Checkable menus will give a checkable toolbar item. Beware though that checkable tools
+-- normally require a specific @on command@ handler to keep them synchronised with the 
+-- corresponding menu item.
+toolMenu :: ToolBar a -> MenuItem a -> String -> FilePath -> [Prop ToolBarItem] -> IO ToolBarItem
+toolMenu toolbar menuitem label bitmapPath props
+  = withBitmapFromFile bitmapPath $ \bitmap ->
+      toolMenuFromBitmap toolbar menuitem label bitmap props
+
+-- | This is a generalized version of 'toolMenu' function. You can specify 'Bitmap' that is
+-- loaded from any other place instead of using 'FilePath' directly.
+toolMenuFromBitmap :: ToolBar a -> MenuItem a -> String -> Bitmap b -> [Prop ToolBarItem] -> IO ToolBarItem
+toolMenuFromBitmap toolbar menuitem label bitmap props
+  = do isToggle <- get menuitem checkable
+       id       <- get menuitem identity
+       lhelp    <- get menuitem help
+       shelp    <- get menuitem help
+       toolBarAddTool2 toolbar id label bitmap nullBitmap 
+                       (if isToggle then wxITEM_CHECK else wxITEM_NORMAL)
+                       shelp lhelp
+       let t = ToolBarItem (downcastToolBar toolbar) id isToggle
+       set t props
+       toolBarRealize toolbar
+       return t
+
+-- | Create an /orphan/ toolbar item that is unassociated with a menu. Takes a 
+-- label, a flag that is 'True' when the item is 'checkable' and a path to an image
+-- (bmp, png, gif, ico, etc.) as arguments.
+toolItem :: ToolBar a -> String -> Bool -> FilePath -> [Prop ToolBarItem] -> IO ToolBarItem
+toolItem toolbar label isCheckable bitmapPath props
+  = withBitmapFromFile bitmapPath $ \bitmap ->
+    do id <- idCreate
+       toolBarAddTool2 toolbar id label bitmap nullBitmap 
+                            (if isCheckable then wxITEM_CHECK else wxITEM_NORMAL)
+                            "" ""
+       let t = ToolBarItem (downcastToolBar toolbar) id isCheckable
+       set t props
+       toolBarRealize toolbar
+       return t
+
+-- | Add an arbitrary control to a toolbar (typically a 'ComboBox'). The control
+-- must be created with the toolbar as the parent.
+toolControl :: ToolBar a -> Control b -> IO ()
+toolControl toolbar control
+  = do toolBarAddControl toolbar control
+       return ()
+   
+
+{--------------------------------------------------------------------------------
+  Statusbar
+--------------------------------------------------------------------------------}
+-- | A field in a status bar.
+--
+-- * Instances: 'Textual'
+-- 
+data StatusField  = SF (Var Int) (Var (StatusBar ())) (Var Int) (Var String)
+
+-- | The status width attribute determines the width of a status bar field.
+-- A negative width makes the field stretchable. The width than determines
+-- the amount of stretch in relation to other fields. The default
+-- status width is @-1@, ie. all fields stretch evenly.
+--
+-- Here is an example of a status bar
+-- with three fields, where the last field is 50 pixels wide, the first takes
+-- 66% of the remaining space and the second field 33%.
+--
+-- > field1 <- statusField [statusWidth := -2]
+-- > field2 <- statusField [text := "hi"]
+-- > field3 <- statusField [statusWidth := 50]
+-- > set frame [statusBar := [field1,field2,field3]] 
+--
+statusWidth :: Attr StatusField Int
+statusWidth 
+  = newAttr "statusWidth" getter setter
+  where
+    getter (SF vwidth _ _ _)
+      = varGet vwidth
+
+    setter (SF vwidth _ _ _) w
+      = varSet vwidth w
+
+-- | Create a status field.
+statusField :: [Prop StatusField] -> IO StatusField
+statusField props
+  = do vwidth<- varCreate (-1)
+       vsbar <- varCreate objectNull
+       vidx  <- varCreate (-1)
+       vtext <- varCreate ""
+       let sf = SF vwidth vsbar vidx vtext
+       set sf props
+       return sf
+
+
+instance Textual StatusField where
+  text
+    = newAttr "text" get set
+    where
+      get (SF _ vsbar vidx vtext)
+        = varGet vtext
+
+      set (SF _ vsbar vidx vtext)  text
+        = do varSet vtext text
+             idx <- varGet vidx
+             if (idx >= 0)
+              then do sbar <- varGet vsbar
+                      statusBarSetStatusText sbar text idx
+              else return ()
+
+
+
+{-# DEPRECATED statusbar "Use statusBar instead" #-}
+-- | /Deprecated/: use 'statusBar'. 
+statusbar :: WriteAttr (Frame a) [StatusField]
+statusbar
+  = statusBar
+
+-- | Specify the statusbar of a frame.
+statusBar :: WriteAttr (Frame a) [StatusField]
+statusBar
+  = writeAttr "statusbar" set
+  where
+    set f fields
+      = do ws <- mapM (\field -> get field statusWidth) fields
+           sb <- statusBarCreateFields f ws
+           mapM_ (setsb sb) (zip [0..] fields )
+
+    setsb sb (idx,SF _ vsbar vidx vtext)
+      = do varSet vsbar sb
+           varSet vidx idx
+           text <- varGet vtext
+           statusBarSetStatusText sb text idx -- initialize
src/Graphics/UI/WX/Timer.hs view
@@ -1,74 +1,74 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}----------------------------------------------------------------------------------{-|	Module      :  Timer-	Copyright   :  (c) Daan Leijen 2003-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Support for milli-second timers.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Timer-            ( Timer, timer, interval-            ) where--import Graphics.UI.WXCore.WxcClasses hiding (Timer)-import Graphics.UI.WXCore.Events  --import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Events--{------------------------------------------------------------------------------------------------------------------------------------------}--- | A timer generates a 'command' event on a specified milli-second 'interval'.------ * Attributes: 'interval'------ * Instances: 'Able', 'Commanding'----type Timer  = TimerEx ()---- | Create a new timer with a 1 second interval. The timer is automatically discarded--- when the parent is deleted.-timer :: Window a -> [Prop Timer] -> IO Timer-timer parent props-  = do t <- windowTimerCreate parent-       timerStart t 1000 False-       set t props-       return t---- | The milli-second interval of the timer.-interval :: Attr Timer Int-interval-  = newAttr "timer-interval"-      (\t   -> timerGetInterval t)-      (\t i -> do runs <- timerIsRuning t-                  if (runs)-                   then do timerStop t-                           isone <- timerIsOneShot t-                           timerStart t i isone-                           return ()-                   else do timerStart t i True-                           timerStop t)--instance Able Timer where-  enabled-    = newAttr "enabled"-        (\t      -> timerIsRuning t)-        (\t able -> do runs <- timerIsRuning t-                       when (runs /= able)-                        (if able then do i <- get t interval-                                         timerStart t i False-                                         return ()-                                 else do timerStop t))--instance Commanding Timer where-  command+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+--------------------------------------------------------------------------------
+{-|	Module      :  Timer
+	Copyright   :  (c) Daan Leijen 2003
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Support for milli-second timers.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Timer
+            ( Timer, timer, interval
+            ) where
+
+import Graphics.UI.WXCore.WxcClasses hiding (Timer)
+import Graphics.UI.WXCore.Events  
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Events
+
+{--------------------------------------------------------------------
+
+--------------------------------------------------------------------}
+-- | A timer generates a 'command' event on a specified milli-second 'interval'.
+--
+-- * Attributes: 'interval'
+--
+-- * Instances: 'Able', 'Commanding'
+--
+type Timer  = TimerEx ()
+
+-- | Create a new timer with a 1 second interval. The timer is automatically discarded
+-- when the parent is deleted.
+timer :: Window a -> [Prop Timer] -> IO Timer
+timer parent props
+  = do t <- windowTimerCreate parent
+       timerStart t 1000 False
+       set t props
+       return t
+
+-- | The milli-second interval of the timer.
+interval :: Attr Timer Int
+interval
+  = newAttr "timer-interval"
+      (\t   -> timerGetInterval t)
+      (\t i -> do runs <- timerIsRuning t
+                  if (runs)
+                   then do timerStop t
+                           isone <- timerIsOneShot t
+                           timerStart t i isone
+                           return ()
+                   else do timerStart t i True
+                           timerStop t)
+
+instance Able Timer where
+  enabled
+    = newAttr "enabled"
+        (\t      -> timerIsRuning t)
+        (\t able -> do runs <- timerIsRuning t
+                       when (runs /= able)
+                        (if able then do i <- get t interval
+                                         timerStart t i False
+                                         return ()
+                                 else do timerStop t))
+
+instance Commanding Timer where
+  command
     = newEvent "command" timerGetOnCommand timerOnCommand
src/Graphics/UI/WX/Types.hs view
@@ -1,144 +1,144 @@-{-# LANGUAGE ScopedTypeVariables #-}----------------------------------------------------------------------------------{-|	Module      :  Types-	Copyright   :  (c) Daan Leijen 2003-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Basic types.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Types-    (--    -- * Basic Types-      Orientation(..)--    -- ** Objects-    , ( # ), feed, feed2-    , Object, objectNull, objectIsNull, objectCast, objectIsManaged-    , objectDelete-    ---    , Managed, managedNull, managedIsNull, managedCast, createManaged, withManaged, managedTouch--    -- ** Identifiers-    , Id, idAny, idCreate--    -- ** Mutable variables-    , Var, varCreate, varGet, varSet, varUpdate, varSwap--    -- ** Bits-    , BitMask(..), mask, (.+.), (.-.), bits, bitsSet--    -- ** Booleans-    , toCBool, fromCBool--    -- ** Misc.-    , Style-    , EventId-    , TreeItem--    -- * Graphical types--    -- ** Colors-    , Color, rgb, colorRGB, colorRed, colorGreen, colorBlue-    , black, darkgrey, dimgrey, mediumgrey, grey, lightgrey, white-    , red, green, blue-    , cyan, magenta, yellow-    -- *** System colors-    , SystemColor(..), colorSystem--    -- ** Font-    , FontStyle(..), FontFamily(..), FontShape(..), FontWeight(..)-    , fontDefault, fontSwiss, fontSmall, fontItalic, fontFixed-    -    -- ** Brush-    , BrushStyle(..), BrushKind(..)-    , HatchStyle(..)-    , brushDefault-    , brushTransparent-   -    -- ** Pen-    , PenStyle(..), PenKind(..), CapStyle(..), JoinStyle(..), DashStyle(..)-    , penDefault, penColored, penTransparent-   -    -- * Geometrical types--    -- ** Points-    , Point, Point2(Point,pointX,pointY), point, pt, pointFromVec, pointFromSize, pointZero, pointNull-    , pointMove, pointMoveBySize, pointAdd, pointSub, pointScale--    -- ** Sizes-    , Size, Size2D(Size,sizeW,sizeH), sz, sizeFromPoint, sizeFromVec, sizeZero, sizeNull, sizeEncloses-    , sizeMin, sizeMax--    -- ** Vectors-    , Vector, Vector2(Vector,vecX,vecY), vector, vec, vecFromPoint, vecFromSize, vecZero, vecNull-    , vecNegate, vecOrtogonal, vecAdd, vecSub, vecScale, vecBetween, vecLength-    , vecLengthDouble--    -- ** Rectangles-    , Rect, Rect2D(Rect,rectLeft,rectTop,rectWidth,rectHeight)-    , rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight, rectBottom, rectRight-    , rect, rectBetween, rectFromSize, rectZero, rectNull, rectSize, rectIsEmpty-    , rectContains, rectMoveTo, rectFromPoint, rectCentralPoint, rectCentralRect, rectStretchTo-    , rectCentralPointDouble, rectCentralRectDouble-    , rectMove, rectOverlaps, rectsDiff, rectUnion, rectOverlap, rectUnions--    -- * IO Control-    , unitIO, bracket, bracket_, finally, finalize, when--    ) where--import Graphics.UI.WXCore.Types-import Graphics.UI.WXCore.Draw-import Graphics.UI.WXCore.Events( Orientation(..) )---- | Inverse application, i.e. @feed x f@ = @f x@.-feed :: a -> (a -> b) -> b-feed x f-  = f x---- | Composed Inverse application, i.e. @feed2 x y f@ = @f x y@.-feed2 :: a -> b -> (a -> b -> c) -> c-feed2 x y f-  = f x y---- | Data types that can be represented through a bit mask. Only the @assocBitMask@ method--- is required for a new instance.-class Eq b => BitMask b where-  -- | Give the association between the constructors and the bits. If a constructor-  -- corresponds to no bits set, it should come as the last element.-  assocBitMask :: [(b,Int)]--  -- | Convert to a bitmask-  toBitMask    :: b -> Int-  -- | Convert from a bitmask-  fromBitMask  :: Int -> b-  -- | Set the correct bits corresponding to a constructor in a mask.-  setBitMask :: b -> Int -> Int--  toBitMask x-    = case lookup x assocBitMask of-        Just m  -> m-        Nothing -> 0--  fromBitMask i-    = walk assocBitMask-    where-      walk []         = error "Graphics.UI.WX.Types.fromBitMask: empty list"-      walk [(x,0)]    = x-      walk ((x,m):xs) | bitsSet m i = x-                      | otherwise   = walk xs--  setBitMask x i-    = i .-. (bits (map snd (assocBitMask::[(b,Int)]))) .+. toBitMask x----- | Create a bitmask from a list of types.-mask :: BitMask b => [b] -> Int-mask xs+{-# LANGUAGE ScopedTypeVariables #-}
+--------------------------------------------------------------------------------
+{-|	Module      :  Types
+	Copyright   :  (c) Daan Leijen 2003
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Basic types.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Types
+    (
+
+    -- * Basic Types
+      Orientation(..)
+
+    -- ** Objects
+    , ( # ), feed, feed2
+    , Object, objectNull, objectIsNull, objectCast, objectIsManaged
+    , objectDelete
+    
+--    , Managed, managedNull, managedIsNull, managedCast, createManaged, withManaged, managedTouch
+
+    -- ** Identifiers
+    , Id, idAny, idCreate
+
+    -- ** Mutable variables
+    , Var, varCreate, varGet, varSet, varUpdate, varSwap
+
+    -- ** Bits
+    , BitMask(..), mask, (.+.), (.-.), bits, bitsSet
+
+    -- ** Booleans
+    , toCBool, fromCBool
+
+    -- ** Misc.
+    , Style
+    , EventId
+    , TreeItem
+
+    -- * Graphical types
+
+    -- ** Colors
+    , Color, rgb, colorRGB, colorRed, colorGreen, colorBlue
+    , black, darkgrey, dimgrey, mediumgrey, grey, lightgrey, white
+    , red, green, blue
+    , cyan, magenta, yellow
+    -- *** System colors
+    , SystemColor(..), colorSystem
+
+    -- ** Font
+    , FontStyle(..), FontFamily(..), FontShape(..), FontWeight(..)
+    , fontDefault, fontSwiss, fontSmall, fontItalic, fontFixed
+    
+    -- ** Brush
+    , BrushStyle(..), BrushKind(..)
+    , HatchStyle(..)
+    , brushDefault
+    , brushTransparent
+   
+    -- ** Pen
+    , PenStyle(..), PenKind(..), CapStyle(..), JoinStyle(..), DashStyle(..)
+    , penDefault, penColored, penTransparent
+   
+    -- * Geometrical types
+
+    -- ** Points
+    , Point, Point2(Point,pointX,pointY), point, pt, pointFromVec, pointFromSize, pointZero, pointNull
+    , pointMove, pointMoveBySize, pointAdd, pointSub, pointScale
+
+    -- ** Sizes
+    , Size, Size2D(Size,sizeW,sizeH), sz, sizeFromPoint, sizeFromVec, sizeZero, sizeNull, sizeEncloses
+    , sizeMin, sizeMax
+
+    -- ** Vectors
+    , Vector, Vector2(Vector,vecX,vecY), vector, vec, vecFromPoint, vecFromSize, vecZero, vecNull
+    , vecNegate, vecOrtogonal, vecAdd, vecSub, vecScale, vecBetween, vecLength
+    , vecLengthDouble
+
+    -- ** Rectangles
+    , Rect, Rect2D(Rect,rectLeft,rectTop,rectWidth,rectHeight)
+    , rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight, rectBottom, rectRight
+    , rect, rectBetween, rectFromSize, rectZero, rectNull, rectSize, rectIsEmpty
+    , rectContains, rectMoveTo, rectFromPoint, rectCentralPoint, rectCentralRect, rectStretchTo
+    , rectCentralPointDouble, rectCentralRectDouble
+    , rectMove, rectOverlaps, rectsDiff, rectUnion, rectOverlap, rectUnions
+
+    -- * IO Control
+    , unitIO, bracket, bracket_, finally, finalize, when
+
+    ) where
+
+import Graphics.UI.WXCore.Types
+import Graphics.UI.WXCore.Draw
+import Graphics.UI.WXCore.Events( Orientation(..) )
+
+-- | Inverse application, i.e. @feed x f@ = @f x@.
+feed :: a -> (a -> b) -> b
+feed x f
+  = f x
+
+-- | Composed Inverse application, i.e. @feed2 x y f@ = @f x y@.
+feed2 :: a -> b -> (a -> b -> c) -> c
+feed2 x y f
+  = f x y
+
+-- | Data types that can be represented through a bit mask. Only the @assocBitMask@ method
+-- is required for a new instance.
+class Eq b => BitMask b where
+  -- | Give the association between the constructors and the bits. If a constructor
+  -- corresponds to no bits set, it should come as the last element.
+  assocBitMask :: [(b,Int)]
+
+  -- | Convert to a bitmask
+  toBitMask    :: b -> Int
+  -- | Convert from a bitmask
+  fromBitMask  :: Int -> b
+  -- | Set the correct bits corresponding to a constructor in a mask.
+  setBitMask :: b -> Int -> Int
+
+  toBitMask x
+    = case lookup x assocBitMask of
+        Just m  -> m
+        Nothing -> 0
+
+  fromBitMask i
+    = walk assocBitMask
+    where
+      walk []         = error "Graphics.UI.WX.Types.fromBitMask: empty list"
+      walk [(x,0)]    = x
+      walk ((x,m):xs) | bitsSet m i = x
+                      | otherwise   = walk xs
+
+  setBitMask x i
+    = i .-. (bits (map snd (assocBitMask::[(b,Int)]))) .+. toBitMask x
+
+
+-- | Create a bitmask from a list of types.
+mask :: BitMask b => [b] -> Int
+mask xs
   = foldr (.+.) 0 (map toBitMask xs)
src/Graphics/UI/WX/Variable.hs view
@@ -1,33 +1,33 @@----------------------------------------------------------------------------------{-|	Module      :  Variable-	Copyright   :  (c) Daan Leijen 2003-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Mutable variables.--}----------------------------------------------------------------------------------module Graphics.UI.WX.Variable-            ( variable-            ) where--import Control.Concurrent.STM.TVar-import Graphics.UI.WX.Types( Var, varGet, varSet, varCreate, varUpdate )-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Classes--{------------------------------------------------------------------------------------------------------------------------------------------}-instance Valued TVar where-  value = makeAttr "value" varGet varSet varUpdate---- | Create a mutable variable. Change the value using the |value| attribute.-variable :: [Prop (Var a)] -> IO (Var a)-variable props-  = do v <- varCreate (error "Graphics.UI.WX.Variable: uninitialized variable, use the 'value' attribute at creation")-       set v props-       return v+--------------------------------------------------------------------------------
+{-|	Module      :  Variable
+	Copyright   :  (c) Daan Leijen 2003
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Mutable variables.
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Variable
+            ( variable
+            ) where
+
+import Control.Concurrent.STM.TVar
+import Graphics.UI.WX.Types( Var, varGet, varSet, varCreate, varUpdate )
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Classes
+
+{--------------------------------------------------------------------
+
+--------------------------------------------------------------------}
+instance Valued TVar where
+  value = makeAttr "value" varGet varSet varUpdate
+
+-- | Create a mutable variable. Change the value using the |value| attribute.
+variable :: [Prop (Var a)] -> IO (Var a)
+variable props
+  = do v <- varCreate (error "Graphics.UI.WX.Variable: uninitialized variable, use the 'value' attribute at creation")
+       set v props
+       return v
src/Graphics/UI/WX/Window.hs view
@@ -1,439 +1,439 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}----------------------------------------------------------------------------------{-|	Module      :  Window-	Copyright   :  (c) Daan Leijen 2003-	License     :  wxWindows--	Maintainer  :  wxhaskell-devel@lists.sourceforge.net-	Stability   :  provisional-	Portability :  portable--Exports default instances for generic windows.--* Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible',-             'Child', 'Sized', 'Parent', 'Help', 'Bordered',-             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.             --}----------------------------------------------------------------------------------module Graphics.UI.WX.Window-        ( -- * Window-          Window, window, refit, refitMinimal, rootParent, frameParent, tabTraversal      -          -- * ScrolledWindow-        , ScrolledWindow, scrolledWindow, scrollRate-          -- * Internal-        , initialWindow, initialContainer-        , initialIdentity, initialStyle, initialText-        , initialFullRepaintOnResize, initialClipChildren-        ) where--import Graphics.UI.WXCore--import Graphics.UI.WX.Types-import Graphics.UI.WX.Attributes-import Graphics.UI.WX.Layout-import Graphics.UI.WX.Classes-import Graphics.UI.WX.Events---{---------------------------------------------------------------------------------  ScrolledWindow---------------------------------------------------------------------------------}--- | A scrollable window. Use 'virtualSize' and 'scrollRate' to set the scrollbar--- behaviour.------ * Attributes: 'scrollRate'------ * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', ---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.----scrolledWindow :: Window a -> [Prop (ScrolledWindow ())] -> IO (ScrolledWindow ())-scrolledWindow parent props-  = feed2 props 0 $-    initialContainer $ \id rect -> \props style ->-    do sw <- scrolledWindowCreate parent id rect style-       set sw props-       return sw----- | The horizontal and vertical scroll rate of scrolled window. Use @0@ to disable --- scrolling in that direction.-scrollRate :: Attr (ScrolledWindow a) Size-scrollRate-  = newAttr "scrollRate" getter setter-  where-    getter sw-      = do p <- scrolledWindowGetScrollPixelsPerUnit sw-           return (sizeFromPoint p)-     -    setter sw size-      = scrolledWindowSetScrollRate sw (sizeW size) (sizeH size)---{---------------------------------------------------------------------------------  Plain window---------------------------------------------------------------------------------}--- | Create a plain window. Can be used to define custom controls for example.------ * Attributes: 'rootParent', 'frameParent', 'tabTraversal'------ * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', ---             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.-window :: Window a -> [Prop (Window ())] -> IO (Window ())-window parent props-  = feed2 props 0 $-    initialWindow $ \id rect -> \props flags ->-    do w <- windowCreate parent id rect flags-       set w props-       return w---{---------------------------------------------------------------------------------  Properties---------------------------------------------------------------------------------}--- | Helper function that retrieves initial window settings, including--- |identity|, |style|, and |area| (or |position| and |outerSize|).-initialWindow :: (Id -> Rect -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a-initialWindow cont -  = initialIdentity $ \id ->-    initialArea     $ \rect ->-    initialStyle    $ -    initialBorder   $-    cont id rect ---- | Helper function that retrieves initial window settings, including |clipChildren|--- and |fullRepaintOnResize|.-initialContainer :: (Id -> Rect -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a-initialContainer cont-  = initialWindow $ \id rect ->-    initialFullRepaintOnResize $ -    initialClipChildren        $ -    cont id rect ---instance Able (Window a) where-  enabled-    = newAttr "enabled" windowIsEnabled setter-    where-      setter w enable-        | enable    = unitIO $ windowEnable w-        | otherwise = unitIO $ windowDisable w---instance Textual (Window a) where-  text-    = reflectiveAttr "text" getter setter-    where-      getter w-        = fst (getset w)-      setter w x-        = snd (getset w) x--      getset w-        = ifInstanceOf w classComboBox-            (\cb -> (comboBoxGetValue cb, \s -> do comboBoxClear cb; comboBoxAppend cb s)) $-          ifInstanceOf w classTextCtrl-            (\tc -> (textCtrlGetValue tc, \s -> do textCtrlChangeValue tc s)) $-            (windowGetLabel w,windowSetLabel w)--  appendText w s-    = ifInstanceOf w classComboBox-        (\cb -> comboBoxAppend cb s) $-      ifInstanceOf w classTextCtrl-        (\tc -> textCtrlAppendText tc s)-        (set w [text :~ (++s)])----- | Retrieve the initial title from the |text| attribute.-initialText :: Textual w => (String -> [Prop w] -> a) -> [Prop w] -> a-initialText cont props -  = withProperty text "" cont props---instance Dimensions (Window a) where-  outerSize-    = newAttr "size" windowGetSize setSize-    where-      setSize w sz-        = windowSetSize w (rect (pt (-1) (-1)) sz) wxSIZE_USE_EXISTING--  area-    = newAttr "area" windowGetRect setArea-    where-      setArea w rect-        = windowSetSize w rect wxSIZE_USE_EXISTING--  bestSize-    = readAttr "bestSize" windowGetEffectiveMinSize--  position-    = newAttr "position" windowGetPosition windowMove--  clientSize-    = newAttr "clientSize" windowGetClientSize windowSetClientSize--  virtualSize-    = newAttr "virtualSize" windowGetVirtualSize windowSetVirtualSize---instance Sized (Window a) where-  size  = outerSize---- | Retrieve the initial creation area from the |area|, or the |position| and--- |outerSize| properties.-initialArea :: Dimensions w => (Rect -> [Prop w] -> a) -> [Prop w] -> a-initialArea cont props-  = case findProperty area rectNull props of-      Just (rect,props') -> cont rect props'-      Nothing -        -> case findProperty position pointNull props of-             Just (p,props') -> case findProperty outerSize sizeNull props of-                                  Just (sz,props'') -> cont (rect p sz) props''-                                  Nothing           -> cont (rect p sizeNull) props'-             Nothing         -> case findProperty outerSize sizeNull props of-                                  Just (sz,props')  -> cont (rect pointNull sz) props'-                                  Nothing           -> cont rectNull props----instance Colored (Window a) where-  bgcolor-    = newAttr "bgcolor" windowGetBackgroundColour (\w x -> do{ windowSetBackgroundColour w x; return ()})--  color-    = newAttr "color" windowGetForegroundColour (\w x -> do windowSetForegroundColour w x; return ())---instance Literate (Window a) where-  font-    = newAttr "font" getter setter-    where-      getter w-        = ifInstanceOf w classTextCtrl-           (\textCtrl -> bracket (textCtrlGetDefaultStyle textCtrl)-                                 (textAttrDelete)-                                 (\attr -> do hasFont <- textAttrHasFont attr-                                              if (hasFont) -                                                then getFont (textAttrGetFont attr) -                                                else getFont (windowGetFont w)))-           (getFont (windowGetFont w))-        where-          getFont io-            = bracket io fontDelete fontGetFontStyle --      setter w info-        = ifInstanceOf w classTextCtrl-           (\textCtrl -> bracket (textAttrCreateDefault)-                                 (textAttrDelete)-                                 (\attr -> withFontStyle info $ \fnt ->-                                           do textAttrSetFont attr fnt-                                              textCtrlSetDefaultStyle textCtrl attr-                                              return ()))-           (withFontStyle info $ \fnt ->-            do windowSetFont w fnt-               return ())--  textColor-    = newAttr "textcolor" getter setter-    where-      getter w-        = ifInstanceOf w classTextCtrl-           (\textCtrl -> bracket (textCtrlGetDefaultStyle textCtrl)-                                 (textAttrDelete)-                                 (\attr -> do hasColor <- textAttrHasTextColour attr-                                              if (hasColor) then textAttrGetTextColour attr-                                                            else get w color))-           (get w color)--      setter w c-        = ifInstanceOf w classTextCtrl-           (\textCtrl -> bracket (textAttrCreateDefault)-                                 (textAttrDelete)-                                 (\attr -> do textAttrSetTextColour attr c-                                              textCtrlSetDefaultStyle textCtrl attr-                                              return ()))-           (set w [color := c])--  textBgcolor-    = newAttr "textbgcolor" getter setter-    where-      getter w-        = ifInstanceOf w classTextCtrl-           (\textCtrl -> bracket (textCtrlGetDefaultStyle textCtrl)-                                 (textAttrDelete)-                                 (\attr -> do hasColor <- textAttrHasBackgroundColour attr-                                              if (hasColor) then textAttrGetBackgroundColour attr-                                                            else get w bgcolor))-           (get w bgcolor)--      setter w c-       = ifInstanceOf w classTextCtrl-           (\textCtrl -> bracket (textAttrCreateDefault)-                                 (textAttrDelete)-                                 (\attr -> do textAttrSetBackgroundColour attr c-                                              textCtrlSetDefaultStyle textCtrl attr-                                              return ()))-           (set w [bgcolor := c])--  --instance Visible (Window a) where-  visible-    = newAttr "visible" windowIsShown setVisible-    where-      setVisible w vis-        = if vis-           then do{ windowShow w; windowRaise w }-           else unitIO (windowHide w)--  refresh w-    = windowRefresh w True--  fullRepaintOnResize-    = reflectiveAttr "fullRepaintOnResize" getFlag setFlag-    where-      getFlag w-        = do s <- get w style-             return (not (bitsSet wxNO_FULL_REPAINT_ON_RESIZE s))--      setFlag w repaint-        = set w [style :~ \stl -> if repaint -                                   then stl .-. wxNO_FULL_REPAINT_ON_RESIZE -                                   else stl .+. wxNO_FULL_REPAINT_ON_RESIZE]--instance Parent (Window a) where-  children-    = readAttr "children" windowChildren--  clipChildren-    = reflectiveAttr "clipChildren" getFlag setFlag-    where-      getFlag w-        = do s <- get w style-             return (bitsSet wxCLIP_CHILDREN s)-      setFlag w clip-        = set w [style :~ \stl -> if clip-                                   then stl .+. wxCLIP_CHILDREN-                                   else stl .-. wxCLIP_CHILDREN]----- | Helper function that transforms the style accordding--- to the 'fullRepaintOnResize' flag in of the properties-initialFullRepaintOnResize :: Visible w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-initialFullRepaintOnResize -  = withStylePropertyNot fullRepaintOnResize wxNO_FULL_REPAINT_ON_RESIZE----- | Helper function that transforms the style accordding--- to the 'clipChildren' flag out of the properties-initialClipChildren :: Parent w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-initialClipChildren -  = withStyleProperty clipChildren wxCLIP_CHILDREN-----instance Child (Window a) where-  parent-    = readAttr "parent" windowGetParent---- | Ensure that a widget is refitted inside a window when--- its size changes, for example when the 'text' of a --- 'staticText' control changes. (calls 'windowReFit')-refit :: Window a -> IO ()-refit w-  = windowReFit w---- | Ensure that a widget is refitted inside a window when--- its size changes, for example when the 'text' of a --- 'staticText' control changes. Always resizes the--- window to its minimal acceptable size. (calls 'windowReFitMinimal')-refitMinimal :: Window a -> IO ()-refitMinimal w-  = windowReFitMinimal w---- | The ultimate root parent of the widget.-rootParent :: ReadAttr (Window a) (Window ())-rootParent -  = readAttr "rootParent" windowGetRootParent ---- | The parent frame or dialog of a widget.-frameParent :: ReadAttr (Window a) (Window ())-frameParent -  = readAttr "frameParent" windowGetFrameParent ----- | Enable (or disable) tab-traversal. (= wxTAB_TRAVERSAL)-tabTraversal :: Attr (Window a) Bool-tabTraversal-  = newAttr "tabTraversal" getter setter-  where-    getter w-      = do st <- get w style-           return (bitsSet wxTAB_TRAVERSAL st)-    setter w enable-      = set w [style :~ \stl -> if enable then stl .+. wxTAB_TRAVERSAL else stl .-. wxTAB_TRAVERSAL]---instance Identity (Window a) where-  identity-    = reflectiveAttr "identity" windowGetId windowSetId---- | Helper function that retrieves the initial |identity|.-initialIdentity :: Identity w => (Id -> [Prop w] -> a) -> [Prop w] -> a-initialIdentity-  = withProperty identity idAny--instance Styled (Window a) where-  style-    = reflectiveAttr "style" windowGetWindowStyleFlag windowSetWindowStyleFlag---- | Helper function that retrieves the initial |style|.-initialStyle :: Styled w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a-initialStyle cont props stl-  = withProperty style stl (\stl' props' -> cont props' stl') props--instance Tipped (Window a) where-  tooltip-    = newAttr "tooltip" windowGetToolTip windowSetToolTip--{--instance Help (Window a) where-  help-    = newAttr "help" windowSetHelpText windowGetHelpText--}--{---------------------------------------------------------------------------------  Borders---------------------------------------------------------------------------------}-instance Bordered (Window a) where-  border -    = reflectiveAttr "border" getter setter-    where-      getter w-        = do st <- get w style-             return (fromBitMask st)-      setter w b-        = set w [style :~ \stl -> setBitMask b stl]--initialBorder cont props style-  = case filterProperty border props of-      (PropValue x, ps)  -> cont ps (setBitMask x style) -      (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)-      (PropNone, ps)     -> cont ps style--{---------------------------------------------------------------------------------  Events---------------------------------------------------------------------------------}-instance Reactive (Window a) where-  mouse     = newEvent "mouse" windowGetOnMouse (\w h -> windowOnMouse w True h)-  keyboard  = newEvent "keyboard" windowGetOnKeyChar (windowOnKeyChar)-  closing   = newEvent "closing" windowGetOnClose windowOnClose-  idle      = newEvent "idle" windowGetOnIdle windowOnIdle-  resize    = newEvent "resize" windowGetOnSize windowOnSize-  focus     = newEvent "focus" windowGetOnFocus windowOnFocus-  activate  = newEvent "activate" windowGetOnActivate windowOnActivate--instance Paint (Window a) where-  paint     = newEvent "paint" windowGetOnPaint (\w h -> windowOnPaint w h)-  paintRaw  = newEvent "paintRaw" windowGetOnPaintRaw (\w h -> windowOnPaintRaw w h)-  repaint w = windowRefresh w False+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+--------------------------------------------------------------------------------
+{-|	Module      :  Window
+	Copyright   :  (c) Daan Leijen 2003
+	License     :  wxWindows
+
+	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
+	Stability   :  provisional
+	Portability :  portable
+
+Exports default instances for generic windows.
+
+* Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible',
+             'Child', 'Sized', 'Parent', 'Help', 'Bordered',
+             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.             
+-}
+--------------------------------------------------------------------------------
+module Graphics.UI.WX.Window
+        ( -- * Window
+          Window, window, refit, refitMinimal, rootParent, frameParent, tabTraversal      
+          -- * ScrolledWindow
+        , ScrolledWindow, scrolledWindow, scrollRate
+          -- * Internal
+        , initialWindow, initialContainer
+        , initialIdentity, initialStyle, initialText
+        , initialFullRepaintOnResize, initialClipChildren
+        ) where
+
+import Graphics.UI.WXCore
+
+import Graphics.UI.WX.Types
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Layout
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Events
+
+
+{--------------------------------------------------------------------------------
+  ScrolledWindow
+--------------------------------------------------------------------------------}
+-- | A scrollable window. Use 'virtualSize' and 'scrollRate' to set the scrollbar
+-- behaviour.
+--
+-- * Attributes: 'scrollRate'
+--
+-- * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', 
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+--
+scrolledWindow :: Window a -> [Prop (ScrolledWindow ())] -> IO (ScrolledWindow ())
+scrolledWindow parent props
+  = feed2 props 0 $
+    initialContainer $ \id rect -> \props style ->
+    do sw <- scrolledWindowCreate parent id rect style
+       set sw props
+       return sw
+
+
+-- | The horizontal and vertical scroll rate of scrolled window. Use @0@ to disable 
+-- scrolling in that direction.
+scrollRate :: Attr (ScrolledWindow a) Size
+scrollRate
+  = newAttr "scrollRate" getter setter
+  where
+    getter sw
+      = do p <- scrolledWindowGetScrollPixelsPerUnit sw
+           return (sizeFromPoint p)
+     
+    setter sw size
+      = scrolledWindowSetScrollRate sw (sizeW size) (sizeH size)
+
+
+{--------------------------------------------------------------------------------
+  Plain window
+--------------------------------------------------------------------------------}
+-- | Create a plain window. Can be used to define custom controls for example.
+--
+-- * Attributes: 'rootParent', 'frameParent', 'tabTraversal'
+--
+-- * Instances: 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', 
+--             'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
+window :: Window a -> [Prop (Window ())] -> IO (Window ())
+window parent props
+  = feed2 props 0 $
+    initialWindow $ \id rect -> \props flags ->
+    do w <- windowCreate parent id rect flags
+       set w props
+       return w
+
+
+{--------------------------------------------------------------------------------
+  Properties
+--------------------------------------------------------------------------------}
+-- | Helper function that retrieves initial window settings, including
+-- |identity|, |style|, and |area| (or |position| and |outerSize|).
+initialWindow :: (Id -> Rect -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialWindow cont 
+  = initialIdentity $ \id ->
+    initialArea     $ \rect ->
+    initialStyle    $ 
+    initialBorder   $
+    cont id rect 
+
+-- | Helper function that retrieves initial window settings, including |clipChildren|
+-- and |fullRepaintOnResize|.
+initialContainer :: (Id -> Rect -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialContainer cont
+  = initialWindow $ \id rect ->
+    initialFullRepaintOnResize $ 
+    initialClipChildren        $ 
+    cont id rect 
+
+
+instance Able (Window a) where
+  enabled
+    = newAttr "enabled" windowIsEnabled setter
+    where
+      setter w enable
+        | enable    = unitIO $ windowEnable w
+        | otherwise = unitIO $ windowDisable w
+
+
+instance Textual (Window a) where
+  text
+    = reflectiveAttr "text" getter setter
+    where
+      getter w
+        = fst (getset w)
+      setter w x
+        = snd (getset w) x
+
+      getset w
+        = ifInstanceOf w classComboBox
+            (\cb -> (comboBoxGetValue cb, \s -> do comboBoxClear cb; comboBoxAppend cb s)) $
+          ifInstanceOf w classTextCtrl
+            (\tc -> (textCtrlGetValue tc, \s -> do textCtrlChangeValue tc s)) $
+            (windowGetLabel w,windowSetLabel w)
+
+  appendText w s
+    = ifInstanceOf w classComboBox
+        (\cb -> comboBoxAppend cb s) $
+      ifInstanceOf w classTextCtrl
+        (\tc -> textCtrlAppendText tc s)
+        (set w [text :~ (++s)])
+
+
+-- | Retrieve the initial title from the |text| attribute.
+initialText :: Textual w => (String -> [Prop w] -> a) -> [Prop w] -> a
+initialText cont props 
+  = withProperty text "" cont props
+
+
+instance Dimensions (Window a) where
+  outerSize
+    = newAttr "size" windowGetSize setSize
+    where
+      setSize w sz
+        = windowSetSize w (rect (pt (-1) (-1)) sz) wxSIZE_USE_EXISTING
+
+  area
+    = newAttr "area" windowGetRect setArea
+    where
+      setArea w rect
+        = windowSetSize w rect wxSIZE_USE_EXISTING
+
+  bestSize
+    = readAttr "bestSize" windowGetEffectiveMinSize
+
+  position
+    = newAttr "position" windowGetPosition windowMove
+
+  clientSize
+    = newAttr "clientSize" windowGetClientSize windowSetClientSize
+
+  virtualSize
+    = newAttr "virtualSize" windowGetVirtualSize windowSetVirtualSize
+
+
+instance Sized (Window a) where
+  size  = outerSize
+
+-- | Retrieve the initial creation area from the |area|, or the |position| and
+-- |outerSize| properties.
+initialArea :: Dimensions w => (Rect -> [Prop w] -> a) -> [Prop w] -> a
+initialArea cont props
+  = case findProperty area rectNull props of
+      Just (rect,props') -> cont rect props'
+      Nothing 
+        -> case findProperty position pointNull props of
+             Just (p,props') -> case findProperty outerSize sizeNull props of
+                                  Just (sz,props'') -> cont (rect p sz) props''
+                                  Nothing           -> cont (rect p sizeNull) props'
+             Nothing         -> case findProperty outerSize sizeNull props of
+                                  Just (sz,props')  -> cont (rect pointNull sz) props'
+                                  Nothing           -> cont rectNull props
+
+
+
+instance Colored (Window a) where
+  bgcolor
+    = newAttr "bgcolor" windowGetBackgroundColour (\w x -> do{ windowSetBackgroundColour w x; return ()})
+
+  color
+    = newAttr "color" windowGetForegroundColour (\w x -> do windowSetForegroundColour w x; return ())
+
+
+instance Literate (Window a) where
+  font
+    = newAttr "font" getter setter
+    where
+      getter w
+        = ifInstanceOf w classTextCtrl
+           (\textCtrl -> bracket (textCtrlGetDefaultStyle textCtrl)
+                                 (textAttrDelete)
+                                 (\attr -> do hasFont <- textAttrHasFont attr
+                                              if (hasFont) 
+                                                then getFont (textAttrGetFont attr) 
+                                                else getFont (windowGetFont w)))
+           (getFont (windowGetFont w))
+        where
+          getFont io
+            = bracket io fontDelete fontGetFontStyle 
+
+      setter w info
+        = ifInstanceOf w classTextCtrl
+           (\textCtrl -> bracket (textAttrCreateDefault)
+                                 (textAttrDelete)
+                                 (\attr -> withFontStyle info $ \fnt ->
+                                           do textAttrSetFont attr fnt
+                                              textCtrlSetDefaultStyle textCtrl attr
+                                              return ()))
+           (withFontStyle info $ \fnt ->
+            do windowSetFont w fnt
+               return ())
+
+  textColor
+    = newAttr "textcolor" getter setter
+    where
+      getter w
+        = ifInstanceOf w classTextCtrl
+           (\textCtrl -> bracket (textCtrlGetDefaultStyle textCtrl)
+                                 (textAttrDelete)
+                                 (\attr -> do hasColor <- textAttrHasTextColour attr
+                                              if (hasColor) then textAttrGetTextColour attr
+                                                            else get w color))
+           (get w color)
+
+      setter w c
+        = ifInstanceOf w classTextCtrl
+           (\textCtrl -> bracket (textAttrCreateDefault)
+                                 (textAttrDelete)
+                                 (\attr -> do textAttrSetTextColour attr c
+                                              textCtrlSetDefaultStyle textCtrl attr
+                                              return ()))
+           (set w [color := c])
+
+  textBgcolor
+    = newAttr "textbgcolor" getter setter
+    where
+      getter w
+        = ifInstanceOf w classTextCtrl
+           (\textCtrl -> bracket (textCtrlGetDefaultStyle textCtrl)
+                                 (textAttrDelete)
+                                 (\attr -> do hasColor <- textAttrHasBackgroundColour attr
+                                              if (hasColor) then textAttrGetBackgroundColour attr
+                                                            else get w bgcolor))
+           (get w bgcolor)
+
+      setter w c
+       = ifInstanceOf w classTextCtrl
+           (\textCtrl -> bracket (textAttrCreateDefault)
+                                 (textAttrDelete)
+                                 (\attr -> do textAttrSetBackgroundColour attr c
+                                              textCtrlSetDefaultStyle textCtrl attr
+                                              return ()))
+           (set w [bgcolor := c])
+
+  
+
+instance Visible (Window a) where
+  visible
+    = newAttr "visible" windowIsShown setVisible
+    where
+      setVisible w vis
+        = if vis
+           then do{ windowShow w; windowRaise w }
+           else unitIO (windowHide w)
+
+  refresh w
+    = windowRefresh w True
+
+  fullRepaintOnResize
+    = reflectiveAttr "fullRepaintOnResize" getFlag setFlag
+    where
+      getFlag w
+        = do s <- get w style
+             return (not (bitsSet wxNO_FULL_REPAINT_ON_RESIZE s))
+
+      setFlag w repaint
+        = set w [style :~ \stl -> if repaint 
+                                   then stl .-. wxNO_FULL_REPAINT_ON_RESIZE 
+                                   else stl .+. wxNO_FULL_REPAINT_ON_RESIZE]
+
+instance Parent (Window a) where
+  children
+    = readAttr "children" windowChildren
+
+  clipChildren
+    = reflectiveAttr "clipChildren" getFlag setFlag
+    where
+      getFlag w
+        = do s <- get w style
+             return (bitsSet wxCLIP_CHILDREN s)
+      setFlag w clip
+        = set w [style :~ \stl -> if clip
+                                   then stl .+. wxCLIP_CHILDREN
+                                   else stl .-. wxCLIP_CHILDREN]
+
+
+-- | Helper function that transforms the style accordding
+-- to the 'fullRepaintOnResize' flag in of the properties
+initialFullRepaintOnResize :: Visible w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialFullRepaintOnResize 
+  = withStylePropertyNot fullRepaintOnResize wxNO_FULL_REPAINT_ON_RESIZE
+
+
+-- | Helper function that transforms the style accordding
+-- to the 'clipChildren' flag out of the properties
+initialClipChildren :: Parent w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialClipChildren 
+  = withStyleProperty clipChildren wxCLIP_CHILDREN
+
+
+
+
+instance Child (Window a) where
+  parent
+    = readAttr "parent" windowGetParent
+
+-- | Ensure that a widget is refitted inside a window when
+-- its size changes, for example when the 'text' of a 
+-- 'staticText' control changes. (calls 'windowReFit')
+refit :: Window a -> IO ()
+refit w
+  = windowReFit w
+
+-- | Ensure that a widget is refitted inside a window when
+-- its size changes, for example when the 'text' of a 
+-- 'staticText' control changes. Always resizes the
+-- window to its minimal acceptable size. (calls 'windowReFitMinimal')
+refitMinimal :: Window a -> IO ()
+refitMinimal w
+  = windowReFitMinimal w
+
+-- | The ultimate root parent of the widget.
+rootParent :: ReadAttr (Window a) (Window ())
+rootParent 
+  = readAttr "rootParent" windowGetRootParent 
+
+-- | The parent frame or dialog of a widget.
+frameParent :: ReadAttr (Window a) (Window ())
+frameParent 
+  = readAttr "frameParent" windowGetFrameParent 
+
+
+-- | Enable (or disable) tab-traversal. (= wxTAB_TRAVERSAL)
+tabTraversal :: Attr (Window a) Bool
+tabTraversal
+  = newAttr "tabTraversal" getter setter
+  where
+    getter w
+      = do st <- get w style
+           return (bitsSet wxTAB_TRAVERSAL st)
+    setter w enable
+      = set w [style :~ \stl -> if enable then stl .+. wxTAB_TRAVERSAL else stl .-. wxTAB_TRAVERSAL]
+
+
+instance Identity (Window a) where
+  identity
+    = reflectiveAttr "identity" windowGetId windowSetId
+
+-- | Helper function that retrieves the initial |identity|.
+initialIdentity :: Identity w => (Id -> [Prop w] -> a) -> [Prop w] -> a
+initialIdentity
+  = withProperty identity idAny
+
+instance Styled (Window a) where
+  style
+    = reflectiveAttr "style" windowGetWindowStyleFlag windowSetWindowStyleFlag
+
+-- | Helper function that retrieves the initial |style|.
+initialStyle :: Styled w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialStyle cont props stl
+  = withProperty style stl (\stl' props' -> cont props' stl') props
+
+instance Tipped (Window a) where
+  tooltip
+    = newAttr "tooltip" windowGetToolTip windowSetToolTip
+
+{-
+instance Help (Window a) where
+  help
+    = newAttr "help" windowSetHelpText windowGetHelpText
+-}
+
+{--------------------------------------------------------------------------------
+  Borders
+--------------------------------------------------------------------------------}
+instance Bordered (Window a) where
+  border 
+    = reflectiveAttr "border" getter setter
+    where
+      getter w
+        = do st <- get w style
+             return (fromBitMask st)
+      setter w b
+        = set w [style :~ \stl -> setBitMask b stl]
+
+initialBorder cont props style
+  = case filterProperty border props of
+      (PropValue x, ps)  -> cont ps (setBitMask x style) 
+      (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)
+      (PropNone, ps)     -> cont ps style
+
+{--------------------------------------------------------------------------------
+  Events
+--------------------------------------------------------------------------------}
+instance Reactive (Window a) where
+  mouse     = newEvent "mouse" windowGetOnMouse (\w h -> windowOnMouse w True h)
+  keyboard  = newEvent "keyboard" windowGetOnKeyChar (windowOnKeyChar)
+  closing   = newEvent "closing" windowGetOnClose windowOnClose
+  idle      = newEvent "idle" windowGetOnIdle windowOnIdle
+  resize    = newEvent "resize" windowGetOnSize windowOnSize
+  focus     = newEvent "focus" windowGetOnFocus windowOnFocus
+  activate  = newEvent "activate" windowGetOnActivate windowOnActivate
+
+instance Paint (Window a) where
+  paint     = newEvent "paint" windowGetOnPaint (\w h -> windowOnPaint w h)
+  paintRaw  = newEvent "paintRaw" windowGetOnPaintRaw (\w h -> windowOnPaintRaw w h)
+  repaint w = windowRefresh w False
wx.cabal view
@@ -1,58 +1,58 @@-Name:           wx-Version:        0.90.1.0-License:        OtherLicense-License-file:   license.txt-Homepage:       http://haskell.org/haskellwiki/WxHaskell-Author:         Daan Leijen-Build-Type:     Simple-Category:       GUI, User interfaces-Cabal-Version:  >= 1.2-Description:    wxHaskell is a portable and native GUI library for Haskell.  -                It is built on top of wxWidgets - a comprehensive C++-                library that is portable across all major GUI platforms;-                including GTK, Windows, X11, and MacOS X.  This version-                works with wxWidgets 2.9 only.-Maintainer:     wxhaskell-devel@lists.sourceforge.net-Synopsis:       wxHaskell-Data-Files:     wx.cabal--Flag splitBase-    Description: Choose the new smaller, split-up base package.--Flag newBase-    Description: pick base >= 4--Library-    if flag(splitBase)-        build-depends: wxcore >= 0.90.1.0,-                       stm-        if flag(newBase)-            build-depends:-                base >= 4 && < 5-        else-            build-depends:-                base >= 3 && < 4-    else-        build-depends: base <  3, -                       wxcore >= 0.90.1.0,-                       stm-- Exposed-Modules:-  Graphics.UI.WX.Draw-  Graphics.UI.WX.Media-  Graphics.UI.WX.TopLevelWindow-  Graphics.UI.WX.Attributes-  Graphics.UI.WX.Window-  Graphics.UI.WX.Variable-  Graphics.UI.WX.Events-  Graphics.UI.WX.Frame-  Graphics.UI.WX.Layout-  Graphics.UI.WX.Controls-  Graphics.UI.WX.Types-  Graphics.UI.WX.Dialogs-  Graphics.UI.WX.Classes-  Graphics.UI.WX.Timer-  Graphics.UI.WX.Menu-  Graphics.UI.WX-- Hs-Source-Dirs: src+Name:           wx
+Version:        0.91.0.0
+License:        OtherLicense
+License-file:   license.txt
+Homepage:       http://haskell.org/haskellwiki/WxHaskell
+Author:         Daan Leijen
+Build-Type:     Simple
+Category:       GUI, User interfaces
+Cabal-Version:  >= 1.2
+Description:    wxHaskell is a portable and native GUI library for Haskell.  
+                It is built on top of wxWidgets - a comprehensive C++
+                library that is portable across all major GUI platforms;
+                including GTK, Windows, X11, and MacOS X.  This version
+                works with wxWidgets 2.9 and 3.0.
+Maintainer:     wxhaskell-devel@lists.sourceforge.net
+Synopsis:       wxHaskell
+Data-Files:     wx.cabal
+
+Flag splitBase
+    Description: Choose the new smaller, split-up base package.
+
+Flag newBase
+    Description: pick base >= 4
+
+Library
+    if flag(splitBase)
+        build-depends: wxcore >= 0.91,
+                       stm
+        if flag(newBase)
+            build-depends:
+                base >= 4 && < 5
+        else
+            build-depends:
+                base >= 3 && < 4
+    else
+        build-depends: base <  3, 
+                       wxcore >= 0.91,
+                       stm
+
+ Exposed-Modules:
+  Graphics.UI.WX.Draw
+  Graphics.UI.WX.Media
+  Graphics.UI.WX.TopLevelWindow
+  Graphics.UI.WX.Attributes
+  Graphics.UI.WX.Window
+  Graphics.UI.WX.Variable
+  Graphics.UI.WX.Events
+  Graphics.UI.WX.Frame
+  Graphics.UI.WX.Layout
+  Graphics.UI.WX.Controls
+  Graphics.UI.WX.Types
+  Graphics.UI.WX.Dialogs
+  Graphics.UI.WX.Classes
+  Graphics.UI.WX.Timer
+  Graphics.UI.WX.Menu
+  Graphics.UI.WX
+
+ Hs-Source-Dirs: src