glib-0.13.4.1/0000755000000000000000000000000013005220034011026 5ustar0000000000000000glib-0.13.4.1/COPYING0000644000000000000000000006351013005220034012066 0ustar0000000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 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. Copyright (C) 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 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. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! glib-0.13.4.1/glib.cabal0000644000000000000000000000602513005220034012732 0ustar0000000000000000Name: glib Version: 0.13.4.1 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team Author: Axel Simon, Duncan Coutts Maintainer: gtk2hs-users@lists.sourceforge.net Build-Type: Custom Cabal-Version: >= 1.24 Stability: stable homepage: http://projects.haskell.org/gtk2hs/ bug-reports: https://github.com/gtk2hs/gtk2hs/issues Synopsis: Binding to the GLIB library for Gtk2Hs. Description: GLib is a collection of C data structures and utility functions for the GObject system, main loop implementation, for strings and common data structures dealing with Unicode. This package only binds as much functionality as required to support the packages that wrap libraries that are themselves based on GLib. Category: System Tested-With: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.1 Extra-Source-Files: System/Glib/hsgclosure.c System/Glib/hsgclosure.h Source-Repository head type: git location: https://github.com/gtk2hs/gtk2hs subdir: glib Flag closure_signals Description: Connect to signals using the Duncan way. custom-setup setup-depends: base >= 4.6, Cabal >= 1.24 && < 1.25, gtk2hs-buildtools >= 0.13.2.0 && < 0.14 Library build-depends: base >= 4 && < 5, utf8-string >= 0.2 && < 1.1, bytestring >= 0.9.1.10 && < 0.11, text >= 1.0.0.0 && < 1.3, containers cpp-options: -U__BLOCKS__ if os(darwin) cpp-options: -D__attribute__(A)= -D_Nullable= -D_Nonnull= if flag(closure_signals) cpp-options: -DUSE_GCLOSURE_SIGNALS_IMPL c-sources: System/Glib/hsgclosure.c include-dirs: System/Glib exposed-modules: System.Glib System.Glib.GError System.Glib.Properties System.Glib.Attributes System.Glib.Signals System.Glib.MainLoop System.Glib.GDateTime System.Glib.GObject System.Glib.Utils System.Glib.StoreValue System.Glib.FFI System.Glib.Flags System.Glib.UTFString System.Glib.Types System.Glib.GList System.Glib.GString System.Glib.GType System.Glib.GTypeConstants System.Glib.GValue System.Glib.GValueTypes System.Glib.GParameter default-language: Haskell98 default-extensions: ForeignFunctionInterface x-c2hs-Header: glib-object.h pkgconfig-depends: glib-2.0, gobject-2.0 glib-0.13.4.1/Setup.hs0000644000000000000000000000040313005220034012457 0ustar0000000000000000-- Adjustments specific to this package, -- all Gtk2Hs-specific boilerplate is kept in -- gtk2hs-buildtools:Gtk2HsSetup -- import Gtk2HsSetup ( gtk2hsUserHooks ) import Distribution.Simple ( defaultMainWithHooks ) main = defaultMainWithHooks gtk2hsUserHooks glib-0.13.4.1/System/0000755000000000000000000000000013005220034012312 5ustar0000000000000000glib-0.13.4.1/System/Glib.hs0000644000000000000000000000111213005220034013516 0ustar0000000000000000 module System.Glib ( module System.Glib.UTFString, module System.Glib.GType, module System.Glib.GValueTypes, module System.Glib.GObject, module System.Glib.GParameter, module System.Glib.GError, module System.Glib.GList, module System.Glib.GDateTime, module System.Glib.Utils ) where import System.Glib.UTFString import System.Glib.GType import System.Glib.GValueTypes import System.Glib.GObject import System.Glib.GParameter import System.Glib.GError import System.Glib.GList import System.Glib.GDateTime import System.Glib.Utils -- do not import System.Glib.FFI glib-0.13.4.1/System/Glib/0000755000000000000000000000000013005220034013167 5ustar0000000000000000glib-0.13.4.1/System/Glib/Attributes.hs0000644000000000000000000001335413005220034015657 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Attributes interface -- -- Author : Duncan Coutts -- -- Created: 21 January 2005 -- -- Copyright (C) 2005 Duncan Coutts -- -- Partially derived from the hs-fltk and wxHaskell projects which -- are both under LGPL compatible licenses. -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : experimental -- Portability : portable -- -- Attributes interface -- -- Attributes of an object can be get and set. Getting the value of an -- object's attribute is straingtforward. As an example consider a @button@ -- widget and an attribute called @buttonLabel@. -- -- > value <- get button buttonLabel -- -- The syntax for setting or updating an attribute is only slightly more -- complex. At the simplest level it is just: -- -- > set button [ buttonLabel := value ] -- -- However as the list notation would indicate, you can set or update multiple -- attributes of the same object in one go: -- -- > set button [ buttonLabel := value, buttonFocusOnClick := False ] -- -- You are not limited to setting the value of an attribute, you can also -- apply an update function to an attribute's value. That is the function -- receives the current value of the attribute and returns the new value. -- -- > set spinButton [ spinButtonValue :~ (+1) ] -- -- There are other variants of these operators, (see 'AttrOp'). ':=>' and -- ':~>' and like ':=' and ':~' but operate in the 'IO' monad rather -- than being pure. There is also '::=' and '::~' which take the object -- as an extra parameter. -- -- Attributes can be read only, write only or both read\/write. -- module System.Glib.Attributes ( -- * Attribute types Attr, ReadAttr, WriteAttr, ReadWriteAttr, -- * Interface for getting, setting and updating attributes AttrOp(..), get, set, -- * Internal attribute constructors newNamedAttr, readNamedAttr, writeNamedAttr, newAttr, readAttr, writeAttr, ) where infixr 0 :=,:~,:=>,:~>,::=,::~ -- | An ordinary attribute. Most attributes have the same get and set types. type Attr o a = ReadWriteAttr o a a -- | A read-only attribute. type ReadAttr o a = ReadWriteAttr o a () -- | A write-only attribute. type WriteAttr o b = ReadWriteAttr o () b -- | A generalised attribute with independent get and set types. data ReadWriteAttr o a b = Attr String !(o -> IO a) !(o -> b -> IO ()) instance Show (ReadWriteAttr o a b) where show (Attr str _ _) = str -- | Create a new attribute with a getter and setter function. newNamedAttr :: String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b newNamedAttr prop getter setter = Attr prop getter setter -- | Create a new read-only attribute. readNamedAttr :: String -> (o -> IO a) -> ReadAttr o a readNamedAttr prop getter = Attr prop getter (\_ _ -> return ()) -- | Create a new write-only attribute. writeNamedAttr :: String -> (o -> b -> IO ()) -> WriteAttr o b writeNamedAttr prop setter = Attr prop (\_ -> return ()) setter -- | Create a new attribute with a getter and setter function. newAttr :: (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b newAttr getter setter = Attr "unnamed attribute" getter setter -- | Create a new read-only attribute. readAttr :: (o -> IO a) -> ReadAttr o a readAttr getter = Attr "unnamed attribute" getter (\_ _ -> return ()) -- | Create a new write-only attribute. writeAttr :: (o -> b -> IO ()) -> WriteAttr o b writeAttr setter = Attr "unnamed attribute" (\_ -> return ()) setter -- | A set or update operation on an attribute. data AttrOp o = forall a b. ReadWriteAttr o a b := b -- ^ Assign a value to an -- attribute. | forall a b. ReadWriteAttr o a b :~ ( a -> b) -- ^ Apply an update function to -- an attribute. | forall a b. ReadWriteAttr o a b :=> ( IO b) -- ^ Assign the result of an IO -- action to an attribute. | forall a b. ReadWriteAttr o a b :~> ( a -> IO b) -- ^ Apply a IO update function -- to an attribute. | forall a b. ReadWriteAttr o a b ::= (o -> b) -- ^ Assign a value to an -- attribute with the object as -- an argument. | forall a b. ReadWriteAttr o a b ::~ (o -> a -> b) -- ^ Apply an update function to -- an attribute with the object -- as an argument. -- | Set a number of properties for some object. set :: o -> [AttrOp o] -> IO () set obj = mapM_ app where app (Attr _ getter setter := x) = setter obj x app (Attr _ getter setter :~ f) = getter obj >>= \v -> setter obj (f v) app (Attr _ getter setter :=> x) = x >>= setter obj app (Attr _ getter setter :~> f) = getter obj >>= f >>= setter obj app (Attr _ getter setter ::= f) = setter obj (f obj) app (Attr _ getter setter ::~ f) = getter obj >>= \v -> setter obj (f obj v) -- | Get an Attr of an object. get :: o -> ReadWriteAttr o a b -> IO a get o (Attr _ getter setter) = getter o glib-0.13.4.1/System/Glib/FFI.hs0000644000000000000000000000475013005220034014135 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- GIMP Toolkit (GTK) FFI extras and version dependencies -- -- Author : Axel Simon -- -- Created: 22 June 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- -- 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. -- -- #hide -- | -- -- This module serves as an impedance matcher for different compiler -- versions. It also adds a few FFI utility functions. -- module System.Glib.FFI ( nullForeignPtr, maybeNull, newForeignPtr, withForeignPtrs, #if MIN_VERSION_base(4,4,0) unsafePerformIO, unsafeForeignPtrToPtr, #endif module Foreign, module Foreign.C ) where -- We should almost certainly not be using the standard free function anywhere -- in the glib or gtk bindings, so we do not re-export it from this module. import Foreign.C #if MIN_VERSION_base(4,4,0) import Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr, newForeignPtr, free) import System.IO.Unsafe (unsafePerformIO) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) #else import Foreign hiding (newForeignPtr, free) #endif import qualified Foreign.Concurrent newForeignPtr :: Ptr a -> FinalizerPtr a -> IO (ForeignPtr a) newForeignPtr p finalizer = Foreign.Concurrent.newForeignPtr p (mkFinalizer finalizer p) foreign import ccall "dynamic" mkFinalizer :: FinalizerPtr a -> Ptr a -> IO () nullForeignPtr :: ForeignPtr a nullForeignPtr = unsafePerformIO $ newForeignPtr_ nullPtr -- This is useful when it comes to marshaling lists of GObjects -- withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b withForeignPtrs fptrs body = do result <- body (map unsafeForeignPtrToPtr fptrs) mapM_ touchForeignPtr fptrs return result -- A marshaling utility function that is used by the code produced by the code -- generator to marshal return values that can be null maybeNull :: (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a) maybeNull marshal genPtr = do ptr <- genPtr if ptr == nullPtr then return Nothing else do result <- marshal (return ptr) return (Just result) glib-0.13.4.1/System/Glib/Flags.hs0000644000000000000000000000433013005220034014557 0ustar0000000000000000-- -*-haskell-*- -- class of flag types -- -- Author : Duncan Coutts -- -- Created: 21 January 2005 -- -- Copyright (C) 2001-2005 Duncan Coutts, Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable -- -- This module defines a type class for flags that are marshaled as bitflags. -- module System.Glib.Flags ( Flags, fromFlags, toFlags ) where import Data.Bits ((.|.), (.&.), testBit, shiftL, shiftR) import Data.Maybe (catMaybes) class (Enum a, Bounded a) => Flags a fromFlags :: Flags a => [a] -> Int fromFlags is = orNum 0 is where orNum n [] = n orNum n (i:is) = orNum (n .|. fromEnum i) is -- * Note that this function ignores bits set in the passed -- 'Int' that do not correspond to a flag. toFlags :: Flags a => Int -> [a] toFlags n = catMaybes [ if n .&. fromEnum flag == fromEnum flag then Just flag else Nothing | flag <- [minBound .. maxBound] ] ------------------------- -- QuickCheck test code {- import Test.QuickCheck import List (sort, nub) -- to run these tests you must copy EventMask and its Enum instance here -- and make it an instance of Ord, Eq and Show. prop_ToFlagsFromFlags :: Int -> Property prop_ToFlagsFromFlags n = (n >= 1 && n <= 21) ==> collect n $ let flag :: [EventMask] flag = toFlags (2^n) in 2^n == fromFlags flag prop_FromFlagsToFlags :: [EventMask] -> Bool prop_FromFlagsToFlags flags = (nub . sort) flags == toFlags (fromFlags flags) instance Arbitrary EventMask where arbitrary = sized $ \_ -> do x <- choose (1,21 :: Int) return (toEnum $ 2^x) -} glib-0.13.4.1/System/Glib/GDateTime.chs0000644000000000000000000002464613005220034015505 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) -- -- Author : Peter Gavin -- -- Created: July 2007 -- -- Copyright (C) 2007 Peter Gavin -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- module System.Glib.GDateTime ( GTimeValPart, GTimeVal(..), gGetCurrentTime, gUSleep, gTimeValAdd, #if GLIB_CHECK_VERSION(2,12,0) gTimeValFromISO8601, gTimeValToISO8601, #endif GDate(..), GDateDay, GDateMonth, GDateYear, GDateJulianDay, GDateWeekday, gDateValidJulian, gDateValidDMY, gDateNewJulian, gDateNewDMY, gDateSetDay, gDateSetMonth, gDateSetYear, #if GLIB_CHECK_VERSION(2,10,0) gDateNewTimeVal, #endif gDateParse, gDateAddDays, gDateSubtractDays, gDateAddMonths, gDateSubtractMonths, gDateAddYears, gDateSubtractYears, gDateDaysBetween, gDateCompare, gDateClamp, gDateDay, gDateMonth, gDateYear, gDateWeekday ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString type GTimeValPart = {# type glong #} data GTimeVal = GTimeVal { gTimeValSec :: GTimeValPart , gTimeValUSec :: GTimeValPart } deriving (Eq, Ord) instance Storable GTimeVal where sizeOf _ = {# sizeof GTimeVal #} alignment _ = alignment (undefined :: CString) peek ptr = do sec <- {# get GTimeVal->tv_sec #} ptr uSec <- {# get GTimeVal->tv_usec #} ptr return $ GTimeVal sec uSec poke ptr (GTimeVal sec uSec) = do {# set GTimeVal->tv_sec #} ptr sec {# set GTimeVal->tv_usec #} ptr uSec gGetCurrentTime :: IO GTimeVal gGetCurrentTime = alloca $ \ptr -> do {# call g_get_current_time #} $ castPtr ptr peek ptr gUSleep :: GTimeValPart -> IO () gUSleep microseconds = {# call g_usleep #} $ fromIntegral microseconds gTimeValAdd :: GTimeVal -> GTimeValPart -> GTimeVal gTimeValAdd time microseconds = unsafePerformIO $ with time $ \ptr -> do {# call g_time_val_add #} (castPtr ptr) microseconds peek ptr #if GLIB_CHECK_VERSION(2,12,0) gTimeValFromISO8601 :: GlibString string => string -> Maybe GTimeVal gTimeValFromISO8601 isoDate = unsafePerformIO $ withUTFString isoDate $ \cISODate -> alloca $ \ptr -> do success <- liftM toBool $ {# call g_time_val_from_iso8601 #} cISODate $ castPtr ptr if success then liftM Just $ peek ptr else return Nothing gTimeValToISO8601 :: GlibString string => GTimeVal -> string gTimeValToISO8601 time = unsafePerformIO $ with time $ \ptr -> {# call g_time_val_to_iso8601 #} (castPtr ptr) >>= readUTFString #endif newtype GDateDay = GDateDay {# type GDateDay #} deriving (Eq, Ord) instance Bounded GDateDay where minBound = GDateDay 1 maxBound = GDateDay 31 {# enum GDateMonth {underscoreToCase} deriving (Eq, Ord) #} instance Bounded GDateMonth where minBound = GDateJanuary maxBound = GDateDecember newtype GDateYear = GDateYear {# type GDateYear #} deriving (Eq, Ord) instance Bounded GDateYear where minBound = GDateYear 1 maxBound = GDateYear (maxBound :: {# type guint16 #}) type GDateJulianDay = {# type guint32 #} newtype GDate = GDate { gDateJulianDay :: GDateJulianDay } deriving (Eq) instance Storable GDate where sizeOf _ = {# sizeof GDate #} alignment _ = alignment (undefined :: CString) peek = (liftM (GDate . fromIntegral)) . {# call g_date_get_julian #} . castPtr poke ptr val = {# call g_date_set_julian #} (castPtr ptr) $ gDateJulianDay val {# enum GDateWeekday {underscoreToCase} deriving (Eq, Ord) #} instance Bounded GDateWeekday where minBound = GDateMonday maxBound = GDateSunday gDateValidJulian :: GDateJulianDay -> Bool gDateValidJulian = toBool . {# call fun g_date_valid_julian #} gDateValidDMY :: GDateDay -> GDateMonth -> GDateYear -> Bool gDateValidDMY (GDateDay day) month (GDateYear year) = toBool $ {# call fun g_date_valid_dmy #} day (fromIntegral $ fromEnum month) year gDateNewJulian :: GDateJulianDay -> Maybe GDate gDateNewJulian julian = if gDateValidJulian julian then Just $ GDate julian else Nothing gDateNewDMY :: GDateDay -> GDateMonth -> GDateYear -> Maybe GDate gDateNewDMY day month year = if gDateValidDMY day month year then Just $ unsafePerformIO $ alloca $ \ptr -> do let GDateDay day' = day GDateYear year' = year {# call g_date_set_dmy #} (castPtr ptr) day' (fromIntegral $ fromEnum month) year' peek ptr else Nothing gDateSetDay :: GDate -> GDateDay -> Maybe GDate gDateSetDay date (GDateDay day) = unsafePerformIO $ with date $ \ptr -> do {# call g_date_set_day #} (castPtr ptr) day valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr if valid then liftM Just $ peek ptr else return Nothing gDateSetMonth :: GDate -> GDateMonth -> Maybe GDate gDateSetMonth date month = unsafePerformIO $ with date $ \ptr -> do {# call g_date_set_month #} (castPtr ptr) $ fromIntegral $ fromEnum month valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr if valid then liftM Just $ peek ptr else return Nothing gDateSetYear :: GDate -> GDateYear -> Maybe GDate gDateSetYear date (GDateYear year) = unsafePerformIO $ with date $ \ptr -> do {# call g_date_set_year #} (castPtr ptr) year valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr if valid then liftM Just $ peek ptr else return Nothing #if GLIB_CHECK_VERSION(2,10,0) gDateNewTimeVal :: GTimeVal -> GDate gDateNewTimeVal timeVal = unsafePerformIO $ alloca $ \ptr -> with timeVal $ \timeValPtr -> do {# call g_date_set_time_val #} (castPtr ptr) $ castPtr timeValPtr peek ptr #endif gDateParse :: GlibString string => string -> IO (Maybe GDate) gDateParse str = alloca $ \ptr -> do withUTFString str $ {# call g_date_set_parse #} $ castPtr ptr valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr if valid then liftM Just $ peek ptr else return Nothing gDateAddDays :: GDate -> Word -> GDate gDateAddDays date nDays = unsafePerformIO $ with date $ \ptr -> do {# call g_date_add_days #} (castPtr ptr) $ fromIntegral nDays peek ptr gDateSubtractDays :: GDate -> Word -> GDate gDateSubtractDays date nDays = unsafePerformIO $ with date $ \ptr -> do {# call g_date_subtract_days #} (castPtr ptr) $ fromIntegral nDays peek ptr gDateAddMonths :: GDate -> Word -> GDate gDateAddMonths date nMonths = unsafePerformIO $ with date $ \ptr -> do {# call g_date_add_months #} (castPtr ptr) $ fromIntegral nMonths peek ptr gDateSubtractMonths :: GDate -> Word -> GDate gDateSubtractMonths date nMonths = unsafePerformIO $ with date $ \ptr -> do {# call g_date_subtract_months #} (castPtr ptr) $ fromIntegral nMonths peek ptr gDateAddYears :: GDate -> Word -> GDate gDateAddYears date nYears = unsafePerformIO $ with date $ \ptr -> do {# call g_date_add_years #} (castPtr ptr) $ fromIntegral nYears peek ptr gDateSubtractYears :: GDate -> Word -> GDate gDateSubtractYears date nYears = unsafePerformIO $ with date $ \ptr -> do {# call g_date_subtract_years #} (castPtr ptr) $ fromIntegral nYears peek ptr gDateDaysBetween :: GDate -> GDate -> Int gDateDaysBetween date1 date2 = fromIntegral $ unsafePerformIO $ with date1 $ \ptr1 -> with date2 $ \ptr2 -> {# call g_date_days_between #} (castPtr ptr1) $ castPtr ptr2 gDateCompare :: GDate -> GDate -> Ordering gDateCompare date1 date2 = let result = fromIntegral $ unsafePerformIO $ with date1 $ \ptr1 -> with date2 $ \ptr2 -> {# call g_date_compare #} (castPtr ptr1) $ castPtr ptr2 ordering | result < 0 = LT | result > 0 = GT | otherwise = EQ in ordering instance Ord GDate where compare = gDateCompare gDateClamp :: GDate -> GDate -> GDate -> GDate gDateClamp date minDate maxDate = unsafePerformIO $ with date $ \ptr -> with minDate $ \minPtr -> with maxDate $ \maxPtr -> do {# call g_date_clamp #} (castPtr ptr) (castPtr minPtr) $ castPtr maxPtr peek ptr gDateDay :: GDate -> GDateDay gDateDay date = GDateDay $ unsafePerformIO $ with date $ {# call g_date_get_day #} . castPtr gDateMonth :: GDate -> GDateMonth gDateMonth date = toEnum $ fromIntegral $ unsafePerformIO $ with date $ {# call g_date_get_month #} . castPtr gDateYear :: GDate -> GDateYear gDateYear date = GDateYear $ unsafePerformIO $ with date $ {# call g_date_get_year #} . castPtr gDateWeekday :: GDate -> GDateWeekday gDateWeekday date = toEnum $ fromIntegral $ unsafePerformIO $ with date $ {# call g_date_get_weekday #} . castPtr glib-0.13.4.1/System/Glib/GError.chs0000644000000000000000000002501213005220034015066 0ustar0000000000000000{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) GError API -- -- Author : Duncan Coutts -- -- Created: 2 July 2004 -- -- Copyright (C) 2004 Duncan Coutts -- parts derived from Structs.hsc Copyright (c) 1999..2002 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Error Reporting, glib's system for reporting errors. -- -- 'GError's are used by glib to report recoverable runtime errors. -- -- This module provides functions for checking glib\/gtk functions that report -- 'GError's. It also provides functions for throwing and catching 'GError's as -- Haskell exceptions. -- module System.Glib.GError ( -- * Data types -- GError(..), GErrorDomain, GErrorCode, GErrorMessage, -- * Catching GError exceptions -- | To catch GError exceptions thrown by Gtk2Hs functions use the -- catchGError* or handleGError* functions. They work in a similar way to -- the standard 'Control.Exception.catch' and 'Control.Exception.handle' -- functions. -- -- 'catchGError' \/ 'handleGError' catches all GError exceptions, you provide -- a handler function that gets given the GError if an exception was thrown. -- This is the most general but is probably not what you want most of the -- time. It just gives you the raw error code rather than a Haskell -- enumeration of the error codes. Most of the time you will only want to -- catch a specific error or any error from a specific error domain. To -- catch just a single specific error use -- 'catchGErrorJust' \/ 'handleGErrorJust'. To catch any error in a -- particular error domain use 'catchGErrorJustDomain' \/ -- 'handleGErrorJustDomain' -- catchGErrorJust, catchGErrorJustDomain, handleGErrorJust, handleGErrorJustDomain, -- ** Deprecated catchGError, handleGError, failOnGError, throwGError, -- * Checking for GErrors returned by glib\/gtk functions -- | * Note, these functions are only useful to implementors -- -- If you are wrapping a new API that reports 'GError's you should probably -- use 'propagateGError' to convert the GError into an exception. You should -- also note in the documentation for the function that it throws GError -- exceptions and the Haskell enumeration for the expected glib GError -- domain(s), so that users know what exceptions they might want to catch. -- -- If you think it is more appropriate to use an alternate return value (eg -- Either\/Maybe) then you should use 'checkGError'. GErrorClass(..), propagateGError, checkGError ) where import Foreign import Foreign.C import System.Glib.UTFString import Control.Exception import Data.Typeable import Data.Text (Text) import qualified Data.Text as T (unpack) import Prelude hiding (catch) -- | A GError consists of a domain, code and a human readable message. data GError = GError !GErrorDomain !GErrorCode !GErrorMessage deriving Typeable instance Show GError where show (GError _ _ msg) = T.unpack msg instance Exception GError type GQuark = {#type GQuark #} -- | A code used to identify the \'namespace\' of the error. Within each error -- domain all the error codes are defined in an enumeration. Each gtk\/gnome -- module that uses GErrors has its own error domain. The rationale behind -- using error domains is so that each module can organise its own error codes -- without having to coordinate on a global error code list. type GErrorDomain = GQuark -- | A code to identify a specific error within a given 'GErrorDomain'. Most of -- time you will not need to deal with this raw code since there is an -- enumeration type for each error domain. Of course which enumeraton to use -- depends on the error domain, but if you use 'catchGErrorJustDomain' or -- 'handleGErrorJustDomain', this is worked out for you automatically. type GErrorCode = Int -- | A human readable error message. type GErrorMessage = Text instance Storable GError where sizeOf _ = {#sizeof GError #} alignment _ = alignment (undefined:: GQuark) peek ptr = do (domain :: GQuark) <- {#get GError->domain #} ptr (code :: {#type gint #}) <- {#get GError->code #} ptr (msgPtr :: CString) <- {#get GError->message #} ptr msg <- peekUTFString msgPtr return $ GError (fromIntegral domain) (fromIntegral code) msg poke _ = error "GError::poke: not implemented" -- | Each error domain's error enumeration type should be an instance of this -- class. This class helps to hide the raw error and domain codes from the -- user. This interface should be implemented by calling the approrpiate -- @{error_domain}_error_quark@. It is safe to use a pure FFI call for this. -- -- Example for 'Graphics.UI.Gtk.Gdk.Pixbuf.PixbufError': -- -- > instance GErrorClass PixbufError where -- > gerrorDomain _ = {#call pure unsafe pixbuf_error_quark#} -- class Enum err => GErrorClass err where gerrorDomain :: err -> GErrorDomain -- ^ This must not use the value of its -- parameter so that it is safe to pass -- 'undefined'. -- | Glib functions which report 'GError's take as a parameter a @GError -- **error@. Use this function to supply such a parameter. It checks if an -- error was reported and if so throws it as a Haskell exception. -- -- Example of use: -- -- > propagateGError $ \gerrorPtr -> -- > {# call g_some_function_that_might_return_an_error #} a b gerrorPtr -- propagateGError :: (Ptr (Ptr ()) -> IO a) -> IO a propagateGError action = checkGError action throwGError -- | Like 'propagateGError' but instead of throwing the GError as an exception -- handles the error immediately using the supplied error handler. -- -- Example of use: -- -- > checkGError -- > (\gerrorPtr -> {# call g_some_function_that_might_return_an_error #} a b gerrorPtr) -- > (\(GError domain code msg) -> ...) -- checkGError :: (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a checkGError action handler = alloca $ \(errPtrPtr :: Ptr (Ptr GError)) -> do poke errPtrPtr nullPtr result <- action (castPtr errPtrPtr) errPtr <- peek errPtrPtr if errPtr == nullPtr then return result else do gerror <- peek errPtr {# call unsafe g_error_free #} (castPtr errPtr) handler gerror -- | Use this if you need to explicitly throw a GError or re-throw an existing -- GError that you do not wish to handle. throwGError :: GError -> IO a throwGError = throw {-# DEPRECATED throwGError "Use ordinary Control.Exception.throw" #-} -- | This will catch any GError exception. The handler function will receive the -- raw GError. This is probably only useful when you want to take some action -- that does not depend on which GError exception has occured, otherwise it -- would be better to use either 'catchGErrorJust' or 'catchGErrorJustDomain'. -- For example: -- -- > catchGError -- > (do ... -- > ...) -- > (\(GError dom code msg) -> fail msg) -- catchGError :: IO a -- ^ The computation to run -> (GError -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a catchGError = catch {-# DEPRECATED catchGError "Use ordinary Control.Exception.catch" #-} -- | This will catch just a specific GError exception. If you need to catch a -- range of related errors, 'catchGErrorJustDomain' is probably more -- appropriate. Example: -- -- > do image <- catchGErrorJust PixbufErrorCorruptImage -- > loadImage -- > (\errorMessage -> do log errorMessage -- > return mssingImagePlaceholder) -- catchGErrorJust :: GErrorClass err => err -- ^ The error to catch -> IO a -- ^ The computation to run -> (GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a catchGErrorJust code action handler = catch action handler' where handler' gerror@(GError domain code' msg) | fromIntegral domain == gerrorDomain code && code' == fromEnum code = handler msg | otherwise = throw gerror -- | Catch all GErrors from a particular error domain. The handler function -- should just deal with one error enumeration type. If you need to catch -- errors from more than one error domain, use this function twice with an -- appropriate handler functions for each. -- -- > catchGErrorJustDomain -- > loadImage -- > (\err message -> case err of -- > PixbufErrorCorruptImage -> ... -- > PixbufErrorInsufficientMemory -> ... -- > PixbufErrorUnknownType -> ... -- > _ -> ...) -- catchGErrorJustDomain :: GErrorClass err => IO a -- ^ The computation to run -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a catchGErrorJustDomain action (handler :: err -> GErrorMessage -> IO a) = catch action handler' where handler' gerror@(GError domain code msg) | fromIntegral domain == gerrorDomain (undefined::err) = handler (toEnum code) msg | otherwise = throwGError gerror -- | A verson of 'catchGError' with the arguments swapped around. -- -- > handleGError (\(GError dom code msg) -> ...) $ -- > ... -- handleGError :: (GError -> IO a) -> IO a -> IO a handleGError = handle {-# DEPRECATED handleGError "Use ordinary Control.Exception.handle" #-} -- | A verson of 'handleGErrorJust' with the arguments swapped around. handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a -> IO a handleGErrorJust code = flip (catchGErrorJust code) -- | A verson of 'catchGErrorJustDomain' with the arguments swapped around. handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> IO a -> IO a handleGErrorJustDomain = flip catchGErrorJustDomain -- | Catch all GError exceptions and convert them into a general failure. failOnGError :: IO a -> IO a failOnGError action = catchGError action (\(GError dom code msg) -> fail (T.unpack msg)) glib-0.13.4.1/System/Glib/GList.chs0000644000000000000000000000746213005220034014721 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) -- -- Author : Axel Simon -- -- Created: 19 March 2002 -- -- Copyright (C) 2002 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Defines functions to extract data from a GList and to produce a GList from -- a list of pointers. -- -- * The same for GSList. -- module System.Glib.GList ( GList, readGList, fromGList, toGList, withGList, GSList, readGSList, fromGSList, fromGSListRev, toGSList, withGSList, ) where import Foreign import Control.Exception (bracket) import Control.Monad (foldM) {# context lib="glib" prefix="g" #} {#pointer * GList#} {#pointer * GSList#} -- methods -- Turn a GList into a list of pointers but don't destroy the list. -- readGList :: GList -> IO [Ptr a] readGList glist | glist==nullPtr = return [] | otherwise = do x <- {#get GList->data#} glist glist' <- {#get GList->next#} glist xs <- readGList glist' return (castPtr x:xs) -- Turn a GList into a list of pointers (freeing the GList in the process). -- fromGList :: GList -> IO [Ptr a] fromGList glist = do glist' <- {#call unsafe list_reverse#} glist extractList glist' [] where extractList gl xs | gl==nullPtr = return xs | otherwise = do x <- {#get GList.data#} gl gl' <- {#call unsafe list_delete_link#} gl gl extractList gl' (castPtr x:xs) -- Turn a GSList into a list of pointers but don't destroy the list. -- readGSList :: GSList -> IO [Ptr a] readGSList gslist | gslist==nullPtr = return [] | otherwise = do x <- {#get GSList->data#} gslist gslist' <- {#get GSList->next#} gslist xs <- readGSList gslist' return (castPtr x:xs) -- Turn a GSList into a list of pointers (freeing the GSList in the process). -- fromGSList :: GSList -> IO [Ptr a] fromGSList gslist | gslist==nullPtr = return [] | otherwise = do x <- {#get GSList->data#} gslist gslist' <- {#call unsafe slist_delete_link#} gslist gslist xs <- fromGSList gslist' return (castPtr x:xs) -- Turn a GSList into a list of pointers and reverse it. -- fromGSListRev :: GSList -> IO [Ptr a] fromGSListRev gslist = extractList gslist [] where extractList gslist xs | gslist==nullPtr = return xs | otherwise = do x <- {#get GSList->data#} gslist gslist' <- {#call unsafe slist_delete_link#} gslist gslist extractList gslist' (castPtr x:xs) -- Turn a list of something into a GList. -- toGList :: [Ptr a] -> IO GList toGList = foldM prepend nullPtr . reverse where -- prepend :: GList -> Ptr a -> IO GList prepend l x = {#call unsafe list_prepend#} l (castPtr x) -- Turn a list of something into a GSList. -- toGSList :: [Ptr a] -> IO GSList toGSList = foldM prepend nullPtr . reverse where -- prepend :: GSList -> Ptr a -> IO GList prepend l x = {#call unsafe slist_prepend#} l (castPtr x) -- Temporarily allocate a list of something -- withGList :: [Ptr a] -> (GSList -> IO b) -> IO b withGList xs = bracket (toGList xs) {# call unsafe g_list_free #} -- Temporarily allocate a list of something -- withGSList :: [Ptr a] -> (GSList -> IO b) -> IO b withGSList xs = bracket (toGSList xs) {# call unsafe g_slist_free #} glib-0.13.4.1/System/Glib/GObject.chs0000644000000000000000000001762413005220034015215 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) GObject -- -- Author : Axel Simon -- -- Created: 9 April 2001 -- -- Copyright (C) 2001 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The base object type for all glib objects -- module System.Glib.GObject ( -- * Types module System.Glib.Types, -- * Low level binding functions -- | All these functions are internal and are only interesting to people -- writing bindings to GObject-style C libraries. objectNew, objectRef, #if GLIB_CHECK_VERSION(2,10,0) objectRefSink, #endif makeNewGObject, constructNewGObject, wrapNewGObject, -- ** GType queries gTypeGObject, isA, -- ** Callback support DestroyNotify, destroyFunPtr, destroyStablePtr, -- ** User-Defined Attributes Quark, quarkFromString, objectCreateAttribute, objectSetAttribute, objectGetAttributeUnsafe ) where import Control.Monad (liftM, when) import Data.IORef (newIORef, readIORef, writeIORef) import qualified Data.Text as T (pack) import System.Glib.FFI import System.Glib.UTFString {#import System.Glib.Types#} import System.Glib.GValue (GValue) import System.Glib.GType (GType, typeInstanceIsA) import System.Glib.GTypeConstants ( object ) import System.Glib.GParameter import System.Glib.Attributes (newNamedAttr, Attr) import Foreign.StablePtr import Control.Concurrent.MVar ( MVar, newMVar, modifyMVar ) {# context lib="glib" prefix="g" #} {# pointer *GParameter as GParm -> GParameter #} -- | Construct a new object (should rairly be used directly) -- objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject) objectNew objType parameters = liftM castPtr $ --caller must makeNewGObject as we don't know --if it this a GObject or a GtkObject withArray (map GParameter parameters) $ \paramArrayPtr -> {# call g_object_newv #} objType (fromIntegral $ length parameters) paramArrayPtr #if GLIB_CHECK_VERSION(2,10,0) -- | Reference and sink an object. objectRefSink :: GObjectClass obj => Ptr obj -> IO () objectRefSink obj = do {#call unsafe object_ref_sink#} (castPtr obj) return () #endif -- | Increase the reference counter of an object -- objectRef :: GObjectClass obj => Ptr obj -> IO () objectRef obj = do {#call unsafe object_ref#} (castPtr obj) return () -- | The type constant to check if an instance is of 'GObject' type. gTypeGObject :: GType gTypeGObject = object -- | This function wraps any object that does not derive from Object. -- It should be used whenever a function returns a pointer to an existing -- 'GObject' (as opposed to a function that constructs a new object). -- -- * The first argument is the contructor of the specific object. -- makeNewGObject :: GObjectClass obj => (ForeignPtr obj -> obj, FinalizerPtr obj) -- ^ constructor for the Haskell object and finalizer C function -> IO (Ptr obj) -- ^ action which yields a pointer to the C object -> IO obj makeNewGObject (constr, objectUnref) generator = do objPtr <- generator when (objPtr == nullPtr) (fail "makeNewGObject: object is NULL") objectRef objPtr obj <- newForeignPtr objPtr objectUnref return $! constr obj {#pointer GDestroyNotify as DestroyNotify#} -- | This function wraps any newly created objects that derives from -- GInitiallyUnowned also known as objects with -- \"floating-references\". The object will be refSink (for glib -- versions >= 2.10). On non-floating objects, this function behaves -- exactly the same as "makeNewGObject". -- constructNewGObject :: GObjectClass obj => (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj constructNewGObject (constr, objectUnref) generator = do objPtr <- generator #if GLIB_CHECK_VERSION(2,10,0) -- change the exisiting floating reference into a proper reference; -- the name is confusing, what the function does is ref,sink,unref objectRefSink objPtr #endif obj <- newForeignPtr objPtr objectUnref return $! constr obj -- | This function wraps any newly created object that does not derived -- from GInitiallyUnowned (that is a GObject with no floating -- reference). Since newly created 'GObject's have a reference count of -- one, they don't need ref'ing. -- wrapNewGObject :: GObjectClass obj => (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj wrapNewGObject (constr, objectUnref) generator = do objPtr <- generator when (objPtr == nullPtr) (fail "wrapNewGObject: object is NULL") obj <- newForeignPtr objPtr objectUnref return $! constr obj -- | Many methods in classes derived from GObject take a callback function and -- a destructor function which is called to free that callback function when -- it is no longer required. This constants is an address of a functions in -- C land that will free a function pointer. foreign import ccall unsafe "&freeHaskellFunctionPtr" destroyFunPtr :: DestroyNotify type Quark = {#type GQuark#} -- | A counter for generating unique names. {-# NOINLINE uniqueCnt #-} uniqueCnt :: MVar Int uniqueCnt = unsafePerformIO $ newMVar 0 -- | Create a unique id based on the given string. quarkFromString :: GlibString string => string -> IO Quark quarkFromString name = withUTFString name {#call unsafe quark_from_string#} -- | Add an attribute to this object. -- -- * The function returns a new attribute that can be set or retrieved from -- any 'GObject'. The attribute is wrapped in a 'Maybe' type to reflect -- the circumstance when the attribute is not set or if it should be unset. -- objectCreateAttribute :: GObjectClass o => IO (Attr o (Maybe a)) objectCreateAttribute = do cnt <- modifyMVar uniqueCnt (\cnt -> return (cnt+1, cnt)) let propName = "Gtk2HsAttr"++show cnt attr <- quarkFromString $ T.pack propName return (newNamedAttr propName (objectGetAttributeUnsafe attr) (objectSetAttribute attr)) -- | The address of a function freeing a 'StablePtr'. See 'destroyFunPtr'. foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: DestroyNotify -- | Set the value of an association. -- objectSetAttribute :: GObjectClass o => Quark -> o -> Maybe a -> IO () objectSetAttribute attr obj Nothing = do {#call object_set_qdata#} (toGObject obj) attr nullPtr objectSetAttribute attr obj (Just val) = do sPtr <- newStablePtr val {#call object_set_qdata_full#} (toGObject obj) attr (castStablePtrToPtr sPtr) destroyStablePtr -- | Get the value of an association. -- -- * Note that this function may crash the Haskell run-time since the -- returned type can be forced to be anything. See 'objectCreateAttribute' -- for a safe wrapper around this funciton. -- objectGetAttributeUnsafe :: GObjectClass o => Quark -> o -> IO (Maybe a) objectGetAttributeUnsafe attr obj = do sPtr <- {#call unsafe object_get_qdata#} (toGObject obj) attr if sPtr==nullPtr then return Nothing else liftM Just $! deRefStablePtr (castPtrToStablePtr sPtr) -- | Determine if this is an instance of a particular GTK type -- isA :: GObjectClass o => o -> GType -> Bool isA obj gType = typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr.unGObject.toGObject) obj) gType -- at this point we would normally implement the notify signal handler; -- I've moved this definition into the Object class of the gtk package -- since there's a quite a bit of machinery missing here (generated signal -- register functions and the problem of recursive modules) glib-0.13.4.1/System/Glib/GParameter.hsc0000644000000000000000000000267413005220034015726 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) GParameter -- -- Author : Duncan Coutts -- -- Created: 29 March 2004 -- -- Copyright (c) 2004 Duncan Coutts -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Storable instance for GParameter, used by objectNew -- module System.Glib.GParameter ( GParameter(..) ) where import Foreign import Foreign.C import System.Glib.GValue #include --newtype GParameter = GParameter (String, GenericValue) newtype GParameter = GParameter (String, GValue) instance Storable GParameter where sizeOf _ = #const sizeof(GParameter) alignment _ = #{const __alignof__(GParameter)} poke ptr (GParameter (name, GValue gvaluePtr)) = do strPtr <- newCString name #{poke GParameter, name} ptr strPtr -- poke (#{ptr GParameter, value} ptr) value #{poke GParameter, value} ptr gvaluePtr glib-0.13.4.1/System/Glib/GString.chs0000644000000000000000000000444513005220034015252 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) -- -- Author : Andreas Baldeau -- -- Created: 14 November 2010 -- -- Copyright (C) 2010 Andreas Baldeau -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Defines functions to extract data from a GString. -- module System.Glib.GString ( GString, readGString, readGStringByteString, fromGString, ) where import Foreign import Control.Exception (bracket) import Control.Monad (foldM) import Data.ByteString (ByteString, packCStringLen) import System.Glib.FFI {# context lib="glib" prefix="g" #} {#pointer * GString#} -- methods -- Turn a GString into a String but don't destroy it. -- readGString :: GString -> IO (Maybe String) readGString gstring | gstring == nullPtr = return Nothing | otherwise = do gstr <- {#get GString->str#} gstring len <- {#get GString->len#} gstring fmap Just $ peekCStringLen (gstr, fromIntegral len) -- Turn a GString into a ByteString but don't destroy it. -- readGStringByteString :: GString -> IO (Maybe ByteString) readGStringByteString gstring | gstring == nullPtr = return Nothing | otherwise = do gstr <- {#get GString->str#} gstring len <- {#get GString->len#} gstring fmap Just $ packCStringLen (gstr, fromIntegral len) -- Turn a GList into a list of pointers (freeing the GList in the process). -- fromGString :: GString -> IO (Maybe String) fromGString gstring | gstring == nullPtr = return Nothing | otherwise = do gstr <- {#get GString->str#} gstring len <- {#get GString->len#} gstring str <- fmap Just $ peekCStringLen (gstr, fromIntegral len) _ <- {#call unsafe string_free#} gstring $ fromBool True return str glib-0.13.4.1/System/Glib/GType.chs0000644000000000000000000000327113005220034014721 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) GType -- -- Author : Axel Simon -- -- Created: 1 June 2001 -- -- Copyright (c) 1999..2002 Axel Simon -- -- Copyright (C) 2001 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This module implements only the necessities for the GTK binding. -- module System.Glib.GType ( GType, typeInstanceIsA, glibTypeInit, ) where import System.Glib.FFI {# context lib="glib" prefix="g" #} type GType = {#type GType#} -- | Check if an object is of the specific type or derived from it. -- -- * Internally used by Hierarchy. -- typeInstanceIsA :: Ptr () -> GType -> Bool typeInstanceIsA obj p = toBool $ unsafePerformIO ({#call unsafe g_type_check_instance_is_a#} obj p) -- | Prior to any use of the glib type/object system, @glibTypeInit@ has to -- be called to initialise the system. -- -- Note that this is not needed for gtk applications using @initGUI@ since -- that initialises everything itself. It is only needed for applications -- using glib directly, without also using gtk. -- glibTypeInit :: IO () glibTypeInit = {# call g_type_init #} glib-0.13.4.1/System/Glib/GTypeConstants.hsc0000644000000000000000000000326513005220034016621 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) GType constants -- -- Author : Axel Simon -- -- Created: 23 May 2001 -- -- Copyright (c) 1999..2002 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- module System.Glib.GTypeConstants ( invalid, none, uint, int, uint64, int64, uchar, char, bool, enum, flags, pointer, float, double, string, object, boxed ) where import System.Glib.GType (GType) #include invalid, none, uint, int, uint64, int64, uchar, char, bool, enum, flags, pointer, float, double, string, object, boxed :: GType invalid = #const G_TYPE_INVALID none = #const G_TYPE_NONE uint = #const G_TYPE_UINT int = #const G_TYPE_INT uint64 = #const G_TYPE_UINT64 int64 = #const G_TYPE_INT64 uchar = #const G_TYPE_UCHAR char = #const G_TYPE_CHAR bool = #const G_TYPE_BOOLEAN enum = #const G_TYPE_ENUM flags = #const G_TYPE_FLAGS pointer = #const G_TYPE_POINTER float = #const G_TYPE_FLOAT double = #const G_TYPE_DOUBLE string = #const G_TYPE_STRING object = #const G_TYPE_OBJECT boxed = #const G_TYPE_BOXED glib-0.13.4.1/System/Glib/GValue.chs0000644000000000000000000000400013005220034015043 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) GValue -- -- Author : Axel Simon -- -- Created: 1 June 2001 -- -- Copyright (c) 1999..2002 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This module implements only the necessities for the GTK binding. -- -- * Everything here is only used by "Graphics.UI.Gtk.TreeList.TreeModel" and -- friends. -- module System.Glib.GValue ( GValue(GValue), valueInit, valueGetType, allocaGValue ) where import System.Glib.FFI import System.Glib.GType (GType) {# context lib="glib" prefix="g" #} {# pointer *GValue newtype #} -- | Clear a GValue. -- valueInit :: GValue -> GType -> IO () valueInit gv gt = do -- The g_type field of the value must be zero or g_value_init will fail. {# call unsafe value_init #} gv gt return () -- | Get the type of the value stored in the GValue -- valueGetType :: GValue -> IO GType valueGetType (GValue gvPtr) = {# get GValue->g_type #} gvPtr -- | Temporarily allocate a GValue. -- allocaGValue :: (GValue -> IO b) -> IO b allocaGValue body = -- c2hs is broken in that it can't handle arrays of compound arrays in the -- sizeof hook allocaBytes ({# sizeof GType #}+ 2* {# sizeof guint64 #}) $ \gvPtr -> do -- The g_type field of the value must be zero or g_value_init will fail. {# set GValue->g_type #} gvPtr (0 :: GType) result <- body (GValue gvPtr) {#call unsafe value_unset#} (GValue gvPtr) return result glib-0.13.4.1/System/Glib/GValueTypes.chs0000644000000000000000000001731713005220034016107 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) GValueTypes -- -- Author : Axel Simon -- -- Created: 1 June 2001 -- -- Copyright (c) 1999..2002 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This is used by the implementation of properties and by the -- 'Graphics.UI.Gtk.TreeList.TreeModel' and -- related modules. -- module System.Glib.GValueTypes ( valueSetUInt, valueGetUInt, valueSetInt, valueGetInt, valueSetUInt64, valueGetUInt64, valueSetInt64, valueGetInt64, valueSetBool, valueGetBool, valueSetPointer, valueGetPointer, valueSetFloat, valueGetFloat, valueSetDouble, valueGetDouble, valueSetEnum, valueGetEnum, valueSetFlags, valueGetFlags, valueSetString, valueGetString, valueSetMaybeString, valueGetMaybeString, valueSetFilePath, valueGetFilePath, valueSetMaybeFilePath, valueGetMaybeFilePath, valueSetBoxed, valueGetBoxed, valueSetGObject, valueGetGObject, valueSetMaybeGObject, valueGetMaybeGObject, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags import System.Glib.UTFString {#import System.Glib.GValue#} (GValue(GValue)) import System.Glib.GObject {# context lib="glib" prefix="g" #} valueSetUInt :: GValue -> Word -> IO () valueSetUInt gvalue value = {# call unsafe value_set_uint #} gvalue (fromIntegral value) valueGetUInt :: GValue -> IO Word valueGetUInt gvalue = liftM fromIntegral $ {# call unsafe value_get_uint #} gvalue valueSetInt :: GValue -> Int -> IO () valueSetInt gvalue value = {# call unsafe value_set_int #} gvalue (fromIntegral value) valueGetInt :: GValue -> IO Int valueGetInt gvalue = liftM fromIntegral $ {# call unsafe value_get_int #} gvalue valueSetUInt64 :: GValue -> Word64 -> IO () valueSetUInt64 gvalue value = {# call unsafe value_set_uint64 #} gvalue (fromIntegral value) valueGetUInt64 :: GValue -> IO Word64 valueGetUInt64 gvalue = liftM fromIntegral $ {# call unsafe value_get_uint64 #} gvalue valueSetInt64 :: GValue -> Int64 -> IO () valueSetInt64 gvalue value = {# call unsafe value_set_int64 #} gvalue (fromIntegral value) valueGetInt64 :: GValue -> IO Int64 valueGetInt64 gvalue = liftM fromIntegral $ {# call unsafe value_get_int64 #} gvalue valueSetBool :: GValue -> Bool -> IO () valueSetBool gvalue value = {# call unsafe value_set_boolean #} gvalue (fromBool value) valueGetBool :: GValue -> IO Bool valueGetBool gvalue = liftM toBool $ {# call unsafe value_get_boolean #} gvalue -- These functions should probably never be used as they are dangerous. -- valueSetPointer :: GValue -> (Ptr ()) -> IO () valueSetPointer gvalue value = {# call unsafe value_set_pointer #} gvalue value valueGetPointer :: GValue -> IO (Ptr ()) valueGetPointer gvalue = {# call unsafe value_get_pointer #} gvalue valueSetFloat :: GValue -> Float -> IO () valueSetFloat gvalue value = {# call unsafe value_set_float #} gvalue (realToFrac value) valueGetFloat :: GValue -> IO Float valueGetFloat gvalue = liftM realToFrac $ {# call unsafe value_get_float #} gvalue valueSetDouble :: GValue -> Double -> IO () valueSetDouble gvalue value = {# call unsafe value_set_double #} gvalue (realToFrac value) valueGetDouble :: GValue -> IO Double valueGetDouble gvalue = liftM realToFrac $ {# call unsafe value_get_double #} gvalue valueSetEnum :: Enum enum => GValue -> enum -> IO () valueSetEnum gvalue value = {# call unsafe value_set_enum #} gvalue (fromIntegral $ fromEnum value) valueGetEnum :: Enum enum => GValue -> IO enum valueGetEnum gvalue = liftM (toEnum . fromIntegral) $ {# call unsafe value_get_enum #} gvalue valueSetFlags :: Flags flag => GValue -> [flag] -> IO () valueSetFlags gvalue value = {# call unsafe value_set_flags #} gvalue (fromIntegral $ fromFlags value) valueGetFlags :: Flags flag => GValue -> IO [flag] valueGetFlags gvalue = liftM (toFlags . fromIntegral) $ {# call unsafe value_get_flags #} gvalue valueSetString :: GlibString string => GValue -> string -> IO () valueSetString gvalue str = withUTFString str $ \strPtr -> {# call unsafe value_set_string #} gvalue strPtr valueGetString :: GlibString string => GValue -> IO string valueGetString gvalue = do strPtr <- {# call unsafe value_get_string #} gvalue if strPtr == nullPtr then return "" else peekUTFString strPtr valueSetMaybeString :: GlibString string => GValue -> Maybe string -> IO () valueSetMaybeString gvalue (Just str) = withUTFString str $ \strPtr -> {# call unsafe value_set_string #} gvalue strPtr valueSetMaybeString gvalue Nothing = {# call unsafe value_set_static_string #} gvalue nullPtr valueGetMaybeString :: GlibString string => GValue -> IO (Maybe string) valueGetMaybeString gvalue = {# call unsafe value_get_string #} gvalue >>= maybePeek peekUTFString valueSetFilePath :: GlibFilePath string => GValue -> string -> IO () valueSetFilePath gvalue str = withUTFFilePath str $ \strPtr -> {# call unsafe value_set_string #} gvalue strPtr valueGetFilePath :: GlibFilePath string => GValue -> IO string valueGetFilePath gvalue = do strPtr <- {# call unsafe value_get_string #} gvalue if strPtr == nullPtr then return "" else peekUTFFilePath strPtr valueSetMaybeFilePath :: GlibFilePath string => GValue -> Maybe string -> IO () valueSetMaybeFilePath gvalue (Just str) = withUTFFilePath str $ \strPtr -> {# call unsafe value_set_string #} gvalue strPtr valueSetMaybeFilePath gvalue Nothing = {# call unsafe value_set_static_string #} gvalue nullPtr valueGetMaybeFilePath :: GlibFilePath string => GValue -> IO (Maybe string) valueGetMaybeFilePath gvalue = {# call unsafe value_get_string #} gvalue >>= maybePeek peekUTFFilePath valueSetBoxed :: (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> GValue -> boxed -> IO () valueSetBoxed with gvalue boxed = with boxed $ \boxedPtr -> do {# call unsafe g_value_set_boxed #} gvalue (castPtr boxedPtr) valueGetBoxed :: (Ptr boxed -> IO boxed) -> GValue -> IO boxed valueGetBoxed peek gvalue = {# call unsafe g_value_get_boxed #} gvalue >>= peek . castPtr -- for some weird reason the API says that gv is a gpointer, not a GObject -- valueSetGObject :: GObjectClass gobj => GValue -> gobj -> IO () valueSetGObject gvalue obj = withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> {# call unsafe g_value_set_object #} gvalue (castPtr objPtr) -- Unsafe because it performs an unchecked downcast. Only for internal use. -- valueGetGObject :: GObjectClass gobj => GValue -> IO gobj valueGetGObject gvalue = liftM unsafeCastGObject $ makeNewGObject mkGObject $ throwIfNull "GValue.valueGetObject: extracting invalid object" $ liftM castPtr $ {# call unsafe value_get_object #} gvalue valueSetMaybeGObject :: GObjectClass gobj => GValue -> (Maybe gobj) -> IO () valueSetMaybeGObject gvalue (Just obj) = valueSetGObject gvalue obj valueSetMaybeGObject gvalue Nothing = {# call unsafe g_value_set_object #} gvalue nullPtr valueGetMaybeGObject :: GObjectClass gobj => GValue -> IO (Maybe gobj) valueGetMaybeGObject gvalue = liftM (liftM unsafeCastGObject) $ maybeNull (makeNewGObject mkGObject) $ liftM castPtr $ {# call unsafe value_get_object #} gvalue glib-0.13.4.1/System/Glib/hsgclosure.c0000644000000000000000000002337613005220034015524 0ustar0000000000000000/* GIMP Toolkit (GTK) Gtk2HsClosure implementation * * Author : Duncan Coutts * * Created: 22 March 2005 * * Copyright (C) 2005 Duncan Coutts * * 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. */ /* GHC's semi-public Rts API */ #include #include "hsgclosure.h" #ifdef DEBUG #define WHEN_DEBUG(a) a #else #define WHEN_DEBUG(a) #endif #if __GLASGOW_HASKELL__>604 #define GHC_RTS_USES_CAPABILITY #define CAP cap, #else #define CAP #endif /* Gtk2HsClosure is a _private_ structure */ typedef struct _Gtk2HsClosure Gtk2HsClosure; struct _Gtk2HsClosure { GClosure closure; HsStablePtr callback; }; /* TODO: check if we should be using invalidate or finalise */ static void gtk2hs_closure_invalidate(gpointer data, GClosure *closure) { Gtk2HsClosure *hc = (Gtk2HsClosure *)closure; WHEN_DEBUG(g_debug("gtk2hs_closure_invalidate: enter, callback=%p", hc->callback)); /* I think invalidate can be called more than once in the case of cycles * so be safe and allow that */ if (hc->callback) hs_free_stable_ptr(hc->callback); hc->callback = NULL; WHEN_DEBUG(g_debug("gtk2hs_closure_invalidate: leave")); } /* forward defs */ #ifdef GHC_RTS_USES_CAPABILITY static HaskellObj gtk2hs_value_as_haskellobj(Capability *cap, const GValue *value); #else static HaskellObj gtk2hs_value_as_haskellobj(const GValue *value); #endif static void gtk2hs_value_from_haskellobj(GValue *value, HaskellObj obj); extern StgClosure * GHCziStable_deRefStablePtr_closure; static void gtk2hs_closure_marshal(GClosure *closure, GValue *return_value, guint n_param_values, const GValue *param_values, gpointer invocation_hint, gpointer marshal_data) { Gtk2HsClosure *hc = (Gtk2HsClosure *)closure; HaskellObj call, ret; #ifdef GHC_RTS_USES_CAPABILITY Capability *cap; #else SchedulerStatus cap; #endif guint i; WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to run callback, n_param_values=%d", hc->callback, n_param_values)); #ifdef GHC_RTS_USES_CAPABILITY cap = rts_lock(); #else rts_lock(); #endif call = (StgClosure *)deRefStablePtr(hc->callback); /* construct the function call */ for (i = 0; i < n_param_values; i++) { WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): param_values[%d]=%s :: %s", hc->callback, i, g_strdup_value_contents(¶m_values[i]), g_type_name(G_VALUE_TYPE(¶m_values[i])))); call = rts_apply(CAP call, gtk2hs_value_as_haskellobj(CAP ¶m_values[i])); } WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_evalIO", hc->callback)); /* perform the call */ #if __GLASGOW_HASKELL__>=704 rts_evalIO(&cap, rts_apply(CAP (HaskellObj)runIO_closure, call),&ret); #else cap=rts_evalIO(CAP rts_apply(CAP (HaskellObj)runIO_closure, call),&ret); #endif WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_checkSchedStatus", hc->callback)); /* barf if anything went wrong */ /* TODO: pass a sensible value for call site so we get better error messages */ /* or perhaps we can propogate any error? */ rts_checkSchedStatus("gtk2hs_closure_marshal", cap); WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): ret=%p", hc->callback, ret)); if (return_value) { WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): return_value :: %s, ret=%p, UNTAG_CLOSURE(ret)=%p", hc->callback, /* g_strdup_value_contents(return_value), */ g_type_name(G_VALUE_TYPE(return_value)), ret, UNTAG_CLOSURE(ret))); gtk2hs_value_from_haskellobj(return_value, ret); } #ifdef GHC_RTS_USES_CAPABILITY rts_unlock(cap); #else rts_unlock(); #endif WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): done running callback", hc->callback)); } GClosure * gtk2hs_closure_new(HsStablePtr callback) { GClosure *closure; WHEN_DEBUG(g_debug("gtk2hs_closure_new: enter, callback=%p", callback)); closure = g_closure_new_simple(sizeof(Gtk2HsClosure), NULL); /* TODO: check if we should be using invalidate or finalise notifier */ g_closure_add_invalidate_notifier(closure, NULL, gtk2hs_closure_invalidate); g_closure_set_marshal(closure, gtk2hs_closure_marshal); ((Gtk2HsClosure *)closure)->callback = callback; WHEN_DEBUG(g_debug("gtk2hs_closure_new: leave")); return closure; } /* GValue <-> HaskellObj marshaling functions */ static HaskellObj #ifdef GHC_RTS_USES_CAPABILITY gtk2hs_value_as_haskellobj(Capability *cap, const GValue *value) { #else gtk2hs_value_as_haskellobj(const GValue *value) { #endif switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { case G_TYPE_INTERFACE: if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) return rts_mkPtr(CAP g_value_get_object(value)); else break; case G_TYPE_CHAR: #if GLIB_CHECK_VERSION(2,31,0) return rts_mkChar(CAP g_value_get_schar(value)); #else return rts_mkChar(CAP g_value_get_char(value)); #endif case G_TYPE_UCHAR: return rts_mkChar(CAP g_value_get_uchar(value)); case G_TYPE_BOOLEAN: return rts_mkBool(CAP g_value_get_boolean(value)); case G_TYPE_INT: return rts_mkInt(CAP g_value_get_int(value)); case G_TYPE_UINT: return rts_mkWord(CAP g_value_get_uint(value)); case G_TYPE_LONG: return rts_mkInt(CAP g_value_get_long(value)); case G_TYPE_ULONG: return rts_mkWord(CAP g_value_get_ulong(value)); /* case G_TYPE_INT64: return rts_mkInt64(CAP g_value_get_int64(value)); case G_TYPE_UINT64: return rts_mkWord64(CAP g_value_get_uint64(value)); */ case G_TYPE_ENUM: return rts_mkInt(CAP g_value_get_enum(value)); case G_TYPE_FLAGS: return rts_mkWord(CAP g_value_get_enum(value)); case G_TYPE_FLOAT: return rts_mkFloat(CAP g_value_get_float(value)); case G_TYPE_DOUBLE: return rts_mkDouble(CAP g_value_get_double(value)); case G_TYPE_STRING: return rts_mkPtr(CAP (char *)g_value_get_string(value)); /* CHECKME: is the string freed? */ case G_TYPE_POINTER: return rts_mkPtr(CAP g_value_get_pointer(value)); case G_TYPE_BOXED: return rts_mkPtr(CAP g_value_get_boxed(value)); case G_TYPE_PARAM: return rts_mkPtr(CAP g_value_get_param(value)); case G_TYPE_OBJECT: return rts_mkPtr(CAP g_value_get_object(value)); } g_error("gtk2hs_value_as_haskellobj: unable to handle GValue with type %s\n" "please report this as a bug to gtk2hs-devel@lists.sourceforge.net", g_type_name(G_VALUE_TYPE(value))); } void gtk2hs_value_from_haskellobj(GValue *value, HaskellObj obj) { switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { case G_TYPE_INVALID: case G_TYPE_NONE: return; case G_TYPE_INTERFACE: /* we only handle interface types that have a GObject prereq */ if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) { g_value_set_object(value, rts_getPtr(obj)); } else { break; } return; case G_TYPE_CHAR: #if GLIB_CHECK_VERSION(2,31,0) g_value_set_schar(value, rts_getChar(obj)); #else g_value_set_char(value, rts_getChar(obj)); #endif return; case G_TYPE_UCHAR: #if GLIB_CHECK_VERSION(2,31,0) g_value_set_schar(value, rts_getChar(obj)); #else g_value_set_char(value, rts_getChar(obj)); #endif return; case G_TYPE_BOOLEAN: g_value_set_boolean(value, rts_getBool(obj)); return; case G_TYPE_INT: g_value_set_int(value, rts_getInt(obj)); return; case G_TYPE_UINT: g_value_set_uint(value, rts_getWord(obj)); return; case G_TYPE_LONG: g_value_set_long(value, rts_getInt(obj)); return; case G_TYPE_ULONG: g_value_set_ulong(value, rts_getWord(obj)); return; /* case G_TYPE_INT64: g_value_set_int64(value, rts_getInt64(obj)); return; case G_TYPE_UINT64: g_value_set_uint64(value, rts_getWord64(obj)); return; */ case G_TYPE_ENUM: g_value_set_enum(value, rts_getInt(obj)); return; case G_TYPE_FLAGS: g_value_set_flags(value, rts_getInt(obj)); return; case G_TYPE_FLOAT: g_value_set_float(value, rts_getFloat(obj)); return; case G_TYPE_DOUBLE: g_value_set_double(value, rts_getDouble(obj)); return; case G_TYPE_STRING: g_value_set_string(value, rts_getPtr(obj)); return; case G_TYPE_POINTER: g_value_set_pointer(value, rts_getPtr(obj)); return; /* case G_TYPE_BOXED: { g_value_set_boxed(value, obj); break; } case G_TYPE_PARAM: g_value_set_param(value, (obj)); break; */ case G_TYPE_OBJECT: g_value_set_object(value, rts_getPtr(obj)); return; } g_error("gtk2hs_value_from_haskellobj: unable to handle GValue with type %s\n" "please report this as a bug to gtk2hs-devel@lists.sourceforge.net", g_type_name(G_VALUE_TYPE(value))); } glib-0.13.4.1/System/Glib/hsgclosure.h0000644000000000000000000000136413005220034015522 0ustar0000000000000000/* GIMP Toolkit (GTK) HSGClosure interface * * Author : Duncan Coutts * * Created: 22 March 2005 * * Copyright (C) 2005 Duncan Coutts * * 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. */ #include GClosure * gtk2hs_closure_new(HsStablePtr callback); glib-0.13.4.1/System/Glib/MainLoop.chs0000644000000000000000000002674413005220034015421 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) General -- -- Author : Axel Simon, Manuel M. T. Chakravarty, Duncan Coutts -- -- Created: 11 October 2005 -- -- Copyright (C) 2000..2005 Axel Simon, Manuel M. T. Chakravarty, Duncan Coutts -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- main event loop, and events -- module System.Glib.MainLoop ( HandlerId, timeoutAdd, timeoutAddFull, timeoutRemove, idleAdd, idleRemove, IOCondition(..), inputAdd, inputRemove, Priority, priorityLow, priorityDefaultIdle, priorityHighIdle, priorityDefault, priorityHigh, MainLoop, mainLoopNew, mainLoopRun, mainLoopQuit, mainLoopIsRunning, MainContext, mainContextNew, mainContextDefault, mainContextIteration, mainContextFindSourceById, Source(..), sourceAttach, sourceSetPriority, sourceGetPriority, sourceDestroy, #if GLIB_CHECK_VERSION(2,12,0) sourceIsDestroyed #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags import System.Glib.GObject (DestroyNotify, destroyFunPtr) {#context lib="glib" prefix ="g"#} {#pointer SourceFunc#} foreign import ccall "wrapper" mkSourceFunc :: (Ptr () -> IO {#type gint#}) -> IO SourceFunc type HandlerId = {#type guint#} -- Turn a function into a function pointer and a destructor pointer. -- makeCallback :: IO {#type gint#} -> IO (SourceFunc, DestroyNotify) makeCallback fun = do funPtr <- mkSourceFunc (const fun) return (funPtr, destroyFunPtr) -- | Sets a function to be called at regular intervals, with the default -- priority 'priorityDefault'. The function is called repeatedly until it -- returns @False@, after which point the timeout function will not be called -- again. The first call to the function will be at the end of the first interval. -- -- Note that timeout functions may be delayed, due to the processing of other -- event sources. Thus they should not be relied on for precise timing. After -- each call to the timeout function, the time of the next timeout is -- recalculated based on the current time and the given interval (it does not -- try to 'catch up' time lost in delays). -- timeoutAdd :: IO Bool -> Int -> IO HandlerId timeoutAdd fun msec = timeoutAddFull fun priorityDefault msec -- | Sets a function to be called at regular intervals, with the given -- priority. The function is called repeatedly until it returns @False@, after -- which point the timeout function will not be called again. The first call -- to the function will be at the end of the first interval. -- -- Note that timeout functions may be delayed, due to the processing of other -- event sources. Thus they should not be relied on for precise timing. After -- each call to the timeout function, the time of the next timeout is -- recalculated based on the current time and the given interval (it does not -- try to 'catch up' time lost in delays). -- timeoutAddFull :: IO Bool -> Priority -> Int -> IO HandlerId timeoutAddFull fun pri msec = do (funPtr, dPtr) <- makeCallback (liftM fromBool fun) {#call unsafe g_timeout_add_full#} (fromIntegral pri) (fromIntegral msec) funPtr (castFunPtrToPtr funPtr) dPtr -- | Remove a previously added timeout handler by its 'HandlerId'. -- timeoutRemove :: HandlerId -> IO () timeoutRemove id = {#call source_remove#} id >> return () -- | Add a callback that is called whenever the system is idle. -- -- * A priority can be specified via an integer. This should usually be -- 'priorityDefaultIdle'. -- -- * If the function returns @False@ it will be removed. -- idleAdd :: IO Bool -> Priority -> IO HandlerId idleAdd fun pri = do (funPtr, dPtr) <- makeCallback (liftM fromBool fun) {#call unsafe idle_add_full#} (fromIntegral pri) funPtr (castFunPtrToPtr funPtr) dPtr -- | Remove a previously added idle handler by its 'HandlerId'. -- idleRemove :: HandlerId -> IO () idleRemove id = {#call source_remove#} id >> return () -- | Flags representing a condition to watch for on a file descriptor. -- -- [@IOIn@] There is data to read. -- [@IOOut@] Data can be written (without blocking). -- [@IOPri@] There is urgent data to read. -- [@IOErr@] Error condition. -- [@IOHup@] Hung up (the connection has been broken, usually for -- pipes and sockets). -- [@IOInvalid@] Invalid request. The file descriptor is not open. -- {# enum IOCondition { G_IO_IN as IOIn, G_IO_OUT as IOOut, G_IO_PRI as IOPri, G_IO_ERR as IOErr, G_IO_HUP as IOHup, G_IO_NVAL as IOInvalid } deriving (Eq, Bounded) #} instance Flags IOCondition {#pointer *IOChannel newtype#} {#pointer IOFunc#} foreign import ccall "wrapper" mkIOFunc :: (Ptr IOChannel -> CInt -> Ptr () -> IO {#type gboolean#}) -> IO IOFunc type FD = Int -- | Adds the file descriptor into the main event loop with the given priority. -- inputAdd :: FD -- ^ a file descriptor -> [IOCondition] -- ^ the condition to watch for -> Priority -- ^ the priority of the event source -> IO Bool -- ^ the function to call when the condition is satisfied. -- The function should return False if the event source -- should be removed. -> IO HandlerId -- ^ the event source id inputAdd fd conds pri fun = do funPtr <- mkIOFunc (\_ _ _ -> liftM fromBool fun) channel <- {#call unsafe g_io_channel_unix_new #} (fromIntegral fd) {#call unsafe g_io_add_watch_full#} (IOChannel channel) (fromIntegral pri) ((fromIntegral . fromFlags) conds) funPtr (castFunPtrToPtr funPtr) destroyFunPtr inputRemove :: HandlerId -> IO () inputRemove id = {#call source_remove#} id >> return () -- Standard priorities #define G_PRIORITY_HIGH -100 #define G_PRIORITY_DEFAULT 0 #define G_PRIORITY_HIGH_IDLE 100 #define G_PRIORITY_DEFAULT_IDLE 200 #define G_PRIORITY_LOW 300 -- | Priorities for installing callbacks. -- type Priority = Int priorityHigh :: Int priorityHigh = G_PRIORITY_HIGH priorityDefault :: Int priorityDefault = G_PRIORITY_DEFAULT priorityHighIdle :: Int priorityHighIdle = G_PRIORITY_HIGH_IDLE priorityDefaultIdle :: Int priorityDefaultIdle = G_PRIORITY_DEFAULT_IDLE priorityLow :: Int priorityLow = G_PRIORITY_LOW -- | A main event loop abstraction. {# pointer *GMainLoop as MainLoop foreign newtype #} -- | An opaque datatype representing a set of sources to be handled in -- a main loop. {# pointer *GMainContext as MainContext foreign newtype #} -- | Create a new 'MainLoop'. mainLoopNew :: Maybe MainContext -- ^ @context@ - the context to use, or 'Nothing' to use the default context -> Bool -- ^ @isRunning@ - 'True' to indicate that the loop is running; 'False' otherwise -> IO MainLoop -- ^ the new 'MainLoop' mainLoopNew context isRunning = do let context' = maybe (MainContext nullForeignPtr) id context loopPtr <- {# call main_loop_new #} context' $ fromBool isRunning liftM MainLoop $ newForeignPtr loopPtr mainLoopFinalizer foreign import ccall unsafe "&g_main_loop_unref" mainLoopFinalizer :: FunPtr (Ptr MainLoop -> IO ()) -- | Runs a main loop until 'mainLoopQuit' is called on the -- loop. If this is called for the thread of the loop's -- 'MainContext', it will process events from the loop, otherwise it -- will simply wait. mainLoopRun :: MainLoop -> IO () mainLoopRun loop = {# call main_loop_run #} loop -- | Stops a 'MainLoop' from running. Any calls to mainLoopRun for the -- loop will return. mainLoopQuit :: MainLoop -> IO () mainLoopQuit loop = {# call main_loop_quit #} loop -- | Checks to see if the main loop is currently being run via mainLoopRun. mainLoopIsRunning :: MainLoop -> IO Bool mainLoopIsRunning loop = liftM toBool $ {# call main_loop_is_running #} loop -- | Gets a 'MainLoop's context. mainLoopGetContext :: MainLoop -> MainContext mainLoopGetContext loop = MainContext $ unsafePerformIO $ {# call main_loop_get_context #} loop >>= flip newForeignPtr mainContextFinalizer foreign import ccall unsafe "&g_main_context_unref" mainContextFinalizer :: FunPtr (Ptr MainContext -> IO ()) -- | Creates a new 'MainContext'. mainContextNew :: IO MainContext mainContextNew = newContextMarshal {# call main_context_new #} -- | The default 'MainContext'. This is the main context used for main -- loop functions when a main loop is not explicitly specified. mainContextDefault :: MainContext mainContextDefault = unsafePerformIO $ newContextMarshal {# call main_context_default #} newContextMarshal action = do ptr <- action liftM MainContext $ newForeignPtr ptr mainContextFinalizer -- | Runs a single iteration for the given main loop. This involves -- checking to see if any event sources are ready to be processed, -- then if no events sources are ready and @mayBlock@ is 'True', -- waiting for a source to become ready, then dispatching the -- highest priority events sources that are ready. Note that even -- when @mayBlock@ is 'True', it is still possible for -- 'mainContextIteration' to return FALSE, since the the wait -- may be interrupted for other reasons than an event source -- becoming ready. mainContextIteration :: MainContext -> Bool -> IO Bool mainContextIteration context mayBlock = liftM toBool $ {# call main_context_iteration #} context (fromBool mayBlock) mainContextFindSourceById :: MainContext -> HandlerId -> IO Source mainContextFindSourceById context id = {# call main_context_find_source_by_id #} context (fromIntegral id) >>= newSource . castPtr {# pointer *GSource as Source foreign newtype #} newSource :: Ptr Source -> IO Source newSource sourcePtr = liftM Source $ newForeignPtr sourcePtr sourceFinalizer foreign import ccall unsafe "&g_source_unref" sourceFinalizer :: FunPtr (Ptr Source -> IO ()) sourceAttach :: Source -> MainContext -> IO HandlerId sourceAttach source context = liftM fromIntegral $ {# call source_attach #} source context sourceSetPriority :: Source -> Priority -> IO () sourceSetPriority source priority = {# call source_set_priority #} source $ fromIntegral priority sourceGetPriority :: Source -> IO Priority sourceGetPriority source = liftM fromIntegral $ {# call source_get_priority #} source sourceDestroy :: Source -> IO () sourceDestroy source = {# call source_destroy #} source #if GLIB_CHECK_VERSION(2,12,0) sourceIsDestroyed :: Source -> IO Bool sourceIsDestroyed source = liftM toBool $ {# call source_is_destroyed #} source #endif sourceRemove :: HandlerId -> IO Bool sourceRemove tag = liftM toBool $ {# call source_remove #} $ fromIntegral tag glib-0.13.4.1/System/Glib/Properties.chs0000644000000000000000000005014313005220034016025 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) GObject Properties -- -- Author : Duncan Coutts -- -- Created: 16 April 2005 -- -- Copyright (C) 2005 Duncan Coutts -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Functions for getting and setting GObject properties -- module System.Glib.Properties ( -- * per-type functions for getting and setting GObject properties objectSetPropertyInt, objectGetPropertyInt, objectSetPropertyUInt, objectGetPropertyUInt, objectSetPropertyInt64, objectGetPropertyInt64, objectSetPropertyUInt64, objectGetPropertyUInt64, objectSetPropertyChar, objectGetPropertyChar, objectSetPropertyBool, objectGetPropertyBool, objectSetPropertyEnum, objectGetPropertyEnum, objectSetPropertyFlags, objectGetPropertyFlags, objectSetPropertyFloat, objectGetPropertyFloat, objectSetPropertyDouble, objectGetPropertyDouble, objectSetPropertyString, objectGetPropertyString, objectSetPropertyMaybeString, objectGetPropertyMaybeString, objectSetPropertyFilePath, objectGetPropertyFilePath, objectSetPropertyMaybeFilePath, objectGetPropertyMaybeFilePath, objectSetPropertyBoxedOpaque, objectGetPropertyBoxedOpaque, objectSetPropertyBoxedStorable, objectGetPropertyBoxedStorable, objectSetPropertyGObject, objectGetPropertyGObject, -- * constructors for attributes backed by GObject properties newAttrFromIntProperty, readAttrFromIntProperty, newAttrFromUIntProperty, readAttrFromUIntProperty, writeAttrFromUIntProperty, newAttrFromCharProperty, readAttrFromCharProperty, newAttrFromBoolProperty, readAttrFromBoolProperty, newAttrFromFloatProperty, readAttrFromFloatProperty, newAttrFromDoubleProperty, readAttrFromDoubleProperty, newAttrFromEnumProperty, readAttrFromEnumProperty, writeAttrFromEnumProperty, newAttrFromFlagsProperty, readAttrFromFlagsProperty, newAttrFromStringProperty, readAttrFromStringProperty, writeAttrFromStringProperty, newAttrFromMaybeStringProperty, readAttrFromMaybeStringProperty, writeAttrFromMaybeStringProperty, newAttrFromFilePathProperty, readAttrFromFilePathProperty, writeAttrFromFilePathProperty, newAttrFromMaybeFilePathProperty, readAttrFromMaybeFilePathProperty, writeAttrFromMaybeFilePathProperty, newAttrFromBoxedOpaqueProperty, readAttrFromBoxedOpaqueProperty, writeAttrFromBoxedOpaqueProperty, newAttrFromBoxedStorableProperty, readAttrFromBoxedStorableProperty, newAttrFromObjectProperty, readAttrFromObjectProperty, writeAttrFromObjectProperty, newAttrFromMaybeObjectProperty, readAttrFromMaybeObjectProperty, writeAttrFromMaybeObjectProperty, -- TODO: do not export these once we dump the old TreeList API: objectGetPropertyInternal, objectSetPropertyInternal, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags (Flags) {#import System.Glib.Types#} {#import System.Glib.GValue#} (GValue(GValue), valueInit, allocaGValue) import qualified System.Glib.GTypeConstants as GType import System.Glib.GType import System.Glib.GValueTypes import System.Glib.Attributes (Attr, ReadAttr, WriteAttr, ReadWriteAttr, newNamedAttr, readNamedAttr, writeNamedAttr) {# context lib="glib" prefix="g" #} objectSetPropertyInternal :: GObjectClass gobj => GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO () objectSetPropertyInternal gtype valueSet prop obj val = withCString prop $ \propPtr -> allocaGValue $ \gvalue -> do valueInit gvalue gtype valueSet gvalue val {# call g_object_set_property #} (toGObject obj) propPtr gvalue objectGetPropertyInternal :: GObjectClass gobj => GType -> (GValue -> IO a) -> String -> gobj -> IO a objectGetPropertyInternal gtype valueGet prop obj = withCString prop $ \propPtr -> allocaGValue $ \gvalue -> do valueInit gvalue gtype {# call unsafe g_object_get_property #} (toGObject obj) propPtr gvalue valueGet gvalue objectSetPropertyInt :: GObjectClass gobj => String -> gobj -> Int -> IO () objectSetPropertyInt = objectSetPropertyInternal GType.int valueSetInt objectGetPropertyInt :: GObjectClass gobj => String -> gobj -> IO Int objectGetPropertyInt = objectGetPropertyInternal GType.int valueGetInt objectSetPropertyUInt :: GObjectClass gobj => String -> gobj -> Int -> IO () objectSetPropertyUInt = objectSetPropertyInternal GType.uint (\gv v -> valueSetUInt gv (fromIntegral v)) objectGetPropertyUInt :: GObjectClass gobj => String -> gobj -> IO Int objectGetPropertyUInt = objectGetPropertyInternal GType.uint (\gv -> liftM fromIntegral $ valueGetUInt gv) objectSetPropertyInt64 :: GObjectClass gobj => String -> gobj -> Int64 -> IO () objectSetPropertyInt64 = objectSetPropertyInternal GType.int64 valueSetInt64 objectGetPropertyInt64 :: GObjectClass gobj => String -> gobj -> IO Int64 objectGetPropertyInt64 = objectGetPropertyInternal GType.int64 valueGetInt64 objectSetPropertyUInt64 :: GObjectClass gobj => String -> gobj -> Word64 -> IO () objectSetPropertyUInt64 = objectSetPropertyInternal GType.uint64 (\gv v -> valueSetUInt64 gv (fromIntegral v)) objectGetPropertyUInt64 :: GObjectClass gobj => String -> gobj -> IO Word64 objectGetPropertyUInt64 = objectGetPropertyInternal GType.uint64 (\gv -> liftM fromIntegral $ valueGetUInt64 gv) objectSetPropertyChar :: GObjectClass gobj => String -> gobj -> Char -> IO () objectSetPropertyChar = objectSetPropertyInternal GType.uint (\gv v -> valueSetUInt gv (fromIntegral (fromEnum v))) objectGetPropertyChar :: GObjectClass gobj => String -> gobj -> IO Char objectGetPropertyChar = objectGetPropertyInternal GType.uint (\gv -> liftM (toEnum . fromIntegral) $ valueGetUInt gv) objectSetPropertyBool :: GObjectClass gobj => String -> gobj -> Bool -> IO () objectSetPropertyBool = objectSetPropertyInternal GType.bool valueSetBool objectGetPropertyBool :: GObjectClass gobj => String -> gobj -> IO Bool objectGetPropertyBool = objectGetPropertyInternal GType.bool valueGetBool objectSetPropertyEnum :: (GObjectClass gobj, Enum enum) => GType -> String -> gobj -> enum -> IO () objectSetPropertyEnum gtype = objectSetPropertyInternal gtype valueSetEnum objectGetPropertyEnum :: (GObjectClass gobj, Enum enum) => GType -> String -> gobj -> IO enum objectGetPropertyEnum gtype = objectGetPropertyInternal gtype valueGetEnum objectSetPropertyFlags :: (GObjectClass gobj, Flags flag) => GType -> String -> gobj -> [flag] -> IO () objectSetPropertyFlags gtype = objectSetPropertyInternal gtype valueSetFlags objectGetPropertyFlags :: (GObjectClass gobj, Flags flag) => GType -> String -> gobj -> IO [flag] objectGetPropertyFlags gtype = objectGetPropertyInternal gtype valueGetFlags objectSetPropertyFloat :: GObjectClass gobj => String -> gobj -> Float -> IO () objectSetPropertyFloat = objectSetPropertyInternal GType.float valueSetFloat objectGetPropertyFloat :: GObjectClass gobj => String -> gobj -> IO Float objectGetPropertyFloat = objectGetPropertyInternal GType.float valueGetFloat objectSetPropertyDouble :: GObjectClass gobj => String -> gobj -> Double -> IO () objectSetPropertyDouble = objectSetPropertyInternal GType.double valueSetDouble objectGetPropertyDouble :: GObjectClass gobj => String -> gobj -> IO Double objectGetPropertyDouble = objectGetPropertyInternal GType.double valueGetDouble objectSetPropertyString :: (GObjectClass gobj, GlibString string) => String -> gobj -> string -> IO () objectSetPropertyString = objectSetPropertyInternal GType.string valueSetString objectGetPropertyString :: (GObjectClass gobj, GlibString string) => String -> gobj -> IO string objectGetPropertyString = objectGetPropertyInternal GType.string valueGetString objectSetPropertyMaybeString :: (GObjectClass gobj, GlibString string) => String -> gobj -> Maybe string -> IO () objectSetPropertyMaybeString = objectSetPropertyInternal GType.string valueSetMaybeString objectGetPropertyMaybeString :: (GObjectClass gobj, GlibString string) => String -> gobj -> IO (Maybe string) objectGetPropertyMaybeString = objectGetPropertyInternal GType.string valueGetMaybeString objectSetPropertyFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> string -> IO () objectSetPropertyFilePath = objectSetPropertyInternal GType.string valueSetFilePath objectGetPropertyFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> IO string objectGetPropertyFilePath = objectGetPropertyInternal GType.string valueGetFilePath objectSetPropertyMaybeFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> Maybe string -> IO () objectSetPropertyMaybeFilePath = objectSetPropertyInternal GType.string valueSetMaybeFilePath objectGetPropertyMaybeFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> IO (Maybe string) objectGetPropertyMaybeFilePath = objectGetPropertyInternal GType.string valueGetMaybeFilePath objectSetPropertyBoxedOpaque :: GObjectClass gobj => (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> GType -> String -> gobj -> boxed -> IO () objectSetPropertyBoxedOpaque with gtype = objectSetPropertyInternal gtype (valueSetBoxed with) objectGetPropertyBoxedOpaque :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed objectGetPropertyBoxedOpaque peek gtype = objectGetPropertyInternal gtype (valueGetBoxed peek) objectSetPropertyBoxedStorable :: (GObjectClass gobj, Storable boxed) => GType -> String -> gobj -> boxed -> IO () objectSetPropertyBoxedStorable = objectSetPropertyBoxedOpaque with objectGetPropertyBoxedStorable :: (GObjectClass gobj, Storable boxed) => GType -> String -> gobj -> IO boxed objectGetPropertyBoxedStorable = objectGetPropertyBoxedOpaque peek objectSetPropertyGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> gobj' -> IO () objectSetPropertyGObject gtype = objectSetPropertyInternal gtype valueSetGObject objectGetPropertyGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> IO gobj' objectGetPropertyGObject gtype = objectGetPropertyInternal gtype valueGetGObject objectSetPropertyMaybeGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> (Maybe gobj') -> IO () objectSetPropertyMaybeGObject gtype = objectSetPropertyInternal gtype valueSetMaybeGObject objectGetPropertyMaybeGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> IO (Maybe gobj') objectGetPropertyMaybeGObject gtype = objectGetPropertyInternal gtype valueGetMaybeGObject -- Convenience functions to make attribute implementations in the other modules -- shorter and more easily extensible. -- newAttrFromIntProperty :: GObjectClass gobj => String -> Attr gobj Int newAttrFromIntProperty propName = newNamedAttr propName (objectGetPropertyInt propName) (objectSetPropertyInt propName) readAttrFromIntProperty :: GObjectClass gobj => String -> ReadAttr gobj Int readAttrFromIntProperty propName = readNamedAttr propName (objectGetPropertyInt propName) newAttrFromUIntProperty :: GObjectClass gobj => String -> Attr gobj Int newAttrFromUIntProperty propName = newNamedAttr propName (objectGetPropertyUInt propName) (objectSetPropertyUInt propName) readAttrFromUIntProperty :: GObjectClass gobj => String -> ReadAttr gobj Int readAttrFromUIntProperty propName = readNamedAttr propName (objectGetPropertyUInt propName) newAttrFromCharProperty :: GObjectClass gobj => String -> Attr gobj Char newAttrFromCharProperty propName = newNamedAttr propName (objectGetPropertyChar propName) (objectSetPropertyChar propName) readAttrFromCharProperty :: GObjectClass gobj => String -> ReadAttr gobj Char readAttrFromCharProperty propName = readNamedAttr propName (objectGetPropertyChar propName) writeAttrFromUIntProperty :: GObjectClass gobj => String -> WriteAttr gobj Int writeAttrFromUIntProperty propName = writeNamedAttr propName (objectSetPropertyUInt propName) newAttrFromBoolProperty :: GObjectClass gobj => String -> Attr gobj Bool newAttrFromBoolProperty propName = newNamedAttr propName (objectGetPropertyBool propName) (objectSetPropertyBool propName) readAttrFromBoolProperty :: GObjectClass gobj => String -> ReadAttr gobj Bool readAttrFromBoolProperty propName = readNamedAttr propName (objectGetPropertyBool propName) newAttrFromFloatProperty :: GObjectClass gobj => String -> Attr gobj Float newAttrFromFloatProperty propName = newNamedAttr propName (objectGetPropertyFloat propName) (objectSetPropertyFloat propName) readAttrFromFloatProperty :: GObjectClass gobj => String -> ReadAttr gobj Float readAttrFromFloatProperty propName = readNamedAttr propName (objectGetPropertyFloat propName) newAttrFromDoubleProperty :: GObjectClass gobj => String -> Attr gobj Double newAttrFromDoubleProperty propName = newNamedAttr propName (objectGetPropertyDouble propName) (objectSetPropertyDouble propName) readAttrFromDoubleProperty :: GObjectClass gobj => String -> ReadAttr gobj Double readAttrFromDoubleProperty propName = readNamedAttr propName (objectGetPropertyDouble propName) newAttrFromEnumProperty :: (GObjectClass gobj, Enum enum) => String -> GType -> Attr gobj enum newAttrFromEnumProperty propName gtype = newNamedAttr propName (objectGetPropertyEnum gtype propName) (objectSetPropertyEnum gtype propName) readAttrFromEnumProperty :: (GObjectClass gobj, Enum enum) => String -> GType -> ReadAttr gobj enum readAttrFromEnumProperty propName gtype = readNamedAttr propName (objectGetPropertyEnum gtype propName) writeAttrFromEnumProperty :: (GObjectClass gobj, Enum enum) => String -> GType -> WriteAttr gobj enum writeAttrFromEnumProperty propName gtype = writeNamedAttr propName (objectSetPropertyEnum gtype propName) newAttrFromFlagsProperty :: (GObjectClass gobj, Flags flag) => String -> GType -> Attr gobj [flag] newAttrFromFlagsProperty propName gtype = newNamedAttr propName (objectGetPropertyFlags gtype propName) (objectSetPropertyFlags gtype propName) readAttrFromFlagsProperty :: (GObjectClass gobj, Flags flag) => String -> GType -> ReadAttr gobj [flag] readAttrFromFlagsProperty propName gtype = readNamedAttr propName (objectGetPropertyFlags gtype propName) newAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> Attr gobj string newAttrFromStringProperty propName = newNamedAttr propName (objectGetPropertyString propName) (objectSetPropertyString propName) readAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> ReadAttr gobj string readAttrFromStringProperty propName = readNamedAttr propName (objectGetPropertyString propName) writeAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> WriteAttr gobj string writeAttrFromStringProperty propName = writeNamedAttr propName (objectSetPropertyString propName) newAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> Attr gobj (Maybe string) newAttrFromMaybeStringProperty propName = newNamedAttr propName (objectGetPropertyMaybeString propName) (objectSetPropertyMaybeString propName) readAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> ReadAttr gobj (Maybe string) readAttrFromMaybeStringProperty propName = readNamedAttr propName (objectGetPropertyMaybeString propName) writeAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> WriteAttr gobj (Maybe string) writeAttrFromMaybeStringProperty propName = writeNamedAttr propName (objectSetPropertyMaybeString propName) newAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> Attr gobj string newAttrFromFilePathProperty propName = newNamedAttr propName (objectGetPropertyFilePath propName) (objectSetPropertyFilePath propName) readAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> ReadAttr gobj string readAttrFromFilePathProperty propName = readNamedAttr propName (objectGetPropertyFilePath propName) writeAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> WriteAttr gobj string writeAttrFromFilePathProperty propName = writeNamedAttr propName (objectSetPropertyFilePath propName) newAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> Attr gobj (Maybe string) newAttrFromMaybeFilePathProperty propName = newNamedAttr propName (objectGetPropertyMaybeFilePath propName) (objectSetPropertyMaybeFilePath propName) readAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> ReadAttr gobj (Maybe string) readAttrFromMaybeFilePathProperty propName = readNamedAttr propName (objectGetPropertyMaybeFilePath propName) writeAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> WriteAttr gobj (Maybe string) writeAttrFromMaybeFilePathProperty propName = writeNamedAttr propName (objectSetPropertyMaybeFilePath propName) newAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> String -> GType -> Attr gobj boxed newAttrFromBoxedOpaqueProperty peek with propName gtype = newNamedAttr propName (objectGetPropertyBoxedOpaque peek gtype propName) (objectSetPropertyBoxedOpaque with gtype propName) readAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> String -> GType -> ReadAttr gobj boxed readAttrFromBoxedOpaqueProperty peek propName gtype = readNamedAttr propName (objectGetPropertyBoxedOpaque peek gtype propName) writeAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> String -> GType -> WriteAttr gobj boxed writeAttrFromBoxedOpaqueProperty with propName gtype = writeNamedAttr propName (objectSetPropertyBoxedOpaque with gtype propName) newAttrFromBoxedStorableProperty :: (GObjectClass gobj, Storable boxed) => String -> GType -> Attr gobj boxed newAttrFromBoxedStorableProperty propName gtype = newNamedAttr propName (objectGetPropertyBoxedStorable gtype propName) (objectSetPropertyBoxedStorable gtype propName) readAttrFromBoxedStorableProperty :: (GObjectClass gobj, Storable boxed) => String -> GType -> ReadAttr gobj boxed readAttrFromBoxedStorableProperty propName gtype = readNamedAttr propName (objectGetPropertyBoxedStorable gtype propName) newAttrFromObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj gobj' gobj'' newAttrFromObjectProperty propName gtype = newNamedAttr propName (objectGetPropertyGObject gtype propName) (objectSetPropertyGObject gtype propName) writeAttrFromObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> WriteAttr gobj gobj' writeAttrFromObjectProperty propName gtype = writeNamedAttr propName (objectSetPropertyGObject gtype propName) readAttrFromObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> ReadAttr gobj gobj' readAttrFromObjectProperty propName gtype = readNamedAttr propName (objectGetPropertyGObject gtype propName) newAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'') newAttrFromMaybeObjectProperty propName gtype = newNamedAttr propName (objectGetPropertyMaybeGObject gtype propName) (objectSetPropertyMaybeGObject gtype propName) writeAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> WriteAttr gobj (Maybe gobj') writeAttrFromMaybeObjectProperty propName gtype = writeNamedAttr propName (objectSetPropertyMaybeGObject gtype propName) readAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> ReadAttr gobj (Maybe gobj') readAttrFromMaybeObjectProperty propName gtype = readNamedAttr propName (objectGetPropertyMaybeGObject gtype propName) glib-0.13.4.1/System/Glib/Signals.chs0000644000000000000000000002073413005220034015274 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# CFILES hsgclosure.c #-} -- -*-haskell-*- -- Callback installers for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Axel Simon -- -- Created: 1 July 2000 -- -- Copyright (C) 2000-2005 Axel Simon, Duncan Coutts -- -- 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. -- -- #prune -- The object system in the second version of GTK is based on GObject from -- GLIB. This base class is rather primitive in that it only implements -- ref and unref methods (and others that are not interesting to us). If -- the marshall list mentions OBJECT it refers to an instance of this -- GObject which is automatically wrapped with a ref and unref call. -- Structures which are not derived from GObject have to be passed as -- BOXED which gives the signal connect function a possiblity to do the -- conversion into a proper ForeignPtr type. In special cases the signal -- connect function use a PTR type which will then be mangled in the -- user function directly. The latter is needed if a signal delivers a -- pointer to a string and its length in a separate integer. -- module System.Glib.Signals ( Signal(Signal), on, after, SignalName, GSignalMatchType(..), ConnectAfter, ConnectId(ConnectId), signalDisconnect, signalBlock, signalBlockMatched, signalUnblock, signalStopEmission, disconnect, GClosure, #ifdef USE_GCLOSURE_SIGNALS_IMPL connectGeneric, #else GClosureNotify, mkFunPtrClosureNotify, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.GType import System.Glib.Flags {#import System.Glib.GObject#} #ifndef USE_GCLOSURE_SIGNALS_IMPL import Data.IORef #endif {#context lib="glib" prefix="g" #} newtype Signal object handler = Signal (Bool -> object -> handler -> IO (ConnectId object)) -- | Perform an action in response to a signal. -- -- Use it like this: -- -- > on obj sig $ do -- > ... -- -- or if the signal handler takes any arguments: -- -- > on obj sig $ \args -> do -- > ... -- on :: object -> Signal object callback -> callback -> IO (ConnectId object) on object (Signal connect) handler = connect False object handler -- | Perform an action in response to a signal. -- -- * Like 'on' but the signal is executed after Gtk's default handler has -- run. -- after :: object -> Signal object callback -> callback -> IO (ConnectId object) after object (Signal connect) handler = connect True object handler -- Specify if the handler is to run before (False) or after (True) the -- default handler. type ConnectAfter = Bool type SignalName = String -- | The type of signal handler ids. If you ever need to 'disconnect' a signal -- handler then you will need to retain the 'ConnectId' you got when you -- registered it. -- data GObjectClass o => ConnectId o = ConnectId {#type gulong#} o -- old name for backwards compatability disconnect :: GObjectClass obj => ConnectId obj -> IO () disconnect = signalDisconnect {-# DEPRECATED disconnect "use signalDisconnect instead" #-} -- | Disconnect a signal handler. After disconnecting the handler will no -- longer be invoked when the event occurs. -- signalDisconnect :: GObjectClass obj => ConnectId obj -> IO () signalDisconnect (ConnectId handler obj) = withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> {# call g_signal_handler_disconnect #} (castPtr objPtr) handler -- | Block a specific signal handler. -- -- * Blocks a handler of an instance so it will not be called during any -- signal emissions unless it is unblocked again. Thus \"blocking\" a signal -- handler means to temporarily deactive it, a signal handler has to be -- unblocked exactly the same amount of times it has been blocked before -- to become active again. -- signalBlock :: GObjectClass obj => ConnectId obj -> IO () signalBlock (ConnectId handler obj) = withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> {# call g_signal_handler_block #} (castPtr objPtr) handler {# enum GSignalMatchType {underscoreToCase} deriving (Eq, Ord, Bounded) #} instance Flags GSignalMatchType -- | Blocks all handlers on an instance that match a certain selection -- criteria. The criteria mask is passed as a list of `GSignalMatchType` flags, -- and the criteria values are passed as arguments. Passing at least one of -- the `SignalMatchClosure`, `SignalMatchFunc` or `SignalMatchData` match flags -- is required for successful matches. If no handlers were found, 0 is returned, -- the number of blocked handlers otherwise. signalBlockMatched :: GObjectClass obj => obj -> [GSignalMatchType] -> SignalName -> GType -> Quark -> Maybe GClosure -> Maybe (Ptr ()) -> Maybe (Ptr ()) -> IO Int signalBlockMatched obj mask sigName gType quark closure func userData = do sigId <- withCString sigName $ \strPtr -> {# call g_signal_lookup #} strPtr gType liftM fromIntegral $ withForeignPtr (unGObject $ toGObject obj) $ \objPtr -> {# call g_signal_handlers_block_matched #} (castPtr objPtr) (fromIntegral $ fromFlags mask) sigId quark (maybe nullPtr (\(GClosure p) -> castPtr p) closure) (maybe nullPtr id func) (maybe nullPtr id userData) -- | Unblock a specific signal handler. -- -- * Undoes the effect of a previous 'signalBlock' call. A blocked handler -- is skipped during signal emissions and will not be invoked, unblocking -- it (for exactly the amount of times it has been blocked before) reverts -- its \"blocked\" state, so the handler will be recognized by the signal -- system and is called upon future or currently ongoing signal emissions -- (since the order in which handlers are called during signal emissions -- is deterministic, whether the unblocked handler in question is called -- as part of a currently ongoing emission depends on how far that -- emission has proceeded yet). -- signalUnblock :: GObjectClass obj => ConnectId obj -> IO () signalUnblock (ConnectId handler obj) = withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> {# call g_signal_handler_unblock #} (castPtr objPtr) handler -- | Stops a signal's current emission. -- -- * This will prevent the default method from running. The sequence in which -- handlers are run is \"first\", \"on\", \"last\" then \"after\" where -- Gtk-internal -- signals are connected either at \"first\" or at \"last\". Hence this -- function can only stop the signal processing if it is called from within -- a handler that is connected with an \"on\" signal and if the Gtk-internal -- handler is connected as \"last\". Gtk prints a warning if this function -- is used on a signal which isn't being emitted. -- signalStopEmission :: GObjectClass obj => obj -> SignalName -> IO () signalStopEmission obj sigName = withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> withCString sigName $ \strPtr -> {# call g_signal_stop_emission_by_name #} (castPtr objPtr) strPtr {# pointer *GClosure newtype #} #ifdef USE_GCLOSURE_SIGNALS_IMPL connectGeneric :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> handler -> IO (ConnectId obj) connectGeneric signal after obj user = do sptr <- newStablePtr user gclosurePtr <- gtk2hs_closure_new sptr sigId <- withCString signal $ \signalPtr -> withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> {# call g_signal_connect_closure #} (castPtr objPtr) signalPtr (GClosure gclosurePtr) (fromBool after) return $ ConnectId sigId obj foreign import ccall unsafe "gtk2hs_closure_new" gtk2hs_closure_new :: StablePtr a -> IO (Ptr GClosure) #else {#pointer GClosureNotify#} foreign import ccall "wrapper" mkDestructor :: IO () -> IO GClosureNotify mkFunPtrClosureNotify :: FunPtr a -> IO GClosureNotify mkFunPtrClosureNotify hPtr = do dRef <- newIORef nullFunPtr dPtr <- mkDestructor $ do freeHaskellFunPtr hPtr dPtr <- readIORef dRef freeHaskellFunPtr dPtr writeIORef dRef dPtr return dPtr #endif glib-0.13.4.1/System/Glib/StoreValue.hsc0000644000000000000000000001515213005220034015763 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) StoreValue GenericValue -- -- Author : Axel Simon -- -- Created: 23 May 2001 -- -- Copyright (c) 1999..2002 Axel Simon -- -- 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. -- -- TODO: this module is deprecated and should be removed. The GenericValue -- type is currently exposed to users and it should not be. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- module System.Glib.StoreValue ( TMType(..), GenericValue(..), valueSetGenericValue, valueGetGenericValue, ) where import Control.Monad (liftM) import Data.Text (Text) import Control.Exception (throw, AssertionFailed(..)) #include import System.Glib.FFI import System.Glib.GValue (GValue, valueInit, valueGetType) import System.Glib.GValueTypes import qualified System.Glib.GTypeConstants as GType import System.Glib.Types (GObject) -- | A union with information about the currently stored type. -- -- * Internally used by "Graphics.UI.Gtk.TreeList.TreeModel". -- data GenericValue = GVuint Word | GVint Int -- | GVuchar #{type guchar} -- | GVchar #{type gchar} | GVboolean Bool | GVenum Int | GVflags Int -- | GVpointer (Ptr ()) | GVfloat Float | GVdouble Double | GVstring (Maybe Text) | GVobject GObject -- | GVboxed (Ptr ()) -- This is an enumeration of all GTypes that can be used in a TreeModel. -- data TMType = TMinvalid | TMuint | TMint -- | TMuchar -- | TMchar | TMboolean | TMenum | TMflags -- | TMpointer | TMfloat | TMdouble | TMstring | TMobject -- | TMboxed instance Enum TMType where fromEnum TMinvalid = #const G_TYPE_INVALID fromEnum TMuint = #const G_TYPE_UINT fromEnum TMint = #const G_TYPE_INT -- fromEnum TMuchar = #const G_TYPE_UCHAR -- fromEnum TMchar = #const G_TYPE_CHAR fromEnum TMboolean = #const G_TYPE_BOOLEAN fromEnum TMenum = #const G_TYPE_ENUM fromEnum TMflags = #const G_TYPE_FLAGS -- fromEnum TMpointer = #const G_TYPE_POINTER fromEnum TMfloat = #const G_TYPE_FLOAT fromEnum TMdouble = #const G_TYPE_DOUBLE fromEnum TMstring = #const G_TYPE_STRING fromEnum TMobject = #const G_TYPE_OBJECT -- fromEnum TMboxed = #const G_TYPE_BOXED toEnum #{const G_TYPE_INVALID} = TMinvalid toEnum #{const G_TYPE_UINT} = TMuint toEnum #{const G_TYPE_INT} = TMint -- toEnum #{const G_TYPE_UCHAR} = TMuchar -- toEnum #{const G_TYPE_CHAR} = TMchar toEnum #{const G_TYPE_BOOLEAN} = TMboolean toEnum #{const G_TYPE_ENUM} = TMenum toEnum #{const G_TYPE_FLAGS} = TMflags -- toEnum #{const G_TYPE_POINTER} = TMpointer toEnum #{const G_TYPE_FLOAT} = TMfloat toEnum #{const G_TYPE_DOUBLE} = TMdouble toEnum #{const G_TYPE_STRING} = TMstring toEnum #{const G_TYPE_OBJECT} = TMobject -- toEnum #{const G_TYPE_BOXED} = TMboxed toEnum _ = error "StoreValue.toEnum(TMType): no dynamic types allowed." valueSetGenericValue :: GValue -> GenericValue -> IO () valueSetGenericValue gvalue (GVuint x) = do valueInit gvalue GType.uint valueSetUInt gvalue x valueSetGenericValue gvalue (GVint x) = do valueInit gvalue GType.int valueSetInt gvalue x --valueSetGenericValue gvalue (GVuchar x) = valueSetUChar gvalue x --valueSetGenericValue gvalue (GVchar x) = valueSetChar gvalue x valueSetGenericValue gvalue (GVboolean x) = do valueInit gvalue GType.bool valueSetBool gvalue x valueSetGenericValue gvalue (GVenum x) = do valueInit gvalue GType.enum valueSetUInt gvalue (fromIntegral x) valueSetGenericValue gvalue (GVflags x) = do valueInit gvalue GType.flags valueSetUInt gvalue (fromIntegral x) --valueSetGenericValue gvalue (GVpointer x) = valueSetPointer gvalue x valueSetGenericValue gvalue (GVfloat x) = do valueInit gvalue GType.float valueSetFloat gvalue x valueSetGenericValue gvalue (GVdouble x) = do valueInit gvalue GType.double valueSetDouble gvalue x valueSetGenericValue gvalue (GVstring x) = do valueInit gvalue GType.string valueSetMaybeString gvalue x valueSetGenericValue gvalue (GVobject x) = do valueInit gvalue GType.object valueSetGObject gvalue x --valueSetGenericValue gvalue (GVboxed x) = valueSetPointer gvalue x valueGetGenericValue :: GValue -> IO GenericValue valueGetGenericValue gvalue = do gtype <- valueGetType gvalue case (toEnum . fromIntegral) gtype of TMinvalid -> throw $ AssertionFailed "StoreValue.valueGetGenericValue: invalid or unavailable value." TMuint -> liftM GVuint $ valueGetUInt gvalue TMint -> liftM GVint $ valueGetInt gvalue -- TMuchar -> liftM GVuchar $ valueGetUChar gvalue -- TMchar -> liftM GVchar $ valueGetChar gvalue TMboolean -> liftM GVboolean $ valueGetBool gvalue TMenum -> liftM (GVenum . fromIntegral) $ valueGetUInt gvalue TMflags -> liftM (GVflags . fromIntegral) $ valueGetUInt gvalue -- TMpointer -> liftM GVpointer $ valueGetPointer gvalue TMfloat -> liftM GVfloat $ valueGetFloat gvalue TMdouble -> liftM GVdouble $ valueGetDouble gvalue TMstring -> liftM GVstring $ valueGetMaybeString gvalue TMobject -> liftM GVobject $ valueGetGObject gvalue -- TMboxed -> liftM GVpointer $ valueGetPointer gvalue glib-0.13.4.1/System/Glib/Types.chs0000644000000000000000000000316413005220034014776 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget GObject -- -- Author : Axel Simon -- -- Created: 9 April 2001 -- -- Copyright (c) 2001 Axel Simon -- -- 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. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Implements the base GObject class. -- module System.Glib.Types ( GObject(..), GObjectClass, mkGObject, unGObject, toGObject, unsafeCastGObject, castToGObject, objectUnref ) where import System.Glib.FFI {# context lib="glib" prefix="g" #} {#pointer *GObject foreign newtype #} deriving (Eq) mkGObject = (GObject, objectUnref) unGObject (GObject o) = o class GObjectClass o where -- | Safe upcast. toGObject :: o -> GObject -- | Unchecked downcast. unsafeCastGObject :: GObject -> o instance GObjectClass GObject where toGObject = id unsafeCastGObject = id castToGObject :: GObjectClass obj => obj -> obj castToGObject = id -- | Decrease the reference counter of an object -- foreign import ccall unsafe "&g_object_unref" objectUnref :: FinalizerPtr a glib-0.13.4.1/System/Glib/UTFString.hs0000644000000000000000000002251013005220034015350 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -- GIMP Toolkit (GTK) UTF aware string marshalling -- -- Author : Axel Simon -- -- Created: 22 June 2001 -- -- Copyright (c) 1999..2002 Axel Simon -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This module adds CString-like functions that handle UTF8 strings. -- module System.Glib.UTFString ( GlibString(..), readUTFString, readCString, withUTFStrings, withUTFStringArray, withUTFStringArray0, peekUTFStringArray, peekUTFStringArray0, readUTFStringArray0, UTFCorrection, ofsToUTF, ofsFromUTF, glibToString, stringToGlib, DefaultGlibString, GlibFilePath(..), withUTFFilePaths, withUTFFilePathArray, withUTFFilePathArray0, peekUTFFilePathArray0, readUTFFilePathArray0 ) where import Codec.Binary.UTF8.String import Control.Applicative ((<$>)) import Control.Monad (liftM) import Data.Char (ord, chr) import Data.Maybe (maybe) import Data.String (IsString) import Data.Monoid (Monoid) import System.Glib.FFI import qualified Data.Text as T (replace, length, pack, unpack, Text) import qualified Data.Text.Foreign as T (withCStringLen, peekCStringLen) import Data.ByteString (useAsCString) import Data.Text.Encoding (encodeUtf8) class (IsString s, Monoid s, Show s) => GlibString s where -- | Like 'withCString' but using the UTF-8 encoding. -- withUTFString :: s -> (CString -> IO a) -> IO a -- | Like 'withCStringLen' but using the UTF-8 encoding. -- withUTFStringLen :: s -> (CStringLen -> IO a) -> IO a -- | Like 'peekCString' but using the UTF-8 encoding. -- peekUTFString :: CString -> IO s -- | Like 'maybePeek' 'peekCString' but using the UTF-8 encoding to retrieve -- UTF-8 from a 'CString' which may be the 'nullPtr'. -- maybePeekUTFString :: CString -> IO (Maybe s) -- | Like 'peekCStringLen' but using the UTF-8 encoding. -- peekUTFStringLen :: CStringLen -> IO s -- | Like 'newCString' but using the UTF-8 encoding. -- newUTFString :: s -> IO CString -- | Like Define newUTFStringLen to emit UTF-8. -- newUTFStringLen :: s -> IO CStringLen -- | Create a list of offset corrections. -- genUTFOfs :: s -> UTFCorrection -- | Length of the string in characters -- stringLength :: s -> Int -- Escape percent signs (used in MessageDialog) unPrintf :: s -> s -- GTK+ has a lot of asserts that the ptr is not NULL even if the length is 0 -- Until they fix this we need to fudge pointer values to keep the noise level -- in the logs. noNullPtrs :: CStringLen -> CStringLen noNullPtrs (p, 0) | p == nullPtr = (plusPtr p 1, 0) noNullPtrs s = s instance GlibString [Char] where withUTFString = withCAString . encodeString withUTFStringLen s f = withCAStringLen (encodeString s) (f . noNullPtrs) peekUTFString = liftM decodeString . peekCAString maybePeekUTFString = liftM (maybe Nothing (Just . decodeString)) . maybePeek peekCAString peekUTFStringLen = liftM decodeString . peekCAStringLen newUTFString = newCAString . encodeString newUTFStringLen = newCAStringLen . encodeString genUTFOfs str = UTFCorrection (gUO 0 str) where gUO n [] = [] gUO n (x:xs) | ord x<=0x007F = gUO (n+1) xs | ord x<=0x07FF = n:gUO (n+1) xs | ord x<=0xFFFF = n:n:gUO (n+1) xs | otherwise = n:n:n:gUO (n+1) xs stringLength = length unPrintf s = s >>= replace where replace '%' = "%%" replace c = return c foreign import ccall unsafe "string.h strlen" c_strlen :: CString -> IO CSize instance GlibString T.Text where withUTFString = useAsCString . encodeUtf8 withUTFStringLen s f = T.withCStringLen s (f . noNullPtrs) peekUTFString s = do len <- c_strlen s T.peekCStringLen (s, fromIntegral len) maybePeekUTFString = maybePeek peekUTFString peekUTFStringLen = T.peekCStringLen newUTFString = newUTFString . T.unpack -- TODO optimize newUTFStringLen = newUTFStringLen . T.unpack -- TODO optimize genUTFOfs = genUTFOfs . T.unpack -- TODO optimize stringLength = T.length unPrintf = T.replace "%" "%%" glibToString :: T.Text -> String glibToString = T.unpack stringToGlib :: String -> T.Text stringToGlib = T.pack -- | Like like 'peekUTFString' but then frees the string using g_free -- readUTFString :: GlibString s => CString -> IO s readUTFString strPtr = do str <- peekUTFString strPtr g_free strPtr return str -- | Like 'peekCString' but then frees the string using @g_free@. -- readCString :: CString -> IO String readCString strPtr = do str <- peekCAString strPtr g_free strPtr return str foreign import ccall unsafe "g_free" g_free :: Ptr a -> IO () -- | Temporarily allocate a list of UTF-8 'CString's. -- withUTFStrings :: GlibString s => [s] -> ([CString] -> IO a) -> IO a withUTFStrings hsStrs = withUTFStrings' hsStrs [] where withUTFStrings' :: GlibString s => [s] -> [CString] -> ([CString] -> IO a) -> IO a withUTFStrings' [] cs body = body (reverse cs) withUTFStrings' (s:ss) cs body = withUTFString s $ \c -> withUTFStrings' ss (c:cs) body -- | Temporarily allocate an array of UTF-8 encoded 'CString's. -- withUTFStringArray :: GlibString s => [s] -> (Ptr CString -> IO a) -> IO a withUTFStringArray hsStr body = withUTFStrings hsStr $ \cStrs -> do withArray cStrs body -- | Temporarily allocate a null-terminated array of UTF-8 encoded 'CString's. -- withUTFStringArray0 :: GlibString s => [s] -> (Ptr CString -> IO a) -> IO a withUTFStringArray0 hsStr body = withUTFStrings hsStr $ \cStrs -> do withArray0 nullPtr cStrs body -- | Convert an array (of the given length) of UTF-8 encoded 'CString's to a -- list of Haskell 'String's. -- peekUTFStringArray :: GlibString s => Int -> Ptr CString -> IO [s] peekUTFStringArray len cStrArr = do cStrs <- peekArray len cStrArr mapM peekUTFString cStrs -- | Convert a null-terminated array of UTF-8 encoded 'CString's to a list of -- Haskell 'String's. -- peekUTFStringArray0 :: GlibString s => Ptr CString -> IO [s] peekUTFStringArray0 cStrArr = do cStrs <- peekArray0 nullPtr cStrArr mapM peekUTFString cStrs -- | Like 'peekUTFStringArray0' but then free the string array including all -- strings. -- -- To be used when functions indicate that their return value should be freed -- with @g_strfreev@. -- readUTFStringArray0 :: GlibString s => Ptr CString -> IO [s] readUTFStringArray0 cStrArr | cStrArr == nullPtr = return [] | otherwise = do cStrs <- peekArray0 nullPtr cStrArr strings <- mapM peekUTFString cStrs g_strfreev cStrArr return strings foreign import ccall unsafe "g_strfreev" g_strfreev :: Ptr a -> IO () -- | Offset correction for String to UTF8 mapping. -- newtype UTFCorrection = UTFCorrection [Int] deriving Show ofsToUTF :: Int -> UTFCorrection -> Int ofsToUTF n (UTFCorrection oc) = oTU oc where oTU [] = n oTU (x:xs) | n<=x = n | otherwise = 1+oTU xs ofsFromUTF :: Int -> UTFCorrection -> Int ofsFromUTF n (UTFCorrection oc) = oFU n oc where oFU n [] = n oFU n (x:xs) | n<=x = n | otherwise = oFU (n-1) xs type DefaultGlibString = T.Text class fp ~ FilePath => GlibFilePath fp where withUTFFilePath :: fp -> (CString -> IO a) -> IO a peekUTFFilePath :: CString -> IO fp instance GlibFilePath FilePath where withUTFFilePath = withUTFString . T.pack peekUTFFilePath f = T.unpack <$> peekUTFString f withUTFFilePaths :: GlibFilePath fp => [fp] -> ([CString] -> IO a) -> IO a withUTFFilePaths hsStrs = withUTFFilePath' hsStrs [] where withUTFFilePath' :: GlibFilePath fp => [fp] -> [CString] -> ([CString] -> IO a) -> IO a withUTFFilePath' [] cs body = body (reverse cs) withUTFFilePath' (fp:fps) cs body = withUTFFilePath fp $ \c -> withUTFFilePath' fps (c:cs) body withUTFFilePathArray :: GlibFilePath fp => [fp] -> (Ptr CString -> IO a) -> IO a withUTFFilePathArray hsFP body = withUTFFilePaths hsFP $ \cStrs -> do withArray cStrs body withUTFFilePathArray0 :: GlibFilePath fp => [fp] -> (Ptr CString -> IO a) -> IO a withUTFFilePathArray0 hsFP body = withUTFFilePaths hsFP $ \cStrs -> do withArray0 nullPtr cStrs body peekUTFFilePathArray0 :: GlibFilePath fp => Ptr CString -> IO [fp] peekUTFFilePathArray0 cStrArr = do cStrs <- peekArray0 nullPtr cStrArr mapM peekUTFFilePath cStrs readUTFFilePathArray0 :: GlibFilePath fp => Ptr CString -> IO [fp] readUTFFilePathArray0 cStrArr | cStrArr == nullPtr = return [] | otherwise = do cStrs <- peekArray0 nullPtr cStrArr fps <- mapM peekUTFFilePath cStrs g_strfreev cStrArr return fps glib-0.13.4.1/System/Glib/Utils.chs0000644000000000000000000000571613005220034014777 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) Miscellaneous utilities -- -- Author : John Millikin -- -- Created: 15 November 2009 -- -- Copyright (C) 2009 John Millikin -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This module binds GLib-specific utility procedures. -- module System.Glib.Utils ( getApplicationName , setApplicationName , getProgramName , setProgramName ) where import System.Glib.FFI import System.Glib.UTFString {# context lib="glib" prefix="g" #} -- | -- Gets a human-readable name for the application, as set by -- 'setApplicationName'. This name should be localized if possible, and is -- intended for display to the user. Contrast with 'getProgramName', which -- gets a non-localized name. If 'setApplicationName' has not been performed, -- returns the result of 'getProgramName' (which may be 'Nothing' if -- 'setProgramName' has also not been performed). -- getApplicationName :: GlibString string => IO (Maybe string) getApplicationName = {#call unsafe get_application_name #} >>= maybePeek peekUTFString -- | -- Sets a human-readable name for the application. This name should be -- localized if possible, and is intended for display to the user. Contrast -- with 'setProgramName', which sets a non-localized name. 'setProgramName' -- will be performed automatically by 'initGUI', but 'setApplicationName' -- will not. -- -- Note that for thread safety reasons, this computation can only be performed -- once. -- -- The application name will be used in contexts such as error messages, or -- when displaying an application's name in the task list. -- setApplicationName :: GlibString string => string -> IO () setApplicationName = flip withUTFString {#call unsafe set_application_name #} -- | -- Gets the name of the program. This name should /not/ be localized, contrast -- with 'getApplicationName'. If you are using GDK or GTK+, the program name -- is set in 'initGUI' to the last component of argv[0]. -- getProgramName :: GlibString string => IO (Maybe string) getProgramName = {#call unsafe get_prgname #} >>= maybePeek peekUTFString -- | -- Sets the name of the program. This name should /not/ be localized, contrast -- with 'setApplicationName'. Note that for thread-safety reasons this -- computation can only be performed once. -- setProgramName :: GlibString string => string -> IO () setProgramName = flip withUTFString {#call unsafe set_prgname #}