gtk-0.15.9/0000755000000000000000000000000007346545000010564 5ustar0000000000000000gtk-0.15.9/COPYING0000644000000000000000000006351007346545000011624 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! gtk-0.15.9/Graphics/UI/0000755000000000000000000000000007346545000012641 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk.chs0000644000000000000000000005534507346545000014101 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) -- -- Author : Axel Simon -- -- Created: 9 April 2001 -- -- Copyright (C) 2001-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. -- -- Everything that is marked as deprecated, vanishing or useless for -- applications is not bound. -- -- The following modules are not bound: -- DialogMessage : has only one variadic function which cannot be bound. -- The same functionality can be simulated with Dialog. -- Item : The only child of this abstract class is MenuItem. The -- three signals Item defines are therefore bound in -- MenuItem. -- -- TODO -- -- Every module that is commented out and not mentioned above. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This module gathers all publicly available functions from the Gtk binding. -- module Graphics.UI.Gtk ( -- * General things, initialization module Graphics.UI.Gtk.General.General, module Graphics.UI.Gtk.General.IconFactory, module Graphics.UI.Gtk.General.IconTheme, module Graphics.UI.Gtk.General.StockItems, module Graphics.UI.Gtk.General.Selection, module Graphics.UI.Gtk.General.Settings, module Graphics.UI.Gtk.General.Drag, module Graphics.UI.Gtk.Gdk.Keys, module Graphics.UI.Gtk.General.Style, module Graphics.UI.Gtk.General.RcStyle, module Graphics.UI.Gtk.General.Clipboard, -- * Drawing and other Low-Level Operations module Graphics.UI.Gtk.Gdk.AppLaunchContext, module Graphics.UI.Gtk.Gdk.Cursor, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.Gdk.Drawable, #endif module Graphics.UI.Gtk.Gdk.DrawWindow, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.Gdk.Region, #endif -- module Graphics.UI.Gtk.Gdk.GC, module Graphics.UI.Gtk.Gdk.EventM, #if GTK_CHECK_VERSION(3,16,0) module Graphics.UI.Gtk.Gdk.GLContext, #endif module Graphics.UI.Gtk.Gdk.Pixbuf, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.Gdk.Pixmap, #endif module Graphics.UI.Gtk.Gdk.Screen, module Graphics.UI.Gtk.Gdk.Keymap, module Graphics.UI.Gtk.Gdk.Display, module Graphics.UI.Gtk.Gdk.DisplayManager, module Graphics.UI.Gtk.Gdk.Gdk, -- ** cairo integration module Graphics.UI.Gtk.Cairo, -- * Windows module Graphics.UI.Gtk.Windows.Window, module Graphics.UI.Gtk.Windows.OffscreenWindow, module Graphics.UI.Gtk.Windows.Invisible, module Graphics.UI.Gtk.Windows.Dialog, module Graphics.UI.Gtk.Windows.AboutDialog, module Graphics.UI.Gtk.Windows.Assistant, module Graphics.UI.Gtk.Windows.MessageDialog, module Graphics.UI.Gtk.Windows.WindowGroup, -- * Display widgets, module Graphics.UI.Gtk.Display.AccelLabel, module Graphics.UI.Gtk.Display.Image, module Graphics.UI.Gtk.Display.Label, #if GTK_CHECK_VERSION(3,6,0) module Graphics.UI.Gtk.Display.LevelBar, #endif module Graphics.UI.Gtk.Display.ProgressBar, module Graphics.UI.Gtk.Display.Spinner, module Graphics.UI.Gtk.Display.Statusbar, module Graphics.UI.Gtk.Display.StatusIcon, #if GTK_CHECK_VERSION(2,18,0) module Graphics.UI.Gtk.Display.InfoBar, #endif -- * Buttons and toggles module Graphics.UI.Gtk.Buttons.Button, module Graphics.UI.Gtk.Buttons.CheckButton, module Graphics.UI.Gtk.Buttons.RadioButton, module Graphics.UI.Gtk.Buttons.ToggleButton, module Graphics.UI.Gtk.Buttons.LinkButton, module Graphics.UI.Gtk.Buttons.ScaleButton, module Graphics.UI.Gtk.Buttons.VolumeButton, -- * Numeric\/text data entry module Graphics.UI.Gtk.Entry.Editable, module Graphics.UI.Gtk.Entry.Entry, module Graphics.UI.Gtk.Entry.EntryBuffer, module Graphics.UI.Gtk.Entry.EntryCompletion, module Graphics.UI.Gtk.Entry.HScale, module Graphics.UI.Gtk.Entry.VScale, module Graphics.UI.Gtk.Entry.SpinButton, -- * Multiline text editor module Graphics.UI.Gtk.Multiline.TextIter, module Graphics.UI.Gtk.Multiline.TextMark, module Graphics.UI.Gtk.Multiline.TextBuffer, module Graphics.UI.Gtk.Multiline.TextTag, module Graphics.UI.Gtk.Multiline.TextTagTable, module Graphics.UI.Gtk.Multiline.TextView, -- * Tree and list widget module Graphics.UI.Gtk.ModelView.CellEditable, module Graphics.UI.Gtk.ModelView.CellLayout, module Graphics.UI.Gtk.ModelView.CellRenderer, module Graphics.UI.Gtk.ModelView.CellRendererSpinner, module Graphics.UI.Gtk.ModelView.CellRendererCombo, module Graphics.UI.Gtk.ModelView.CellRendererPixbuf, module Graphics.UI.Gtk.ModelView.CellRendererProgress, module Graphics.UI.Gtk.ModelView.CellRendererText, module Graphics.UI.Gtk.ModelView.CellRendererAccel, module Graphics.UI.Gtk.ModelView.CellRendererSpin, module Graphics.UI.Gtk.ModelView.CellRendererToggle, module Graphics.UI.Gtk.ModelView.CellView, module Graphics.UI.Gtk.ModelView.CustomStore, module Graphics.UI.Gtk.ModelView.IconView, module Graphics.UI.Gtk.ModelView.ListStore, module Graphics.UI.Gtk.ModelView.TreeDrag, module Graphics.UI.Gtk.ModelView.TreeModel, module Graphics.UI.Gtk.ModelView.TreeModelSort, module Graphics.UI.Gtk.ModelView.TreeSortable, module Graphics.UI.Gtk.ModelView.TreeModelFilter, module Graphics.UI.Gtk.ModelView.TreeRowReference, module Graphics.UI.Gtk.ModelView.TreeSelection, module Graphics.UI.Gtk.ModelView.TreeStore, module Graphics.UI.Gtk.ModelView.TreeView, module Graphics.UI.Gtk.ModelView.TreeViewColumn, -- * Menus, combo box, toolbar module Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.MenuComboToolbar.Combo, #endif module Graphics.UI.Gtk.MenuComboToolbar.ComboBox, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry, #endif module Graphics.UI.Gtk.MenuComboToolbar.Menu, module Graphics.UI.Gtk.MenuComboToolbar.MenuBar, module Graphics.UI.Gtk.MenuComboToolbar.MenuItem, module Graphics.UI.Gtk.MenuComboToolbar.MenuShell, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.MenuComboToolbar.OptionMenu, #endif module Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem, module Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem, module Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem, module Graphics.UI.Gtk.MenuComboToolbar.Toolbar, module Graphics.UI.Gtk.MenuComboToolbar.ToolItem, module Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup, module Graphics.UI.Gtk.MenuComboToolbar.ToolPalette, module Graphics.UI.Gtk.MenuComboToolbar.ToolButton, module Graphics.UI.Gtk.MenuComboToolbar.MenuToolButton, module Graphics.UI.Gtk.MenuComboToolbar.ToggleToolButton, module Graphics.UI.Gtk.MenuComboToolbar.RadioToolButton, module Graphics.UI.Gtk.MenuComboToolbar.SeparatorMenuItem, module Graphics.UI.Gtk.MenuComboToolbar.SeparatorToolItem, -- * Action-based menus and toolbars module Graphics.UI.Gtk.ActionMenuToolbar.Action, module Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup, module Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction, module Graphics.UI.Gtk.ActionMenuToolbar.RadioAction, module Graphics.UI.Gtk.ActionMenuToolbar.RecentAction, module Graphics.UI.Gtk.ActionMenuToolbar.UIManager, -- * Selectors (file\/font\/color) module Graphics.UI.Gtk.Selectors.ColorSelection, module Graphics.UI.Gtk.Selectors.ColorSelectionDialog, module Graphics.UI.Gtk.Selectors.ColorButton, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.Selectors.FileSelection, #endif module Graphics.UI.Gtk.Selectors.FontSelection, module Graphics.UI.Gtk.Selectors.FontSelectionDialog, module Graphics.UI.Gtk.Selectors.FontButton, #if GTK_CHECK_VERSION(2,14,0) module Graphics.UI.Gtk.Selectors.HSV, #endif #if GTK_MAJOR_VERSION < 3 -- * Special-purpose features module Graphics.UI.Gtk.Special.Ruler, module Graphics.UI.Gtk.Special.HRuler, module Graphics.UI.Gtk.Special.VRuler, #endif -- module InputDialog, -- ** File chooser module Graphics.UI.Gtk.Selectors.FileChooser, module Graphics.UI.Gtk.Selectors.FileChooserDialog, module Graphics.UI.Gtk.Selectors.FileChooserWidget, module Graphics.UI.Gtk.Selectors.FileChooserButton, module Graphics.UI.Gtk.Selectors.FileFilter, -- * Layout containers module Graphics.UI.Gtk.Layout.Alignment, module Graphics.UI.Gtk.Layout.AspectFrame, module Graphics.UI.Gtk.Layout.HBox, module Graphics.UI.Gtk.Layout.HButtonBox, module Graphics.UI.Gtk.Layout.Fixed, module Graphics.UI.Gtk.Layout.HPaned, module Graphics.UI.Gtk.Layout.Layout, module Graphics.UI.Gtk.Layout.Notebook, #if GTK_MAJOR_VERSION >= 3 module Graphics.UI.Gtk.Layout.Grid, module Graphics.UI.Gtk.Layout.Overlay, #endif module Graphics.UI.Gtk.Layout.Expander, module Graphics.UI.Gtk.Layout.Table, module Graphics.UI.Gtk.Layout.VBox, module Graphics.UI.Gtk.Layout.VButtonBox, module Graphics.UI.Gtk.Layout.VPaned, #if GTK_CHECK_VERSION(3,10,0) module Graphics.UI.Gtk.Layout.Stack, module Graphics.UI.Gtk.Layout.StackSwitcher, #endif -- * Ornaments module Graphics.UI.Gtk.Ornaments.Frame, module Graphics.UI.Gtk.Ornaments.HSeparator, module Graphics.UI.Gtk.Ornaments.VSeparator, -- * Printing module Graphics.UI.Gtk.Printing.PaperSize, module Graphics.UI.Gtk.Printing.PageSetup, module Graphics.UI.Gtk.Printing.PrintContext, module Graphics.UI.Gtk.Printing.PrintOperation, module Graphics.UI.Gtk.Printing.PrintSettings, -- * Recent module Graphics.UI.Gtk.Recent.RecentChooserMenu, module Graphics.UI.Gtk.Recent.RecentChooserWidget, module Graphics.UI.Gtk.Recent.RecentFilter, module Graphics.UI.Gtk.Recent.RecentManager, module Graphics.UI.Gtk.Recent.RecentInfo, module Graphics.UI.Gtk.Recent.RecentChooser, -- * Scrolling module Graphics.UI.Gtk.Scrolling.HScrollbar, module Graphics.UI.Gtk.Scrolling.ScrolledWindow, module Graphics.UI.Gtk.Scrolling.VScrollbar, -- * Miscellaneous module Graphics.UI.Gtk.Misc.Accessible, module Graphics.UI.Gtk.Misc.Adjustment, module Graphics.UI.Gtk.Misc.Arrow, module Graphics.UI.Gtk.Misc.Calendar, module Graphics.UI.Gtk.Misc.DrawingArea, #if GTK_CHECK_VERSION(3,16,0) module Graphics.UI.Gtk.Misc.GLArea, #endif module Graphics.UI.Gtk.Misc.EventBox, module Graphics.UI.Gtk.Misc.HandleBox, module Graphics.UI.Gtk.Misc.IMMulticontext, module Graphics.UI.Gtk.Misc.IMContextSimple, module Graphics.UI.Gtk.Misc.SizeGroup, module Graphics.UI.Gtk.Misc.Tooltip, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.Misc.Tooltips, #endif module Graphics.UI.Gtk.Misc.Viewport, #if GTK_MAJOR_VERSION >= 3 module Graphics.UI.Gtk.Misc.Switch, #endif -- * Abstract base classes module Graphics.UI.Gtk.Abstract.Box, module Graphics.UI.Gtk.Abstract.ButtonBox, module Graphics.UI.Gtk.Abstract.Container, module Graphics.UI.Gtk.Abstract.Bin, module Graphics.UI.Gtk.Abstract.Misc, module Graphics.UI.Gtk.Abstract.IMContext, module Graphics.UI.Gtk.Abstract.Object, module Graphics.UI.Gtk.Abstract.Paned, module Graphics.UI.Gtk.Abstract.Range, module Graphics.UI.Gtk.Abstract.Scale, module Graphics.UI.Gtk.Abstract.Scrollbar, module Graphics.UI.Gtk.Abstract.Separator, module Graphics.UI.Gtk.Abstract.Widget, #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) -- * Cross-process embedding module Graphics.UI.Gtk.Embedding.Plug, module Graphics.UI.Gtk.Embedding.Socket, #endif -- * Non-widgets module System.Glib.Signals, module System.Glib.Attributes, module System.Glib.GObject, module Graphics.UI.Gtk.Builder, -- * Pango text layout modules module Graphics.Rendering.Pango.Context, module Graphics.Rendering.Pango.Markup, module Graphics.Rendering.Pango.Layout, module Graphics.Rendering.Pango.Rendering, module Graphics.Rendering.Pango.Font, module Graphics.Rendering.Pango.Enums ) where -- general things, initialization import Graphics.UI.Gtk.General.General import Graphics.UI.Gtk.General.IconFactory import Graphics.UI.Gtk.General.IconTheme import Graphics.UI.Gtk.General.StockItems import Graphics.UI.Gtk.General.Selection import Graphics.UI.Gtk.General.Settings import Graphics.UI.Gtk.General.Drag import Graphics.UI.Gtk.General.Clipboard -- drawing import Graphics.UI.Gtk.Gdk.Keys import Graphics.UI.Gtk.General.Style import Graphics.UI.Gtk.General.RcStyle import Graphics.UI.Gtk.Gdk.AppLaunchContext import Graphics.UI.Gtk.Gdk.Cursor #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Drawable #endif import Graphics.UI.Gtk.Gdk.DrawWindow #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Region hiding (makeNewRegion) #endif --import Graphics.UI.Gtk.Gdk.GC import Graphics.UI.Gtk.Gdk.EventM #if GTK_CHECK_VERSION(3,16,0) import Graphics.UI.Gtk.Gdk.GLContext #endif import Graphics.UI.Gtk.Gdk.Pixbuf #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Pixmap #endif import Graphics.UI.Gtk.Gdk.Screen import Graphics.UI.Gtk.Gdk.Keymap import Graphics.UI.Gtk.Gdk.Display import Graphics.UI.Gtk.Gdk.DisplayManager import Graphics.UI.Gtk.Gdk.Gdk -- cairo integration import Graphics.UI.Gtk.Cairo -- windows import Graphics.UI.Gtk.Windows.Dialog import Graphics.UI.Gtk.Windows.Window import Graphics.UI.Gtk.Windows.OffscreenWindow import Graphics.UI.Gtk.Windows.Invisible import Graphics.UI.Gtk.Windows.AboutDialog import Graphics.UI.Gtk.Windows.Assistant import Graphics.UI.Gtk.Windows.MessageDialog import Graphics.UI.Gtk.Windows.WindowGroup -- display widgets import Graphics.UI.Gtk.Display.AccelLabel import Graphics.UI.Gtk.Display.Image import Graphics.UI.Gtk.Display.Label #if GTK_CHECK_VERSION(3,6,0) import Graphics.UI.Gtk.Display.LevelBar #endif import Graphics.UI.Gtk.Display.ProgressBar import Graphics.UI.Gtk.Display.Spinner import Graphics.UI.Gtk.Display.Statusbar #if GTK_CHECK_VERSION(2,10,0) && !DISABLE_DEPRECATED import Graphics.UI.Gtk.Display.StatusIcon hiding (onActivate,afterActivate,onPopupMenu,afterPopupMenu) #else import Graphics.UI.Gtk.Display.StatusIcon #endif #if GTK_CHECK_VERSION(2,18,0) import Graphics.UI.Gtk.Display.InfoBar #endif -- buttons and toggles import Graphics.UI.Gtk.Buttons.Button import Graphics.UI.Gtk.Buttons.CheckButton import Graphics.UI.Gtk.Buttons.RadioButton import Graphics.UI.Gtk.Buttons.ToggleButton import Graphics.UI.Gtk.Buttons.LinkButton import Graphics.UI.Gtk.Buttons.ScaleButton import Graphics.UI.Gtk.Buttons.VolumeButton -- numeric\/text data entry import Graphics.UI.Gtk.Entry.Editable import Graphics.UI.Gtk.Entry.Entry import Graphics.UI.Gtk.Entry.EntryBuffer import Graphics.UI.Gtk.Entry.EntryCompletion import Graphics.UI.Gtk.Entry.HScale import Graphics.UI.Gtk.Entry.VScale import Graphics.UI.Gtk.Entry.SpinButton -- multiline text editor import Graphics.UI.Gtk.Multiline.TextIter import Graphics.UI.Gtk.Multiline.TextMark import Graphics.UI.Gtk.Multiline.TextBuffer import Graphics.UI.Gtk.Multiline.TextTag import Graphics.UI.Gtk.Multiline.TextTagTable import qualified Graphics.UI.Gtk.Multiline.TextView import Graphics.UI.Gtk.Multiline.TextView -- tree and list widget import Graphics.UI.Gtk.ModelView.CellEditable import Graphics.UI.Gtk.ModelView.CellLayout import Graphics.UI.Gtk.ModelView.CellRenderer import Graphics.UI.Gtk.ModelView.CellRendererSpinner import Graphics.UI.Gtk.ModelView.CellRendererCombo import Graphics.UI.Gtk.ModelView.CellRendererPixbuf import Graphics.UI.Gtk.ModelView.CellRendererProgress import Graphics.UI.Gtk.ModelView.CellRendererText import Graphics.UI.Gtk.ModelView.CellRendererAccel import Graphics.UI.Gtk.ModelView.CellRendererSpin import Graphics.UI.Gtk.ModelView.CellRendererToggle import Graphics.UI.Gtk.ModelView.CellView import Graphics.UI.Gtk.ModelView.CustomStore import Graphics.UI.Gtk.ModelView.IconView import Graphics.UI.Gtk.ModelView.ListStore import Graphics.UI.Gtk.ModelView.TreeDrag import Graphics.UI.Gtk.ModelView.TreeModel import Graphics.UI.Gtk.ModelView.TreeModelSort import Graphics.UI.Gtk.ModelView.TreeSortable import Graphics.UI.Gtk.ModelView.TreeModelFilter import Graphics.UI.Gtk.ModelView.TreeRowReference import Graphics.UI.Gtk.ModelView.TreeSelection import Graphics.UI.Gtk.ModelView.TreeStore import Graphics.UI.Gtk.ModelView.TreeView import Graphics.UI.Gtk.ModelView.TreeViewColumn -- menus, combo box, toolbar #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.MenuComboToolbar.Combo #endif import Graphics.UI.Gtk.MenuComboToolbar.ComboBox #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry #endif -- import ItemFactory import Graphics.UI.Gtk.MenuComboToolbar.Menu import Graphics.UI.Gtk.MenuComboToolbar.MenuBar import Graphics.UI.Gtk.MenuComboToolbar.MenuItem import Graphics.UI.Gtk.MenuComboToolbar.MenuShell #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.MenuComboToolbar.OptionMenu #endif import Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem import Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem import Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem import Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem import Graphics.UI.Gtk.MenuComboToolbar.Toolbar import Graphics.UI.Gtk.MenuComboToolbar.ToolItem import Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup import Graphics.UI.Gtk.MenuComboToolbar.ToolPalette import Graphics.UI.Gtk.MenuComboToolbar.ToolButton import Graphics.UI.Gtk.MenuComboToolbar.MenuToolButton import Graphics.UI.Gtk.MenuComboToolbar.ToggleToolButton import Graphics.UI.Gtk.MenuComboToolbar.RadioToolButton import Graphics.UI.Gtk.MenuComboToolbar.SeparatorMenuItem import Graphics.UI.Gtk.MenuComboToolbar.SeparatorToolItem -- action based menus and toolbars import Graphics.UI.Gtk.ActionMenuToolbar.Action import Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup import Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction import Graphics.UI.Gtk.ActionMenuToolbar.RadioAction import Graphics.UI.Gtk.ActionMenuToolbar.RecentAction import Graphics.UI.Gtk.ActionMenuToolbar.UIManager -- selectors (file\/font\/color\/input device) import Graphics.UI.Gtk.Selectors.ColorSelection import Graphics.UI.Gtk.Selectors.ColorSelectionDialog import Graphics.UI.Gtk.Selectors.ColorButton #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Selectors.FileSelection #endif import Graphics.UI.Gtk.Selectors.FileChooser import Graphics.UI.Gtk.Selectors.FileChooserDialog import Graphics.UI.Gtk.Selectors.FileChooserWidget import Graphics.UI.Gtk.Selectors.FileChooserButton import Graphics.UI.Gtk.Selectors.FileFilter import Graphics.UI.Gtk.Selectors.FontSelection import Graphics.UI.Gtk.Selectors.FontSelectionDialog import Graphics.UI.Gtk.Selectors.FontButton #if GTK_CHECK_VERSION(2,14,0) import Graphics.UI.Gtk.Selectors.HSV #endif #if GTK_MAJOR_VERSION < 3 -- Special-purpose features import Graphics.UI.Gtk.Special.Ruler import Graphics.UI.Gtk.Special.HRuler import Graphics.UI.Gtk.Special.VRuler #endif --import InputDialog -- layout containers import Graphics.UI.Gtk.Layout.Alignment import Graphics.UI.Gtk.Layout.AspectFrame import Graphics.UI.Gtk.Layout.HBox import Graphics.UI.Gtk.Layout.VBox import Graphics.UI.Gtk.Layout.HButtonBox import Graphics.UI.Gtk.Layout.VButtonBox import Graphics.UI.Gtk.Layout.Fixed import Graphics.UI.Gtk.Layout.HPaned import Graphics.UI.Gtk.Layout.VPaned import Graphics.UI.Gtk.Layout.Layout import Graphics.UI.Gtk.Layout.Notebook #if GTK_MAJOR_VERSION >= 3 import Graphics.UI.Gtk.Layout.Grid import Graphics.UI.Gtk.Layout.Overlay #endif #if GTK_CHECK_VERSION(3,10,0) import Graphics.UI.Gtk.Layout.Stack import Graphics.UI.Gtk.Layout.StackSwitcher #endif import Graphics.UI.Gtk.Layout.Expander import Graphics.UI.Gtk.Layout.Table -- ornaments import Graphics.UI.Gtk.Ornaments.Frame import Graphics.UI.Gtk.Ornaments.HSeparator import Graphics.UI.Gtk.Ornaments.VSeparator -- printing import Graphics.UI.Gtk.Printing.PaperSize import Graphics.UI.Gtk.Printing.PageSetup import Graphics.UI.Gtk.Printing.PrintContext import Graphics.UI.Gtk.Printing.PrintOperation import Graphics.UI.Gtk.Printing.PrintSettings -- recent import Graphics.UI.Gtk.Recent.RecentChooserMenu import Graphics.UI.Gtk.Recent.RecentChooserWidget import Graphics.UI.Gtk.Recent.RecentFilter import Graphics.UI.Gtk.Recent.RecentManager import Graphics.UI.Gtk.Recent.RecentInfo import Graphics.UI.Gtk.Recent.RecentChooser -- scrolling import Graphics.UI.Gtk.Scrolling.HScrollbar import Graphics.UI.Gtk.Scrolling.VScrollbar import Graphics.UI.Gtk.Scrolling.ScrolledWindow -- miscellaneous import Graphics.UI.Gtk.Misc.Accessible import Graphics.UI.Gtk.Misc.Adjustment import Graphics.UI.Gtk.Misc.Arrow import Graphics.UI.Gtk.Misc.Calendar import Graphics.UI.Gtk.Misc.DrawingArea #if GTK_CHECK_VERSION(3,16,0) import Graphics.UI.Gtk.Misc.GLArea #endif import Graphics.UI.Gtk.Misc.EventBox import Graphics.UI.Gtk.Misc.HandleBox import Graphics.UI.Gtk.Misc.IMMulticontext import Graphics.UI.Gtk.Misc.IMContextSimple import Graphics.UI.Gtk.Misc.SizeGroup import Graphics.UI.Gtk.Misc.Tooltip #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Misc.Tooltips #endif import Graphics.UI.Gtk.Misc.Viewport #if GTK_MAJOR_VERSION >= 3 import Graphics.UI.Gtk.Misc.Switch #endif --import Accessible -- abstract base classes import Graphics.UI.Gtk.Abstract.Box import Graphics.UI.Gtk.Abstract.ButtonBox import Graphics.UI.Gtk.Abstract.Container import Graphics.UI.Gtk.Abstract.Bin import Graphics.UI.Gtk.Abstract.Misc import Graphics.UI.Gtk.Abstract.IMContext import Graphics.UI.Gtk.Abstract.Object ( #if GTK_MAJOR_VERSION < 3 Object, ObjectClass, castToObject, gTypeObject, toObject, #endif GWeakNotify, objectWeakref, objectWeakunref, objectDestroy, notifyProperty ) import Graphics.UI.Gtk.Abstract.Paned import Graphics.UI.Gtk.Abstract.Range import Graphics.UI.Gtk.Abstract.Scale import Graphics.UI.Gtk.Abstract.Scrollbar import Graphics.UI.Gtk.Abstract.Separator import Graphics.UI.Gtk.Abstract.Widget -- cross-process embedding #if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) || defined(GDK_WINDOWING_X11) import Graphics.UI.Gtk.Embedding.Plug import Graphics.UI.Gtk.Embedding.Socket #endif -- non widgets import System.Glib.Signals {- do eport 'on' and 'after' (ConnectId, disconnect, signalDisconnect, signalBlock, signalUnblock) -} import System.Glib.Attributes import System.Glib.GObject ( GObject, GObjectClass, toGObject, castToGObject, gTypeGObject, quarkFromString, objectCreateAttribute, objectSetAttribute, objectGetAttributeUnsafe, isA ) import Graphics.UI.Gtk.Builder -- pango modules import Graphics.Rendering.Pango.Context import Graphics.Rendering.Pango.Markup import Graphics.Rendering.Pango.Layout import Graphics.Rendering.Pango.Rendering import Graphics.Rendering.Pango.Font import Graphics.Rendering.Pango.Enums gtk-0.15.9/Graphics/UI/Gtk/Abstract/0000755000000000000000000000000007346545000015131 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Abstract/Bin.chs0000644000000000000000000000502707346545000016344 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Bin -- -- Author : Duncan Coutts -- -- Created: 25 April 2004 -- -- Copyright (C) 2004-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) -- -- A container with just one child -- module Graphics.UI.Gtk.Abstract.Bin ( -- * Detail -- -- | The 'Bin' widget is a container with just one child. It is not very -- useful itself, but it is useful for deriving subclasses, since it provides -- common code needed for handling a single child widget. -- -- Many Gtk+ widgets are subclasses of 'Bin', including 'Window', 'Button', -- 'Frame', 'HandleBox', and 'ScrolledWindow'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Bin -- | +----'Window' -- | +----'Alignment' -- | +----'Frame' -- | +----'Button' -- | +----'Item' -- | +----'ComboBox' -- | +----'EventBox' -- | +----'Expander' -- | +----'HandleBox' -- | +----'ToolItem' -- | +----'ScrolledWindow' -- | +----'Viewport' -- @ -- * Types Bin, BinClass, castToBin, gTypeBin, toBin, -- * Methods binGetChild, ) where import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Gets the child of the 'Bin', or @Nothing@ if the bin contains no child -- widget. -- binGetChild :: BinClass self => self -> IO (Maybe Widget) -- ^ returns pointer to child of the 'Bin' binGetChild self = maybeNull (makeNewObject mkWidget) $ {# call gtk_bin_get_child #} (toBin self) gtk-0.15.9/Graphics/UI/Gtk/Abstract/Box.chs0000644000000000000000000003735507346545000016375 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Box -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for box containers -- module Graphics.UI.Gtk.Abstract.Box ( -- * Detail -- -- | 'Box' is an abstract widget which encapsulates functionality for a -- particular kind of container, one that organizes a variable number of -- widgets into a rectangular area. 'Box' currently has two derived classes, -- 'HBox' and 'VBox'. -- -- The rectangular area of a 'Box' is organized into either a single row or -- a single column of child widgets depending upon whether the box is of type -- 'HBox' or 'VBox', respectively. Thus, all children of a 'Box' are allocated -- one dimension in common, which is the height of a row, or the width of a -- column. -- -- 'Box' uses a notion of /packing/. Packing refers to adding widgets with -- reference to a particular position in a 'Container'. For a 'Box', there are -- two reference positions: the /start/ and the /end/ of the box. For a 'VBox', -- the start is defined as the top of the box and the end is defined as the -- bottom. For a 'HBox' the start is defined as the left side and the end is -- defined as the right side. -- -- Use repeated calls to 'boxPackStart' to pack widgets into a 'Box' from -- start to end. Use 'boxPackEnd' to add widgets from end to start. You may -- intersperse these calls and add widgets from both ends of the same 'Box'. -- Besides adding widgets at the start or the end of a box, you can also -- specify the padding around each widget (in pixels) and a 'Packing' -- parameter that denotes how to fill up unused space. -- -- While the right amount of padding around each widget is a matter of -- appearance, the 'Packing' parameter specifies the way the widgets in -- the container behave when the window is resized and thereby affect -- the usability. Hence, once you have created a window, you should resize -- it and see if the widgets behave as expected. The 'Packing' parameter of -- each child widget determines how excess space is used by that particular -- widget. See the description of 'Packing' for a detailed explanaition. -- -- Because 'Box' is a 'Container', you may also use -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd' to insert widgets into -- the box, and they will be packed as if with 'boxPackStart' with 'PackRepel' -- and 0 padding. Use 'Graphics.UI.Gtk.Abstract.Container.containerRemove' to -- remove widgets from the 'Box'. -- -- Use 'boxSetHomogeneous' to specify whether or not all children of the -- 'Box' are forced to get the same amount of space. Note that the -- 'Packing' options 'PackNatural' and 'PackRepel' coincide if space is -- allotted homogeneously. -- -- Use 'boxSetSpacing' to determine how much space will be minimally placed -- between all children in the 'Box'. -- -- Use 'boxReorderChild' to move a 'Box' child to a different place in the -- box. -- -- Use 'boxSetChildPacking' to reset the expand, fill, and padding -- attributes of any 'Box' child. Use 'boxQueryChildPacking' to query these -- fields. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Box -- | +----'ButtonBox' -- | +----'VBox' -- | +----'HBox' -- @ -- * Types Box, BoxClass, castToBox, gTypeBox, toBox, Packing(..), -- * Methods boxPackStart, boxPackEnd, #if GTK_MAJOR_VERSION < 3 boxPackStartDefaults, boxPackEndDefaults, #endif boxGetHomogeneous, boxSetHomogeneous, boxGetSpacing, boxSetSpacing, boxReorderChild, boxQueryChildPacking, boxSetChildPacking, #if GTK_CHECK_VERSION(3,10,0) boxGetBaselinePosition, boxSetBaselinePosition, #endif #if GTK_CHECK_VERSION(3,12,0) boxGetCenterWidget, boxSetCenterWidget, #endif -- * Attributes boxSpacing, boxHomogeneous, #if GTK_CHECK_VERSION(3,10,0) boxBaselinePosition, #endif #if GTK_CHECK_VERSION(3,12,0) boxCenterWidget, #endif -- * Child Attributes boxChildPacking, boxChildPadding, boxChildPackType, boxChildPosition, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (PackType(..), Packing(..), toPacking, fromPacking) import Graphics.UI.Gtk.Abstract.ContainerChildProperties #if GTK_CHECK_VERSION(3,10,0) import Graphics.UI.Gtk.General.Enums (BaselinePosition) #endif #if GTK_CHECK_VERSION(3,12,0) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Adds the @child@ widget to the box, packed with reference to the start of -- the box. The -- @child@ is packed after any other child packed with reference to the start -- of the box. -- -- boxPackStart :: (BoxClass self, WidgetClass child) => self -> child -- ^ @child@ - the 'Widget' to be added to the box. -> Packing -> Int -- ^ @padding@ - extra space in pixels to put between this child and -- its neighbors, over and above the global amount specified by -- spacing 'boxSetSpacing'. If @child@ -- is a widget at one of the reference ends of @box@, then @padding@ -- pixels are also put between @child@ and the reference edge of -- @box@. -> IO () boxPackStart self child packing padding = {# call box_pack_start #} (toBox self) (toWidget child) (fromBool expand) (fromBool fill) (fromIntegral padding) where (expand, fill) = fromPacking packing -- | Adds the @child@ widget to the box, packed with reference to the end of -- the box. The -- @child@ is packed after (away from end of) any other child packed with -- reference to the end of the box. -- -- Note that -- for 'boxPackEnd' the 'PackNatural' option will move a child to the right in -- an 'HBox' or to the bottom in an 'VBox' if there is more space available. -- boxPackEnd :: (BoxClass self, WidgetClass child) => self -> child -- ^ @child@ - the 'Widget' to be added to the box. -> Packing -> Int -- ^ @padding@ - extra space in pixels to put between this child and -- its neighbors, over and above the global amount specified by -- spacing 'boxSetSpacing'. If @child@ -- is a widget at one of the reference ends of @box@, then @padding@ -- pixels are also put between @child@ and the reference edge of -- @box@. -> IO () boxPackEnd self child packing padding = {# call box_pack_end #} (toBox self) (toWidget child) (fromBool expand) (fromBool fill) (fromIntegral padding) where (expand, fill) = fromPacking packing #if GTK_MAJOR_VERSION < 3 -- | Like 'boxPackStart' but uses the default parameters 'PackRepel' and 0 for -- padding. -- -- Removed in Gtk3 boxPackStartDefaults :: (BoxClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the 'Widget' to be added to the box. -> IO () boxPackStartDefaults self widget = {# call box_pack_start_defaults #} (toBox self) (toWidget widget) -- | Like 'boxPackEnd' but uses the default parameters 'PackRepel' and 0 for -- padding. -- -- Removed in Gtk3 boxPackEndDefaults :: (BoxClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the 'Widget' to be added to the box. -> IO () boxPackEndDefaults self widget = {# call box_pack_end_defaults #} (toBox self) (toWidget widget) #endif -- | Sets the homogeneous property, -- controlling whether or not all children of the box are given equal space -- boxSetHomogeneous :: BoxClass self => self -> Bool -- ^ @homogeneous@ - a boolean value, @True@ to create equal -- allotments, @False@ for variable allotments. -> IO () boxSetHomogeneous self homogeneous = {# call box_set_homogeneous #} (toBox self) (fromBool homogeneous) -- | Returns whether the box is homogeneous (all children are the same size). -- See 'boxSetHomogeneous'. -- boxGetHomogeneous :: BoxClass self => self -> IO Bool -- ^ returns @True@ if the box is homogeneous. boxGetHomogeneous self = liftM toBool $ {# call box_get_homogeneous #} (toBox self) -- | Set the standard spacing between two children. -- -- This space is in addition to the padding parameter that is given for each -- child. -- boxSetSpacing :: BoxClass self => self -> Int -- ^ @spacing@ - the number of pixels to put between children. -> IO () boxSetSpacing self spacing = {# call box_set_spacing #} (toBox self) (fromIntegral spacing) -- | Moves @child@ to a new @position@ in the list of @box@ children. The list -- contains both widgets packed 'PackStart' as well as widgets packed -- 'PackEnd', in the order that these widgets were added to the box. -- -- A widget's position in the box children list determines where the -- widget is packed into the box. A child widget at some position in the list -- will be packed just after all other widgets of the same packing type that -- appear earlier in the list. -- boxReorderChild :: (BoxClass self, WidgetClass child) => self -> child -- ^ @child@ - the 'Widget' to move. -> Int -- ^ @position@ - the new position for @child@ in the children list -- starting from 0. If negative, indicates the end of the list. -> IO () boxReorderChild self child position = {# call box_reorder_child #} (toBox self) (toWidget child) (fromIntegral position) -- | Returns information about how @child@ is packed into the box. -- -- Returns information on the behaviour if free space is available -- (in 'Packing'), the additional padding for this widget and if the widget -- was inserted at the start or end of the container ('PackType'). -- boxQueryChildPacking :: (BoxClass self, WidgetClass child) => self -> child -- ^ @child@ - the 'Widget' of the child to query. -> IO (Packing,Int,PackType) -- ^ @(packing, padding, packType)@ boxQueryChildPacking self child = alloca $ \expandPtr -> alloca $ \fillPtr -> alloca $ \paddingPtr -> alloca $ \packPtr -> do {# call unsafe box_query_child_packing #} (toBox self) (toWidget child) expandPtr fillPtr paddingPtr packPtr expand <- liftM toBool $ peek expandPtr fill <- liftM toBool $ peek fillPtr padding <- liftM fromIntegral $ peek paddingPtr pack <- liftM (toEnum.fromIntegral) $ peek packPtr return (toPacking expand fill, padding, pack) -- | Sets the way @child@ is packed into the box. -- boxSetChildPacking :: (BoxClass self, WidgetClass child) => self -> child -- ^ @child@ - the 'Widget' of the child to set. -> Packing -> Int -- ^ @padding@ -> PackType -- ^ @packType@ -> IO () boxSetChildPacking self child packing padding packType = {# call box_set_child_packing #} (toBox self) (toWidget child) (fromBool expand) (fromBool fill) (fromIntegral padding) ((fromIntegral . fromEnum) packType) where (expand, fill) = fromPacking packing #if GTK_CHECK_VERSION(3,10,0) -- | Gets the value set by `boxSetBaselinePosition` boxGetBaselinePosition :: BoxClass self => self -> IO BaselinePosition boxGetBaselinePosition self = liftM (toEnum . fromIntegral) $ {# call unsafe box_get_baseline_position #} (toBox self) -- | Sets the baseline position of a box. This affects only -- horizontal boxes with at least one baseline aligned child. -- If there is more vertical space available than requested, -- and the baseline is not allocated by the parent then -- `position` is used to allocate the baseline wrt the extra -- space available. boxSetBaselinePosition :: BoxClass self => self -> BaselinePosition -> IO () boxSetBaselinePosition self position = {# call unsafe box_set_baseline_position #} (toBox self) (fromIntegral $ fromEnum position) #endif #if GTK_CHECK_VERSION(3,12,0) -- | Retrieves the center widget of the box. boxGetCenterWidget :: BoxClass self => self -> IO Widget boxGetCenterWidget self = makeNewObject mkWidget $ {# call unsafe box_get_center_widget #} (toBox self) -- | Sets a center widget; that is a child widget that will be -- centered with respect to the full width of the box, even if -- the children at either side take up different amounts of space. boxSetCenterWidget :: (BoxClass self, WidgetClass widget) => self -> widget -> IO () boxSetCenterWidget self position = {# call unsafe box_set_center_widget #} (toBox self) (toWidget position) #endif -- | Retrieves the standard spacing between widgets. -- boxGetSpacing :: BoxClass self => self -> IO Int -- ^ returns spacing between children boxGetSpacing self = liftM fromIntegral $ {# call unsafe box_get_spacing #} (toBox self) -------------------- -- Attributes -- | The amount of space between children. -- -- Allowed values: >= 0 -- -- Default value: 0 -- boxSpacing :: BoxClass self => Attr self Int boxSpacing = newAttr boxGetSpacing boxSetSpacing -- | Whether the children should all be the same size. -- -- Default value: @False@ -- boxHomogeneous :: BoxClass self => Attr self Bool boxHomogeneous = newAttr boxGetHomogeneous boxSetHomogeneous #if GTK_CHECK_VERSION(3,10,0) -- | The position of the baseline aligned widgets if extra space is available. boxBaselinePosition :: BoxClass self => Attr self BaselinePosition boxBaselinePosition = newAttr boxGetBaselinePosition boxSetBaselinePosition #endif #if GTK_CHECK_VERSION(3,12,0) -- | A child widget that will be centered with respect to the -- full width of the box, even if the children at either side -- take up different amounts of space. boxCenterWidget :: (BoxClass self, WidgetClass widget) => ReadWriteAttr self Widget widget boxCenterWidget = newAttr boxGetCenterWidget boxSetCenterWidget #endif -------------------- -- Child Attributes -- | The packing style of the child. -- -- Default value: @'PackGrow'@ -- boxChildPacking :: (BoxClass self, WidgetClass child) => child -> Attr self Packing boxChildPacking child = newAttr (\container -> do expand <- containerChildGetPropertyBool "expand" child container fill <- containerChildGetPropertyBool "fill" child container return (toPacking expand fill)) (\container packing -> case fromPacking packing of (expand, fill) -> do containerChildSetPropertyBool "expand" child container expand containerChildSetPropertyBool "fill" child container fill) -- | Extra space to put between the child and its neighbors, in pixels. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 0 -- boxChildPadding :: (BoxClass self, WidgetClass child) => child -> Attr self Int boxChildPadding = newAttrFromContainerChildUIntProperty "padding" -- | A 'PackType' indicating whether the child is packed with reference to the -- start or end of the parent. -- -- Default value: 'PackStart' -- boxChildPackType :: (BoxClass self, WidgetClass child) => child -> Attr self PackType boxChildPackType = newAttrFromContainerChildEnumProperty "pack-type" {# call pure unsafe gtk_pack_type_get_type #} -- | The index of the child in the parent. -- -- Allowed values: >= -1 -- -- Default value: 0 -- boxChildPosition :: (BoxClass self, WidgetClass child) => child -> Attr self Int boxChildPosition = newAttrFromContainerChildIntProperty "position" gtk-0.15.9/Graphics/UI/Gtk/Abstract/ButtonBox.chs0000644000000000000000000001617207346545000017563 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ButtonBox -- -- Author : Matthew Walton -- -- Created: 28 April 2004 -- -- Copyright (C) 2004-2005 Matthew Walton -- -- 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) -- -- Base class for 'HButtonBox' and 'VButtonBox' -- module Graphics.UI.Gtk.Abstract.ButtonBox ( -- * Detail -- -- | The primary purpose of this class is to keep track of the various -- properties of 'HButtonBox' and 'VButtonBox' widgets. -- -- 'buttonBoxGetChildSize' retrieves the minimum width and height for -- widgets in a given button box. 'buttonBoxSetChildSize' allows those -- properties to be changed. -- -- The internal padding of buttons can be retrieved and changed per button -- box using 'buttonBoxGetChildIpadding' and 'buttonBoxSetChildIpadding' -- respectively. -- -- 'buttonBoxGetSpacing' and 'buttonBoxSetSpacing' retrieve and change -- default number of pixels between buttons, respectively. -- -- 'buttonBoxGetLayout' and 'buttonBoxSetLayout' retrieve and alter the -- method used to spread the buttons in a button box across the container, -- respectively. -- -- The main purpose of 'ButtonBox' is to make sure the children have all the -- same size. Therefore it ignores the homogeneous property which it inherited -- from 'Box', and always behaves as if homogeneous was @True@. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----ButtonBox -- | +----'HButtonBox' -- | +----'VButtonBox' -- @ -- * Types ButtonBox, ButtonBoxClass, castToButtonBox, gTypeButtonBox, toButtonBox, ButtonBoxStyle(..), -- * Methods buttonBoxGetLayout, buttonBoxSetLayout, buttonBoxSetChildSecondary, #if GTK_CHECK_VERSION(2,4,0) buttonBoxGetChildSecondary, #endif #if GTK_CHECK_VERSION(3,2,0) buttonBoxSetChildNonHomogeneous, buttonBoxGetChildNonHomogeneous, #endif -- * Attributes buttonBoxLayoutStyle, -- * Child Attributes buttonBoxChildSecondary, #if GTK_CHECK_VERSION(3,2,0) buttonBoxChildNonHomogeneous, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (ButtonBoxStyle(..)) import Graphics.UI.Gtk.Abstract.ContainerChildProperties {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Retrieves the method being used to arrange the buttons in the button box. -- buttonBoxGetLayout :: ButtonBoxClass self => self -> IO ButtonBoxStyle buttonBoxGetLayout self = liftM (toEnum . fromIntegral) $ {# call gtk_button_box_get_layout #} (toButtonBox self) #if GTK_CHECK_VERSION(2,4,0) -- | Returns whether @child@ should appear in a secondary group of children. -- -- * Available since Gtk+ version 2.4 -- buttonBoxGetChildSecondary :: (ButtonBoxClass self, WidgetClass child) => self -> child -- ^ @child@ - a child of the button box widget -> IO Bool -- ^ returns whether @child@ should appear in a secondary group of -- children. buttonBoxGetChildSecondary self child = liftM toBool $ {# call gtk_button_box_get_child_secondary #} (toButtonBox self) (toWidget child) #endif #if GTK_CHECK_VERSION(3,2,0) -- | Sets whether the child is exempted from homogeous sizing. -- buttonBoxSetChildNonHomogeneous :: (ButtonBoxClass self, WidgetClass child) => self -> child -- ^ @child@ - a child of the button box widget -> Bool -- ^ @nonHomogeneous@ -> IO () buttonBoxSetChildNonHomogeneous self child nonHomogeneous = {# call gtk_button_box_set_child_non_homogeneous #} (toButtonBox self) (toWidget child) (fromBool nonHomogeneous) -- | Returns whether the child is exempted from homogeneous sizing. -- buttonBoxGetChildNonHomogeneous :: (ButtonBoxClass self, WidgetClass child) => self -> child -- ^ @child@ - a child of the button box widget -> IO Bool buttonBoxGetChildNonHomogeneous self child = liftM toBool $ {# call gtk_button_box_get_child_non_homogeneous #} (toButtonBox self) (toWidget child) #endif -- | Changes the way buttons are arranged in their container. -- buttonBoxSetLayout :: ButtonBoxClass self => self -> ButtonBoxStyle -- ^ @layoutStyle@ - the new layout style. -> IO () buttonBoxSetLayout self layoutStyle = {# call gtk_button_box_set_layout #} (toButtonBox self) ((fromIntegral . fromEnum) layoutStyle) -- | Sets whether @child@ should appear in a secondary group of children. A -- typical use of a secondary child is the help button in a dialog. -- -- This group appears after the other children if the style is -- 'ButtonboxStart', 'ButtonboxSpread' or 'ButtonboxEdge', and before the other -- children if the style is 'ButtonboxEnd'. For horizontal button boxes, the -- definition of before\/after depends on direction of the widget (see -- 'widgetSetDirection'). If the style is 'ButtonboxStart' or 'ButtonboxEnd', -- then the secondary children are aligned at the other end of the button box -- from the main children. For the other styles, they appear immediately next -- to the main children. -- buttonBoxSetChildSecondary :: (ButtonBoxClass self, WidgetClass child) => self -> child -- ^ @child@ - a child of the button box widget -> Bool -- ^ @isSecondary@ - if @True@, the @child@ appears in a secondary -- group of the button box. -> IO () buttonBoxSetChildSecondary self child isSecondary = {# call gtk_button_box_set_child_secondary #} (toButtonBox self) (toWidget child) (fromBool isSecondary) -------------------- -- Attributes -- | How to layout the buttons in the box. Possible values are default, -- spread, edge, start and end. -- -- Default value: 'ButtonboxDefaultStyle' -- buttonBoxLayoutStyle :: ButtonBoxClass self => Attr self ButtonBoxStyle buttonBoxLayoutStyle = newAttr buttonBoxGetLayout buttonBoxSetLayout -------------------- -- Child Attributes -- | If @True@, the child appears in a secondary group of children, suitable -- for, e.g., help buttons. -- -- Default value: @False@ -- buttonBoxChildSecondary :: (ButtonBoxClass self, WidgetClass child) => child -> Attr self Bool buttonBoxChildSecondary = newAttrFromContainerChildBoolProperty "secondary" #if GTK_CHECK_VERSION(3,2,0) -- | If @True@, the child will not be subject to homogeneous sizing. -- -- Default value: @False@ -- buttonBoxChildNonHomogeneous :: (ButtonBoxClass self, WidgetClass child) => child -> Attr self Bool buttonBoxChildNonHomogeneous = newAttrFromContainerChildBoolProperty "non-homogeneous" #endif gtk-0.15.9/Graphics/UI/Gtk/Abstract/Container.chs0000644000000000000000000005166007346545000017562 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Container -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for widgets which contain other widgets -- module Graphics.UI.Gtk.Abstract.Container ( -- * Detail -- -- | A Gtk+ user interface is constructed by nesting widgets inside widgets. -- Container widgets are the inner nodes in the resulting tree of widgets: they -- contain other widgets. So, for example, you might have a 'Window' containing -- a 'Frame' containing a 'Label'. If you wanted an image instead of a textual -- label inside the frame, you might replace the 'Label' widget with a 'Image' -- widget. -- -- There are two major kinds of container widgets in Gtk+. Both are -- subclasses of the abstract 'Container' base class. -- -- The first type of container widget has a single child widget and derives -- from 'Bin'. These containers are decorators, which add some kind of -- functionality to the child. For example, a 'Button' makes its child into a -- clickable button; a 'Frame' draws a frame around its child and a 'Window' -- places its child widget inside a top-level window. -- -- The second type of container can have more than one child; its purpose is -- to manage layout. This means that these containers assign sizes and -- positions to their children. For example, a 'HBox' arranges its children in -- a horizontal row, and a 'Table' arranges the widgets it contains in a -- two-dimensional grid. -- -- To fulfill its task, a layout container must negotiate the size -- requirements with its parent and its children. This negotiation is carried -- out in two phases, size requisition and size allocation. -- ** Size Requisition -- -- | The size requisition of a widget is it's desired width and height. This -- is represented by a 'Requisition'. -- -- How a widget determines its desired size depends on the widget. A -- 'Label', for example, requests enough space to display all its text. -- Container widgets generally base their size request on the requisitions of -- their children. -- -- The size requisition phase of the widget layout process operates -- top-down. It starts at a top-level widget, typically a 'Window'. The -- top-level widget asks its child for its size requisition by calling -- 'widgetSizeRequest'. To determine its requisition, the child asks its own -- children for their requisitions and so on. Finally, the top-level widget -- will get a requisition back from its child. -- ** Size Allocation -- -- | When the top-level widget has determined how much space its child would -- like to have, the second phase of the size negotiation, size allocation, -- begins. Depending on its configuration (see 'windowSetResizable'), the -- top-level widget may be able to expand in order to satisfy the size request -- or it may have to ignore the size request and keep its fixed size. It then -- tells its child widget how much space it gets by calling -- 'widgetSizeAllocate'. The child widget divides the space among its children -- and tells each child how much space it got, and so on. Under normal -- circumstances, a 'Window' will always give its child the amount of space the -- child requested. -- -- A child's size allocation is represented by an 'Allocation'. -- This contains not only a width and height, but also a -- position (i.e. X and Y coordinates), so that containers can tell their -- children not only how much space they have gotten, but also where they are -- positioned inside the space available to the container. -- -- Widgets are required to honor the size allocation they receive; a size -- request is only a request, and widgets must be able to cope with any size. -- ** Child attributes -- -- | 'Container' introduces child attributes - these are object attributes -- that are not specific to either the container or the contained widget, but -- rather to their relation. Typical examples of child attributes are the -- position or pack-type of a widget which is contained in a 'Box'. -- -- The 'Container' class does not itself define any child attributes, they are -- defined (and documented) by the various 'Container' subclasses. -- -- Child attributes can be set or obtained in a similar way to ordinary -- attributes. So ordinary attributes are set like so: -- -- > set object [ attr := value ] -- -- Whereas child attributes take the child object as a parameter: -- -- > set container [ attr child := value ] -- -- And similarly for getting a child attribute's value: -- -- > value <- get container (attr child) -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Container -- | +----'Bin' -- | +----'Box' -- | +----'CList' -- | +----'Fixed' -- | +----'Paned' -- | +----'IconView' -- | +----'Layout' -- | +----'List' -- | +----'MenuShell' -- | +----'Notebook' -- | +----'Socket' -- | +----'Table' -- | +----'TextView' -- | +----'Toolbar' -- | +----'TreeView' -- @ -- * Types Container, ContainerClass, castToContainer, gTypeContainer, toContainer, ContainerForeachCB, ResizeMode(..), -- * Methods containerAdd, containerRemove, containerForeach, containerForall, containerGetChildren, containerSetFocusChild, containerSetFocusChain, containerGetFocusChain, containerUnsetFocusChain, containerSetFocusVAdjustment, containerGetFocusVAdjustment, containerSetFocusHAdjustment, containerGetFocusHAdjustment, containerResizeChildren, containerSetBorderWidth, containerGetBorderWidth, containerGetResizeMode, containerSetResizeMode, -- * Attributes containerResizeMode, containerBorderWidth, containerChild, containerFocusHAdjustment, containerFocusVAdjustment, -- * Signals add, checkResize, remove, setFocusChild, -- * Deprecated #ifndef DISABLE_DEPRECATED onAdd, afterAdd, onCheckResize, afterCheckResize, onRemove, afterRemove, onSetFocusChild, afterSetFocusChild, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import System.Glib.GList (fromGList, withGList) import Graphics.UI.Gtk.General.Enums (ResizeMode(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Adds @widget@ to the container. Typically used for simple containers such -- as 'Window', 'Frame', or 'Button'; for more complicated layout containers -- such as 'Box' or 'Table', this function will pick default packing parameters -- that may not be correct. So consider functions such as 'boxPackStart' and -- 'tableAttach' as an alternative to 'containerAdd' in those cases. A widget -- may be added to only one container at a time; you can't place the same -- widget inside two different containers. -- containerAdd :: (ContainerClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - a widget to be placed inside @container@ -> IO () containerAdd self widget = {# call container_add #} (toContainer self) (toWidget widget) -- | Removes @widget@ from @container@. @widget@ must be inside @container@. -- containerRemove :: (ContainerClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - a current child of @container@ -> IO () containerRemove self widget = {# call container_remove #} (toContainer self) (toWidget widget) -- | Maps @callback@ over each non-internal child of @container@. See -- 'containerForall' for details on what constitutes an \"internal\" child. -- Most applications should use 'containerForeach', rather than -- 'containerForall'. -- containerForeach :: ContainerClass self => self -> ContainerForeachCB -> IO () containerForeach self fun = do fPtr <- mkContainerForeachFunc (\wPtr _ -> do w <- makeNewObject mkWidget (return wPtr) fun w) {# call container_foreach #} (toContainer self) fPtr nullPtr freeHaskellFunPtr fPtr -- | A function that is invoked for all widgets in a container. type ContainerForeachCB = Widget -> IO () {#pointer Callback#} foreign import ccall "wrapper" mkContainerForeachFunc :: (Ptr Widget -> Ptr () -> IO ()) -> IO Callback -- | Maps @callback@ over each child of @container@, including children that -- are considered \"internal\" (implementation details of the container). -- \"Internal\" children generally weren't added by the user of the container, -- but were added by the container implementation itself. Most applications -- should use 'containerForeach', rather than 'containerForall'. -- containerForall :: ContainerClass self => self -> ContainerForeachCB -- ^ @callback@ - a callback -> IO () containerForall self fun = do fPtr <- mkContainerForeachFunc (\wPtr _ -> do w <- makeNewObject mkWidget (return wPtr) fun w) {# call container_forall #} (toContainer self) fPtr nullPtr freeHaskellFunPtr fPtr -- | Returns the container's non-internal children. See 'containerForall' for -- details on what constitutes an \"internal\" child. -- containerGetChildren :: ContainerClass self => self -> IO [Widget] containerGetChildren self = do glist <- {# call container_get_children #} (toContainer self) widgetPtrs <- fromGList glist mapM (makeNewObject mkWidget . return) widgetPtrs -- | Give the focus to a specific child of the container. -- containerSetFocusChild :: (ContainerClass self, WidgetClass child) => self -> child -- ^ @child@ -> IO () containerSetFocusChild self child = {# call container_set_focus_child #} (toContainer self) (toWidget child) -- | Sets a focus chain, overriding the one computed automatically by Gtk+. -- -- In principle each widget in the chain should be a descendant of the -- container, but this is not enforced by this method, since it's allowed to -- set the focus chain before you pack the widgets, or have a widget in the -- chain that isn't always packed. The necessary checks are done when the focus -- chain is actually traversed. -- containerSetFocusChain :: ContainerClass self => self -> [Widget] -- ^ @focusableWidgets@ - the new focus chain. -> IO () containerSetFocusChain self chain = withForeignPtrs (map unWidget chain) $ \wPtrs -> withGList wPtrs $ \glist -> {# call container_set_focus_chain #} (toContainer self) glist -- | Retrieves the focus chain of the container, if one has been set -- explicitly. If no focus chain has been explicitly set, Gtk+ computes the -- focus chain based on the positions of the children. In that case the -- function returns @Nothing@. -- containerGetFocusChain :: ContainerClass self => self -> IO (Maybe [Widget]) containerGetFocusChain self = alloca $ \glistPtr -> do {# call container_get_focus_chain #} (toContainer self) glistPtr if glistPtr == nullPtr then return Nothing else liftM Just $ do glist <- peek glistPtr widgetPtrs <- fromGList glist mapM (makeNewObject mkWidget . return) widgetPtrs -- | Removes a focus chain explicitly set with 'containerSetFocusChain'. -- containerUnsetFocusChain :: ContainerClass self => self -> IO () containerUnsetFocusChain self = {# call container_unset_focus_chain #} (toContainer self) -- | Hooks up an adjustment to focus handling in a container, so when a child -- of the container is focused, the adjustment is scrolled to show that widget. -- This function sets the vertical alignment. See -- 'scrolledWindowGetVAdjustment' for a typical way of obtaining the adjustment -- and 'containerSetFocusHAdjustment' for setting the horizontal adjustment. -- -- The adjustments have to be in pixel units and in the same coordinate -- system as the allocation for immediate children of the container. -- containerSetFocusVAdjustment :: ContainerClass self => self -> Adjustment -- ^ @adjustment@ - an adjustment which should be adjusted when -- the focus is moved among the descendents of @container@ -> IO () containerSetFocusVAdjustment self adjustment = {# call container_set_focus_vadjustment #} (toContainer self) adjustment -- | Retrieves the vertical focus adjustment for the container. See -- 'containerSetFocusVAdjustment'. -- containerGetFocusVAdjustment :: ContainerClass self => self -> IO (Maybe Adjustment) -- ^ returns the vertical focus adjustment, or -- @Nothing@ if none has been set. containerGetFocusVAdjustment self = maybeNull (makeNewObject mkAdjustment) $ {# call unsafe container_get_focus_vadjustment #} (toContainer self) -- | Hooks up an adjustment to focus handling in a container, so when a child -- of the container is focused, the adjustment is scrolled to show that widget. -- This function sets the horizontal alignment. See -- 'scrolledWindowGetHAdjustment' for a typical way of obtaining the adjustment -- and 'containerSetFocusVAdjustment' for setting the vertical adjustment. -- -- The adjustments have to be in pixel units and in the same coordinate -- system as the allocation for immediate children of the container. -- containerSetFocusHAdjustment :: ContainerClass self => self -> Adjustment -- ^ @adjustment@ - an adjustment which should be adjusted when -- the focus is moved among the descendents of @container@ -> IO () containerSetFocusHAdjustment self adjustment = {# call container_set_focus_hadjustment #} (toContainer self) adjustment -- | Retrieves the horizontal focus adjustment for the container. See -- 'containerSetFocusHAdjustment'. -- containerGetFocusHAdjustment :: ContainerClass self => self -> IO (Maybe Adjustment) -- ^ returns the horizontal focus adjustment, or -- @Nothing@ if none has been set. containerGetFocusHAdjustment self = maybeNull (makeNewObject mkAdjustment) $ {# call unsafe container_get_focus_hadjustment #} (toContainer self) -- | Make the container resize its children. -- containerResizeChildren :: ContainerClass self => self -> IO () containerResizeChildren self = {# call container_resize_children #} (toContainer self) -- | Sets the border width of the container. -- -- The border width of a container is the amount of space to leave around -- the outside of the container. The only exception to this is 'Window'; -- because toplevel windows can't leave space outside, they leave the space -- inside. The border is added on all sides of the container. To add space to -- only one side, one approach is to create a 'Alignment' widget, call -- 'widgetSetSizeRequest' to give it a size, and place it on the side of the -- container as a spacer. -- containerSetBorderWidth :: ContainerClass self => self -> Int -- ^ @borderWidth@ - amount of blank space to leave /outside/ the -- container. Valid values are in the range 0-65535 pixels. -> IO () containerSetBorderWidth self borderWidth = {# call container_set_border_width #} (toContainer self) (fromIntegral borderWidth) -- | Retrieves the border width of the container. See -- 'containerSetBorderWidth'. -- containerGetBorderWidth :: ContainerClass self => self -> IO Int -- ^ returns the current border width containerGetBorderWidth self = liftM fromIntegral $ {# call unsafe container_get_border_width #} (toContainer self) -- | Returns the resize mode for the container. See 'containerSetResizeMode'. -- containerGetResizeMode :: ContainerClass self => self -> IO ResizeMode -- ^ returns the current resize mode containerGetResizeMode self = liftM (toEnum . fromIntegral) $ {# call gtk_container_get_resize_mode #} (toContainer self) -- | Sets the resize mode for the container. -- -- The resize mode of a container determines whether a resize request will -- be passed to the container's parent, queued for later execution or executed -- immediately. -- containerSetResizeMode :: ContainerClass self => self -> ResizeMode -- ^ @resizeMode@ - the new resize mode. -> IO () containerSetResizeMode self resizeMode = {# call gtk_container_set_resize_mode #} (toContainer self) ((fromIntegral . fromEnum) resizeMode) -------------------- -- Attributes -- | Specify how resize events are handled. -- -- Default value: 'ResizeParent' -- containerResizeMode :: ContainerClass self => Attr self ResizeMode containerResizeMode = newAttr containerGetResizeMode containerSetResizeMode -- | The width of the empty border outside the containers children. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 0 -- containerBorderWidth :: ContainerClass self => Attr self Int containerBorderWidth = newAttr containerGetBorderWidth containerSetBorderWidth -- | Can be used to add a new child to the container. -- containerChild :: (ContainerClass self, WidgetClass widget) => WriteAttr self widget containerChild = writeAttrFromObjectProperty "child" {# call pure unsafe gtk_widget_get_type #} -- | \'focusHadjustment\' property. See 'containerGetFocusHAdjustment' and -- 'containerSetFocusHAdjustment' -- containerFocusHAdjustment :: ContainerClass self => ReadWriteAttr self (Maybe Adjustment) Adjustment containerFocusHAdjustment = newAttr containerGetFocusHAdjustment containerSetFocusHAdjustment -- | \'focusVadjustment\' property. See 'containerGetFocusVAdjustment' and -- 'containerSetFocusVAdjustment' -- containerFocusVAdjustment :: ContainerClass self => ReadWriteAttr self (Maybe Adjustment) Adjustment containerFocusVAdjustment = newAttr containerGetFocusVAdjustment containerSetFocusVAdjustment -------------------- -- Signals -- %hash c:26b d:af3f -- | A widget was added to the container. -- add :: ContainerClass self => Signal self (Widget -> IO ()) add = Signal (connect_OBJECT__NONE "add") -- %hash c:f43a d:af3f -- | A widget was removed from the container. -- remove :: ContainerClass self => Signal self (Widget -> IO ()) remove = Signal (connect_OBJECT__NONE "remove") -- %hash c:21a9 d:af3f -- | Emitted when widgets need to be queried again for their preferred size. -- checkResize :: ContainerClass self => Signal self (IO ()) checkResize = Signal (connect_NONE__NONE "check-resize") -- %hash c:b3a d:af3f -- | A widget in the container received or lost the input focus. -- setFocusChild :: ContainerClass self => Signal self (Maybe Widget -> IO ()) setFocusChild = Signal (connect_MOBJECT__NONE "set-focus-child") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- %hash c:fb37 onAdd :: ContainerClass self => self -> (Widget -> IO ()) -> IO (ConnectId self) onAdd = connect_OBJECT__NONE "add" False {-# DEPRECATED onAdd "instead of 'onAdd obj' use 'on obj add'" #-} -- %hash c:c9d6 afterAdd :: ContainerClass self => self -> (Widget -> IO ()) -> IO (ConnectId self) afterAdd = connect_OBJECT__NONE "add" True {-# DEPRECATED afterAdd "instead of 'afterAdd obj' use 'after obj add'" #-} -- %hash c:9b66 onRemove :: ContainerClass self => self -> (Widget -> IO ()) -> IO (ConnectId self) onRemove = connect_OBJECT__NONE "remove" False {-# DEPRECATED onRemove "instead of 'onRemove obj' use 'on obj remove'" #-} -- %hash c:f165 afterRemove :: ContainerClass self => self -> (Widget -> IO ()) -> IO (ConnectId self) afterRemove = connect_OBJECT__NONE "remove" True {-# DEPRECATED afterRemove "instead of 'afterRemove obj' use 'after obj remove'" #-} -- %hash c:8424 onCheckResize :: ContainerClass self => self -> IO () -> IO (ConnectId self) onCheckResize = connect_NONE__NONE "check_resize" False {-# DEPRECATED onCheckResize "instead of 'onCheckResize obj' use 'on obj checkResize'" #-} -- %hash c:6803 afterCheckResize :: ContainerClass self => self -> IO () -> IO (ConnectId self) afterCheckResize = connect_NONE__NONE "check_resize" True {-# DEPRECATED afterCheckResize "instead of 'afterCheckResize obj' use 'after obj checkResize'" #-} -- %hash c:1ac6 onSetFocusChild :: ContainerClass self => self -> (Maybe Widget -> IO ()) -> IO (ConnectId self) onSetFocusChild = connect_MOBJECT__NONE "set-focus-child" False {-# DEPRECATED onSetFocusChild "instead of 'onSetFocusChild obj' use 'on obj setFocusChild'" #-} -- %hash c:23e5 afterSetFocusChild :: ContainerClass self => self -> (Maybe Widget -> IO ()) -> IO (ConnectId self) afterSetFocusChild = connect_MOBJECT__NONE "set-focus-child" True {-# DEPRECATED afterSetFocusChild "instead of 'afterSetFocusChild obj' use 'after obj setFocusChild'" #-} #endif gtk-0.15.9/Graphics/UI/Gtk/Abstract/ContainerChildProperties.chs0000644000000000000000000001275007346545000022600 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Container child 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. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Functions for getting and setting container child properties -- module Graphics.UI.Gtk.Abstract.ContainerChildProperties ( containerChildGetPropertyBool, containerChildSetPropertyBool, newAttrFromContainerChildIntProperty, newAttrFromContainerChildUIntProperty, newAttrFromContainerChildBoolProperty, newAttrFromContainerChildEnumProperty, newAttrFromContainerChildFlagsProperty, newAttrFromContainerChildStringProperty, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags {#import Graphics.UI.Gtk.Types#} import System.Glib.GType import qualified System.Glib.GTypeConstants as GType import System.Glib.GValueTypes {#import System.Glib.GValue#} (GValue(GValue), allocaGValue, valueInit) import System.Glib.Attributes (Attr, newAttr) {# context lib="gtk" prefix="gtk" #} containerChildSetPropertyInternal :: (ContainerClass container, WidgetClass child) => GType -> (GValue -> a -> IO ()) -> String -> child -> container -> a -> IO () containerChildSetPropertyInternal gtype valueSet prop child container val = withCString prop $ \propertyNamePtr -> allocaGValue $ \gvalue -> do valueInit gvalue gtype valueSet gvalue val {# call container_child_set_property #} (toContainer container) (toWidget child) propertyNamePtr gvalue containerChildGetPropertyInternal :: (ContainerClass container, WidgetClass child) => GType -> (GValue -> IO a) -> String -> child -> container -> IO a containerChildGetPropertyInternal gtype valueGet prop child container = withCString prop $ \propertyNamePtr -> allocaGValue $ \gvalue -> do valueInit gvalue gtype {# call container_child_get_property #} (toContainer container) (toWidget child) propertyNamePtr gvalue valueGet gvalue -- Versions for specific types: -- we actually don't use any others than bool at the moment -- containerChildGetPropertyBool :: (ContainerClass container, WidgetClass child) => String -> child -> container -> IO Bool containerChildGetPropertyBool = containerChildGetPropertyInternal GType.bool valueGetBool containerChildSetPropertyBool :: (ContainerClass container, WidgetClass child) => String -> child -> container -> Bool -> IO () containerChildSetPropertyBool = containerChildSetPropertyInternal GType.bool valueSetBool -- Convenience functions to make attribute implementations in the other modules -- shorter and more easily extensible. -- newAttrFromContainerChildIntProperty :: (ContainerClass container, WidgetClass child) => String -> child -> Attr container Int newAttrFromContainerChildIntProperty propName child = newAttr (containerChildGetPropertyInternal GType.int valueGetInt propName child) (containerChildSetPropertyInternal GType.int valueSetInt propName child) newAttrFromContainerChildUIntProperty :: (ContainerClass container, WidgetClass child) => String -> child -> Attr container Int newAttrFromContainerChildUIntProperty propName child = newAttr (containerChildGetPropertyInternal GType.uint (\gv -> liftM fromIntegral $ valueGetUInt gv) propName child) (containerChildSetPropertyInternal GType.uint (\gv v -> valueSetUInt gv (fromIntegral v)) propName child) newAttrFromContainerChildBoolProperty :: (ContainerClass container, WidgetClass child) => String -> child -> Attr container Bool newAttrFromContainerChildBoolProperty propName child = newAttr (containerChildGetPropertyInternal GType.bool valueGetBool propName child) (containerChildSetPropertyInternal GType.bool valueSetBool propName child) newAttrFromContainerChildEnumProperty :: (ContainerClass container, WidgetClass child, Enum enum) => String -> GType -> child -> Attr container enum newAttrFromContainerChildEnumProperty propName gtype child = newAttr (containerChildGetPropertyInternal gtype valueGetEnum propName child) (containerChildSetPropertyInternal gtype valueSetEnum propName child) newAttrFromContainerChildFlagsProperty :: (ContainerClass container, WidgetClass child, Flags flag) => String -> GType -> child -> Attr container [flag] newAttrFromContainerChildFlagsProperty propName gtype child = newAttr (containerChildGetPropertyInternal gtype valueGetFlags propName child) (containerChildSetPropertyInternal gtype valueSetFlags propName child) newAttrFromContainerChildStringProperty :: (ContainerClass container, WidgetClass child, GlibString string) => String -> child -> Attr container string newAttrFromContainerChildStringProperty propName child = newAttr (containerChildGetPropertyInternal GType.string valueGetString propName child) (containerChildSetPropertyInternal GType.string valueSetString propName child) gtk-0.15.9/Graphics/UI/Gtk/Abstract/IMContext.chs0000644000000000000000000002745207346545000017514 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget IMContext -- -- Author : Colin McQuillan -- -- Created: 30 April 2009 -- -- Copyright (C) 2009 Colin McQuillan -- -- 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) -- -- Base class for input method contexts -- module Graphics.UI.Gtk.Abstract.IMContext ( -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----IMContext -- | +----'IMContextSimple' -- | +----'IMMulticontext' -- @ -- * Types IMContext, IMContextClass, castToIMContext, gTypeIMContext, toIMContext, -- * Methods imContextSetClientWindow, imContextGetPreeditString, imContextFilterKeypress, imContextFocusIn, imContextFocusOut, imContextReset, imContextSetCursorLocation, imContextSetUsePreedit, imContextSetSurrounding, imContextGetSurrounding, imContextDeleteSurrounding, -- * Signals imContextPreeditStart, imContextPreeditEnd, imContextPreeditChanged, imContextCommit, imContextRetrieveSurrounding, imContextDeleteSurrounding', ) where import Control.Monad (liftM) import Control.Monad.Reader.Class (ask) import Control.Monad.Trans (liftIO) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.UTFString (readUTFString, withUTFString, genUTFOfs, ofsToUTF, ofsFromUTF, GlibString) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey) import Graphics.UI.Gtk.General.Structs (Rectangle) import Graphics.Rendering.Pango.Enums (PangoAttribute) import Graphics.Rendering.Pango.Attributes (readAttrList) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Set the client window for the input context; this is the 'DrawWindow' in -- which the input appears. This window is used in order to correctly position -- status windows, and may also be used for purposes internal to the input -- method. -- imContextSetClientWindow :: IMContextClass self => self -> Maybe DrawWindow -- ^ @window@ - the client window. 'Nothing' indicates -- that the previous client window no longer exists. -> IO () imContextSetClientWindow self window = {# call im_context_set_client_window #} (toIMContext self) (fromMaybe (DrawWindow nullForeignPtr) window) -- | Retrieve the current preedit string for the input context, and a list of -- attributes to apply to the string. This string should be displayed inserted -- at the insertion point. -- imContextGetPreeditString :: (IMContextClass self, GlibString string) => self -> IO (string, [[PangoAttribute]], Int) -- ^ @(str, attrs, cursorPos)@ Retrieved string, -- attributes to apply to the string, position of cursor. imContextGetPreeditString self = alloca $ \strPtr -> alloca $ \attrListPtr -> alloca $ \cursorPosPtr -> {# call im_context_get_preedit_string #} (toIMContext self) strPtr attrListPtr cursorPosPtr >> peek strPtr >>= readUTFString >>= \str -> peek attrListPtr >>= readAttrList (genUTFOfs str) >>= \attrs -> peek cursorPosPtr >>= \cursorPos -> return (str, attrs, fromIntegral cursorPos) -- | Allow an input method to internally handle key press and release events. -- If this function returns @True@, then no further processing should be done -- for this key event. -- imContextFilterKeypress :: IMContextClass self => self -> EventM EKey Bool -- ^ returns @True@ if the input method handled the key -- event. imContextFilterKeypress self = liftM toBool $ ask >>= \eventPtr -> liftIO $ {# call im_context_filter_keypress #} (toIMContext self) (castPtr eventPtr) -- | Notify the input method that the widget to which this input context -- corresponds has gained focus. The input method may, for example, change the -- displayed feedback to reflect this change. -- imContextFocusIn :: IMContextClass self => self -> IO () imContextFocusIn self = {# call im_context_focus_in #} (toIMContext self) -- | Notify the input method that the widget to which this input context -- corresponds has lost focus. The input method may, for example, change the -- displayed feedback or reset the contexts state to reflect this change. -- imContextFocusOut :: IMContextClass self => self -> IO () imContextFocusOut self = {# call im_context_focus_out #} (toIMContext self) -- | Notify the input method that a change such as a change in cursor position -- has been made. This will typically cause the input method to clear the -- preedit state. -- imContextReset :: IMContextClass self => self -> IO () imContextReset self = {# call im_context_reset #} (toIMContext self) -- | Notify the input method that a change in cursor position has been made. -- The location is relative to the client window. -- imContextSetCursorLocation :: IMContextClass self => self -> Rectangle -- ^ @area@ - new location -> IO () imContextSetCursorLocation self area = with area $ \areaPtr -> {# call im_context_set_cursor_location #} (toIMContext self) (castPtr areaPtr) -- | Sets whether the IM context should use the preedit string to display -- feedback. If @usePreedit@ is @False@ (default is @True@), then the IM -- context may use some other method to display feedback, such as displaying it -- in a child of the root window. -- imContextSetUsePreedit :: IMContextClass self => self -> Bool -- ^ @usePreedit@ - whether the IM context should use the preedit -- string. -> IO () imContextSetUsePreedit self usePreedit = {# call im_context_set_use_preedit #} (toIMContext self) (fromBool usePreedit) -- | Sets surrounding context around the insertion point and preedit string. -- This function is expected to be called in response to the -- 'imContextRetrieveSurrounding' signal, and will likely have no effect if -- called at other times. -- imContextSetSurrounding :: (IMContextClass self, GlibString string) => self -> string -- ^ @text@ - text surrounding the insertion point, as UTF-8. the -- preedit string should not be included within @text@. -> Int -- ^ @cursorIndex@ - the index of the insertion cursor within -- @text@. -> IO () imContextSetSurrounding self text cursorIndex = withUTFString text $ \textPtr -> {# call im_context_set_surrounding #} (toIMContext self) textPtr (-1) (fromIntegral (ofsToUTF cursorIndex (genUTFOfs text))) -- | Retrieves context around the insertion point. Input methods typically -- want context in order to constrain input text based on existing text; this -- is important for languages such as Thai where only some sequences of -- characters are allowed. -- -- This function is implemented by emitting the -- 'imContextRetrieveSurrounding' signal on the input method; in response to -- this signal, a widget should provide as much context as is available, up to -- an entire paragraph, by calling 'imContextSetSurrounding'. Note that there -- is no obligation for a widget to respond to the 'imContextRetrieveSurrounding' -- signal, so input methods must be prepared to function without context. -- imContextGetSurrounding :: (IMContextClass self, GlibString string) => self -> IO (Maybe (string, Int)) -- ^ @Maybe (text,cursorIndex)@ Text holding -- context around the insertion point and the -- index of the insertion cursor within @text@. -- 'Nothing' if no surrounding text was -- provided. imContextGetSurrounding self = alloca $ \textPtr -> alloca $ \cursorIndexPtr -> {# call im_context_get_surrounding #} (toIMContext self) textPtr cursorIndexPtr >>= \provided -> if toBool provided then peek textPtr >>= readUTFString >>= \text -> peek cursorIndexPtr >>= \cursorIndex -> return (Just (text, ofsFromUTF (fromIntegral cursorIndex) (genUTFOfs text))) else return Nothing -- | Asks the widget that the input context is attached to to delete -- characters around the cursor position by emitting the -- 'imContextDeleteSurrounding' signal. -- -- In order to use this function, you should first call -- 'imContextGetSurrounding' to get the current context, and call this function -- immediately afterwards to make sure that you know what you are deleting. You -- should also account for the fact that even if the signal was handled, the -- input context might not have deleted all the characters that were requested -- to be deleted. -- -- This function is used by an input method that wants to make substitutions -- in the existing text in response to new input. It is not useful for -- applications. -- imContextDeleteSurrounding :: IMContextClass self => self -> Int -- ^ @offset@ - offset from cursor position in chars; a negative -- value means start before the cursor. -> Int -- ^ @nChars@ - number of characters to delete. -> IO Bool -- ^ returns @True@ if the signal was handled. imContextDeleteSurrounding self offset nChars = liftM toBool $ {# call im_context_delete_surrounding #} (toIMContext self) (fromIntegral offset) (fromIntegral nChars) -------------------- -- Signals -- | This signal is emitted when a new preediting sequence starts. -- imContextPreeditStart :: IMContextClass self => Signal self (IO ()) imContextPreeditStart = Signal (connect_NONE__NONE "preedit-start") -- | This signal is emitted when a preediting sequence has been completed or -- canceled. -- imContextPreeditEnd :: IMContextClass self => Signal self (IO ()) imContextPreeditEnd = Signal (connect_NONE__NONE "preedit-end") -- | This signal is emitted whenever the preedit sequence currently being -- entered has changed. It is also emitted at the end of a preedit sequence, -- in which case 'imContextGetPreeditString' returns the empty string. -- imContextPreeditChanged :: IMContextClass self => Signal self (IO ()) imContextPreeditChanged = Signal (connect_NONE__NONE "preedit-changed") -- | This signal is emitted when a complete input sequence has been -- entered by the user. This can be a single character immediately after a -- key press or the final result of preediting. Parameters: -- -- @str@ - the completed character(s) entered by the user imContextCommit :: (IMContextClass self, GlibString string) => Signal self (string -> IO ()) imContextCommit = Signal (connect_GLIBSTRING__NONE "commit") -- | This signal is emitted when the input method requires the context -- surrounding the cursor. The callback should set the input method -- surrounding context by calling 'imContextSetSurrounding'. -- -- Returns True if the signal was handled. imContextRetrieveSurrounding :: IMContextClass self => Signal self (IO Bool) imContextRetrieveSurrounding = Signal (connect_NONE__BOOL "retrieve-surrounding") -- | This signal is emitted when the input method needs to delete all or part -- of the context surrounding the cursor. Parameters: -- -- @offset@ - the character offset from the cursor position of the text to be -- deleted. A negative value indicates a position before the cursor. -- -- @n_chars@ - the number of characters to be deleted. -- -- Returns True if the signal was handled. imContextDeleteSurrounding' :: IMContextClass self => Signal self (Int -> Int -> IO Bool) imContextDeleteSurrounding' = Signal (connect_INT_INT__BOOL "delete-surrounding") gtk-0.15.9/Graphics/UI/Gtk/Abstract/Misc.chs0000644000000000000000000001140007346545000016517 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Misc -- -- Author : Manuel M. T. Chakravarty, Axel Simon -- -- Created: 2 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for widgets with alignments and padding -- module Graphics.UI.Gtk.Abstract.Misc ( -- * Detail -- -- | The 'Misc' widget is an abstract widget which is not useful itself, but -- is used to derive subclasses which have alignment and padding attributes. -- -- The horizontal and vertical padding attributes allows extra space to be -- added around the widget. -- -- The horizontal and vertical alignment attributes enable the widget to be -- positioned within its allocated area. Note that if the widget is added to a -- container in such a way that it expands automatically to fill its allocated -- area, the alignment settings will not alter the widgets position. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Misc -- | +----'Label' -- | +----'Arrow' -- | +----'Image' -- | +----'Pixmap' -- @ -- * Types Misc, MiscClass, castToMisc, gTypeMisc, toMisc, -- * Methods miscSetAlignment, miscGetAlignment, miscSetPadding, miscGetPadding, -- * Attributes miscXalign, miscYalign, miscXpad, miscYpad, ) where import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Sets the alignment of the widget. -- miscSetAlignment :: MiscClass self => self -> Float -- ^ @xalign@ - the horizontal alignment, from 0 (left) to 1 -- (right). -> Float -- ^ @yalign@ - the vertical alignment, from 0 (top) to 1 (bottom). -> IO () miscSetAlignment self xalign yalign = {# call misc_set_alignment #} (toMisc self) (realToFrac xalign) (realToFrac yalign) -- | Gets the X and Y alignment of the widget within its allocation. See -- 'miscSetAlignment'. -- miscGetAlignment :: MiscClass self => self -> IO (Double, Double) miscGetAlignment self = alloca $ \xalignPtr -> alloca $ \yalignPtr -> do {# call unsafe misc_get_alignment #} (toMisc self) xalignPtr yalignPtr xalign <- peek xalignPtr yalign <- peek yalignPtr return (realToFrac xalign, realToFrac yalign) -- | Sets the amount of space to add around the widget. -- miscSetPadding :: MiscClass self => self -> Int -- ^ @xpad@ - the amount of space to add on the left and right of -- the widget, in pixels. -> Int -- ^ @ypad@ - the amount of space to add on the top and bottom of -- the widget, in pixels. -> IO () miscSetPadding self xpad ypad = {# call misc_set_padding #} (toMisc self) (fromIntegral xpad) (fromIntegral ypad) -- | Gets the padding in the X and Y directions of the widget. See -- 'miscSetPadding'. -- miscGetPadding :: MiscClass self => self -> IO (Int, Int) miscGetPadding self = alloca $ \xpadPtr -> alloca $ \ypadPtr -> do {# call unsafe misc_get_padding #} (toMisc self) xpadPtr ypadPtr xpad <- peek xpadPtr ypad <- peek ypadPtr return (fromIntegral xpad, fromIntegral ypad) -------------------- -- Attributes -- | The horizontal alignment, from 0 (left) to 1 (right). Reversed for RTL -- layouts. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- miscXalign :: MiscClass self => Attr self Float miscXalign = newAttrFromFloatProperty "xalign" -- | The vertical alignment, from 0 (top) to 1 (bottom). -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- miscYalign :: MiscClass self => Attr self Float miscYalign = newAttrFromFloatProperty "yalign" -- | The amount of space to add on the left and right of the widget, in -- pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- miscXpad :: MiscClass self => Attr self Int miscXpad = newAttrFromIntProperty "xpad" -- | The amount of space to add on the top and bottom of the widget, in -- pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- miscYpad :: MiscClass self => Attr self Int miscYpad = newAttrFromIntProperty "ypad" gtk-0.15.9/Graphics/UI/Gtk/Abstract/Object.chs0000644000000000000000000001275407346545000017047 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Object -- -- Author : Axel Simon -- -- Created: 9 April 2001 -- -- Copyright (C) 2001-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The base class of the Gtk+ type hierarchy. -- -- * Each widget is a represented as a purely abstract data type. It can only -- be accessed through and the special access functions that are defined -- in each widget file. -- module Graphics.UI.Gtk.Abstract.Object ( -- * Detail -- -- | 'Object' is the base class for all widgets, and for a few non-widget -- objects such as 'Adjustment'. 'Object' predates 'GObject'; non-widgets that -- derive from 'Object' rather than 'GObject' do so for backward compatibility -- reasons. -- -- Object has been removed in Gt3k, but this module still provides useful -- functions. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----Object -- | +----'Widget' -- | +----'Adjustment' -- | +----'CellRenderer' -- | +----'FileFilter' -- | +----'ItemFactory' -- | +----'Tooltips' -- | +----'TreeViewColumn' -- @ #if GTK_MAJOR_VERSION < 3 -- * Types Object, ObjectClass, castToObject, gTypeObject, toObject, #endif -- * Methods makeNewObject, -- * Weak references GWeakNotify, objectWeakref, objectWeakunref, -- * Signals objectDestroy, notifyProperty ) where import Control.Monad (when) import System.Glib.FFI import System.Glib.Attributes (ReadWriteAttr) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Data.IORef {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- turn the initial floating state to sunk -- -- * The floating\/sunk concept of a GTK object is not very useful to us. -- The following procedure circumvents the whole subject and ensures -- proper cleanup: -- on creation: objectRef, objectSink -- on finalization: objectUnref -- -- * This function cannot be bound by c2hs because it is not possible to -- override the pointer hook. #if !GLIB_CHECK_VERSION(2,10,0) foreign import ccall unsafe "gtk_object_sink" objectSink :: Ptr obj -> IO () #endif -- This is a convenience function to generate a new widget. It adds the -- finalizer with the method described under objectSink. -- -- * The constr argument is the constructor of the specific object. -- #if GTK_MAJOR_VERSION < 3 makeNewObject :: ObjectClass obj => #else makeNewObject :: GObjectClass obj => #endif (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj makeNewObject (constr, objectUnref) generator = do objPtr <- generator when (objPtr == nullPtr) (fail "makeNewObject: object is NULL") #if GLIB_CHECK_VERSION(2,10,0) objectRefSink objPtr #else objectRef objPtr objectSink objPtr #endif obj <- newForeignPtr objPtr objectUnref return $! constr obj {#pointer GWeakNotify#} foreign import ccall "wrapper" mkDestructor :: (Ptr () -> Ptr GObject -> IO ()) -> IO GWeakNotify -- | Attach a callback that will be called after the -- destroy hooks have been called -- #if GTK_MAJOR_VERSION < 3 objectWeakref :: ObjectClass o => o -> IO () -> IO GWeakNotify #else objectWeakref :: GObjectClass o => o -> IO () -> IO GWeakNotify #endif objectWeakref obj uFun = do funPtrContainer <- newIORef nullFunPtr uFunPtr <- mkDestructor $ \_ _ -> do uFun funPtr <- readIORef funPtrContainer freeHaskellFunPtr funPtr writeIORef funPtrContainer uFunPtr {#call unsafe g_object_weak_ref#} (toGObject obj) uFunPtr nullPtr return uFunPtr -- | Detach a weak destroy callback function -- #if GTK_MAJOR_VERSION < 3 objectWeakunref :: ObjectClass o => o -> GWeakNotify -> IO () #else objectWeakunref :: GObjectClass o => o -> GWeakNotify -> IO () #endif objectWeakunref obj fun = {#call unsafe g_object_weak_unref#} (toGObject obj) fun nullPtr -------------------- -- Signals -- | Signals that all holders of a reference to the 'Object' should release -- the reference that they hold. May result in finalization of the object if -- all references are released. -- #if GTK_MAJOR_VERSION < 3 objectDestroy :: ObjectClass self => Signal self (IO ()) #else objectDestroy :: WidgetClass self => Signal self (IO ()) #endif objectDestroy = Signal (connect_NONE__NONE "destroy") -- | Register a notify callback that is triggered when the given property -- has been modified. -- -- * Note that this callback is triggered even if the actual value of -- the property has not changed. -- * Not all attributes are properties. A warning will be generated at -- runtime if the passed-in attribute is not a property of the class -- with which it was registered. -- #if GTK_MAJOR_VERSION < 3 notifyProperty :: ObjectClass self => ReadWriteAttr self a b -> Signal self (IO ()) #else notifyProperty :: GObjectClass self => ReadWriteAttr self a b -> Signal self (IO ()) #endif notifyProperty attr = Signal (\on obj cb -> connect_PTR__NONE ("notify::"++show attr) on obj (const cb)) gtk-0.15.9/Graphics/UI/Gtk/Abstract/Paned.chs0000644000000000000000000002500607346545000016662 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Paned -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for widgets with two adjustable panes -- module Graphics.UI.Gtk.Abstract.Paned ( -- * Detail -- -- | 'Paned' is the base class for widgets with two panes, arranged either -- horizontally ('HPaned') or vertically ('VPaned'). Child widgets are added to -- the panes of the widget with 'panedPack1' and 'panedPack2'. The division -- between the two children is set by default from the size requests of the -- children, but it can be adjusted by the user. -- -- A paned widget draws a separator between the two child widgets and a -- small handle that the user can drag to adjust the division. It does not draw -- any relief around the children or around the separator. (The space in which -- the separator is called the gutter.) Often, it is useful to put each child -- inside a 'Frame' with the shadow type set to -- 'Graphics.UI.Gtk.General.Enums.ShadowIn' so that the gutter appears as a -- ridge. -- -- Each child has two options that can be set, @resize@ and @shrink@. If -- @resize@ is true, then when the 'Paned' is resized, that child will expand -- or shrink along with the paned widget. If @shrink@ is true, then when that -- child can be made smaller than its requisition by the user. Setting @shrink@ -- to @False@ allows the application to set a minimum size. If @resize@ is -- false for both children, then this is treated as if @resize@ is true for -- both children. -- -- The application can set the position of the slider as if it were set by -- the user, by calling 'panedSetPosition'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Paned -- | +----'HPaned' -- | +----'VPaned' -- @ -- * Types Paned, PanedClass, castToPaned, gTypePaned, toPaned, -- * Methods panedAdd1, panedAdd2, panedPack1, panedPack2, panedSetPosition, panedGetPosition, #if GTK_CHECK_VERSION(2,4,0) panedGetChild1, panedGetChild2, #endif #if GTK_CHECK_VERSION(2,20,0) panedGetHandleWindow, #endif -- * Attributes panedPosition, panedPositionSet, #if GTK_CHECK_VERSION(2,4,0) panedMinPosition, panedMaxPosition, #endif -- * Child Attributes #if GTK_CHECK_VERSION(2,4,0) panedChildResize, panedChildShrink, #endif -- * Deprecated Signals #ifndef DISABLE_DEPRECATED onCycleChildFocus, afterCycleChildFocus, onToggleHandleFocus, afterToggleHandleFocus, onMoveHandle, afterMoveHandle, onCycleHandleFocus, afterCycleHandleFocus, onAcceptPosition, afterAcceptPosition, onCancelPosition, afterCancelPosition, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} #ifndef DISABLE_DEPRECATED {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (ScrollType) #endif import Graphics.UI.Gtk.Abstract.ContainerChildProperties {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Adds a child to the top or left pane with default parameters. This is -- equivalent to @'panedPack1' paned child False True@. -- panedAdd1 :: (PanedClass self, WidgetClass child) => self -> child -- ^ @child@ - the child to add -> IO () panedAdd1 self child = {# call paned_add1 #} (toPaned self) (toWidget child) -- | Adds a child to the bottom or right pane with default parameters. This is -- equivalent to @'panedPack2' paned child True True@. -- panedAdd2 :: (PanedClass self, WidgetClass child) => self -> child -- ^ @child@ - the child to add -> IO () panedAdd2 self child = {# call paned_add2 #} (toPaned self) (toWidget child) -- | Adds a child to the top or left pane. -- panedPack1 :: (PanedClass self, WidgetClass child) => self -> child -- ^ @child@ - the child to add -> Bool -- ^ @resize@ - should this child expand when the paned widget is -- resized. -> Bool -- ^ @shrink@ - can this child be made smaller than its requsition. -> IO () panedPack1 self child resize shrink = {# call paned_pack1 #} (toPaned self) (toWidget child) (fromBool resize) (fromBool shrink) -- | Adds a child to the bottom or right pane. -- panedPack2 :: (PanedClass self, WidgetClass child) => self -> child -- ^ @child@ - the child to add -> Bool -- ^ @resize@ - should this child expand when the paned widget is -- resized. -> Bool -- ^ @shrink@ - can this child be made smaller than its requsition. -> IO () panedPack2 self child resize shrink = {# call paned_pack2 #} (toPaned self) (toWidget child) (fromBool resize) (fromBool shrink) -- | Sets the position of the divider between the two panes. -- panedSetPosition :: PanedClass self => self -> Int -- ^ @position@ - pixel position of divider, a negative value means -- that the position is unset. -> IO () panedSetPosition self position = {# call paned_set_position #} (toPaned self) (fromIntegral position) -- | Obtains the position of the divider between the two panes. -- panedGetPosition :: PanedClass self => self -> IO Int -- ^ returns position of the divider panedGetPosition self = liftM fromIntegral $ {# call unsafe paned_get_position #} (toPaned self) #if GTK_CHECK_VERSION(2,4,0) -- | Obtains the first child of the paned widget. -- -- * Available since Gtk+ version 2.4 -- panedGetChild1 :: PanedClass self => self -> IO (Maybe Widget) -- ^ returns first child, or @Nothing@ if it is not set. panedGetChild1 self = maybeNull (makeNewObject mkWidget) $ {# call unsafe paned_get_child1 #} (toPaned self) -- | Obtains the second child of the paned widget. -- -- * Available since Gtk+ version 2.4 -- panedGetChild2 :: PanedClass self => self -> IO (Maybe Widget) -- ^ returns second child, or @Nothing@ if it is not -- set. panedGetChild2 self = maybeNull (makeNewObject mkWidget) $ {# call unsafe paned_get_child2 #} (toPaned self) #endif #if GTK_CHECK_VERSION(2,20,0) -- | Returns the 'Window' of the handle. This function is useful when handling button or motion events -- because it enables the callback to distinguish between the window of the paned, a child and the -- handle. panedGetHandleWindow :: PanedClass self => self -> IO DrawWindow panedGetHandleWindow self = makeNewGObject mkDrawWindow $ {#call gtk_paned_get_handle_window #} (toPaned self) #endif -------------------- -- Attributes -- | Position of paned separator in pixels (0 means all the way to the -- left\/top). -- -- Allowed values: >= 0 -- -- Default value: 0 -- panedPosition :: PanedClass self => Attr self Int panedPosition = newAttr panedGetPosition panedSetPosition -- | @True@ if the Position property should be used. -- -- Default value: @False@ -- panedPositionSet :: PanedClass self => Attr self Bool panedPositionSet = newAttrFromBoolProperty "position-set" #if GTK_CHECK_VERSION(2,4,0) -- | The smallest possible value for the position property. This property is -- derived from the size and shrinkability of the widget's children. -- -- Allowed values: >= 0 -- -- Default value: 0 -- panedMinPosition :: PanedClass self => ReadAttr self Int panedMinPosition = readAttrFromIntProperty "min-position" -- | The largest possible value for the position property. This property is -- derived from the size and shrinkability of the widget's children. -- -- Allowed values: >= 0 -- -- Default value: 2147483647 -- panedMaxPosition :: PanedClass self => ReadAttr self Int panedMaxPosition = readAttrFromIntProperty "max-position" #endif -------------------- -- Child Attributes #if GTK_CHECK_VERSION(2,4,0) -- | The \"resize\" child property determines whether the child expands and -- shrinks along with the paned widget. -- -- Default value: @True@ -- panedChildResize :: (PanedClass self, WidgetClass child) => child -> Attr self Bool panedChildResize = newAttrFromContainerChildBoolProperty "resize" -- | The \"shrink\" child property determines whether the child can be made -- smaller than its requisition. -- -- Default value: @True@ -- panedChildShrink :: (PanedClass self, WidgetClass child) => child -> Attr self Bool panedChildShrink = newAttrFromContainerChildBoolProperty "shrink" #endif -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | -- onCycleChildFocus, afterCycleChildFocus :: PanedClass self => self -> (Bool -> IO Bool) -> IO (ConnectId self) onCycleChildFocus = connect_BOOL__BOOL "cycle_child_focus" False afterCycleChildFocus = connect_BOOL__BOOL "cycle_child_focus" True -- | -- onToggleHandleFocus, afterToggleHandleFocus :: PanedClass self => self -> IO Bool -> IO (ConnectId self) onToggleHandleFocus = connect_NONE__BOOL "toggle_handle_focus" False afterToggleHandleFocus = connect_NONE__BOOL "toggle_handle_focus" True -- | -- onMoveHandle, afterMoveHandle :: PanedClass self => self -> (ScrollType -> IO Bool) -> IO (ConnectId self) onMoveHandle = connect_ENUM__BOOL "move_handle" False afterMoveHandle = connect_ENUM__BOOL "move_handle" True -- | -- onCycleHandleFocus, afterCycleHandleFocus :: PanedClass self => self -> (Bool -> IO Bool) -> IO (ConnectId self) onCycleHandleFocus = connect_BOOL__BOOL "cycle_handle_focus" False afterCycleHandleFocus = connect_BOOL__BOOL "cycle_handle_focus" True -- | -- onAcceptPosition, afterAcceptPosition :: PanedClass self => self -> IO Bool -> IO (ConnectId self) onAcceptPosition = connect_NONE__BOOL "accept_position" False afterAcceptPosition = connect_NONE__BOOL "accept_position" True -- | -- onCancelPosition, afterCancelPosition :: PanedClass self => self -> IO Bool -> IO (ConnectId self) onCancelPosition = connect_NONE__BOOL "cancel_position" False afterCancelPosition = connect_NONE__BOOL "cancel_position" True #endif gtk-0.15.9/Graphics/UI/Gtk/Abstract/Range.chs0000644000000000000000000004355207346545000016675 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Range -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for widgets which visualize an adjustment -- module Graphics.UI.Gtk.Abstract.Range ( -- * Description -- -- | For signals regarding a change in the range or increments, refer to -- 'Adjustment' which is contained in the 'Range' object. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Range -- | +----'Scale' -- | +----'Scrollbar' -- @ -- * Types Range, RangeClass, castToRange, gTypeRange, toRange, -- * Methods rangeGetAdjustment, rangeSetAdjustment, #if GTK_MAJOR_VERSION < 3 rangeGetUpdatePolicy, rangeSetUpdatePolicy, #endif rangeGetInverted, rangeSetInverted, rangeGetValue, rangeSetValue, rangeSetIncrements, rangeSetRange, ScrollType(..), #if GTK_CHECK_VERSION(2,10,0) SensitivityType(..), rangeSetLowerStepperSensitivity, rangeGetLowerStepperSensitivity, rangeSetUpperStepperSensitivity, rangeGetUpperStepperSensitivity, #endif #if GTK_CHECK_VERSION(2,20,0) rangeGetMinSliderSize, rangeGetRangeRect, rangeGetSliderRange, rangeGetSliderSizeFixed, rangeSetMinSliderSize, rangeSetSliderSizeFixed, #endif -- * Attributes #if GTK_MAJOR_VERSION < 3 rangeUpdatePolicy, #endif rangeAdjustment, rangeInverted, #if GTK_CHECK_VERSION(2,10,0) rangeLowerStepperSensitivity, rangeUpperStepperSensitivity, #endif rangeValue, #if GTK_CHECK_VERSION(2,20,0) rangeSliderSizeFixed, rangeMinSliderSize, #endif -- * Signals adjustBounds, valueChanged, #if GTK_CHECK_VERSION(2,6,0) changeValue, #endif -- * Deprecated #ifndef DISABLE_DEPRECATED onMoveSlider, afterMoveSlider, onAdjustBounds, afterAdjustBounds, #if GTK_CHECK_VERSION(2,6,0) onRangeChangeValue, afterRangeChangeValue, #endif onRangeValueChanged, afterRangeValueChanged #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (ScrollType(..)) #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Enums (UpdateType(..)) #endif import Graphics.UI.Gtk.General.Structs (Rectangle(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Get the 'Adjustment' which is the \"model\" object for 'Range'. See -- 'rangeSetAdjustment' for details. -- rangeGetAdjustment :: RangeClass self => self -> IO Adjustment -- ^ returns a 'Adjustment' rangeGetAdjustment self = makeNewObject mkAdjustment $ {# call unsafe range_get_adjustment #} (toRange self) -- | Sets the adjustment to be used as the \"model\" object for this range -- widget. The adjustment indicates the current range value, the minimum and -- maximum range values, the step\/page increments used for keybindings and -- scrolling, and the page size. The page size is normally 0 for 'Scale' and -- nonzero for 'Scrollbar', and indicates the size of the visible area of the -- widget being scrolled. The page size affects the size of the scrollbar -- slider. -- rangeSetAdjustment :: RangeClass self => self -> Adjustment -- ^ @adjustment@ - a 'Adjustment' -> IO () rangeSetAdjustment self adjustment = {# call range_set_adjustment #} (toRange self) adjustment #if GTK_MAJOR_VERSION < 3 -- | Gets the update policy of @range@. See 'rangeSetUpdatePolicy'. -- -- Removed in Gtk3. rangeGetUpdatePolicy :: RangeClass self => self -> IO UpdateType -- ^ returns the current update policy rangeGetUpdatePolicy self = liftM (toEnum . fromIntegral) $ {# call unsafe range_get_update_policy #} (toRange self) -- | Sets the update policy for the range. 'UpdateContinuous' means that -- anytime the range slider is moved, the range value will change and the -- value_changed signal will be emitted. 'UpdateDelayed' means that the value -- will be updated after a brief timeout where no slider motion occurs, so -- updates are spaced by a short time rather than continuous. -- 'UpdateDiscontinuous' means that the value will only be updated when the -- user releases the button and ends the slider drag operation. -- -- Removed in Gtk3. rangeSetUpdatePolicy :: RangeClass self => self -> UpdateType -- ^ @policy@ - update policy -> IO () rangeSetUpdatePolicy self policy = {# call range_set_update_policy #} (toRange self) ((fromIntegral . fromEnum) policy) #endif -- | Gets the value set by 'rangeSetInverted'. -- rangeGetInverted :: RangeClass self => self -> IO Bool -- ^ returns @True@ if the range is inverted rangeGetInverted self = liftM toBool $ {# call unsafe range_get_inverted #} (toRange self) -- | Ranges normally move from lower to higher values as the slider moves from -- top to bottom or left to right. Inverted ranges have higher values at the -- top or on the right rather than on the bottom or left. -- rangeSetInverted :: RangeClass self => self -> Bool -- ^ @setting@ - @True@ to invert the range -> IO () rangeSetInverted self setting = {# call range_set_inverted #} (toRange self) (fromBool setting) -- | Gets the current value of the range. -- rangeGetValue :: RangeClass self => self -> IO Double -- ^ returns current value of the range. rangeGetValue self = liftM realToFrac $ {# call unsafe range_get_value #} (toRange self) -- | Sets the current value of the range; if the value is outside the minimum -- or maximum range values, it will be clamped to fit inside them. The range -- emits the 'valueChanged' signal if the value changes. -- rangeSetValue :: RangeClass self => self -> Double -- ^ @value@ - new value of the range -> IO () rangeSetValue self value = {# call range_set_value #} (toRange self) (realToFrac value) -- | Sets the step and page sizes for the range. The step size is used when -- the user clicks the 'Scrollbar' arrows or moves 'Scale' via arrow keys. The -- page size is used for example when moving via Page Up or Page Down keys. -- rangeSetIncrements :: RangeClass self => self -> Double -- ^ @step@ - step size -> Double -- ^ @page@ - page size -> IO () rangeSetIncrements self step page = {# call range_set_increments #} (toRange self) (realToFrac step) (realToFrac page) -- | Sets the allowable values in the 'Range', and clamps the range value to -- be between @min@ and @max@. (If the range has a non-zero page size, it is -- clamped between @min@ and @max@ - page-size.) -- rangeSetRange :: RangeClass self => self -> Double -- ^ @min@ - minimum range value -> Double -- ^ @max@ - maximum range value -> IO () rangeSetRange self min max = {# call range_set_range #} (toRange self) (realToFrac min) (realToFrac max) #if GTK_CHECK_VERSION(2,10,0) -- | Determines how Gtk+ handles the sensitivity of stepper arrows at the end of range widgets. -- -- * 'SensitivityAuto': the arrow is made insensitive if the thumb is at the end -- -- * 'SensitivityOn': the arrow is always sensitive -- -- * 'SensitivityOff': the arrow is always insensitive -- {#enum SensitivityType {underscoreToCase} deriving (Bounded,Eq,Show)#} -- %hash c:3a8d d:d336 -- | Sets the sensitivity policy for the stepper that points to the \'lower\' -- end of the 'Range''s adjustment. -- -- * Available since Gtk+ version 2.10 -- rangeSetLowerStepperSensitivity :: RangeClass self => self -> SensitivityType -- ^ @sensitivity@ - the lower stepper's sensitivity -- policy. -> IO () rangeSetLowerStepperSensitivity self sensitivity = {# call gtk_range_set_lower_stepper_sensitivity #} (toRange self) ((fromIntegral . fromEnum) sensitivity) -- %hash c:12a2 d:2f2a -- | Gets the sensitivity policy for the stepper that points to the \'lower\' -- end of the 'Range''s adjustment. -- -- * Available since Gtk+ version 2.10 -- rangeGetLowerStepperSensitivity :: RangeClass self => self -> IO SensitivityType -- ^ returns The lower stepper's sensitivity policy. rangeGetLowerStepperSensitivity self = liftM (toEnum . fromIntegral) $ {# call gtk_range_get_lower_stepper_sensitivity #} (toRange self) -- %hash c:a939 d:2d79 -- | Sets the sensitivity policy for the stepper that points to the \'upper\' -- end of the 'Range''s adjustment. -- -- * Available since Gtk+ version 2.10 -- rangeSetUpperStepperSensitivity :: RangeClass self => self -> SensitivityType -- ^ @sensitivity@ - the upper stepper's sensitivity -- policy. -> IO () rangeSetUpperStepperSensitivity self sensitivity = {# call gtk_range_set_upper_stepper_sensitivity #} (toRange self) ((fromIntegral . fromEnum) sensitivity) -- %hash c:456e d:896d -- | Gets the sensitivity policy for the stepper that points to the \'upper\' -- end of the 'Range''s adjustment. -- -- * Available since Gtk+ version 2.10 -- rangeGetUpperStepperSensitivity :: RangeClass self => self -> IO SensitivityType -- ^ returns The upper stepper's sensitivity policy. rangeGetUpperStepperSensitivity self = liftM (toEnum . fromIntegral) $ {# call gtk_range_get_upper_stepper_sensitivity #} (toRange self) #endif #if GTK_CHECK_VERSION(2,20,0) -- | This function is useful mainly for 'Range' subclasses. -- -- See 'rangeSetMinSliderSize'. rangeGetMinSliderSize :: RangeClass self => self -> IO Int -- ^ returns The minimum size of the range's slider. rangeGetMinSliderSize range = liftM fromIntegral $ {#call gtk_range_get_min_slider_size #} (toRange range) -- | This function returns the area that contains the range's through and its steppers, in 'DrawWindow' -- coordinates. -- -- This function is useful mainly for 'Range' subclasses. rangeGetRangeRect :: RangeClass self => self -> IO Rectangle rangeGetRangeRect self = alloca $ \rPtr -> do {# call gtk_range_get_range_rect #} (toRange self) (castPtr rPtr) peek rPtr -- | This function returns sliders range along the long dimension, in 'DrawWindow' coordinates. -- -- This function is useful mainly for 'Range' subclasses. rangeGetSliderRange :: RangeClass self => self -> IO (Maybe (Int, Int)) rangeGetSliderRange range = alloca $ \ startPtr -> alloca $ \ endPtr -> do {#call gtk_range_get_slider_range #} (toRange range) startPtr endPtr if (startPtr /= nullPtr && endPtr /= nullPtr) then do start <- peek startPtr end <- peek endPtr return (Just (fromIntegral start, fromIntegral end)) else return Nothing -- | This function is useful mainly for 'Range' subclasses. -- -- See 'rangeSetSliderSizeFixed'. rangeGetSliderSizeFixed :: RangeClass self => self -> IO Bool -- ^ returns whether the range's slider has a fixed size. rangeGetSliderSizeFixed self = liftM toBool $ {#call gtk_range_get_slider_size_fixed #} (toRange self) -- | Sets the minimum size of the range's slider. -- -- This function is useful mainly for 'Range' subclasses. rangeSetMinSliderSize :: RangeClass self => self -> Bool -> IO () rangeSetMinSliderSize self minSize = {#call gtk_range_set_min_slider_size #} (toRange self) (fromBool minSize) -- | Sets whether the range's slider has a fixed size, or a size that depends on it's adjustment's page -- size. -- -- This function is useful mainly for 'Range' subclasses. rangeSetSliderSizeFixed :: RangeClass self => self -> Bool -- ^ @sizeFixed@ 'True' to make the slider size constant -> IO () rangeSetSliderSizeFixed self sizeFixed = {#call gtk_range_set_slider_size_fixed #} (toRange self) (fromBool sizeFixed) #endif -------------------- -- Attributes #if GTK_MAJOR_VERSION < 3 -- | How the range should be updated on the screen. -- -- Default value: 'UpdateContinuous' -- -- Removed in Gtk3. rangeUpdatePolicy :: RangeClass self => Attr self UpdateType rangeUpdatePolicy = newAttr rangeGetUpdatePolicy rangeSetUpdatePolicy #endif -- | The 'Adjustment' that contains the current value of this range object. -- rangeAdjustment :: RangeClass self => Attr self Adjustment rangeAdjustment = newAttr rangeGetAdjustment rangeSetAdjustment -- | Invert direction slider moves to increase range value. -- -- Default value: @False@ -- rangeInverted :: RangeClass self => Attr self Bool rangeInverted = newAttr rangeGetInverted rangeSetInverted #if GTK_CHECK_VERSION(2,10,0) -- %hash c:b6dd d:1607 -- | The sensitivity policy for the stepper that points to the adjustment's -- lower side. -- -- Default value: 'SensitivityAuto' -- rangeLowerStepperSensitivity :: RangeClass self => Attr self SensitivityType rangeLowerStepperSensitivity = newAttrFromEnumProperty "lower-stepper-sensitivity" {# call pure unsafe gtk_sensitivity_type_get_type #} -- %hash c:2fc6 d:132a -- | The sensitivity policy for the stepper that points to the adjustment's -- upper side. -- -- Default value: 'SensitivityAuto' -- rangeUpperStepperSensitivity :: RangeClass self => Attr self SensitivityType rangeUpperStepperSensitivity = newAttrFromEnumProperty "upper-stepper-sensitivity" {# call pure unsafe gtk_sensitivity_type_get_type #} #endif -- %hash c:f615 d:2481 -- | \'value\' property. See 'rangeGetValue' and 'rangeSetValue' -- rangeValue :: RangeClass self => Attr self Double rangeValue = newAttr rangeGetValue rangeSetValue #if GTK_CHECK_VERSION(2,20,0) -- | Whether range's slikder has a fixed size, or a size that depends on it's adjustment's page size. rangeSliderSizeFixed :: RangeClass self => Attr self Bool rangeSliderSizeFixed = newAttr rangeGetSliderSizeFixed rangeSetSliderSizeFixed -- | Get\/Set sliders range along the long dimension, in 'DrawWindow' coordinates. rangeMinSliderSize :: RangeClass self => ReadWriteAttr self Int Bool rangeMinSliderSize = newAttr rangeGetMinSliderSize rangeSetMinSliderSize #endif -------------------- -- Signals -- %hash c:9758 d:680f -- | Emitted when the range value changes. -- valueChanged :: RangeClass self => Signal self (IO ()) valueChanged = Signal (connect_NONE__NONE "value-changed") -- %hash c:9576 d:af3f -- | -- adjustBounds :: RangeClass self => Signal self (Double -> IO ()) adjustBounds = Signal (connect_DOUBLE__NONE "adjust-bounds") #if GTK_CHECK_VERSION(2,6,0) -- %hash c:a84 d:a60c -- | The 'changeValue' signal is emitted when a scroll action is performed on -- a range. It allows an application to determine the type of scroll event that -- occurred and the resultant new value. The application can handle the event -- itself and return @True@ to prevent further processing. Or, by returning -- @False@, it can pass the event to other handlers until the default Gtk+ -- handler is reached. -- -- The value parameter is unrounded. An application that overrides the -- 'changeValue' signal is responsible for clamping the value to the desired -- number of decimal digits. -- -- It is not possible to use delayed update policies in an overridden -- 'changeValue' handler. -- -- * Available since Gtk+ version 2.6 -- changeValue :: RangeClass self => Signal self (ScrollType -> Double -> IO Bool) changeValue = Signal (connect_ENUM_DOUBLE__BOOL "change-value") #endif -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,6,0) -- | Emitted when a scroll action is performed on a range. It allows -- an application to determine the type of scroll event that -- occurred and the resultant new value. The application can handle -- the event itself and return 'True' to prevent further -- processing. Or, by returning 'False', it can pass the event to -- other handlers until the default GTK+ handler is reached. -- -- * Since Gtk 2.6 -- onRangeChangeValue, afterRangeChangeValue :: RangeClass self => self -> (ScrollType -> Double -> IO Bool) -> IO (ConnectId self) onRangeChangeValue = connect_ENUM_DOUBLE__BOOL "change_value" False afterRangeChangeValue = connect_ENUM_DOUBLE__BOOL "change_value" True #endif -- | Emitted when the range value is changed either programmatically or by -- user action. -- onRangeValueChanged, afterRangeValueChanged :: RangeClass self => self -> IO () -> IO (ConnectId self) onRangeValueChanged = connect_NONE__NONE "value_changed" False afterRangeValueChanged = connect_NONE__NONE "value_changed" True -- | Emitted when the range is adjusted by user action. Note the value can be -- outside the bounds of the range since it depends on the mouse position. -- -- Usually you should use 'onRangeValueChanged' \/ 'afterRangeValueChanged' -- instead. -- onAdjustBounds, afterAdjustBounds :: RangeClass self => self -> (Double -> IO ()) -> IO (ConnectId self) onAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" False afterAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" True -- | Emitted when the user presses a key (e.g. Page Up, Home, Right Arrow) to -- move the slider. The 'ScrollType' parameter gives the key that was pressed. -- -- Usually you should use 'onRangeValueChanged' \/ -- 'afterRangeValueChanged' instead. -- onMoveSlider, afterMoveSlider :: RangeClass self => self -> (ScrollType -> IO ()) -> IO (ConnectId self) onMoveSlider = connect_ENUM__NONE "move_slider" False afterMoveSlider = connect_ENUM__NONE "move_slider" True #endif gtk-0.15.9/Graphics/UI/Gtk/Abstract/Scale.chs0000644000000000000000000001216107346545000016660 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Scale -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for 'HScale' and 'VScale' -- module Graphics.UI.Gtk.Abstract.Scale ( -- * Detail -- -- | A 'Scale' is a slider control used to select a numeric value. To use it, -- you'll probably want to investigate the methods on its base class, 'Range', -- in addition to the methods for 'Scale' itself. To set the value of a scale, -- you would normally use 'Graphics.UI.Gtk.Abstract.Range.rangeSetValue'. -- To detect changes to the value, you would normally use the -- 'Graphics.UI.Gtk.Abstract.Range.onRangeValueChanged' signal. -- -- The 'Scale' widget is an abstract class, used only for deriving the -- subclasses 'HScale' and 'VScale'. To create a scale widget, call -- 'Graphics.UI.Gtk.Entry.HScale.hScaleNewWithRange' or -- 'Graphics.UI.Gtk.Entry.VScale.vScaleNewWithRange'. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Range' -- | +----Scale -- | +----'HScale' -- | +----'VScale' -- @ -- * Types Scale, ScaleClass, castToScale, gTypeScale, toScale, -- * Methods scaleSetDigits, scaleGetDigits, scaleSetDrawValue, scaleGetDrawValue, PositionType(..), scaleSetValuePos, scaleGetValuePos, -- * Attributes scaleDigits, scaleDrawValue, scaleValuePos, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (PositionType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Sets the number of decimal places that are displayed in the value. Also -- causes the value of the adjustment to be rounded off to this number of -- digits, so the retrieved value matches the value the user saw. -- scaleSetDigits :: ScaleClass self => self -> Int -- ^ @digits@ - the number of decimal places to display, e.g. use 1 -- to display 1.0, 2 to display 1.00 etc. -> IO () scaleSetDigits self digits = {# call scale_set_digits #} (toScale self) (fromIntegral digits) -- | Gets the number of decimal places that are displayed in the value. -- scaleGetDigits :: ScaleClass self => self -> IO Int -- ^ returns the number of decimal places that are displayed. scaleGetDigits self = liftM fromIntegral $ {# call unsafe scale_get_digits #} (toScale self) -- | Specifies whether the current value is displayed as a string next to the -- slider. -- scaleSetDrawValue :: ScaleClass self => self -> Bool -- ^ @drawValue@ - a boolean. -> IO () scaleSetDrawValue self drawValue = {# call scale_set_draw_value #} (toScale self) (fromBool drawValue) -- | Returns whether the current value is displayed as a string next to the -- slider. -- scaleGetDrawValue :: ScaleClass self => self -> IO Bool -- ^ returns whether the current value is displayed as a string. scaleGetDrawValue self = liftM toBool $ {# call unsafe scale_get_draw_value #} (toScale self) -- | Sets the position in which the current value is displayed. -- scaleSetValuePos :: ScaleClass self => self -> PositionType -- ^ @pos@ - the position in which the current value is -- displayed. -> IO () scaleSetValuePos self pos = {# call scale_set_value_pos #} (toScale self) ((fromIntegral . fromEnum) pos) -- | Gets the position in which the current value is displayed. -- scaleGetValuePos :: ScaleClass self => self -> IO PositionType -- ^ returns the position in which the current value is -- displayed. scaleGetValuePos self = liftM (toEnum . fromIntegral) $ {# call unsafe scale_get_value_pos #} (toScale self) -------------------- -- Attributes -- | The number of decimal places that are displayed in the value. -- -- Allowed values: [-1,64] -- -- Default value: 1 -- scaleDigits :: ScaleClass self => Attr self Int scaleDigits = newAttr scaleGetDigits scaleSetDigits -- | Whether the current value is displayed as a string next to the slider. -- -- Default value: @True@ -- scaleDrawValue :: ScaleClass self => Attr self Bool scaleDrawValue = newAttr scaleGetDrawValue scaleSetDrawValue -- | The position in which the current value is displayed. -- -- Default value: 'PosTop' -- scaleValuePos :: ScaleClass self => Attr self PositionType scaleValuePos = newAttr scaleGetValuePos scaleSetValuePos gtk-0.15.9/Graphics/UI/Gtk/Abstract/Scrollbar.hs0000644000000000000000000000437007346545000017414 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Scrollbar -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for 'Graphics.UI.Gtk.Scrolling.HScrollbar' and -- 'Graphics.UI.Gtk.Scrolling.VScrollbar' -- module Graphics.UI.Gtk.Abstract.Scrollbar ( -- * Detail -- -- | The 'Scrollbar' widget is an abstract base class for -- 'Graphics.UI.Gtk.Scrolling.HScrollbar' and -- 'Graphics.UI.Gtk.Scrolling.VScrollbar'. It is not very useful in itself. -- -- The position of the thumb in a scrollbar is controlled by the scroll -- adjustments. See 'Graphics.UI.Gtk.Misc.Adjustment' for the fields in an -- adjustment - for -- 'Scrollbar', the \"value\" field represents the position of the scrollbar, -- which must be between the \"lower\" field and \"upper - page_size.\" The -- \"page_size\" field represents the size of the visible scrollable area. The -- \"step_increment\" and \"page_increment\" fields are used when the user asks -- to step down (using the small stepper arrows) or page down (using for -- example the PageDown key). -- * Class Hierarchy -- | -- @ -- | 'System.Glib.GObject' -- | +----'Graphics.UI.Gtk.Abstract.Object' -- | +----'Graphics.UI.Gtk.Abstract.Widget' -- | +----'Graphics.UI.Gtk.Abstract.Range' -- | +----Scrollbar -- | +----'Graphics.UI.Gtk.Scrolling.HScrollbar' -- | +----'Graphics.UI.Gtk.Scrolling.VScrollbar' -- @ -- * Types Scrollbar, ScrollbarClass, castToScrollbar, gTypeScrollbar, toScrollbar, ) where import Graphics.UI.Gtk.Types gtk-0.15.9/Graphics/UI/Gtk/Abstract/Separator.hs0000644000000000000000000000313407346545000017426 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Separator -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Base class for 'Graphics.UI.Gtk.Ornaments.HSeparator' and -- 'Graphics.UI.Gtk.Ornaments.VSeparator'. -- module Graphics.UI.Gtk.Abstract.Separator ( -- * Detail -- -- | The 'Separator' widget is an abstract class, used only for deriving the -- subclasses 'Graphics.UI.Gtk.Ornaments.HSeparator' and -- 'Graphics.UI.Gtk.Ornaments.VSeparator'. -- * Class Hierarchy -- | -- @ -- | 'System.Glib.GObject' -- | +----'Graphics.UI.Gtk.Abstract.Object' -- | +----'Graphics.UI.Gtk.Abstract.Widget' -- | +----Separator -- | +----'Graphics.UI.Gtk.Ornaments.HSeparator' -- | +----'Graphics.UI.Gtk.Ornaments.VSeparator' -- @ -- * Types Separator, SeparatorClass, castToSeparator, gTypeSeparator, toSeparator, ) where import Graphics.UI.Gtk.Types gtk-0.15.9/Graphics/UI/Gtk/Abstract/Widget.chs0000644000000000000000000050742707346545000017072 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Widget -- -- Author : Axel Simon -- -- Created: 27 April 2001 -- -- Copyright (C) 2001-2008 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 class for all widgets. -- module Graphics.UI.Gtk.Abstract.Widget ( -- * Detail -- -- | The base class for all widgets. While a widget cannot be created directly, -- this module contains many useful methods common to all widgets. In -- particular, these functions are needed to add functionality to -- blank widgets such as 'DrawingArea' or 'Layout'. -- -- 'Widget' introduces style properties - these are basically object -- properties that are stored not on the object, but in the style object -- associated to the widget. Style properties are set in resource files. This -- mechanism is used for configuring such things as the location of the -- scrollbar arrows through the theme, giving theme authors more control over -- the look of applications without the need to write a theme engine in C. -- -- Widgets receive events, that is, signals that indicate some low-level -- user interaction. The signal handlers for all these events have to -- return @True@ if the signal has been dealt with and @False@ if other -- signal handlers should be run. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----Widget -- | +----/too many to list/ -- @ -- * Types Widget, WidgetClass, castToWidget, gTypeWidget, toWidget, EventMask(..), #if GTK_MAJOR_VERSION < 3 ExtensionMode(..), #endif GType, KeyVal, #if GTK_MAJOR_VERSION < 3 Region, Bitmap, #endif Requisition(..), Rectangle(..), Color, IconSize(..), StateType(..), TextDirection(..), AccelFlags(..), DirectionType(..), StockId, WidgetHelpType(..), Allocation, -- * Methods widgetShow, widgetShowNow, widgetHide, widgetShowAll, #if GTK_MAJOR_VERSION < 3 widgetHideAll, #endif widgetDestroy, #if GTK_CHECK_VERSION(3,0,0) widgetDraw, #endif widgetQueueDraw, widgetQueueResize, #if GTK_CHECK_VERSION(2,4,0) widgetQueueResizeNoRedraw, #endif #if GTK_CHECK_VERSION(3,8,0) widgetGetFrameClock, #endif #if GTK_CHECK_VERSION(3,10,0) widgetGetScaleFactor, #endif widgetSizeRequest, widgetGetChildRequisition, widgetSizeAllocate, #if GTK_CHECK_VERSION(3,10,0) widgetSizeAllocateWithBaseline, #endif widgetAddAccelerator, widgetRemoveAccelerator, widgetSetAccelPath, #if GTK_CHECK_VERSION(2,4,0) widgetCanActivateAccel, #endif widgetActivate, widgetIntersect, widgetHasIntersection, widgetGetIsFocus, widgetGrabFocus, widgetGrabDefault, widgetSetName, widgetGetName, widgetSetSensitive, widgetSetSensitivity, widgetGetParentWindow, #if GTK_MAJOR_VERSION < 3 widgetGetDrawWindow, #endif widgetDelEvents, widgetAddEvents, widgetGetEvents, widgetSetEvents, #if GTK_MAJOR_VERSION < 3 widgetSetExtensionEvents, widgetGetExtensionEvents, #endif widgetGetToplevel, widgetGetAncestor, #if GTK_MAJOR_VERSION < 3 widgetGetColormap, widgetSetColormap, #endif widgetGetPointer, widgetIsAncestor, widgetTranslateCoordinates, widgetSetStyle, widgetGetStyle, #if GTK_MAJOR_VERSION < 3 widgetPushColormap, widgetPopColormap, widgetSetDefaultColormap, widgetGetDefaultColormap, #endif widgetGetDefaultStyle, widgetSetDirection, widgetGetDirection, widgetSetDefaultDirection, widgetGetDefaultDirection, #if GTK_MAJOR_VERSION < 3 widgetShapeCombineMask, #if GTK_CHECK_VERSION(2,10,0) widgetInputShapeCombineMask, #endif #endif #if GTK_CHECK_VERSION(3,0,0) widgetShapeCombineRegion, widgetInputShapeCombineRegion, #endif #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,14,0) widgetGetSnapshot, #endif #endif widgetPath, widgetClassPath, widgetGetCompositeName, #if GTK_CHECK_VERSION(3,0,0) widgetOverrideBackgroundColor, widgetOverrideColor, widgetOverrideFont, widgetOverrideSymbolicColor, widgetOverrideCursor, #endif widgetModifyStyle, widgetGetModifierStyle, widgetModifyFg, widgetModifyBg, widgetModifyText, widgetModifyBase, widgetModifyFont, widgetRestoreFg, widgetRestoreBg, widgetRestoreText, widgetRestoreBase, widgetCreatePangoContext, widgetGetPangoContext, widgetCreateLayout, widgetRenderIcon, widgetQueueDrawArea, #if GTK_CHECK_VERSION(3,0,0) widgetQueueDrawRegion, #endif #if GTK_MAJOR_VERSION < 3 widgetResetShapes, #endif widgetSetAppPaintable, widgetSetDoubleBuffered, widgetSetRedrawOnAllocate, widgetSetCompositeName, widgetMnemonicActivate, #if GTK_MAJOR_VERSION < 3 widgetSetScrollAdjustments, widgetRegionIntersect, #endif widgetGetAccessible, widgetChildFocus, widgetGetChildVisible, widgetGetParent, widgetGetSettings, #if GTK_CHECK_VERSION(2,2,0) widgetGetClipboard, widgetGetDisplay, widgetGetRootWindow, widgetGetScreen, widgetHasScreen, #endif widgetGetSizeRequest, #if GTK_CHECK_VERSION(3,0,0) widgetGetPreferredSize, #endif widgetSetChildVisible, widgetSetSizeRequest, #if GTK_CHECK_VERSION(2,4,0) widgetSetNoShowAll, widgetGetNoShowAll, widgetListMnemonicLabels, widgetAddMnemonicLabel, widgetRemoveMnemonicLabel, #if GTK_CHECK_VERSION(2,10,0) #if GTK_MAJOR_VERSION < 3 widgetGetAction, #endif widgetIsComposited, #endif #endif #if GTK_CHECK_VERSION(2,12,0) widgetErrorBell, widgetKeynavFailed, widgetGetTooltipMarkup, widgetSetTooltipMarkup, widgetGetTooltipText, widgetSetTooltipText, widgetGetTooltipWindow, widgetSetTooltipWindow, widgetGetHasTooltip, widgetSetHasTooltip, widgetTriggerTooltipQuery, #endif #if GTK_CHECK_VERSION(2,14,0) widgetGetWindow, #endif #if GTK_CHECK_VERSION(3,8,0) widgetRegisterWindow, widgetUnregisterWindow, #endif #if GTK_CHECK_VERSION(3,0,0) cairoShouldDrawWindow, cairoTransformToWindow, #endif widgetReparent, #if GTK_CHECK_VERSION(2,18,0) widgetGetCanFocus, widgetSetCanFocus, widgetGetAllocation, #endif #if GTK_CHECK_VERSION(3,0,0) widgetGetAllocatedWidth, widgetGetAllocatedHeight, #endif #if GTK_CHECK_VERSION(3,10,0) widgetGetAllocatedBaseline, #endif #if GTK_CHECK_VERSION(3,14,0) widgetGetClip, widgetSetClip, #endif #if GTK_CHECK_VERSION(2,18,0) widgetGetAppPaintable, widgetGetCanDefault, widgetSetCanDefault, widgetGetHasWindow, widgetSetHasWindow, widgetGetSensitive, widgetIsSensitive, widgetGetState, widgetGetVisible, #endif #if GTK_CHECK_VERSION(3,8,0) widgetIsVisible, #endif #if GTK_CHECK_VERSION(3,0,0) widgetSetStateFlags, widgetUnsetStateFlags, widgetGetStateFlags, #endif #if GTK_CHECK_VERSION(2,18,0) widgetGetHasDefault, widgetGetHasFocus, #endif #if GTK_CHECK_VERSION(3,2,0) widgetHasVisibleFocus, #endif #if GTK_CHECK_VERSION(2,18,0) widgetHasGrab, widgetIsDrawable, widgetIsToplevel, widgetSetWindow, widgetSetReceivesDefault, widgetGetReceivesDefault, #endif #if GTK_CHECK_VERSION(3,0,0) widgetDeviceIsShadowed, #endif #if GTK_CHECK_VERSION(3,4,0) widgetGetModifierMask, #endif #if GTK_CHECK_VERSION(3,0,0) widgetSetSupportMultidevice, widgetGetSupportMultidevice, #endif widgetSetState, #if GTK_MAJOR_VERSION < 3 widgetGetSavedState, widgetGetSize, #endif widgetEvent, #if GTK_CHECK_VERSION(3,0,0) widgetGetHAlign, widgetSetHAlign, widgetGetVAlign, #if GTK_CHECK_VERSION(3,10,0) widgetGetVAlignWithBaseline, #endif widgetSetVAlign, #endif -- * Attributes widgetName, widgetParent, widgetWidthRequest, widgetHeightRequest, widgetMarginLeft, widgetMarginRight, #if GTK_CHECK_VERSION(3,12,0) widgetMarginStart, widgetMarginEnd, #endif widgetMarginTop, widgetMarginBottom, widgetVisible, widgetOpacity, widgetSensitive, widgetAppPaintable, widgetCanFocus, widgetHasFocus, widgetIsFocus, widgetCanDefault, widgetHasDefault, widgetReceivesDefault, widgetCompositeChild, widgetStyle, widgetState, widgetEvents, #if GTK_MAJOR_VERSION < 3 widgetExtensionEvents, #endif widgetExpand, widgetHExpand, widgetHExpandSet, widgetVExpand, widgetVExpandSet, widgetNoShowAll, widgetChildVisible, #if GTK_MAJOR_VERSION < 3 widgetColormap, #endif widgetCompositeName, widgetDirection, widgetTooltipMarkup, widgetTooltipText, widgetHasTooltip, #if GTK_CHECK_VERSION(2,20,0) widgetHasRcStyle, widgetGetRealized, widgetGetMapped, widgetSetRealized, widgetSetMapped, #endif #if GTK_CHECK_VERSION(3,0,0) widgetGetStyleContext, #endif -- * Signals realize, unrealize, mapSignal, unmapSignal, sizeRequest, sizeAllocate, showSignal, hideSignal, focus, stateChanged, #if GTK_CHECK_VERSION(3,0,0) stateFlagsChanged, #endif parentSet, hierarchyChanged, styleSet, directionChanged, grabNotify, popupMenuSignal, showHelp, accelClosuresChanged, screenChanged, queryTooltip, #if GTK_CHECK_VERSION(3,0,0) draw, #endif -- * Events buttonPressEvent, buttonReleaseEvent, configureEvent, deleteEvent, destroyEvent, enterNotifyEvent, exposeEvent, focusInEvent, focusOutEvent, #if GTK_CHECK_VERSION(2,8,0) grabBrokenEvent, #endif keyPressEvent, keyReleaseEvent, leaveNotifyEvent, mapEvent, motionNotifyEvent, noExposeEvent, proximityInEvent, proximityOutEvent, scrollEvent, unmapEvent, visibilityNotifyEvent, windowStateEvent, -- * Deprecated #ifndef DISABLE_DEPRECATED onButtonPress, afterButtonPress, onButtonRelease, afterButtonRelease, onClient, afterClient, onConfigure, afterConfigure, onDelete, afterDelete, onDestroyEvent, -- you probably want onDestroy afterDestroyEvent, onDirectionChanged, afterDirectionChanged, onEnterNotify, afterEnterNotify, onLeaveNotify, afterLeaveNotify, onExpose, afterExpose, onExposeRect, afterExposeRect, onFocus, afterFocus, onFocusIn, afterFocusIn, onFocusOut, afterFocusOut, onGrabFocus, afterGrabFocus, onDestroy, afterDestroy, onHide, afterHide, onHierarchyChanged, afterHierarchyChanged, onKeyPress, afterKeyPress, onKeyRelease, afterKeyRelease, onMnemonicActivate, afterMnemonicActivate, onMotionNotify, afterMotionNotify, onParentSet, afterParentSet, onPopupMenu, afterPopupMenu, onProximityIn, afterProximityIn, onProximityOut, afterProximityOut, onRealize, afterRealize, onScroll, afterScroll, onShow, afterShow, onSizeAllocate, afterSizeAllocate, onSizeRequest, afterSizeRequest, onStateChanged, afterStateChanged, onUnmap, afterUnmap, onUnrealize, afterUnrealize, onVisibilityNotify, afterVisibilityNotify, onWindowState, afterWindowState #endif ) where import Control.Monad (liftM, unless) import Data.Maybe (fromMaybe) import Control.Monad.Reader (ask) import Control.Monad.Trans (liftIO) import System.Glib.FFI import System.Glib.Flags (fromFlags, toFlags) #if GTK_CHECK_VERSION(3,0,0) import System.Glib.GError (failOnGError) import System.Glib.Flags (Flags) #endif import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import System.Glib.GType (GType) import System.Glib.GList (fromGList) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.General.DNDTypes (Atom (Atom), SelectionTag) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Gdk.Enums (EventMask(..) #if GTK_MAJOR_VERSION < 3 , ExtensionMode(..) #endif ) import Graphics.UI.Gtk.Gdk.Keys (KeyVal) #if GTK_MAJOR_VERSION < 3 {#import Graphics.UI.Gtk.Gdk.Region#} (Region(..), makeNewRegion) {#import Graphics.UI.Gtk.Gdk.Pixmap#} (Bitmap) #endif import Graphics.UI.Gtk.General.Structs (Allocation, Rectangle(..) ,Requisition(..), Color, IconSize(..) ,Point #if !GTK_CHECK_VERSION(2,18,0) ,widgetGetState #endif #if GTK_MAJOR_VERSION < 3 ,widgetGetSavedState ,widgetGetDrawWindow, widgetGetSize #endif ) #ifndef DISABLE_DEPRECATED import Graphics.UI.Gtk.Gdk.Events (Event(..), marshalEvent, marshExposeRect) #endif import Graphics.UI.Gtk.Gdk.EventM (EventM, EventM, EAny, EKey, EButton, EScroll, EMotion, EExpose, EVisibility, ECrossing, EFocus, EConfigure, EProperty, EProximity, EWindowState, #if GTK_CHECK_VERSION(2,8,0) EGrabBroken, #endif ) import Graphics.UI.Gtk.General.Enums (StateType(..), TextDirection(..), AccelFlags(..), DirectionType(..), Modifier #if GTK_CHECK_VERSION(3,0,0) ,StateFlags(..), Align(..) #endif #if GTK_CHECK_VERSION(3,4,0) ,ModifierIntent(..) #endif ) {#import Graphics.Rendering.Pango.Types#} {#import Graphics.Rendering.Pango.BasicTypes#} (FontDescription(FontDescription), PangoLayout(PangoLayout), makeNewPangoString ) import Graphics.UI.Gtk.General.StockItems (StockId) import Data.IORef ( newIORef ) import Control.Monad.Reader ( runReaderT ) #if GTK_CHECK_VERSION(3,0,0) import Graphics.Rendering.Cairo.Types (Cairo(..), unCairo, Region(..), withRegion) import Graphics.Rendering.Cairo.Internal (Render(..)) #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Flags a widget to be displayed. Any widget that isn't shown will not -- appear on the screen. If you want to show all the widgets in a container, -- it's easier to call 'widgetShowAll' on the container, instead of -- individually showing the widgets. -- -- Remember that you have to show the containers containing a widget, in -- addition to the widget itself, before it will appear onscreen. -- -- When a toplevel container is shown, it is immediately realized and -- mapped; other shown widgets are realized and mapped when their toplevel -- container is realized and mapped. -- widgetShow :: WidgetClass self => self -> IO () widgetShow self = {# call widget_show #} (toWidget self) -- | Shows a widget. If the widget is an unmapped toplevel widget (i.e. a -- 'Window' that has not yet been shown), enter the main loop and wait for the -- window to actually be mapped. Be careful; because the main loop is running, -- anything can happen during this function. -- widgetShowNow :: WidgetClass self => self -> IO () widgetShowNow self = {# call widget_show_now #} (toWidget self) -- | Reverses the effects of 'widgetShow', causing the widget to be hidden -- (invisible to the user). -- widgetHide :: WidgetClass self => self -> IO () widgetHide self = {# call widget_hide #} (toWidget self) -- | Recursively shows a widget, and any child widgets (if the widget is a -- container). -- widgetShowAll :: WidgetClass self => self -> IO () widgetShowAll self = {# call widget_show_all #} (toWidget self) #if GTK_MAJOR_VERSION < 3 -- | Recursively hides a widget and any child widgets. -- -- Removed in Gtk3. widgetHideAll :: WidgetClass self => self -> IO () widgetHideAll self = {# call widget_hide_all #} (toWidget self) #endif -- | Destroys a widget. Equivalent to -- 'Graphics.UI.Gtk.Abstract.Object.objectDestroy'. -- -- When a widget is destroyed it will be removed from the screen and -- unrealized. When a widget is destroyed, it will break any references it -- holds to other objects.If the widget is inside a container, the widget will -- be removed from the container. The widget will be garbage collected -- (finalized) time after your last reference to the widget disappears. -- -- In most cases, only toplevel widgets (windows) require explicit -- destruction, because when you destroy a toplevel its children will be -- destroyed as well. -- widgetDestroy :: WidgetClass self => self -> IO () widgetDestroy self = {# call widget_destroy #} (toWidget self) #if GTK_CHECK_VERSION(3,0,0) -- | Draws widget to @cr@. The top left corner of the widget will be drawn -- to the currently set origin point of @cr@. -- -- You should pass a cairo context as cr argument that is in an original -- state. Otherwise the resulting drawing is undefined. For example changing -- the operator using 'Graphics.Rendering.Cairo.setOperator' or the line -- width using 'Graphics.Rendering.Cairo.setLineWidth' might have unwanted -- side effects. You may however change the context’s transform matrix - like -- with 'Graphics.Rendering.Cairo.scale', 'Graphics.Rendering.Cairo.translate' -- or 'Graphics.Rendering.Cairo.setMatrix' and clip region with -- 'Graphics.Rendering.Cairo.clip' prior to calling this function. Also, it -- is fine to modify the context with 'Graphics.Rendering.Cairo.save' and -- 'Graphics.Rendering.Cairo.pushGroup' prior to calling this function. -- -- Note that special-purpose widgets may contain special code for rendering -- to the screen and might appear differently on screen and when rendered -- using 'widgetDraw'. -- widgetDraw :: WidgetClass self => self -- ^ the widget to draw. It must be drawable (see 'widgetIsDrawable') -- and a size must have been allocated. -> Cairo -- ^ a cairo context to draw to -> IO () widgetDraw self cr = {# call widget_draw #} (toWidget self) (castPtr $ unCairo cr) #endif -- * Functions to be used with 'Graphics.UI.Gtk.Misc.DrawingArea' or -- container implementations. -- | Send a redraw request to a widget. Equivalent to calling -- 'widgetQueueDrawArea' for the entire area of a widget. -- widgetQueueDraw :: WidgetClass self => self -> IO () widgetQueueDraw self = {# call widget_queue_draw #} (toWidget self) -- | This function is only for use in widget implementations. Flags a widget -- to have its size renegotiated; should be called when a widget for some -- reason has a new size request. For example, when you change the text in a -- 'Graphics.UI.Gtk.Display.Label.Label', -- 'Graphics.UI.Gtk.Display.Label.Label' queues a resize to ensure there's -- enough space for the new text. -- widgetQueueResize :: WidgetClass self => self -> IO () widgetQueueResize self = {# call widget_queue_resize #} (toWidget self) #if GTK_CHECK_VERSION(2,4,0) -- | This function works like 'widgetQueueResize', except that the widget is -- not invalidated. -- -- * Available since Gtk+ version 2.4 -- widgetQueueResizeNoRedraw :: WidgetClass self => self -> IO () widgetQueueResizeNoRedraw self = {# call widget_queue_resize_no_redraw #} (toWidget self) #endif #if GTK_CHECK_VERSION(3,8,0) -- | Obtains the frame clock for a widget. The frame clock is a global “ticker†-- that can be used to drive animations and repaints. The most common reason to -- get the frame clock is to call 'frameClockGetFrameTime', in order to get a -- time to use for animating. For example you might record the start of the -- animation with an initial value from 'frameClockGetFrameTime', and then -- update the animation by calling 'frameClockGetFrameTime' again during each -- repaint. -- -- 'frameClockRequestPhase' will result in a new frame on the clock, but won’t -- necessarily repaint any widgets. To repaint a widget, you have to use -- 'widgetQueueDraw' which invalidates the widget (thus scheduling it to -- receive a draw on the next frame). 'widgetQueueDraw' will also end up -- requesting a frame on the appropriate frame clock. -- -- A widget’s frame clock will not change while the widget is mapped. -- Reparenting a widget (which implies a temporary unmap) can change the -- widget’s frame clock. -- -- Unrealized widgets do not have a frame clock. -- widgetGetFrameClock :: WidgetClass self => self -> IO FrameClock widgetGetFrameClock self = makeNewGObject mkFrameClock $ {# call widget_get_frame_clock #} (toWidget self) #endif #if GTK_CHECK_VERSION(3,10,0) -- | Retrieves the internal scale factor that maps from window coordinates to -- the actual device pixels. On traditional systems this is 1, on high density -- outputs, it can be a higher value (typically 2). -- -- See 'drawWindowGetScaleFactor'. -- widgetGetScaleFactor :: WidgetClass self => self -> IO Int widgetGetScaleFactor self = liftM fromIntegral $ {# call widget_get_scale_factor #} (toWidget self) #endif -- | This function is typically used when implementing a -- 'Graphics.UI.Gtk.Abstract.Container.Container' subclass. Obtains the preferred size -- of a widget. The container uses this information to arrange its child -- widgets and decide what size allocations to give them with -- 'widgetSizeAllocate'. -- -- You can also call this function from an application, with some caveats. -- Most notably, getting a size request requires the widget to be associated -- with a screen, because font information may be needed. Multihead-aware -- applications should keep this in mind. -- -- Also remember that the size request is not necessarily the size a widget -- will actually be allocated. -- widgetSizeRequest :: WidgetClass self => self -> IO Requisition widgetSizeRequest self = alloca $ \reqPtr -> do {#call widget_size_request #} (toWidget self) (castPtr reqPtr) peek reqPtr -- | This function is only for use in widget implementations. Obtains the -- cached requisition information in the widget, unless someone has forced a -- particular geometry on the widget (e.g. with 'widgetSetSizeRequest'), in which -- case it returns that geometry instead of the widget's requisition. -- -- This function differs from 'widgetSizeRequest' in that it retrieves the -- last size request value stored in the widget, while 'widgetSizeRequest' -- actually emits the 'sizeRequest' signal on the widget to compute the size -- request (which updates the widget's requisition information). -- -- Since this function does not emit the 'sizeRequest' signal, it can only be -- used when you know that the widget's requisition is up-to-date, that is, -- 'widgetSizeRequest' has been called since the last time a resize was -- queued. In general, only container implementations have this information; -- applications should use 'widgetSizeRequest'. -- widgetGetChildRequisition :: WidgetClass self => self -> IO Requisition widgetGetChildRequisition self = alloca $ \reqPtr -> do {#call widget_get_child_requisition #} (toWidget self) (castPtr reqPtr) peek reqPtr -- | This function is only used by -- 'Graphics.UI.Gtk.Abstract.Container.Container' subclasses, to assign a -- size and position to their child widgets. -- widgetSizeAllocate :: WidgetClass self => self -> Allocation -- ^ The @x@ and @y@ values of the rectangle determine the -- the position of the widget's area relative to its parent -- allocation. -> IO () widgetSizeAllocate self rect = with rect $ \rectPtr -> {#call widget_size_allocate#} (toWidget self) (castPtr rectPtr) #if GTK_CHECK_VERSION(3,10,0) -- | This function is only used by -- 'Graphics.UI.Gtk.Abstract.Container.Container' subclasses, to assign a -- size, position and (optionally) baseline to their child widgets. -- -- In this function, the allocation and baseline may be adjusted. It will -- be forced to a 1x1 minimum size, and the adjust_size_allocation virtual -- and adjust_baseline_allocation methods on the child will be used to adjust -- the allocation and baseline. Standard adjustments include removing the -- widget's margins, and applying the widget’s 'widgetHAlign' and -- 'widgetVAlign' properties. -- -- If the child widget does not have a valign of AlignBaseline the baseline -- argument is ignored and -1 is used instead. -- widgetSizeAllocateWithBaseline :: WidgetClass self => self -> Allocation -- ^ The @x@ and @y@ values of the rectangle determine the -- the position of the widget's area relative to its parent -- allocation. -> Int -- ^ The baseline of the child, or -1 -> IO () widgetSizeAllocateWithBaseline self rect baseline = with rect $ \rectPtr -> {#call widget_size_allocate_with_baseline#} (toWidget self) (castPtr rectPtr) (fromIntegral baseline) #endif -- %hash c:1e14 d:53c5 -- | Installs an accelerator for this @widget@ in @accelGroup@ that causes -- @accelSignal@ to be emitted if the accelerator is activated. The -- @accelGroup@ needs to be added to the widget's toplevel via -- 'windowAddAccelGroup', and the signal must be of type @G_RUN_ACTION@. -- Accelerators added through this function are not user changeable during -- runtime. If you want to support accelerators that can be changed by the -- user, use 'accelMapAddEntry' and 'widgetSetAccelPath' or -- 'menuItemSetAccelPath' instead. -- widgetAddAccelerator :: (WidgetClass self, GlibString string) => self -> string -- ^ @accelSignal@ - widget signal to emit on accelerator -- activation -> AccelGroup -- ^ @accelGroup@ - accel group for this widget, added to -- its toplevel -> KeyVal -- ^ @accelKey@ - the key of the accelerator -> [Modifier] -- ^ @accelMods@ - modifier key combination of the -- accelerator -> [AccelFlags] -- ^ @accelFlags@ - flag accelerators, e.g. 'AccelVisible' -> IO () widgetAddAccelerator self accelSignal accelGroup accelKey accelMods accelFlags = withUTFString accelSignal $ \accelSignalPtr -> {# call gtk_widget_add_accelerator #} (toWidget self) accelSignalPtr accelGroup (fromIntegral accelKey) ((fromIntegral . fromFlags) accelMods) ((fromIntegral . fromFlags) accelFlags) -- %hash c:3442 d:dfe8 -- | Removes an accelerator from @widget@, previously installed with -- 'widgetAddAccelerator'. -- widgetRemoveAccelerator :: WidgetClass self => self -> AccelGroup -- ^ @accelGroup@ - accel group for this widget -> KeyVal -- ^ @accelKey@ - the key of the accelerator -> [Modifier] -- ^ @accelMods@ - modifier key combination of the -- accelerator -> IO Bool -- ^ returns whether an accelerator was installed and could -- be removed widgetRemoveAccelerator self accelGroup accelKey accelMods = liftM toBool $ {# call gtk_widget_remove_accelerator #} (toWidget self) accelGroup (fromIntegral accelKey) ((fromIntegral . fromFlags) accelMods) -- %hash c:f8d4 d:bd7f -- | Given an accelerator group, @accelGroup@, and an accelerator path, -- @accelPath@, sets up an accelerator in @accelGroup@ so whenever the key -- binding that is defined for @accelPath@ is pressed, @widget@ will be -- activated. This removes any accelerators (for any accelerator group) -- installed by previous calls to 'widgetSetAccelPath'. Associating -- accelerators with paths allows them to be modified by the user and the -- modifications to be saved for future use. (See 'accelMapSave'.) -- -- This function is a low level function that would most likely be used by a -- menu creation system like 'ItemFactory'. If you use 'ItemFactory', setting -- up accelerator paths will be done automatically. -- -- Even when you you aren't using 'ItemFactory', if you only want to set up -- accelerators on menu items 'menuItemSetAccelPath' provides a somewhat more -- convenient interface. -- widgetSetAccelPath :: (WidgetClass self, GlibString string) => self -> string -- ^ @accelPath@ - path used to look up the accelerator -> AccelGroup -- ^ @accelGroup@ - a 'AccelGroup'. -> IO () widgetSetAccelPath self accelPath accelGroup = withUTFString accelPath $ \accelPathPtr -> {# call gtk_widget_set_accel_path #} (toWidget self) accelPathPtr accelGroup #if GTK_CHECK_VERSION(2,4,0) -- %hash c:157e d:82ae -- | Determines whether an accelerator that activates the signal identified by -- @signalId@ can currently be activated. This is done by emitting the -- 'canActivateAccel' signal on the widget the signal is attached to; if the -- signal isn't overridden by a handler or in a derived widget, then the -- default check is that the widget must be sensitive, and the widget and all -- its ancestors mapped. -- -- * Available since Gtk+ version 2.4 -- widgetCanActivateAccel :: WidgetClass self => (ConnectId self) -- ^ @signalId@ - the ID of a signal installed on @widget@ -> IO Bool -- ^ returns @True@ if the accelerator can be activated. widgetCanActivateAccel (ConnectId signalId self) = liftM toBool $ {# call gtk_widget_can_activate_accel #} (toWidget self) (fromIntegral signalId) #endif -- | For widgets that can be \"activated\" (buttons, menu items, etc.) this -- function activates them. Activation is what happens when you press Enter on -- a widget during key navigation. If @widget@ isn't activatable, the function -- returns @False@. -- widgetActivate :: WidgetClass self => self -> IO Bool -- ^ returns @True@ if the widget was activatable widgetActivate self = liftM toBool $ {# call widget_activate #} (toWidget self) -- | Computes the intersection of a widget's area and @area@, returning the -- intersection, and returns @Nothing@ if there was no intersection. -- widgetIntersect :: WidgetClass self => self -> Rectangle -- ^ @area@ - a rectangle -> IO (Maybe Rectangle) -- ^ returns the intersection or @Nothing@ widgetIntersect self area = with area $ \areaPtr -> alloca $ \intersectionPtr -> do hasIntersection <- {# call unsafe widget_intersect #} (toWidget self) (castPtr areaPtr) (castPtr intersectionPtr) if (toBool hasIntersection) then liftM Just $ peek intersectionPtr else return Nothing -- | Check if the widget intersects with a given area. -- widgetHasIntersection :: WidgetClass self => self -> Rectangle -- ^ @area@ - a rectangle -> IO Bool -- ^ returns @True@ if there was an intersection widgetHasIntersection self area = liftM toBool $ with area $ \areaPtr -> {# call unsafe widget_intersect #} (toWidget self) (castPtr areaPtr) (castPtr nullPtr) -- %hash d:1cab -- | Determines if the widget is the focus widget within its toplevel. (This -- does not mean that the 'widgetHasFocus' attribute is necessarily set; -- 'widgetHasFocus' will only be set if the toplevel widget additionally has -- the global input focus.) -- widgetGetIsFocus :: WidgetClass self => self -> IO Bool -- ^ returns @True@ if the widget is the focus widget. widgetGetIsFocus self = liftM toBool $ {# call unsafe widget_is_focus #} (toWidget self) -- %hash d:e1e -- | Causes @widget@ to have the keyboard focus for the 'Window' it's inside. -- @widget@ must be a focusable widget, such as a -- 'Graphics.UI.Gtk.Entry.Entry'; something like -- 'Graphics.UI.Gtk.Ornaments.Frame' won't work. (More precisely, it must have -- the 'widgetCanFocus' flag set.) -- widgetGrabFocus :: WidgetClass self => self -> IO () widgetGrabFocus self = {# call widget_grab_focus #} (toWidget self) -- %hash c:e5e9 d:412a -- | Causes @widget@ to become the default widget. @widget@ must have the -- 'canDefault' flag set. The default widget is -- activated when the user presses Enter in a window. Default widgets must be -- activatable, that is, 'widgetActivate' should affect them. -- widgetGrabDefault :: WidgetClass self => self -> IO () widgetGrabDefault self = {# call gtk_widget_grab_default #} (toWidget self) -- %hash c:4f62 d:d05a -- | Widgets can be named, which allows you to refer to them from a gtkrc -- file. You can apply a style to widgets with a particular name in the gtkrc -- file. See the documentation for gtkrc files. -- -- Note that widget names are separated by periods in paths (see -- 'widgetPath'), so names with embedded periods may cause confusion. -- widgetSetName :: (WidgetClass self, GlibString string) => self -> string -- ^ @name@ - name for the widget -> IO () widgetSetName self name = withUTFString name $ \namePtr -> {# call widget_set_name #} (toWidget self) namePtr -- | Retrieves the name of a widget. See 'widgetSetName' for the significance -- of widget names. -- widgetGetName :: (WidgetClass self, GlibString string) => self -> IO string widgetGetName self = {# call unsafe widget_get_name #} (toWidget self) >>= peekUTFString -- %hash c:25b1 d:f898 -- | Sets the sensitivity of a widget. A widget is sensitive if the user can -- interact with it. Insensitive widgets are \"grayed out\" and the user can't -- interact with them. Insensitive widgets are known as \"inactive\", -- \"disabled\", or \"ghosted\" in some other toolkits. -- widgetSetSensitive :: WidgetClass self => self -> Bool -- ^ @sensitive@ - @True@ to make the widget sensitive -> IO () widgetSetSensitive self sensitive = {# call gtk_widget_set_sensitive #} (toWidget self) (fromBool sensitive) -- bad spelling backwards compatibility definition widgetSetSensitivity :: WidgetClass self => self -> Bool -> IO () widgetSetSensitivity = widgetSetSensitive -- | Gets the widget's parent window. -- widgetGetParentWindow :: WidgetClass self => self -> IO DrawWindow widgetGetParentWindow self = makeNewGObject mkDrawWindow $ {# call gtk_widget_get_parent_window #} (toWidget self) -- | Disable event signals. -- -- * Remove events from the 'EventMask' of this widget. The event mask -- determines which events a widget will receive. Events are signals -- that return an 'Event' data type. On connecting to a such a signal, -- the event mask is automatically adjusted so that he signal is emitted. -- This function is useful to disable the reception of the signal. It -- should be called whenever all signals receiving an 'Event' -- have been disconnected. -- widgetDelEvents :: WidgetClass self => self -> [EventMask] -> IO () widgetDelEvents self events = do mask <- {#call unsafe widget_get_events#} (toWidget self) let mask' = mask .&. (complement (fromIntegral $ fromFlags events)) {#call unsafe widget_set_events#} (toWidget self) mask' -- | Enable event signals. -- -- * See 'widgetDelEvents'. -- widgetAddEvents :: WidgetClass self => self -> [EventMask] -> IO () widgetAddEvents self [] = return () -- special [] case to work around a GTK+ bug, see: -- http://bugzilla.gnome.org/show_bug.cgi?id=316702 widgetAddEvents self events = {# call unsafe widget_add_events #} (toWidget self) (fromIntegral $ fromFlags events) -- | Get enabled event signals. -- -- * See 'widgetDelEvents'. -- widgetGetEvents :: WidgetClass self => self -> IO [EventMask] widgetGetEvents self = liftM (toFlags . fromIntegral) $ {# call unsafe widget_get_events #} (toWidget self) -- %hash c:468a d:49a0 -- | Sets the event mask (see 'EventMask') for a widget. The event mask -- determines which events a widget will receive. Keep in mind that different -- widgets have different default event masks, and by changing the event mask -- you may disrupt a widget's functionality, so be careful. This function must -- be called while a widget is unrealized. Consider 'widgetAddEvents' for -- widgets that are already realized, or if you want to preserve the existing -- event mask. This function can't be used with 'NoWindow' widgets; to get -- events on those widgets, place them inside a -- 'Graphics.UI.Gtk.Misc.EventBox' and receive events on the event box. -- widgetSetEvents :: WidgetClass self => self -> [EventMask] -- ^ @events@ - event mask -> IO () widgetSetEvents self events = {# call unsafe widget_set_events #} (toWidget self) (fromIntegral $ fromFlags events) #if GTK_MAJOR_VERSION < 3 -- %hash c:4f2c d:781 -- | Sets the extension events mask to @mode@. See 'ExtensionMode' and -- 'inputSetExtensionEvents'. -- widgetSetExtensionEvents :: WidgetClass self => self -> [ExtensionMode] -> IO () widgetSetExtensionEvents self mode = {# call widget_set_extension_events #} (toWidget self) ((fromIntegral . fromFlags) mode) -- %hash c:c824 d:e611 -- | Retrieves the extension events the widget will receive; see -- 'widgetSetExtensionEvents'. -- widgetGetExtensionEvents :: WidgetClass self => self -> IO [ExtensionMode] widgetGetExtensionEvents self = liftM (toFlags . fromIntegral) $ {# call widget_get_extension_events #} (toWidget self) #endif -- %hash c:270b d:8877 -- | This function returns the topmost widget in the container hierarchy -- @widget@ is a part of. If @widget@ has no parent widgets, it will be -- returned as the topmost widget. -- widgetGetToplevel :: WidgetClass self => self -- ^ @widget@ - the widget in question -> IO Widget -- ^ returns the topmost ancestor of @widget@, or @widget@ -- itself if there's no ancestor. widgetGetToplevel self = makeNewObject mkWidget $ {# call unsafe widget_get_toplevel #} (toWidget self) -- %hash c:17bc d:f8f9 -- | Gets the first ancestor of @widget@ with type @widgetType@. For example, -- @widgetGetAncestor widget gTypeBox@ gets the first 'Box' that's -- an ancestor of @widget@. See note about checking for a toplevel -- 'Window' in the docs for 'widgetGetToplevel'. -- -- Note that unlike 'widgetIsAncestor', 'widgetGetAncestor' considers -- @widget@ to be an ancestor of itself. -- widgetGetAncestor :: WidgetClass self => self -> GType -- ^ @widgetType@ - ancestor type -> IO (Maybe Widget) -- ^ returns the ancestor widget, or @Nothing@ if not found widgetGetAncestor self widgetType = do ptr <- {# call gtk_widget_get_ancestor #} (toWidget self) widgetType if ptr==nullPtr then return Nothing else liftM Just $ makeNewObject mkWidget (return ptr) #if GTK_MAJOR_VERSION < 3 -- %hash c:bd95 d:eb94 -- | Gets the colormap that will be used to render @widget@. -- widgetGetColormap :: WidgetClass self => self -> IO Colormap -- ^ returns the colormap used by @widget@ widgetGetColormap self = makeNewGObject mkColormap $ {# call gtk_widget_get_colormap #} (toWidget self) -- %hash c:cba1 d:ffeb -- | Sets the colormap for the widget to the given value. Widget must not have -- been previously realized. This probably should only be used from an 'init' -- function (i.e. from the constructor for the widget). -- widgetSetColormap :: WidgetClass self => self -> Colormap -- ^ @colormap@ - a colormap -> IO () widgetSetColormap self colormap = {# call gtk_widget_set_colormap #} (toWidget self) colormap #endif -- %hash c:3522 d:5637 -- | Obtains the location of the mouse pointer in widget coordinates. Widget -- coordinates are a bit odd; for historical reasons, they are defined as -- 'widgetGetParentWindow' coordinates for widgets that are not 'NoWindow' widgets, -- and are relative to the widget's allocation's (x,y) for -- widgets that are 'NoWindow' widgets. -- widgetGetPointer :: WidgetClass self => self -> IO (Int, Int) -- ^ @(x, y)@ - X Y coordinate widgetGetPointer self = alloca $ \xPtr -> alloca $ \yPtr -> {# call gtk_widget_get_pointer #} (toWidget self) xPtr yPtr >> peek xPtr >>= \x -> peek yPtr >>= \y -> return (fromIntegral x, fromIntegral y) -- %hash c:499d -- | Determines whether @widget@ is somewhere inside @ancestor@, possibly with -- intermediate containers. -- widgetIsAncestor :: (WidgetClass self, WidgetClass ancestor) => self -- ^ @widget@ - the widget in question -> ancestor -- ^ @ancestor@ - another 'Widget' -> IO Bool -- ^ returns @True@ if @ancestor@ contains @widget@ as a child, -- grandchild, great grandchild, etc. widgetIsAncestor self ancestor = liftM toBool $ {# call unsafe widget_is_ancestor #} (toWidget self) (toWidget ancestor) -- %hash c:8661 -- | Translate coordinates relative to @srcWidget@'s allocation to coordinates -- relative to @destWidget@'s allocations. In order to perform this operation, -- both widgets must be realized, and must share a common toplevel. -- widgetTranslateCoordinates :: (WidgetClass self, WidgetClass destWidget) => self -- ^ @srcWidget@ - a 'Widget' -> destWidget -- ^ @destWidget@ - a 'Widget' -> Int -- ^ @srcX@ - X position relative to @srcWidget@ -> Int -- ^ @srcY@ - Y position relative to @srcWidget@ -> IO (Maybe (Int, Int)) -- ^ @Just (destX, destY)@ - X and Y position -- relative to @destWidget@. Returns @Nothing@ if -- either widget was not realized, or there was no -- common ancestor. widgetTranslateCoordinates self destWidget srcX srcY = alloca $ \destXPtr -> alloca $ \destYPtr -> do worked <- {# call gtk_widget_translate_coordinates #} (toWidget self) (toWidget destWidget) (fromIntegral srcX) (fromIntegral srcY) destXPtr destYPtr if (toBool worked) then do destX <- peek destXPtr destY <- peek destYPtr return (Just (fromIntegral destX, fromIntegral destY)) else return Nothing -- %hash c:596c d:b7e5 -- | Sets the 'Style' for a widget. You probably don't want -- to use this function; it interacts badly with themes, because themes work by -- replacing the 'Style'. Instead, use 'widgetModifyStyle'. -- widgetSetStyle :: WidgetClass self => self -> Maybe Style -- ^ @style@ - a 'Style', or @Nothing@ to remove the effect of a previous -- 'widgetSetStyle' and go back to the default style -> IO () widgetSetStyle self style = {# call gtk_widget_set_style #} (toWidget self) (fromMaybe (Style nullForeignPtr) style) -- | Retrieve the 'Style' associated with the widget. -- widgetGetStyle :: WidgetClass widget => widget -> IO Style widgetGetStyle widget = do {# call gtk_widget_ensure_style #} (toWidget widget) makeNewGObject mkStyle $ {# call gtk_widget_get_style #} (toWidget widget) #if GTK_MAJOR_VERSION < 3 -- %hash c:d5ed d:dc10 -- | Pushes @cmap@ onto a global stack of colormaps; the topmost colormap on -- the stack will be used to create all widgets. Remove @cmap@ with -- 'widgetPopColormap'. There's little reason to use this function. -- widgetPushColormap :: Colormap -- ^ @cmap@ - a 'Colormap' -> IO () widgetPushColormap cmap = {# call gtk_widget_push_colormap #} cmap -- %hash c:7300 d:2920 -- | Removes a colormap pushed with 'widgetPushColormap'. -- widgetPopColormap :: IO () widgetPopColormap = {# call gtk_widget_pop_colormap #} -- %hash c:1f73 d:590e -- | Sets the default colormap to use when creating widgets. -- 'widgetPushColormap' is a better function to use if you only want to affect -- a few widgets, rather than all widgets. -- widgetSetDefaultColormap :: Colormap -- ^ @colormap@ - a 'Colormap' -> IO () widgetSetDefaultColormap colormap = {# call gtk_widget_set_default_colormap #} colormap #endif -- %hash c:e71b d:72c2 -- | Returns the default style used by all widgets initially. -- widgetGetDefaultStyle :: IO Style -- ^ returns the default style. This 'Style' object is owned by -- Gtk and should not be modified. widgetGetDefaultStyle = makeNewGObject mkStyle $ {# call gtk_widget_get_default_style #} #if GTK_MAJOR_VERSION < 3 -- %hash c:d731 d:52bf -- | Obtains the default colormap used to create widgets. -- widgetGetDefaultColormap :: IO Colormap -- ^ returns default widget colormap widgetGetDefaultColormap = makeNewGObject mkColormap $ {# call gtk_widget_get_default_colormap #} #endif -- | Sets the reading direction on a particular widget. This direction -- controls the primary direction for widgets containing text, and also the -- direction in which the children of a container are packed. The ability to -- set the direction is present in order so that correct localization into -- languages with right-to-left reading directions can be done. Generally, -- applications will let the default reading direction present, except for -- containers where the containers are arranged in an order that is explicitly -- visual rather than logical (such as buttons for text justification). -- -- If the direction is set to 'TextDirNone', then the value set by -- 'widgetSetDefaultDirection' will be used. -- widgetSetDirection :: WidgetClass self => self -> TextDirection -> IO () widgetSetDirection self dir = {# call widget_set_direction #} (toWidget self) ((fromIntegral . fromEnum) dir) -- | Gets the reading direction for a particular widget. See -- 'widgetSetDirection'. -- widgetGetDirection :: WidgetClass self => self -> IO TextDirection widgetGetDirection self = liftM (toEnum . fromIntegral) $ {# call widget_get_direction #} (toWidget self) -- %hash c:ff9a -- | Sets the default reading direction for widgets where the direction has -- not been explicitly set by 'widgetSetDirection'. -- widgetSetDefaultDirection :: TextDirection -- ^ @dir@ - the new default direction. This cannot be -- 'TextDirNone'. -> IO () widgetSetDefaultDirection dir = {# call gtk_widget_set_default_direction #} ((fromIntegral . fromEnum) dir) -- | Obtains the current default reading direction. See -- 'widgetSetDefaultDirection'. -- widgetGetDefaultDirection :: IO TextDirection widgetGetDefaultDirection = liftM (toEnum . fromIntegral) $ {# call gtk_widget_get_default_direction #} #if GTK_MAJOR_VERSION < 3 -- %hash c:c7ba d:3a9c -- | Sets a shape for this widget's 'DrawWindow'. This allows for transparent -- windows etc., see 'windowShapeCombineMask' for more information. -- widgetShapeCombineMask :: WidgetClass self => self -> Maybe Bitmap -- ^ @shapeMask@ - shape to be added, or @Nothint@ to remove an -- existing shape. -> Int -- ^ @offsetX@ - X position of shape mask with respect to @window@. -> Int -- ^ @offsetY@ - Y position of shape mask with respect to @window@. -> IO () widgetShapeCombineMask self shapeMask offsetX offsetY = case (fromMaybe (Pixmap nullForeignPtr) shapeMask) of Pixmap fPtr -> withForeignPtr fPtr $ \bitmapPtr -> {# call gtk_widget_shape_combine_mask #} (toWidget self) (castPtr bitmapPtr) (fromIntegral offsetX) (fromIntegral offsetY) #endif #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,10,0) -- %hash c:3c29 d:68e2 -- | Sets an input shape for this widget's GDK window. This allows for windows -- which react to mouse click in a nonrectangular region, see -- 'windowInputShapeCombineMask' for more information. -- -- * Available since Gtk+ version 2.10 -- widgetInputShapeCombineMask :: WidgetClass self => self -> Maybe Bitmap -- ^ @shapeMask@ - shape to be added, or @Nothint@ to remove an -- existing shape. -> Int -- ^ @offsetX@ - X position of shape mask with respect to @window@. -> Int -- ^ @offsetY@ - Y position of shape mask with respect to @window@. -> IO () widgetInputShapeCombineMask self shapeMask offsetX offsetY = case (fromMaybe (Pixmap nullForeignPtr) shapeMask) of Pixmap fPtr -> withForeignPtr fPtr $ \bitmapPtr -> {# call gtk_widget_input_shape_combine_mask #} (toWidget self) (castPtr bitmapPtr) (fromIntegral offsetX) (fromIntegral offsetY) #endif #endif #if GTK_CHECK_VERSION(3,0,0) -- | Sets a shape for this widget’s GDK window. This allows for transparent -- windows etc., see 'drawWindowShapeCombineRegion' for more information. widgetShapeCombineRegion :: WidgetClass self => self -> Maybe Region -> IO () widgetShapeCombineRegion self region = withRegion (fromMaybe (Region nullForeignPtr) region) $ \ptrRegion -> {# call gtk_widget_shape_combine_region #} (toWidget self) (castPtr ptrRegion) -- | Sets an input shape for this widget’s GDK window. This allows for windows -- which react to mouse click in a nonrectangular region, -- see 'drawWindowInputShapeCombineRegion' for more information. widgetInputShapeCombineRegion :: WidgetClass self => self -> Maybe Region -> IO () widgetInputShapeCombineRegion self region = withRegion (fromMaybe (Region nullForeignPtr) region) $ \ptrRegion -> {# call gtk_widget_input_shape_combine_region #} (toWidget self) (castPtr ptrRegion) #endif #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,14,0) -- | Create a 'Pixmap' of the contents of the widget and its children. -- -- Works even if the widget is obscured. The depth and visual of the resulting pixmap is dependent on -- the widget being snapshot and likely differs from those of a target widget displaying the -- pixmap. The function 'pixbufGetFromDrawable' can be used to convert the pixmap to a visual -- independent representation. -- -- The snapshot area used by this function is the widget's allocation plus any extra space occupied by -- additional windows belonging to this widget (such as the arrows of a spin button). Thus, the -- resulting snapshot pixmap is possibly larger than the allocation. -- -- The resulting pixmap is shrunken to match the specified @clipRect@. The -- (x,y) coordinates of @clipRect@ are interpreted widget relative. If width or height of @clipRect@ are -- 0 or negative, the width or height of the resulting pixmap will be shrunken by the respective -- amount. For instance a @clipRect@ { +5, +5, -10, -10 } will chop off 5 pixels at each side of the -- snapshot pixmap. @clipRect@ will contain the exact widget-relative snapshot coordinates -- upon return. A @clipRect@ of { -1, -1, 0, 0 } can be used to preserve the auto-grown snapshot area -- and use @clipRect@ as a pure output parameter. -- -- The returned pixmap can be 'Nothing', if the resulting @clipArea@ was empty. widgetGetSnapshot :: WidgetClass self => self -> Rectangle -> IO (Maybe Pixmap) -- ^ returns 'Pixmap' snapshot of the widget widgetGetSnapshot widget clipRect = maybeNull (wrapNewGObject mkPixmap) $ with clipRect $ \ clipRectPtr -> {#call gtk_widget_get_snapshot #} (toWidget widget) (castPtr clipRectPtr) #endif #endif -- %hash c:7e36 d:616f -- | Obtains the full path to @widget@. The path is simply the name of a -- widget and all its parents in the container hierarchy, separated by periods. -- The name of a widget comes from 'widgetGetName'. Paths are used to apply -- styles to a widget in gtkrc configuration files. Widget names are the type -- of the widget by default (e.g. \"GtkButton\") or can be set to an -- application-specific value with 'widgetSetName'. By setting the name of a -- widget, you allow users or theme authors to apply styles to that specific -- widget in their gtkrc file. Also returns the path in reverse -- order, i.e. starting with the widget's name instead of starting with the -- name of the widget's outermost ancestor. -- widgetPath :: (WidgetClass self, GlibString string) => self -> IO (Int, string, string) -- ^ @(pathLength, path, pathReversed)@ - length -- of the path, path string and reverse path -- string widgetPath self = alloca $ \pathLengthPtr -> alloca $ \pathPtr -> alloca $ \pathReversedPtr -> {# call gtk_widget_path #} (toWidget self) pathLengthPtr pathPtr pathReversedPtr >> peek pathLengthPtr >>= \pathLength -> peek pathPtr >>= readUTFString >>= \path -> peek pathReversedPtr >>= readUTFString >>= \pathReversed -> return (fromIntegral pathLength, path, pathReversed) -- %hash c:d4a6 -- | Same as 'widgetPath', but always uses the name of a widget's type, never -- uses a custom name set with 'widgetSetName'. -- widgetClassPath :: (WidgetClass self, GlibString string) => self -> IO (Int, string, string) -- ^ @(pathLength, path, pathReversed)@ - length -- of the path, path string and reverse path -- string widgetClassPath self = alloca $ \pathLengthPtr -> alloca $ \pathPtr -> alloca $ \pathReversedPtr -> {# call gtk_widget_class_path #} (toWidget self) pathLengthPtr pathPtr pathReversedPtr >> peek pathLengthPtr >>= \pathLength -> peek pathPtr >>= readUTFString >>= \path -> peek pathReversedPtr >>= readUTFString >>= \pathReversed -> return (fromIntegral pathLength, path, pathReversed) -- %hash c:769e -- | Obtains the composite name of a widget. -- widgetGetCompositeName :: (WidgetClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the composite name of @widget@, or -- @Nothing@ if @widget@ is not a composite child. widgetGetCompositeName self = {# call gtk_widget_get_composite_name #} (toWidget self) >>= maybePeek peekUTFString #if GTK_CHECK_VERSION(3,0,0) -- | Sets the background color to use for a widget. -- -- All other style values are left untouched. See 'widgetOverrideColor'. widgetOverrideBackgroundColor :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the background color. -> Maybe Color -- ^ @color@ - the color to assign, or Nothing to undo the -- effect of previous calls to 'widgetOverrideBackgroundColor' -> IO () widgetOverrideBackgroundColor self state color = maybeWith with color $ \colorPtr -> {# call widget_override_background_color #} (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) -- | Sets the color to use for a widget. -- -- All other style values are left untouched. -- -- This function does not act recursively. Setting the color of a container -- does not affect its children. Note that some widgets that you may not think -- of as containers, for instance 'Button's, are actually containers. -- -- This API is mostly meant as a quick way for applications to change a -- widget appearance. If you are developing a widgets library and intend this -- change to be themeable, it is better done by setting meaningful CSS classes -- and regions in your widget/container implementation through -- 'styleContextAddClass' and 'styleContextAddRegion'. -- -- This way, your widget library can install a 'CssProvider' with the -- GTK_STYLE_PROVIDER_PRIORITY_FALLBACK priority in order to provide a default -- styling for those widgets that need so, and this theming may fully overridden -- by the user’s theme. -- -- Note that for complex widgets this may bring in undesired results (such as -- uniform background color everywhere), in these cases it is better to fully -- style such widgets through a CssProvider with the -- GTK_STYLE_PROVIDER_PRIORITY_APPLICATION priority. widgetOverrideColor :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the color. -> Maybe Color -- ^ @color@ - the color to assign, or @Nothing@ to undo the -- effect of previous calls to 'widgetOverrideColor' -> IO () widgetOverrideColor self state color = maybeWith with color $ \colorPtr -> {# call widget_override_color #} (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) -- | Sets the font to use for a widget. All other style values are left untouched. -- See 'widgetOverrideColor'. widgetOverrideFont :: WidgetClass self => self -> Maybe FontDescription -- ^ @fontDesc@ - the font description to use, or -- @Nothing@ to undo the effect of previous calls to -- 'widgetOverrideFont'. -> IO () widgetOverrideFont self fontDesc = {# call widget_override_font #} (toWidget self) (fromMaybe (FontDescription nullForeignPtr) fontDesc) -- | Sets the symbolic color to use for a widget. -- -- All other style values are left untouched. See 'widgetOverrideColor'. widgetOverrideSymbolicColor :: (WidgetClass self, GlibString string) => self -> string -- ^ @name@ - the name of the symbolic color to modify. -> Maybe Color -- ^ @color@ - the color to assign, or @Nothing@ to undo the -- effect of previous calls to 'widgetOverrideSymbolicColor' -> IO () widgetOverrideSymbolicColor self name color = withUTFString name $ \namePtr -> maybeWith with color $ \colorPtr -> {# call widget_override_symbolic_color #} (toWidget self) namePtr (castPtr colorPtr) -- | Sets the cursor color to use in a widget, overriding the cursor-color -- and secondary-cursor-color style properties. All other style values are -- left untouched. See also 'widgetModifyStyle'. -- -- Note that the alpha values will be ignored. widgetOverrideCursor :: WidgetClass self => self -> Maybe Color -- ^ @cursor@ - the color to use for primary cursor, or @Nothing@ -- to undo the effect of previous calls to of 'widgetOverrideCursor'. -> Maybe Color -- ^ @secondaryCursor@ - the color to use for secondary cursor, or @Nothing@ -- to undo the effect of previous calls to of 'widgetOverrideCursor'. -> IO () widgetOverrideCursor self cursor secondaryCursor = maybeWith with cursor $ \cursorPtr -> maybeWith with secondaryCursor $ \secondaryCursorPtr -> {# call widget_override_cursor #} (toWidget self) (castPtr cursorPtr) (castPtr secondaryCursorPtr) #endif -- | Modifies style values on the widget. Modifications made using this -- technique take precedence over style values set via an RC file, however, -- they will be overridden if a style is explicitly set on the widget using -- 'widgetSetStyle'. The 'RcStyle' structure is designed so each field can -- either be set or unset, so it is possible, using this function, to modify -- some style values and leave the others unchanged. -- -- Note that modifications made with this function are not cumulative with -- previous calls to 'widgetModifyStyle' or with such functions as -- 'widgetModifyFg'. If you wish to retain previous values, you must first call -- 'widgetGetModifierStyle', make your modifications to the returned style, -- then call 'widgetModifyStyle' with that style. On the other hand, if you -- first call 'widgetModifyStyle', subsequent calls to such functions -- 'widgetModifyFg' will have a cumulative effect with the initial -- modifications. -- widgetModifyStyle :: (WidgetClass self, RcStyleClass style) => self -> style -- ^ @style@ - the 'RcStyle' holding the style modifications -> IO () widgetModifyStyle self style = {# call gtk_widget_modify_style #} (toWidget self) (toRcStyle style) -- | Returns the current modifier style for the widget. (As set by -- 'widgetModifyStyle'.) If no style has previously set, a new 'RcStyle' will -- be created with all values unset, and set as the modifier style for the -- widget. If you make changes to this rc style, you must call -- 'widgetModifyStyle', passing in the returned rc style, to make sure that -- your changes take effect. -- -- Caution: passing the style back to 'widgetModifyStyle' will normally end -- up destroying it, because 'widgetModifyStyle' copies the passed-in style and -- sets the copy as the new modifier style, thus dropping any reference to the -- old modifier styl e. Add a reference to the modifier style if you want to -- keep it alive. -- widgetGetModifierStyle :: WidgetClass self => self -> IO RcStyle widgetGetModifierStyle self = makeNewGObject mkRcStyle $ {# call gtk_widget_get_modifier_style #} (toWidget self) -- %hash c:5550 -- | Sets the foreground color for a widget in a particular state. All other -- style values are left untouched. See also 'widgetModifyStyle'. -- widgetModifyFg :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the foreground color. -> Color -- ^ @color@ - the color to assign (does not need to be -- allocated) -> IO () widgetModifyFg self state color = with color $ \colorPtr -> {# call gtk_widget_modify_fg #} (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) -- | Restores the foreground color for a widget in a particular state. This -- undoes the effects of previous calls to `widgetModifyFg'. -- widgetRestoreFg :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to restore the foreground color. -> IO () widgetRestoreFg self state = {# call gtk_widget_modify_fg #} (toWidget self) ((fromIntegral . fromEnum) state) nullPtr -- %hash c:2c5 -- | Sets the background color for a widget in a particular state. All other -- style values are left untouched. See also 'widgetModifyStyle'. -- -- Note that \"no window\" widgets (which have the 'NoWindow' flag set) draw -- on their parent container's window and thus may not draw any background -- themselves. This is the case for e.g. 'Label'. To modify the background of -- such widgets, you have to set the background color on their parent; if you -- want to set the background of a rectangular area around a label, try placing -- the label in a 'EventBox' widget and setting the background color on that. -- widgetModifyBg :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the background color. -> Color -- ^ @color@ - the color to assign (does not need to be -- allocated). -> IO () widgetModifyBg self state color = with color $ \colorPtr -> {# call gtk_widget_modify_bg #} (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) -- | Restores the background color for a widget in a particular state. This -- undoes the effects of previous calls to `widgetModifyBg'. -- widgetRestoreBg :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to restore the background color. -> IO () widgetRestoreBg self state = {# call gtk_widget_modify_bg #} (toWidget self) ((fromIntegral . fromEnum) state) nullPtr -- %hash c:d2ba -- | Sets the text color for a widget in a particular state. All other style -- values are left untouched. The text color is the foreground color used along -- with the base color (see 'widgetModifyBase') for widgets such as 'Entry' and -- 'TextView'. See also 'widgetModifyStyle'. -- widgetModifyText :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the text color. -> Color -- ^ @color@ - the color to assign (does not need to be -- allocated). -> IO () widgetModifyText self state color = with color $ \colorPtr -> {# call gtk_widget_modify_text #} (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) -- | Restores the text color for a widget in a particular state. This -- undoes the effects of previous calls to `widgetModifyText'. -- widgetRestoreText :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to restore the text color. -> IO () widgetRestoreText self state = {# call gtk_widget_modify_text #} (toWidget self) ((fromIntegral . fromEnum) state) nullPtr -- %hash c:ac08 -- | Sets the base color for a widget in a particular state. All other style -- values are left untouched. The base color is the background color used along -- with the text color (see 'widgetModifyText') for widgets such as 'Entry' and -- 'TextView'. See also 'widgetModifyStyle'. -- -- Note that \"no window\" widgets (which have the 'NoWindow' flag set) draw -- on their parent container's window and thus may not draw any background -- themselves. This is the case for e.g. 'Label'. To modify the background of -- such widgets, you have to set the base color on their parent; if you want to -- set the background of a rectangular area around a label, try placing the -- label in a 'EventBox' widget and setting the base color on that. -- widgetModifyBase :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to set the base color. -> Color -- ^ @color@ - the color to assign (does not need to be -- allocated). -> IO () widgetModifyBase self state color = with color $ \colorPtr -> {# call gtk_widget_modify_base #} (toWidget self) ((fromIntegral . fromEnum) state) (castPtr colorPtr) -- | Restores the base color for a widget in a particular state. This undoes -- the effects of previous calls to widgetModifyBase. -- widgetRestoreBase :: WidgetClass self => self -> StateType -- ^ @state@ - the state for which to restore the base color. -> IO () widgetRestoreBase self state = {# call gtk_widget_modify_base #} (toWidget self) ((fromIntegral . fromEnum) state) nullPtr -- %hash c:38d7 -- | Sets the font to use for a widget. All other style values are left -- untouched. See also 'widgetModifyStyle'. -- widgetModifyFont :: WidgetClass self => self -> Maybe FontDescription -- ^ @fontDesc@ - the font description to use, or -- @Nothing@ to undo the effect of previous calls to -- 'widgetModifyFont'. -> IO () widgetModifyFont self fontDesc = {# call gtk_widget_modify_font #} (toWidget self) (fromMaybe (FontDescription nullForeignPtr) fontDesc) -- | Creates a new 'PangoContext' with the appropriate colormap, font description, -- and base direction for drawing text for this widget. See also -- 'widgetGetPangoContext'. -- widgetCreatePangoContext :: WidgetClass self => self -> IO PangoContext -- ^ returns the new 'PangoContext' widgetCreatePangoContext self = wrapNewGObject mkPangoContext $ {# call gtk_widget_create_pango_context #} (toWidget self) -- | Gets a 'PangoContext' with the appropriate font description and base -- direction for this widget. Unlike the context returned by -- 'widgetCreatePangoContext', this context is owned by the widget (it can be -- used until the screen for the widget changes or the widget is removed from -- its toplevel), and will be updated to match any changes to the widget's -- attributes. -- -- If you create and keep a 'PangoLayout' using this context, you must deal -- with changes to the context by calling -- 'layoutContextChanged' on the layout -- in response to the 'onStyleChanged' and 'onDirectionChanged' signals for the -- widget. -- widgetGetPangoContext :: WidgetClass self => self -> IO PangoContext -- ^ returns the 'PangoContext' for the widget. widgetGetPangoContext self = makeNewGObject mkPangoContext $ {# call gtk_widget_get_pango_context #} (toWidget self) -- | Prepare text for display. -- -- The 'PangoLayout' represents the rendered text. It can be shown on screen -- by calling 'drawLayout'. -- -- The returned 'PangoLayout' shares the same font information ('PangoContext') as this -- widget. If this information changes, the 'PangoLayout' should change. The -- following code ensures that the displayed text always reflects the widget's -- settings: -- -- > l <- widgetCreateLayout w "My Text." -- > let update = do -- > layoutContextChanged l -- > -- update the Drawables which show this layout -- > w `onDirectionChanged` update -- > w `onStyleChanged` update -- widgetCreateLayout :: (WidgetClass self, GlibString string) => self -> string -- ^ @text@ - text to set on the layout -> IO PangoLayout widgetCreateLayout self text = do pl <- wrapNewGObject mkPangoLayoutRaw $ withUTFString text $ \textPtr -> {# call unsafe widget_create_pango_layout #} (toWidget self) textPtr ps <- makeNewPangoString text psRef <- newIORef ps return (PangoLayout psRef pl) -- %hash c:cee d:1d29 -- | A convenience function that uses the theme engine and RC file settings -- for @widget@ to look up the stock icon and render it to a -- 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf'. -- The icon should be one of the stock id constants such as -- 'Graphics.UI.Gtk.General.StockItems.stockOpen'. @size@ should be a -- size such as 'Graphics.UI.Gtk.General.IconFactory.IconSizeMenu'. -- @detail@ should be a string that identifies the -- widget or code doing the rendering, so that theme engines can special-case -- rendering for that widget or code. -- -- The pixels in the returned 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf' are -- shared with the rest of the -- application and should not be modified. -- widgetRenderIcon :: (WidgetClass self, GlibString string) => self -> string -- ^ @stockId@ - a stock ID -> IconSize -- ^ @size@ - a stock size -> string -- ^ @detail@ - render detail to pass to theme engine -> IO (Maybe Pixbuf) -- ^ returns a new pixbuf, or @Nothing@ if the stock ID -- wasn't known widgetRenderIcon self stockId size detail = maybeNull (wrapNewGObject mkPixbuf) $ withUTFString detail $ \detailPtr -> withUTFString stockId $ \stockIdPtr -> {# call gtk_widget_render_icon #} (toWidget self) stockIdPtr ((fromIntegral . fromEnum) size) detailPtr -- %hash c:62f d:1863 -- | Invalidates the rectangular area of @widget@ defined by @x@, @y@, @width@ -- and @height@ by calling -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowInvalidateRect' on the widget's -- 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' and all its child windows. Once -- the main loop becomes idle (after the current batch of events has been -- processed, roughly), the window will receive expose events for the union of -- all regions that have been invalidated. -- -- Normally you would only use this function in widget implementations. In -- particular, you might use it, or -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowInvalidateRect' directly, to -- schedule a redraw of a 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawingArea' or some -- portion thereof. -- -- Frequently you can just call -- 'Graphics.UI.Gtk.Gdk.DrawWindow.windowInvalidateRect' or -- 'Graphics.UI.Gtk.Gdk.DrawWindow.windowInvalidateRegion' instead of this -- function. Those functions will invalidate only a single window, instead of -- the widget and all its children. -- -- The advantage of adding to the invalidated region compared to simply -- drawing immediately is efficiency; using an invalid region ensures that you -- only have to redraw one time. -- widgetQueueDrawArea :: WidgetClass self => self -> Int -- ^ @x@ - x coordinate of upper-left corner of rectangle to redraw -> Int -- ^ @y@ - y coordinate of upper-left corner of rectangle to redraw -> Int -- ^ @width@ - width of region to draw -> Int -- ^ @height@ - height of region to draw -> IO () widgetQueueDrawArea self x y width height = {# call gtk_widget_queue_draw_area #} (toWidget self) (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) #if GTK_CHECK_VERSION(3,0,0) -- | Invalidates the area of widget defined by @region@ by calling -- 'drawWindowInvalidateRegion' on the widget’s window and all its child -- windows. Once the main loop becomes idle (after the current batch of -- events has been processed, roughly), the window will receive expose events -- for the union of all regions that have been invalidated. -- -- Normally you would only use this function in widget implementations. You -- might also use it to schedule a redraw of a DrawingArea or some portion -- thereof. widgetQueueDrawRegion :: WidgetClass self => self -> Region -> IO () widgetQueueDrawRegion self region = withRegion region $ \regionPtr -> {# call gtk_widget_queue_draw_region #} (toWidget self) (castPtr regionPtr) #endif #if GTK_MAJOR_VERSION < 3 -- %hash c:5ffb d:3e1a -- | Recursively resets the shape on this widget and its descendants. -- widgetResetShapes :: WidgetClass self => self -> IO () widgetResetShapes self = {# call gtk_widget_reset_shapes #} (toWidget self) #endif -- | Sets whether the application intends to draw on the widget in response -- to an 'onExpose' signal. -- -- * This is a hint to the widget and does not affect the behavior of the -- GTK+ core; many widgets ignore this flag entirely. For widgets that do -- pay attention to the flag, such as 'EventBox' and 'Window', the effect -- is to suppress default themed drawing of the widget's background. -- (Children of the widget will still be drawn.) The application is then -- entirely responsible for drawing the widget background. -- widgetSetAppPaintable :: WidgetClass self => self -> Bool -- ^ @appPaintable@ - @True@ if the application will paint on the -- widget -> IO () widgetSetAppPaintable self appPaintable = {# call widget_set_app_paintable #} (toWidget self) (fromBool appPaintable) -- %hash c:89b2 d:e14d -- | Widgets are double buffered by default; you can use this function to turn -- off the buffering. \"Double buffered\" simply means that -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowBeginPaintRegion' and -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowEndPaint' are called automatically -- around expose events sent to the widget. -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowBeginPaintRegion' diverts all -- drawing to a widget's window to an offscreen buffer, and -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowEndPaint' -- draws the buffer to the screen. The result is that users see the window -- update in one smooth step, and don't see individual graphics primitives -- being rendered. -- -- In very simple terms, double buffered widgets don't flicker, so you would -- only use this function to turn off double buffering if you had special needs -- and really knew what you were doing. -- -- Note: if you turn off double-buffering, you have to handle expose events, -- since even the clearing to the background color or pixmap will not happen -- automatically (as it is done in -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowBeginPaint'). -- widgetSetDoubleBuffered :: WidgetClass self => self -> Bool -- ^ @doubleBuffered@ - @True@ to double-buffer a widget -> IO () widgetSetDoubleBuffered self doubleBuffered = {# call gtk_widget_set_double_buffered #} (toWidget self) (fromBool doubleBuffered) -- %hash c:d61 d:ac24 -- | Sets whether the entire widget is queued for drawing when its size -- allocation changes. By default, this setting is @True@ and the entire widget -- is redrawn on every size change. If your widget leaves the upper left -- unchanged when made bigger, turning this setting on will improve -- performance. -- -- Note that for \"no window\" widgets setting this flag to @False@ turns off -- all allocation on resizing: the widget will not even redraw if its position -- changes; this is to allow containers that don't draw anything to avoid -- excess invalidations. If you set this flag on a \"no window\" widget that -- /does/ draw its window, you are responsible for invalidating both -- the old and new allocation of the widget when the widget is moved and -- responsible for invalidating regions newly when the widget increases size. -- widgetSetRedrawOnAllocate :: WidgetClass self => self -> Bool -- ^ @redrawOnAllocate@ - if @True@, the entire widget will be -- redrawn when it is allocated to a new size. Otherwise, only the -- new portion of the widget will be redrawn. -> IO () widgetSetRedrawOnAllocate self redrawOnAllocate = {# call gtk_widget_set_redraw_on_allocate #} (toWidget self) (fromBool redrawOnAllocate) -- | Sets a widgets composite name. A child widget of a container is -- composite if it serves as an internal widget and, thus, is not -- added by the user. -- widgetSetCompositeName :: (WidgetClass self, GlibString string) => self -> string -- ^ @name@ - the name to set. -> IO () widgetSetCompositeName self name = withUTFString name $ \namePtr -> {# call gtk_widget_set_composite_name #} (toWidget self) namePtr -- | Emits the “mnemonic-activate†signal. -- -- The default handler for this signal activates the widget if groupCycling -- is @False@, and just grabs the focus if @groupCycling@ is @True@. widgetMnemonicActivate :: WidgetClass self => self -> Bool -> IO Bool widgetMnemonicActivate self groupCycling = liftM toBool $ {# call widget_mnemonic_activate #} (toWidget self) (fromBool groupCycling) #if GTK_MAJOR_VERSION < 3 -- %hash c:5c58 d:6895 -- | For widgets that support scrolling, sets the scroll adjustments and -- returns @True@. For widgets that don't support scrolling, does nothing and -- returns @False@. Widgets that don't support scrolling can be scrolled by -- placing them in a 'Viewport', which does support scrolling. -- -- Removed in Gtk3. widgetSetScrollAdjustments :: WidgetClass self => self -> Maybe Adjustment -- ^ @hadjustment@ - an adjustment for horizontal scrolling, or -- @Nothing@ -> Maybe Adjustment -- ^ @vadjustment@ - an adjustment for vertical scrolling, or -- @Nothing@ -> IO Bool -- ^ returns @True@ if the widget supports scrolling widgetSetScrollAdjustments self hadjustment vadjustment = liftM toBool $ {# call gtk_widget_set_scroll_adjustments #} (toWidget self) (fromMaybe (Adjustment nullForeignPtr) hadjustment) (fromMaybe (Adjustment nullForeignPtr) vadjustment) #endif #if GTK_MAJOR_VERSION < 3 -- | Computes the intersection of a widget's area and @region@, returning -- the intersection. The result may be empty, use -- 'Graphics.UI.Gtk.Gdk.Region.regionEmpty' to check. -- widgetRegionIntersect :: WidgetClass self => self -> Region -- ^ @region@ - a 'Region' in the same coordinate system as the -- widget's allocation. That is, relative to the widget's -- 'DrawWindow' for 'NoWindow' widgets; relative to the parent -- 'DrawWindow' of the widget's 'DrawWindow' for widgets with -- their own 'DrawWindow'. -> IO Region -- ^ returns A region holding the intersection of the widget and -- @region@. The coordinates of the return value are relative to -- the widget's 'DrawWindow', if it has one, otherwise -- it is relative to the parent's 'DrawWindow'. widgetRegionIntersect self region = do intersectionPtr <- {# call gtk_widget_region_intersect #} (toWidget self) region makeNewRegion intersectionPtr #endif -- %hash c:3c94 d:cdb6 -- | Returns the accessible object that describes the widget to an assistive -- technology. -- -- If no accessibility library is loaded (i.e. no ATK implementation library -- is loaded via GTK_MODULES or via another application library, such as -- libgnome), then this 'Object' instance may be a no-op. Likewise, if no -- class-specific 'Object' implementation is available for the widget instance -- in question, it will inherit an 'Object' implementation from the first -- ancestor class for which such an implementation is defined. -- -- The documentation of the ATK library contains more information about -- accessible objects and their uses. -- -- Returns a GObject in Gtk3. widgetGetAccessible :: WidgetClass self => self #if GTK_MAJOR_VERSION < 3 -> IO Object -- ^ returns the 'Object' associated with @widget@ #else -> IO GObject -- ^ returns the 'GObject' associated with @widget@ #endif widgetGetAccessible self = #if GTK_MAJOR_VERSION < 3 makeNewGObject mkObject $ #else makeNewGObject mkGObject $ #endif liftM castPtr $ {# call gtk_widget_get_accessible #} (toWidget self) -- %hash c:713d d:c4fc -- | This function is used by custom widget implementations; if you\'re -- writing an app, you\'d use 'widgetGrabFocus' to move the focus to a -- particular widget, and 'containerSetFocusChain' to change the focus tab -- order. So you may want to investigate those functions instead. -- -- The \"focus\" default handler for a widget should return @True@ if moving -- in @direction@ left the focus on a focusable location inside that widget, -- and @False@ if moving in @direction@ moved the focus outside the widget. If -- returning @True@, widgets normally call 'widgetGrabFocus' to place the focus -- accordingly; if returning @False@, they don't modify the current focus -- location. -- widgetChildFocus :: WidgetClass self => self -> DirectionType -- ^ @direction@ - direction of focus movement -> IO Bool -- ^ returns @True@ if focus ended up inside @widget@ widgetChildFocus self direction = liftM toBool $ {# call gtk_widget_child_focus #} (toWidget self) ((fromIntegral . fromEnum) direction) -- %hash c:de20 d:5300 -- | Gets the value set with 'widgetSetChildVisible'. If you feel a need to -- use this function, your code probably needs reorganization. -- -- This function is only useful for container implementations and never -- should be called by an application. -- widgetGetChildVisible :: WidgetClass self => self -> IO Bool -- ^ returns @True@ if the widget is mapped with the parent. widgetGetChildVisible self = liftM toBool $ {# call gtk_widget_get_child_visible #} (toWidget self) -- %hash c:9320 d:367 -- | Returns the parent container of @widget@. -- -- * Returns the parent container of @widget@ if it has one. -- widgetGetParent :: WidgetClass self => self -> IO (Maybe Widget) widgetGetParent self = do parentPtr <- {# call gtk_widget_get_parent #} (toWidget self) if parentPtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkWidget (return parentPtr) -- %hash c:85e3 d:a962 -- | Gets the settings object holding the settings (global property settings, -- RC file information, etc) used for this widget. -- -- Note that this function can only be called when the 'Widget' is attached -- to a toplevel, since the settings object is specific to a particular -- 'Screen'. -- widgetGetSettings :: WidgetClass self => self -> IO Settings -- ^ returns the relevant 'Settings' object widgetGetSettings self = makeNewGObject mkSettings $ {# call gtk_widget_get_settings #} (toWidget self) #if GTK_CHECK_VERSION(2,2,0) -- | Returns the clipboard object for the given selection to -- be used with widget. widget must have a 'Display' -- associated with it, so must be attached to a toplevel -- window. widgetGetClipboard :: WidgetClass self => self -> SelectionTag -- ^ @selection@ a 'Atom' which identifies the clipboard -- to use. 'selectionClipboard' gives the -- default clipboard. Another common value -- is 'selectionPrimary', which gives -- the primary X selection. -> IO Clipboard -- ^ returns the appropriate clipboard object. If no -- clipboard already exists, a new one will -- be created. widgetGetClipboard self (Atom tagPtr) = makeNewGObject mkClipboard $ {#call gtk_widget_get_clipboard #} (toWidget self) tagPtr -- %hash c:45ed d:52ef -- | Get the 'Display' for the toplevel window associated with this widget. -- This function can only be called after the widget has been added to a widget -- hierarchy with a 'Window' at the top. -- -- In general, you should only create display specific resources when a -- widget has been realized, and you should free those resources when the -- widget is unrealized. -- -- * Available since Gtk+ version 2.2 -- widgetGetDisplay :: WidgetClass self => self -> IO Display -- ^ returns the 'Display' for the toplevel for this widget. widgetGetDisplay self = makeNewGObject mkDisplay $ {# call gtk_widget_get_display #} (toWidget self) -- %hash c:8e4e d:252b -- | Get the root window where this widget is located. This function can only -- be called after the widget has been added to a widget hierarchy with -- 'Window' at the top. -- -- The root window is useful for such purposes as creating a popup -- 'DrawWindow' associated with the window. In general, you should only create -- display specific resources when a widget has been realized, and you should -- free those resources when the widget is unrealized. -- -- * Available since Gtk+ version 2.2 -- widgetGetRootWindow :: WidgetClass self => self -> IO DrawWindow -- ^ returns the 'DrawWindow' root window for the toplevel -- for this widget. widgetGetRootWindow self = makeNewGObject mkDrawWindow $ {# call gtk_widget_get_root_window #} (toWidget self) -- %hash c:b929 d:67f0 -- | Get the 'Screen' from the toplevel window associated with this widget. -- This function can only be called after the widget has been added to a widget -- hierarchy with a 'Window' at the top. -- -- In general, you should only create screen specific resources when a -- widget has been realized, and you should free those resources when the -- widget is unrealized. -- -- * Available since Gtk+ version 2.2 -- widgetGetScreen :: WidgetClass self => self -> IO Screen -- ^ returns the 'Screen' for the toplevel for this widget. widgetGetScreen self = makeNewGObject mkScreen $ {# call gtk_widget_get_screen #} (toWidget self) -- %hash c:4fab d:aae2 -- | Checks whether there is a 'Screen' is associated with this widget. All -- toplevel widgets have an associated screen, and all widgets added into a -- hierarchy with a toplevel window at the top. -- -- * Available since Gtk+ version 2.2 -- widgetHasScreen :: WidgetClass self => self -> IO Bool -- ^ returns @True@ if there is a 'Screen' associated with the -- widget. widgetHasScreen self = liftM toBool $ {# call gtk_widget_has_screen #} (toWidget self) #endif -- %hash c:dabc d:8275 -- | Gets the size request that was explicitly set for the widget using -- 'widgetSetSizeRequest'. A value of -1 for @width@ or @height@ -- indicates that that dimension has not been set explicitly and the natural -- requisition of the widget will be used instead. See 'widgetSetSizeRequest'. -- To get the size a widget will actually use, call 'widgetSizeRequest' instead -- of this function. -- widgetGetSizeRequest :: WidgetClass self => self -> IO (Int, Int) -- ^ @(width, height)@ widgetGetSizeRequest self = alloca $ \widthPtr -> alloca $ \heightPtr -> do {# call gtk_widget_get_size_request #} (toWidget self) widthPtr heightPtr width <- peek widthPtr height <- peek heightPtr return (fromIntegral width, fromIntegral height) #if GTK_CHECK_VERSION(3,0,0) -- | Retrieves the minimum and natural size of a widget, taking into account the -- widget’s preference for height-for-width management. -- -- This is used to retrieve a suitable size by container widgets which do not -- impose any restrictions on the child placement. It can be used to deduce -- toplevel window and menu sizes as well as child widgets in free-form containers -- such as GtkLayout. -- -- Handle with care. Note that the natural height of a height-for-width widget -- will generally be a smaller size than the minimum height, since the required -- height for the natural width is generally smaller than the required height for -- the minimum width. -- -- Use gtk_widget_get_preferred_height_and_baseline_for_width() if you want -- to support baseline alignment. -- -- * Available since Gtk+ version 3.0 -- widgetGetPreferredSize :: WidgetClass self => self -> IO (Requisition, Requisition) -- ^ @(minimumSize, naturalSize)@ widgetGetPreferredSize self = alloca $ \minReqPtr -> alloca $ \natReqPtr -> do {#call gtk_widget_get_preferred_size #} (toWidget self) (castPtr minReqPtr) (castPtr natReqPtr) min <- peek minReqPtr nat <- peek natReqPtr return (min, nat) #endif -- %hash c:546d d:3c7f -- | Sets whether @widget@ should be mapped along with its when its parent is -- mapped and @widget@ has been shown with 'widgetShow'. -- -- The child visibility can be set for widget before it is added to a -- container with 'widgetSetParent', to avoid mapping children unnecessary -- before immediately unmapping them. However it will be reset to its default -- state of @True@ when the widget is removed from a container. -- -- Note that changing the child visibility of a widget does not queue a -- resize on the widget. Most of the time, the size of a widget is computed -- from all visible children, whether or not they are mapped. If this is not -- the case, the container can queue a resize itself. -- -- This function is only useful for container implementations and never -- should be called by an application. -- widgetSetChildVisible :: WidgetClass self => self -> Bool -- ^ @isVisible@ - if @True@, @widget@ should be mapped along with -- its parent. -> IO () widgetSetChildVisible self isVisible = {# call gtk_widget_set_child_visible #} (toWidget self) (fromBool isVisible) -- | Sets the minimum size of a widget; that is, the widget's size request -- will be @width@ by @height@. You can use this function to force a widget to -- be either larger or smaller than it normally would be. -- -- In most cases, 'Graphics.UI.Gtk.Windows.Window.windowSetDefaultSize' -- is a better choice for toplevel -- windows than this function; setting the default size will still allow users -- to shrink the window. Setting the size request will force them to leave the -- window at least as large as the size request. When dealing with window -- sizes, 'Graphics.UI.Gtk.Windows.Window.windowSetGeometryHints' can be a -- useful function as well. -- -- Note the inherent danger of setting any fixed size - themes, translations -- into other languages, different fonts, and user action can all change the -- appropriate size for a given widget. So, it's basically impossible to -- hardcode a size that will always be correct. -- -- The size request of a widget is the smallest size a widget can accept -- while still functioning well and drawing itself correctly. However in some -- strange cases a widget may be allocated less than its requested size, and in -- many cases a widget may be allocated more space than it requested. -- -- If the size request in a given direction is -1 (unset), then the -- \"natural\" size request of the widget will be used instead. -- -- Widgets can't actually be allocated a size less than 1 by 1, but you can -- pass 0,0 to this function to mean \"as small as possible.\" -- widgetSetSizeRequest :: WidgetClass self => self -> Int -- ^ @width@ - width @widget@ should request, or -1 to unset -> Int -- ^ @height@ - height @widget@ should request, or -1 to unset -> IO () widgetSetSizeRequest self width height = {# call widget_set_size_request #} (toWidget self) (fromIntegral width) (fromIntegral height) #if GTK_CHECK_VERSION(2,4,0) -- %hash c:83c3 d:e6f1 -- | Sets the 'noShowAll' property, which determines whether calls to -- 'widgetShowAll' and 'widgetHideAll' will affect this widget. -- -- This is mostly for use in constructing widget hierarchies with externally -- controlled visibility, see 'UIManager'. -- -- * Available since Gtk+ version 2.4 -- widgetSetNoShowAll :: WidgetClass self => self -> Bool -- ^ @noShowAll@ - the new value for the 'noShowAll' property -> IO () widgetSetNoShowAll self noShowAll = {# call gtk_widget_set_no_show_all #} (toWidget self) (fromBool noShowAll) -- %hash c:218d d:e07e -- | Returns the current value of the 'noShowAll' property, which -- determines whether calls to 'widgetShowAll' and 'widgetHideAll' will affect -- this widget. -- -- * Available since Gtk+ version 2.4 -- widgetGetNoShowAll :: WidgetClass self => self -> IO Bool -- ^ returns the current value of the \"no_show_all\" property. widgetGetNoShowAll self = liftM toBool $ {# call gtk_widget_get_no_show_all #} (toWidget self) -- %hash c:205b d:c518 -- | Returns a list of the widgets, normally labels, for which -- this widget is a the target of a mnemonic (see for example, -- 'labelSetMnemonicWidget'). -- -- * Available since Gtk+ version 2.4 -- widgetListMnemonicLabels :: WidgetClass self => self -> IO [Widget] -- ^ returns the list of mnemonic labels widgetListMnemonicLabels self = {# call gtk_widget_list_mnemonic_labels #} (toWidget self) >>= fromGList >>= mapM (makeNewGObject mkWidget . return) -- %hash c:eb76 d:28a2 -- | Adds a widget to the list of mnemonic labels for this widget. (See -- 'widgetListMnemonicLabels'). Note the list of mnemonic labels for the widget -- is cleared when the widget is destroyed, so the caller must make sure to -- update its internal state at this point as well, by using a connection to -- the 'destroy' signal or a weak notifier. -- -- * Available since Gtk+ version 2.4 -- widgetAddMnemonicLabel :: (WidgetClass self, WidgetClass label) => self -> label -- ^ @label@ - a 'Widget' that acts as a mnemonic label for -- @widget@. -> IO () widgetAddMnemonicLabel self label = {# call gtk_widget_add_mnemonic_label #} (toWidget self) (toWidget label) -- %hash c:7831 d:d10b -- | Removes a widget from the list of mnemonic labels for this widget. (See -- 'widgetListMnemonicLabels'). The widget must have previously been added to -- the list with 'widgetAddMnemonicLabel'. -- -- * Available since Gtk+ version 2.4 -- widgetRemoveMnemonicLabel :: (WidgetClass self, WidgetClass label) => self -> label -- ^ @label@ - a 'Widget' that was previously set as a mnemnic label -- for @widget@ with 'widgetAddMnemonicLabel'. -> IO () widgetRemoveMnemonicLabel self label = {# call gtk_widget_remove_mnemonic_label #} (toWidget self) (toWidget label) #if GTK_CHECK_VERSION(2,10,0) #if GTK_MAJOR_VERSION < 3 -- %hash c:5c70 d:cbf9 -- | Returns the 'Action' that @widget@ is a proxy for. See also -- 'actionGetProxies'. -- -- * Available since Gtk+ version 2.10 -- -- Removed in Gtk3. widgetGetAction :: WidgetClass self => self -> IO (Maybe Action) -- ^ returns the action that a widget is a proxy for, or -- @Nothing@, if it is not attached to an action. widgetGetAction self = do ptr <- {# call gtk_widget_get_action #} (toWidget self) if ptr==nullPtr then return Nothing else liftM Just $ makeNewGObject mkAction (return ptr) #endif -- %hash c:7ea0 d:2560 -- | Whether @widget@ can rely on having its alpha channel drawn correctly. On -- X11 this function returns whether a compositing manager is running for -- @widget@'s screen -- -- * Available since Gtk+ version 2.10 -- widgetIsComposited :: WidgetClass self => self -> IO Bool -- ^ returns @True@ if the widget can rely on its alpha channel -- being drawn correctly. widgetIsComposited self = liftM toBool $ {# call gtk_widget_is_composited #} (toWidget self) #endif #endif #if GTK_CHECK_VERSION(2,12,0) -- | Notifies the user about an input-related error on this widget. -- If the "gtk-error-bell" setting is @True@, it calls 'drawWindowBeep', -- otherwise it does nothing. -- -- Note that the effect of 'drawWindow_beep' can be configured in many -- ways, depending on the windowing backend and the desktop environment -- or window manager that is used. widgetErrorBell :: WidgetClass self => self -> IO () widgetErrorBell self = {# call widget_error_bell #} (toWidget self) -- | This function should be called whenever keyboard navigation within -- a single widget hits a boundary. The function emits the "keynav-failed" -- signal on the widget and its return value should be interpreted in a -- way similar to the return value of 'widgetChildFocus': -- -- When @True@ is returned, stay in the widget, the failed keyboard -- navigation is Ok and/or there is nowhere we can/should move the -- focus to. -- -- When @False@ is returned, the caller should continue with keyboard -- navigation outside the widget, e.g. by calling 'widgetChildFocus' on -- the widget’s toplevel. -- -- The default ::keynav-failed handler returns @True@ for 'DirTabForward' -- and 'DirTabBackward'. For the other values of 'DirectionType' it -- returns @False@. -- -- Whenever the default handler returns @True@, it also calls -- 'widgetErrorBell' to notify the user of the failed keyboard -- navigation. -- -- A use case for providing an own implementation of ::keynav-failed -- (either by connecting to it or by overriding it) would be a row of -- 'Entry' widgets where the user should be able to navigate the entire -- row with the cursor keys, as e.g. known from user interfaces that -- require entering license keys. widgetKeynavFailed :: WidgetClass self => self -> DirectionType -- ^ @direction@ - direction of focus movement -> IO Bool -- ^ returns @True@ if stopping keyboard navigation is -- fine, @False@ if the emitting widget should try to handle -- the keyboard navigation attempt in its parent container(s). widgetKeynavFailed self direction = liftM toBool $ {# call widget_keynav_failed #} (toWidget self) ((fromIntegral . fromEnum) direction) -- | Gets the contents of the tooltip for widget. widgetGetTooltipMarkup :: (WidgetClass self, GlibString markup) => self -> IO (Maybe markup) -- Returns the tooltip text, or Nothing. widgetGetTooltipMarkup self = {# call widget_get_tooltip_markup #} (toWidget self) >>= maybePeek peekUTFString -- | Sets @markup@ as the contents of the tooltip, which is marked up with the -- Pango text markup language. -- -- This function will take care of setting "has-tooltip" to True and of the -- default handler for the "query-tooltip" signal. -- -- See also the "tooltip-markup" property and 'tooltipSetMarkup'. widgetSetTooltipMarkup :: (WidgetClass self, GlibString markup) => self -> Maybe markup -- ^ the contents of the tooltip for widget, or @Nothing@. -> IO () widgetSetTooltipMarkup self markup = maybeWith withUTFString markup $ \ markupPtr -> {# call widget_set_tooltip_markup #} (toWidget self) markupPtr -- | Gets the contents of the tooltip for widget. widgetGetTooltipText :: (WidgetClass self, GlibString text) => self -> IO (Maybe text) -- Returns the tooltip text, or Nothing. widgetGetTooltipText self = {# call widget_get_tooltip_text #} (toWidget self) >>= maybePeek peekUTFString -- | Sets @text@ as the contents of the tooltip. This function will take care -- of setting "has-tooltip" to @True@ and of the default handler for the -- "query-tooltip" signal. -- -- See also the "tooltip-text" property and 'tooltipSetText'. widgetSetTooltipText :: (WidgetClass widget, GlibString text) => widget -> Maybe text -- ^ the contents of the tooltip for widget, or @Nothing@. -> IO () widgetSetTooltipText widget text = maybeWith withUTFString text $ \ textPtr -> {# call widget_set_tooltip_text #} (toWidget widget) textPtr -- | Returns the 'Window' of the current tooltip. This can be the 'Window' created by default, or the -- custom tooltip window set using 'widgetSetTooltipWindow'. -- -- * Available since Gtk+ version 2.12 -- widgetGetTooltipWindow :: WidgetClass self => self -> IO Window -- ^ returns The 'Window' of the current tooltip widgetGetTooltipWindow self = makeNewObject mkWindow $ {# call gtk_widget_get_tooltip_window #} (toWidget self) -- | Replaces the default, usually yellow, window used for displaying tooltips with @customWindow@. GTK+ -- will take care of showing and hiding @customWindow@ at the right moment, to behave likewise as the -- default tooltip window. If @customWindow@ is 'Nothing', the default tooltip window will be used. -- -- If the custom window should have the default theming it needs to have the name 'gtk-tooltip', see -- 'widgetSetName'. -- -- * Available since Gtk+ version 2.12 -- widgetSetTooltipWindow :: (WidgetClass self, WindowClass customWindow) => self -> Maybe customWindow -- ^ @customWindow@ a 'Window', or 'Nothing'. allow-none. -> IO () widgetSetTooltipWindow self customWindow = {# call gtk_widget_set_tooltip_window #} (toWidget self) (maybe (Window nullForeignPtr) toWindow customWindow) -- | Returns the current value of the has-tooltip property. -- See 'widgetHasTooltip' for more information. widgetGetHasTooltip :: WidgetClass widget => widget -> IO Bool -- ^ current value of 'widgetHasTooltip' on @widget@. widgetGetHasTooltip widget = liftM toBool $ {# call widget_get_has_tooltip #} (toWidget widget) -- | Sets the has-tooltip property on @widget@ to @hasTooltip@. -- See 'widgetHasTooltip' for more information. widgetSetHasTooltip :: WidgetClass widget => widget -> Bool -- ^ @hasTooltip@ whether or not @widget@ has a tooltip. -> IO () widgetSetHasTooltip widget hasTooltip = {# call widget_set_has_tooltip #} (toWidget widget) (fromBool hasTooltip) -- | Triggers a tooltip query on the display where the toplevel of @widget@ is -- located. See 'tooltipTriggerTooltipQuery' for more information. -- -- * Available since Gtk+ version 2.12 -- widgetTriggerTooltipQuery :: WidgetClass self => self -> IO () widgetTriggerTooltipQuery self = {# call gtk_widget_trigger_tooltip_query #} (toWidget self) #endif #if GTK_CHECK_VERSION(2,14,0) -- | Returns the widget's window if it is realized, Nothing otherwise -- -- * Available since Gtk+ version 2.14 -- widgetGetWindow :: WidgetClass self => self -> IO (Maybe DrawWindow) widgetGetWindow self = maybeNull (makeNewGObject mkDrawWindow) $ {# call gtk_widget_get_window #} (toWidget self) #endif #if GTK_CHECK_VERSION(3,8,0) -- | Registers a 'DrawWindow' with the widget and sets it up so that the -- widget receives events for it. Call 'widgetUnregisterWindow' when -- destroying the window. widgetRegisterWindow :: (WidgetClass widget, DrawWindowClass window) => widget -> window -> IO () widgetRegisterWindow widget window = {# call widget_register_window #} (toWidget widget) (toDrawWindow window) -- | Unregisters a 'DrawWindow' from the widget that was previously set up -- with 'widgetRegisterWindow'. You need to call this when the window is no -- longer used by the widget, such as when you destroy it. widgetUnregisterWindow :: (WidgetClass widget, DrawWindowClass window) => widget -> window -> IO () widgetUnregisterWindow widget window = {# call widget_unregister_window #} (toWidget widget) (toDrawWindow window) #endif #if GTK_CHECK_VERSION(3,0,0) -- | This function is supposed to be called in "draw" implementations for -- widgets that support multiple windows. @cr@ must be untransformed from -- invoking of the draw function. This function will return @True@ if the -- contents of the given @window@ are supposed to be drawn and @False@ -- otherwise. Note that when the drawing was not initiated by the windowing -- system this function will return @True@ for all windows, so you need to -- draw the bottommost window first. Also, do not use “else if†statements to -- check which window should be drawn. cairoShouldDrawWindow :: DrawWindowClass window => Cairo -- ^ @cr@ a cairo context -> window -- ^ @window@ the window to check. @window@ may not be an input-only window. -> IO Bool cairoShouldDrawWindow cr window = liftM toBool $ {# call cairo_should_draw_window #} (castPtr $ unCairo cr) (toDrawWindow window) -- | Transforms the given cairo context @cr@ that from @widget@-relative -- coordinates to @window@-relative coordinates. If the @widget@’s window is -- not an ancestor of @window@, no modification will be applied. -- -- This is the inverse to the transformation GTK applies when preparing an -- expose event to be emitted with the “draw†signal. It is intended to help -- porting multiwindow widgets from GTK+ 2 to the rendering architecture of -- GTK+ 3. cairoTransformToWindow :: (WidgetClass widget, DrawWindowClass window) => Cairo -- ^ @cr@ the cairo context to transform -> widget -- ^ @widget@ the widget the context is currently centered for -> window -- ^ @window@ the window to transform the context to -> IO () cairoTransformToWindow cr widget window = {# call gtk_cairo_transform_to_window #} (castPtr $ unCairo cr) (toWidget widget) (toDrawWindow window) #endif -- | Moves a widget from one 'Container' to another. -- widgetReparent :: (WidgetClass self, WidgetClass newParent) => self -> newParent -- ^ @newParent@ - a 'Container' to move the widget into -> IO () widgetReparent self newParent = {# call widget_reparent #} (toWidget self) (toWidget newParent) #if GTK_CHECK_VERSION(2,18,0) -- | Set if this widget can receive keyboard input. -- -- * To use the 'keyPress' event, the widget must be allowed -- to get the input focus. Once it has the input focus all keyboard -- input is directed to this widget. -- widgetSetCanFocus :: WidgetClass self => self -> Bool -> IO () widgetSetCanFocus = objectSetPropertyBool "can_focus" -- | Check if this widget can receive keyboard input. -- widgetGetCanFocus :: WidgetClass self => self -> IO Bool widgetGetCanFocus = objectGetPropertyBool "can_focus" -- | Retrieves the widget's allocation. -- -- * Available since Gtk+ version 2.18 -- widgetGetAllocation :: WidgetClass self => self -> IO Allocation widgetGetAllocation widget = alloca $ \ allocationPtr -> do {#call widget_get_allocation#} (toWidget widget) (castPtr allocationPtr) peek allocationPtr #endif #if GTK_CHECK_VERSION(3,0,0) -- | Returns the width that has currently been allocated to widget. This function is intended -- | to be used when implementing handlers for the "draw" function. widgetGetAllocatedWidth :: WidgetClass self => self -> IO Int widgetGetAllocatedWidth widget = liftM fromIntegral $ {#call widget_get_allocated_width#} (toWidget widget) -- | Returns the height that has currently been allocated to widget. This function is intended -- | to be used when implementing handlers for the "draw" function. widgetGetAllocatedHeight :: WidgetClass self => self -> IO Int widgetGetAllocatedHeight widget = liftM fromIntegral $ {#call widget_get_allocated_height#} (toWidget widget) #endif #if GTK_CHECK_VERSION(3,10,0) -- | Returns the baseline that has currently been allocated to widget . This function is intended -- to be used when implementing handlers for the “draw†function, and when allocating child -- widgets in “size_allocateâ€. widgetGetAllocatedBaseline :: WidgetClass self => self -> IO Int widgetGetAllocatedBaseline widget = liftM fromIntegral $ {#call widget_get_allocated_baseline#} (toWidget widget) #endif #if GTK_CHECK_VERSION(3,14,0) -- | Retrieves the widget’s clip area. -- -- The clip area is the area in which all of widget's drawing will happen. Other -- toolkits call it the bounding box. -- -- Historically, in GTK+ the clip area has been equal to the allocation retrieved -- via widgetGetAllocation. widgetGetClip :: WidgetClass self => self -> IO Allocation widgetGetClip widget = alloca $ \ allocationPtr -> do {#call widget_get_clip#} (toWidget widget) (castPtr allocationPtr) peek allocationPtr -- | Sets the widget’s clip. This must not be used directly, but from within a widget’s 'sizeAllocate' method. -- -- The clip set should be the area that widget draws on. If widget is a GtkContainer, the area -- must contain all children's clips. -- -- If this function is not called by widget during a 'sizeAllocate' handler, it is assumed to be -- equal to the allocation. However, if the function is not called, certain features that might extend -- a widget's allocation will not be available: -- -- * The “draw†signal will be clipped to the widget's allocation to avoid overdraw. -- -- * Calling gtk_render_background() will not draw outset shadows. -- -- It is therefore suggested that you always call widgetSetClip during a 'sizeAllocate' handler. widgetSetClip :: WidgetClass self => self -> Allocation -> IO () widgetSetClip self clip = with clip $ \clipPtr -> {#call widget_set_clip#} (toWidget self) (castPtr clipPtr) #endif #if GTK_CHECK_VERSION(2,18,0) -- | Determines whether the application intends to draw on the widget in an -- "draw" handler. -- See 'widgetSetAppPaintable'. widgetGetAppPaintable :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the @widget@ is app paintable. widgetGetAppPaintable widget = liftM toBool $ {#call widget_get_app_paintable #} (toWidget widget) -- | Determines whether @widget@ can be a default widget. -- See 'widgetSetCanDefault'. widgetGetCanDefault :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ can be a default widget, @False@ otherwise. widgetGetCanDefault widget = liftM toBool $ {#call gtk_widget_get_can_default #} (toWidget widget) -- | Specifies whether @widget@ can be a default widget. -- See 'widgetGrabDefault' for details about the meaning of "default". widgetSetCanDefault :: WidgetClass widget => widget -> Bool -- ^ @canDefault@ whether or not @widget@ can be a default widget. -> IO () widgetSetCanDefault widget canDefault = {# call widget_set_can_default #} (toWidget widget) (fromBool canDefault) -- | Determines whether @widget@ has a 'DrawWindow' of its own. See 'widgetSetHasWindow'. widgetGetHasWindow :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ has a window, @False@ otherwise. widgetGetHasWindow widget = liftM toBool $ {#call widget_get_has_window #} (toWidget widget) -- | Specifies whether @widget@ has a 'DrawWindow' of its own. Note that all -- realized widgets have a non-NULL "window" pointer ('widgetGetWindow' never -- returns a NULL window when a widget is realized), but for many of them it's -- actually the 'DrawWindow' of one of its parent widgets. Widgets that do not -- create a window for themselves in "realize" must announce this by calling -- this function with @hasWindow@ = @False@. -- -- This function should only be called by widget implementations, and they -- should call it in their @init()@ function. widgetSetHasWindow :: WidgetClass widget => widget -> Bool -- ^ @hasWindow@ whether or not @widget@ has a window. -> IO () widgetSetHasWindow widget hasWindow = {# call widget_set_has_window #} (toWidget widget) (fromBool hasWindow) -- | Returns the @widget@’s sensitivity (in the sense of returning the value -- that has been set using 'widgetSetSensitive'). -- -- The effective sensitivity of a widget is however determined by both its own -- and its parent widget’s sensitivity. See 'widgetIsSensitive'. widgetGetSensitive :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the widget is sensitive. widgetGetSensitive widget = liftM toBool $ {#call widget_get_sensitive #} (toWidget widget) -- | Returns the widget’s effective sensitivity, which means it is sensitive -- itself and also its parent widget is sensitive. widgetIsSensitive :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the widget is effectively sensitive. widgetIsSensitive widget = liftM toBool $ {#call widget_is_sensitive #} (toWidget widget) -- | Retrieve the current state of the widget. -- -- * The state refers to different modes of user interaction, see -- 'StateType' for more information. -- widgetGetState :: WidgetClass self => self -> IO StateType widgetGetState widget = liftM (toEnum . fromIntegral) $ {#call widget_get_state#} (toWidget widget) -- | Determines whether the widget is visible. If you want to take into -- account whether the widget’s parent is also marked as visible, use -- 'widgetIsVisible' instead. -- -- This function does not check if the widget is obscured in any way. -- See 'widgetSetVisible'. widgetGetVisible :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the widget is visible. widgetGetVisible widget = liftM toBool $ {#call widget_get_visible #} (toWidget widget) #endif #if GTK_CHECK_VERSION(3,8,0) -- | Determines whether the widget and all its parents are marked as visible. -- -- This function does not check if the widget is obscured in any way. -- -- See also 'widgetGetVisible' and 'widgetSetVisible' widgetIsVisible :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the widget and all its parents are visible. widgetIsVisible widget = liftM toBool $ {#call widget_is_visible #} (toWidget widget) #endif #if GTK_CHECK_VERSION(3,0,0) -- | This function is for use in widget implementations. Turns on flag values -- in the current widget state (insensitive, prelighted, etc.). -- -- This function accepts the values 'StateFlagDirLtr' and 'StateFlagDirRtl' -- but ignores them. If you want to set the widget's direction, use -- 'widgetSetDirection'. -- -- It is worth mentioning that any other state than StateFlagInsensitive', -- will be propagated down to all non-internal children if @widget@ is a -- 'Container', while 'StateFlagInsensitive' itself will be propagated down -- to all 'Container' children by different means than turning on the state -- flag down the hierarchy, both 'widgetGetStateFlags' and -- 'widgetIsSensitive' will make use of these. widgetSetStateFlags :: WidgetClass widget => widget -> [StateFlags] -- ^ @flags@ State flags to turn on -> Bool -- ^ @clear@ Whether to clear state before turning on @flags@ -> IO () widgetSetStateFlags widget flags clear = {# call widget_set_state_flags #} (toWidget widget) (fromIntegral $ fromFlags flags) (fromBool clear) -- | This function is for use in widget implementations. Turns off flag -- values for the current widget state (insensitive, prelighted, etc.). -- See 'widgetSetStateFlags'. widgetUnsetStateFlags :: WidgetClass widget => widget -> [StateFlags] -- ^ @flags@ State flags to turn off -> IO () widgetUnsetStateFlags widget flags = {# call widget_unset_state_flags #} (toWidget widget) (fromIntegral $ fromFlags flags) -- | Returns the widget state as a flag set. It is worth mentioning that the -- effective StateFlagInsensitive state will be returned, that is, also based -- on parent insensitivity, even if @widget@ itself is sensitive. widgetGetStateFlags :: WidgetClass widget => widget -> IO [StateFlags] -- ^ Returns the state flags for @widget@ widgetGetStateFlags widget = liftM (toFlags . fromIntegral) $ {# call widget_get_state_flags #} (toWidget widget) #endif #if GTK_CHECK_VERSION(2,18,0) -- | Determines whether @widget@ is the current default widget within its -- toplevel. See 'widgetSetCanDefault'. widgetGetHasDefault :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ is the current default widget within its toplevel, @False@ otherwise. widgetGetHasDefault widget = liftM toBool $ {#call widget_has_default #} (toWidget widget) -- | Determines if the @widget@ has the global input focus. -- See 'widgetIsFocus' for the difference between having the global input -- focus, and only having the focus within a toplevel. widgetGetHasFocus :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ has the global input focus. widgetGetHasFocus widget = liftM toBool $ {#call widget_has_focus #} (toWidget widget) #endif #if GTK_CHECK_VERSION(3,2,0) -- | Determines if the widget should show a visible indication that it has the -- global input focus. This is a convenience function for use in ::draw -- handlers that takes into account whether focus indication should currently -- be shown in the toplevel window of @widget@. See 'windowGetFocusVisible' -- for more information about focus indication. -- -- To find out if the widget has the global input focus, use 'widgetHasFocus'. widgetHasVisibleFocus :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the widget should display a “focus rectangle†widgetHasVisibleFocus widget = liftM toBool $ {# call widget_has_visible_focus #} (toWidget widget) #endif #if GTK_CHECK_VERSION(2,18,0) -- | Determines whether the widget is currently grabbing events, so it is the -- only widget receiving input events (keyboard and mouse). -- -- See also 'grabAdd'. widgetHasGrab :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if the widget is in the grab_widgets stack widgetHasGrab widget = liftM toBool $ {# call widget_has_grab #} (toWidget widget) -- | Determines whether @widget@ can be drawn to. A widget can be drawn to if -- it is mapped and visible. widgetIsDrawable :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ is drawable, @False@ otherwise widgetIsDrawable widget = liftM toBool $ {# call widget_is_drawable #} (toWidget widget) -- | Determines whether @widget@ is a toplevel widget. -- -- Currently only 'Window' and 'Invisible' (and out-of-process 'Plugs') are -- toplevel widgets. Toplevel widgets have no parent widget. widgetIsToplevel :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ is a toplevel, @False@ otherwise widgetIsToplevel widget = liftM toBool $ {# call widget_is_toplevel #} (toWidget widget) -- | Sets a widget’s window. This function should only be used in a widget’s -- “realize†implementation. The window passed is usually either new window -- created with 'drawWindowNew', or the window of its parent widget as -- returned by 'widgetGetParentWindow'. -- -- Widgets must indicate whether they will create their own 'DrawWindow' by -- calling 'widgetSetHasWindow'. This is usually done in the widget’s init() -- function. -- -- Note that this function does not add any reference to window. widgetSetWindow :: (WidgetClass widget, DrawWindowClass window) => widget -> window -> IO () widgetSetWindow widget window = {# call widget_set_window #} (toWidget widget) (toDrawWindow window) -- | Specifies whether @widget@ will be treated as the default widget within -- its toplevel when it has the focus, even if another widget is the default. -- -- See 'widgetGrabDefault' for details about the meaning of “defaultâ€. widgetSetReceivesDefault :: WidgetClass widget => widget -> Bool -- ^ @receivesDefault@ whether or not widget can be a default widget. -> IO () widgetSetReceivesDefault widget receivesDefault = {# call widget_set_receives_default #} (toWidget widget) (fromBool receivesDefault) -- | Determines whether @widget@ is always treated as the default widget -- within its toplevel when it has the focus, even if another widget is the -- default. -- -- See 'widgetSetReceivesDefault'. widgetGetReceivesDefault :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ acts as the default widget when focussed, @False@ otherwise widgetGetReceivesDefault widget = liftM toBool $ {# call widget_get_receives_default #} (toWidget widget) #endif #if GTK_CHECK_VERSION(3,0,0) -- | Returns @True@ if device has been shadowed by a GTK+ device grab on -- another widget, so it would stop sending events to widget. This may be -- used in the “grab-notify†signal to check for specific devices. -- See 'deviceGrabAdd'. widgetDeviceIsShadowed :: (WidgetClass widget, DeviceClass device) => widget -> device -> IO Bool -- ^ Returns @True@ if there is an ongoing grab on device by another 'Widget' than widget. widgetDeviceIsShadowed widget device = liftM toBool $ {# call widget_device_is_shadowed #} (toWidget widget) (toDevice device) #endif #if GTK_CHECK_VERSION(3,4,0) -- | Returns the modifier mask the @widget@’s windowing system backend uses -- for a particular purpose. -- -- See 'keymapGetModifierMask'. widgetGetModifierMask :: WidgetClass widget => widget -> ModifierIntent -- ^ @intent@ the use case for the modifier mask -> IO [Modifier] -- ^ Returns the modifier mask used for @intent@. widgetGetModifierMask widget intent = liftM (toFlags . fromIntegral) $ {# call widget_get_modifier_mask #} (toWidget widget) ((fromIntegral . fromEnum) intent) #endif #if GTK_CHECK_VERSION(3,0,0) -- | Enables or disables multiple pointer awareness. If this setting is -- @True@, widget will start receiving multiple, per device enter/leave -- events. Note that if custom 'DrawWindows' are created in “realizeâ€, -- 'windowSetSupportMultidevice' will have to be called manually on them. widgetSetSupportMultidevice :: WidgetClass widget => widget -> Bool -- ^ @supportMultidevice@ @True@ to support input from multiple devices. -> IO () widgetSetSupportMultidevice widget supportMultidevice = {# call widget_set_support_multidevice #} (toWidget widget) (fromBool supportMultidevice) -- | Returns @True@ if @widget@ is multiple pointer aware. -- See 'widgetSetSupportMultidevice' for more information. widgetGetSupportMultidevice :: WidgetClass widget => widget -> IO Bool -- ^ Returns @True@ if @widget@ is multidevice aware. widgetGetSupportMultidevice widget = liftM toBool $ {# call widget_get_support_multidevice #} (toWidget widget) #endif -- | This function is for use in widget implementations. Sets the state of a -- widget (insensitive, prelighted, etc.) Usually you should set the state -- using wrapper functions such as 'widgetSetSensitive'. -- widgetSetState :: WidgetClass self => self -> StateType -> IO () widgetSetState widget state = {#call widget_set_state#} (toWidget widget) ((fromIntegral . fromEnum) state) -- | Rarely-used function. This function is used to emit the event signals on a widget (those signals -- should never be emitted without using this function to do so). If you want to synthesize an event -- though, don't use this function; instead, use 'mainDoEvent' so the event will behave as if it -- were in the event queue. Don't synthesize expose events; instead, use 'windowInvalidateRect' -- to invalidate a region of the window. widgetEvent :: WidgetClass self => self -> EventM t Bool widgetEvent widget = do ptr <- ask liftIO $ liftM toBool $ {#call widget_event #} (toWidget widget) (castPtr ptr) -------------------- -- Attributes -- %hash c:6f7f d:9384 -- | The name of the widget. -- -- Default value: @Nothing@ -- widgetName :: (WidgetClass self, GlibString string) => Attr self (Maybe string) widgetName = newAttrFromMaybeStringProperty "name" widgetMarginLeft :: WidgetClass self => Attr self Int widgetMarginLeft = newAttrFromIntProperty "margin-left" widgetMarginRight :: WidgetClass self => Attr self Int widgetMarginRight = newAttrFromIntProperty "margin-right" #if GTK_CHECK_VERSION(3,12,0) widgetMarginStart :: WidgetClass self => Attr self Int widgetMarginStart = newAttrFromIntProperty "margin-start" widgetMarginEnd :: WidgetClass self => Attr self Int widgetMarginEnd = newAttrFromIntProperty "margin-end" #endif widgetMarginTop :: WidgetClass self => Attr self Int widgetMarginTop = newAttrFromIntProperty "margin-top" widgetMarginBottom :: WidgetClass self => Attr self Int widgetMarginBottom = newAttrFromIntProperty "margin-bottom" -- %hash c:1533 d:3213 -- | The parent widget of this widget. Must be a Container widget. -- widgetParent :: (WidgetClass self, ContainerClass container) => ReadWriteAttr self (Maybe Container) (Maybe container) widgetParent = newAttrFromMaybeObjectProperty "parent" gTypeContainer -- %hash c:2b4c d:3c31 -- | Override for width request of the widget, or -1 if natural request should -- be used. -- -- Allowed values: >= -1 -- -- Default value: -1 -- widgetWidthRequest :: WidgetClass self => Attr self Int widgetWidthRequest = newAttrFromIntProperty "width-request" -- %hash c:fa97 d:172a -- | Override for height request of the widget, or -1 if natural request -- should be used. -- -- Allowed values: >= -1 -- -- Default value: -1 -- widgetHeightRequest :: WidgetClass self => Attr self Int widgetHeightRequest = newAttrFromIntProperty "height-request" -- %hash c:70d0 d:e8e2 -- | Whether the widget is visible. -- -- Default value: @False@ -- widgetVisible :: WidgetClass self => Attr self Bool widgetVisible = newAttrFromBoolProperty "visible" -- | The opacity of the widget -- -- Default value: @1.0@ -- widgetOpacity :: WidgetClass self => Attr self Double widgetOpacity = newAttrFromDoubleProperty "opacity" -- %hash c:4dd4 d:594e -- | Whether the widget responds to input. -- -- Default value: @True@ -- widgetSensitive :: WidgetClass self => Attr self Bool widgetSensitive = newAttrFromBoolProperty "sensitive" -- %hash c:7506 d:1dde -- | Whether the application will paint directly on the widget. -- -- Default value: @False@ -- widgetAppPaintable :: WidgetClass self => Attr self Bool widgetAppPaintable = newAttrFromBoolProperty "app-paintable" -- %hash c:6289 d:72ab -- | Whether the widget can accept the input focus. -- -- Default value: @False@ -- widgetCanFocus :: WidgetClass self => Attr self Bool widgetCanFocus = newAttrFromBoolProperty "can-focus" -- %hash c:8e7 d:2645 -- | Whether the widget has the input focus. -- -- Default value: @False@ -- widgetHasFocus :: WidgetClass self => Attr self Bool widgetHasFocus = newAttrFromBoolProperty "has-focus" -- %hash c:7547 d:1d78 -- | Whether the widget is the focus widget within the toplevel. -- -- Default value: @False@ -- widgetIsFocus :: WidgetClass self => Attr self Bool widgetIsFocus = newAttrFromBoolProperty "is-focus" -- %hash c:f2d8 d:1cbb -- | Whether the widget can be the default widget. -- -- Default value: @False@ -- widgetCanDefault :: WidgetClass self => Attr self Bool widgetCanDefault = newAttrFromBoolProperty "can-default" -- %hash c:836 d:4cbe -- | Whether the widget is the default widget. -- -- Default value: @False@ -- widgetHasDefault :: WidgetClass self => Attr self Bool widgetHasDefault = newAttrFromBoolProperty "has-default" -- %hash c:f964 d:b62f -- | If @True@, the widget will receive the default action when it is focused. -- -- Default value: @False@ -- widgetReceivesDefault :: WidgetClass self => Attr self Bool widgetReceivesDefault = newAttrFromBoolProperty "receives-default" -- %hash c:2ca6 d:cad8 -- | Whether the widget is part of a composite widget. -- -- Default value: @False@ -- widgetCompositeChild :: WidgetClass self => ReadAttr self Bool widgetCompositeChild = readAttrFromBoolProperty "composite-child" -- %hash c:4f01 d:bd3 -- | The style of the widget, which contains information about how it will -- look (colors etc). -- widgetStyle :: WidgetClass self => Attr self Style widgetStyle = newAttrFromObjectProperty "style" gTypeStyle -- | The current visual user interaction state of the widget (insensitive, -- prelighted, selected etc). See 'StateType' for more information. -- widgetState :: WidgetClass self => Attr self StateType widgetState = newAttr widgetGetState widgetSetState -- %hash c:e2a4 d:9296 -- | The event mask that decides what kind of GdkEvents this widget gets. -- -- Default value: 'StructureMask' -- widgetEvents :: WidgetClass self => Attr self [EventMask] widgetEvents = newAttrFromFlagsProperty "events" {# call pure unsafe gdk_event_mask_get_type #} #if GTK_MAJOR_VERSION < 3 -- %hash c:ba80 -- | The mask that decides what kind of extension events this widget gets. -- -- Default value: 'ExtensionEventsNone' -- -- Removed in Gtk3. widgetExtensionEvents :: WidgetClass self => Attr self [ExtensionMode] widgetExtensionEvents = newAttr widgetGetExtensionEvents widgetSetExtensionEvents #endif -- | Whether to expand in both directions. Setting this sets both 'widgetHExpand' and 'widgetVExpand' -- -- Default value: @False@ -- widgetExpand :: WidgetClass self => Attr self Bool widgetExpand = newAttrFromBoolProperty "expand" -- | Whether to expand horizontally. See 'widgetSetHExpand' -- -- Default value: @False@ -- widgetHExpand :: WidgetClass self => Attr self Bool widgetHExpand = newAttrFromBoolProperty "hexpand" -- | Whether to use the “hexpand†property. See 'widgetGetHExpandSet'. -- -- Default value: @False@ -- widgetHExpandSet :: WidgetClass self => Attr self Bool widgetHExpandSet = newAttrFromBoolProperty "hexpand-set" -- | Whether to expand vertically. See 'widgetSetVExpand'. -- -- Default value: @False@ -- widgetVExpand :: WidgetClass self => Attr self Bool widgetVExpand = newAttrFromBoolProperty "vexpand" -- | Whether to use the “vexpand†property. See 'widgetGetVExpandSet'. -- -- Default value: @False@ -- widgetVExpandSet :: WidgetClass self => Attr self Bool widgetVExpandSet = newAttrFromBoolProperty "vexpand-set" -- %hash c:1605 d:48ea -- | Whether 'widgetShowAll' should not affect this widget. -- -- Default value: @False@ -- widgetNoShowAll :: WidgetClass self => Attr self Bool widgetNoShowAll = newAttrFromBoolProperty "no-show-all" -- %hash c:cd8d d:59b2 -- | \'childVisible\' property. See 'widgetGetChildVisible' and -- 'widgetSetChildVisible' -- widgetChildVisible :: WidgetClass self => Attr self Bool widgetChildVisible = newAttr widgetGetChildVisible widgetSetChildVisible #if GTK_MAJOR_VERSION < 3 -- %hash c:a20a d:646f -- | \'colormap\' property. See 'widgetGetColormap' and 'widgetSetColormap' -- -- Removed in Gtk3. widgetColormap :: WidgetClass self => Attr self Colormap widgetColormap = newAttr widgetGetColormap widgetSetColormap #endif -- %hash c:a7fd d:55b8 -- | \'compositeName\' property. See 'widgetGetCompositeName' and -- 'widgetSetCompositeName' -- widgetCompositeName :: (WidgetClass self, GlibString string) => ReadWriteAttr self (Maybe string) string widgetCompositeName = newAttr widgetGetCompositeName widgetSetCompositeName -- %hash c:6c03 d:ce3b -- | \'direction\' property. See 'widgetGetDirection' and 'widgetSetDirection' -- widgetDirection :: WidgetClass self => Attr self TextDirection widgetDirection = newAttr widgetGetDirection widgetSetDirection -- | Sets the text of tooltip to be the given string, which is marked up with the Pango text markup -- language. Also see 'tooltipSetMarkup'. -- -- This is a convenience property which will take care of getting the tooltip shown if the given string -- is not \"\": 'hasTooltip' will automatically be set to 'True' and there will be taken care of -- 'queryTooltip' in the default signal handler. -- -- Default value: \"\" -- -- * Available since Gtk+ version 2.12 -- widgetTooltipMarkup :: (WidgetClass self, GlibString markup) => Attr self (Maybe markup) widgetTooltipMarkup = newAttrFromMaybeStringProperty "tooltip-markup" -- | Sets the text of tooltip to be the given string. -- -- Also see 'tooltipSetText'. -- -- This is a convenience property which will take care of getting the tooltip shown if the given string -- is not \"\": 'hasTooltip' will automatically be set to 'True' and there will be taken care of -- 'queryTooltip' in the default signal handler. -- -- Default value: \"\" -- -- * Available since Gtk+ version 2.12 -- widgetTooltipText :: (WidgetClass self, GlibString string) => Attr self (Maybe string) widgetTooltipText = newAttrFromMaybeStringProperty "tooltip-text" -- | Enables or disables the emission of 'queryTooltip' on widget. A value of 'True' indicates that widget -- can have a tooltip, in this case the widget will be queried using 'queryTooltip' to determine -- whether it will provide a tooltip or not. -- -- Note that setting this property to 'True' for the first time will change the event masks of the -- 'Windows' of this widget to include leave-notify and motion-notify events. This cannot and will not -- be undone when the property is set to 'False' again. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.12 -- widgetHasTooltip :: WidgetClass self => Attr self Bool widgetHasTooltip = newAttrFromBoolProperty "has-tooltip" #if GTK_CHECK_VERSION(2,20,0) -- | Determines if the widget style has been looked up through the rc mechanism. widgetHasRcStyle :: WidgetClass self => self -> IO Bool -- ^ returns 'True' if the widget has been looked up through the rc mechanism, 'False' otherwise. widgetHasRcStyle self = liftM toBool $ {#call gtk_widget_has_rc_style #} (toWidget self) -- | Determines whether widget is realized. widgetGetRealized :: WidgetClass self => self -> IO Bool -- ^ returns 'True' if widget is realized, 'False' otherwise widgetGetRealized self = liftM toBool $ {#call gtk_widget_get_realized #} (toWidget self) -- | Whether the widget is mapped. widgetGetMapped :: WidgetClass self => self -> IO Bool -- ^ returns 'True' if the widget is mapped, 'False' otherwise. widgetGetMapped self = liftM toBool $ {#call gtk_widget_get_mapped #} (toWidget self) -- | Marks the @widget@ as being realized. This function must only be called -- after all 'DrawWindows' for the widget have been created and registered. -- -- This function should only ever be called in a derived widget's “realize†-- or “unrealize†implementation. widgetSetRealized :: WidgetClass widget => widget -> Bool -- ^ @realized@ @True@ to mark the widget realized. -> IO () widgetSetRealized widget realized = {# call widget_set_realized #} (toWidget widget) (fromBool realized) -- | Marks the @widget@ as being realized. -- -- This function should only ever be called in a derived widget's “map†or -- “unmap†implementation. widgetSetMapped :: WidgetClass widget => widget -> Bool -- ^ @mapped@ @True@ to mark the widget as mapped. -> IO () widgetSetMapped widget mapped = {# call widget_set_mapped #} (toWidget widget) (fromBool mapped) #endif #if GTK_CHECK_VERSION(3,0,0) -- | Returns the style context associated to @widget@. widgetGetStyleContext :: WidgetClass widget => widget -- ^ @widget@ : a @Widget@ -> IO StyleContext -- ^ a @StyleContext@ widgetGetStyleContext widget = makeNewGObject mkStyleContext $ {# call gtk_widget_get_style_context #} (toWidget widget) -- | Gets the value of the `widgetHAlign` property. -- -- For backwards compatibility reasons this method will never return AlignBaseline, -- but instead it will convert it to AlignFill. Baselines are not supported for -- horizontal alignment. -- widgetGetHAlign :: WidgetClass self => self -> IO Align widgetGetHAlign self = liftM (toEnum . fromIntegral) $ {# call gtk_widget_get_halign #} (toWidget self) -- | Sets the horizontal alignment of widget. See the 'widgetHAlign' property. -- widgetSetHAlign :: WidgetClass self => self -> Align -> IO () widgetSetHAlign self align = {# call gtk_widget_set_halign #} (toWidget self) (fromIntegral $ fromEnum align) -- | Gets the value of the 'widgetVAlign' property. -- -- For backwards compatibility reasons this method will never return AlignBaseline, -- but instead it will convert it to AlignFill. If your widget want to support -- baseline aligned children it must use 'widgetGetVAlignWithBaseline', or -- 'widgetVAlign', which will also report the true value. widgetGetVAlign :: WidgetClass self => self -> IO Align widgetGetVAlign self = liftM (toEnum . fromIntegral) $ {# call gtk_widget_get_valign #} (toWidget self) #if GTK_CHECK_VERSION(3,10,0) -- | Gets the value of the 'widgetVAlign' property, including AlignBaseline. widgetGetVAlignWithBaseline :: WidgetClass self => self -> IO Align widgetGetVAlignWithBaseline self = liftM (toEnum . fromIntegral) $ {# call gtk_widget_get_valign_with_baseline #} (toWidget self) #endif -- | Sets the vertical alignment of widget . See the 'widgetVAlign' property. widgetSetVAlign :: WidgetClass self => self -> Align -> IO () widgetSetVAlign self align = {# call gtk_widget_set_valign #} (toWidget self) (fromIntegral $ fromEnum align) #endif -------------------- -- Signals -- %hash c:4cf5 d:af3f -- | The widget appears on screen. -- mapSignal :: WidgetClass self => Signal self (IO ()) mapSignal = Signal (connect_NONE__NONE "map") -- %hash c:e33e d:af3f -- | The widget disappears from the screen. -- unmapSignal :: WidgetClass self => Signal self (IO ()) unmapSignal = Signal (connect_NONE__NONE "unmap") -- %hash c:1f7f d:af3f -- | The widget should allocate any resources needed, in particular, the -- widget's 'DrawWindow' is created. If you connect to this signal and -- you rely on some of these resources to be present, you have to use -- 'System.Glib.Signals.after'. -- realize :: WidgetClass self => Signal self (IO ()) realize = Signal (connect_NONE__NONE "realize") -- %hash c:7948 d:af3f -- | The widget should deallocate any resources. This signal is emitted before -- the widget is destroyed. -- unrealize :: WidgetClass self => Signal self (IO ()) unrealize = Signal (connect_NONE__NONE "unrealize") -- %hash c:9f6f d:af3f -- | Query the widget for the size it likes to -- have. -- -- * A parent container emits this signal to its child to query the needed -- height and width of the child. There is not guarantee that the widget -- will actually get this area. -- sizeRequest :: WidgetClass self => Signal self (IO Requisition) sizeRequest = Signal (\after w fun -> connect_PTR__NONE "size-request" after w (\rqPtr -> fun >>= \req -> unless (rqPtr==nullPtr) $ poke rqPtr req)) -- %hash c:8ec5 d:af3f -- | Inform widget about the size it has. -- -- * After querying a widget for the size it wants to have (through emitting -- the @\"sizeRequest\"@ signal) a container will emit this signal to -- inform the widget about the real size it should occupy. -- sizeAllocate :: WidgetClass self => Signal self (Allocation -> IO ()) sizeAllocate = Signal (connect_BOXED__NONE "size-allocate" peek) -- %hash c:ae3e d:af3f -- | The widget is shown. -- showSignal :: WidgetClass self => Signal self (IO ()) showSignal = Signal (connect_NONE__NONE "show") -- %hash c:f589 d:af3f -- | The widget is hidden. -- hideSignal :: WidgetClass self => Signal self (IO ()) hideSignal = Signal (connect_NONE__NONE "hide") -- %hash c:a285 d:af3f -- | The widget gains focus via the given user action. -- focus :: WidgetClass self => Signal self (DirectionType -> IO Bool) focus = Signal (connect_ENUM__BOOL "focus") -- %hash c:78ae d:af3f -- | The state of the widget (input focus, insensitive, etc.) has changed. -- stateChanged :: WidgetClass self => Signal self (StateType -> IO ()) stateChanged = Signal (connect_ENUM__NONE "state-changed") #if GTK_CHECK_VERSION(3,0,0) connect_FLAGS__NONE :: (Flags a, GObjectClass obj) => SignalName -> ConnectAfter -> obj -> ([a] -> IO ()) -> IO (ConnectId obj) connect_FLAGS__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Int -> IO () action _ flags1 = failOnGError $ user (toFlags flags1) -- | The state of the widget (input focus, insensitive, etc.) has changed. -- stateFlagsChanged :: WidgetClass self => Signal self ([StateFlags] -> IO ()) stateFlagsChanged = Signal (connect_FLAGS__NONE "state-flags-changed") #endif -- %hash c:bef2 d:1d66 -- | The 'parentSet' signal is emitted when a new parent has been set on a -- widget. The parameter is the new parent. -- parentSet :: WidgetClass self => Signal self (Maybe Widget -> IO ()) parentSet = Signal (connect_MOBJECT__NONE "parent-set") -- %hash c:7e2b d:4049 -- | Emitted when there is a change in the hierarchy to which a widget belong. -- More precisely, a widget is anchored when its toplevel ancestor is a -- 'Window'. This signal is emitted when a widget changes from un-anchored to -- anchored or vice-versa. -- hierarchyChanged :: WidgetClass self => Signal self (Maybe Widget -> IO ()) hierarchyChanged = Signal (connect_MOBJECT__NONE "hierarchy-changed") -- %hash c:5894 d:ba10 -- | The 'styleSet' signal is emitted when a new style has been set on a -- widget. Note that style-modifying functions like 'widgetModifyBase' also -- cause this signal to be emitted. -- styleSet :: WidgetClass self => Signal self (Style -> IO ()) styleSet = Signal (connect_OBJECT__NONE "style-set") -- %hash c:6bb1 d:af3f -- | The default direction of text writing has changed. -- directionChanged :: WidgetClass self => Signal self (TextDirection -> IO ()) directionChanged = Signal (connect_ENUM__NONE "direction-changed") -- %hash c:c28c d:d116 -- | The 'grabNotify' signal is emitted when a widget becomes shadowed by a -- Gtk+ grab (not a pointer or keyboard grab) on another widget, or when it -- becomes unshadowed due to a grab being removed. -- -- A widget is shadowed by a 'grabAdd' when the topmost grab widget in the -- grab stack of its window group is not its ancestor. -- grabNotify :: WidgetClass self => Signal self (Bool -> IO ()) grabNotify = Signal (connect_BOOL__NONE "grab-notify") -- %hash c:e06c d:a681 -- | This signal gets emitted whenever a widget should pop up a -- context-sensitive menu. This usually happens through the standard key -- binding mechanism; by pressing a certain key while a widget is focused, the -- user can cause the widget to pop up a menu. For example, the 'Entry' widget -- creates a menu with clipboard commands. -- popupMenuSignal :: WidgetClass self => Signal self (IO Bool) popupMenuSignal = Signal (connect_NONE__BOOL "popup-menu") -- | Specify what kind of help the user wants. {#enum GtkWidgetHelpType as WidgetHelpType {underscoreToCase} deriving (Eq,Show) #} -- %hash c:b18e d:af3f -- | Tell the widget to show an explanatory help text. Should return @True@ -- if help has been shown. -- showHelp :: WidgetClass self => Signal self (WidgetHelpType -> IO Bool) showHelp = Signal (connect_ENUM__BOOL "show-help") -- %hash c:6a8f d:af3f -- | The set of keyboard accelerators has changed. -- accelClosuresChanged :: WidgetClass self => Signal self (IO ()) accelClosuresChanged = Signal (connect_NONE__NONE "accel-closures-changed") -- %hash c:5ca d:af3f -- | The widget moved to a new screen. -- screenChanged :: WidgetClass self => Signal self (Screen -> IO ()) screenChanged = Signal (connect_OBJECT__NONE "screen-changed") -- | Emitted when 'hasTooltip' is 'True' and the 'gtkTooltipTimeout' has expired with the cursor -- hovering "above" widget; or emitted when widget got focus in keyboard mode. -- -- Using the given coordinates, the signal handler should determine whether a tooltip should be shown -- for widget. If this is the case 'True' should be returned, 'False' otherwise. -- Note if widget got focus in keyboard mode, 'Point' is 'Nothing'. -- -- The signal handler is free to manipulate tooltip with the therefore destined function calls. -- -- * Available since Gtk+ version 2.12 -- queryTooltip :: WidgetClass self => Signal self (Widget -> Maybe Point -> Tooltip -> IO Bool) queryTooltip = Signal (\after model user -> connect_OBJECT_INT_INT_BOOL_OBJECT__BOOL "query-tooltip" after model (\widget x y keyb tooltip -> user widget (if keyb then Nothing else Just (x, y)) tooltip)) #if GTK_CHECK_VERSION(3,0,0) draw :: WidgetClass self => Signal self (Render ()) draw = Signal (\after model (Render user) -> connect_PTR__NONE "draw" after model (\ptr -> runReaderT user (Cairo ptr))) #endif -- * Events -- -- An event is a signal that indicates that some low-level interaction like a -- button or key press, mouse movement, etc. has occurred. In particular, -- events relate to operations on 'DrawWindow's which are a concept of the -- underlying OS rather than the logical widget concept. Some widgets have no -- window and use their parent to receive these events. Widgets normally -- synthesize more sophistiacted signals from events. For instance, the -- 'focusIn' and a 'focusOut' signal indicate that the widget gains or looses -- the input focus. From these events a 'focus' signal is synthesized that -- indicates what maneuver lead to the input focus change (i.e. a tab or -- shift-tab key press). -- -- For applications it is often sufficient to connect to the high-level -- signals rather than the low-level events. Only in cases where a custom -- widget is built based on the 'DarwingArea' skeleton, the functionality of -- such an application-specific widget needs to be implemented using events. -- -- Every event is passed an 'Event' structure that contains the data of the -- event. The return value should be @True@ if the handler has dealt with the -- event and @False@ if the event should be propagated further. For instance, -- if a key press event that isn't meaningful in the widget, the handler can -- return @False@ such that the key is handled by the other widgets (the main -- menu, for instance). -- -- Because there are so many similar signals (those that take an Event and -- return a Bool) we will abstract out the skeleton. As some of these events -- are emitted at a high rate often a bit has to be set to enable emission. eventM :: WidgetClass w => SignalName -> [EventMask] -> ConnectAfter -> w -> (EventM t Bool) -> IO (ConnectId w) eventM name eMask after obj fun = do id <- connect_PTR__BOOL name after obj (runReaderT fun) widgetAddEvents obj eMask return id -- %hash c:6cc d:af3f -- | A mouse button has been depressed while the mouse pointer was within the -- widget area. Sets the widget's 'ButtonPressMask' flag. -- buttonPressEvent :: WidgetClass self => Signal self (EventM EButton Bool) buttonPressEvent = Signal (eventM "button_press_event" [ButtonPressMask]) -- %hash c:62e8 d:af3f -- | A mouse button has been released. Sets the widget's 'ButtonReleaseMask' -- flag. -- buttonReleaseEvent :: WidgetClass self => Signal self (EventM EButton Bool) buttonReleaseEvent = Signal (eventM "button_release_event" [ButtonReleaseMask]) -- %hash c:23e5 d:af3f -- | The scroll wheel of the mouse has been used. Sets the widget's -- 'ScrollMask' flag. -- scrollEvent :: WidgetClass self => Signal self (EventM EScroll Bool) scrollEvent = Signal (eventM "scroll_event" [ScrollMask]) -- %hash c:ee92 d:af3f -- | The mouse pointer has moved. Since receiving all mouse movements is -- expensive, it is necessary to specify exactly what mouse motions are -- required by calling 'widgetAddEvents' on this widget with one or more of -- the following flags: -- -- * 'PointerMotionMask': Track all movements. -- -- * 'ButtonMotionMask': Only track movements if a button is depressed. -- -- * 'Button1MotionMask': Only track movements if the left button is depressed. -- -- * 'Button2MotionMask': Only track movements if the middle button is depressed. -- -- * 'Button3MotionMask': Only track movements if the right button is depressed. -- 'PointerMotionHintMask' is a special flag which can be used in -- combination with any of the above and is used to reduce the number of -- 'motionNotifyEvent's received. Normally a 'motionNotifyEvent' event is -- received each time the mouse moves. However, if the application spends a -- lot of time processing the event (updating the display, for example), it -- can lag behind the position of the mouse. When using -- 'PointerMotionHintMask', fewer 'motionNotifyEvent's will be sent, some of -- which are marked as a hint. To receive more motion events after a motion -- hint event, the application needs to asks for more, by calling -- 'Graphics.UI.Gtk.Gdk.EventM.eventRequestMotions'. This effectively limits -- the rate at which new motion events are received. (Note that you don't -- need to check if the hint is set as -- 'Graphics.UI.Gtk.Gdk.EventM.eventRequestMotions' does so automatically.) -- motionNotifyEvent :: WidgetClass self => Signal self (EventM EMotion Bool) motionNotifyEvent = Signal (eventM "motion_notify_event" []) -- %hash c:8783 d:3e27 -- | The 'deleteEvent' signal is emitted if a user requests that a toplevel -- window is closed. The default handler for this signal destroys the window. -- Calling 'widgetHide' and returning @True@ on reception of this signal will -- cause the window to be hidden instead, so that it can later be shown again -- without reconstructing it. -- deleteEvent :: WidgetClass self => Signal self (EventM EAny Bool) deleteEvent = Signal (eventM "delete_event" []) -- %hash c:c408 d:5514 -- | The 'destroyEvent' signal is emitted when a 'DrawWindow' is destroyed. -- You rarely get this signal, because most widgets disconnect themselves from -- their window before they destroy it, so no widget owns the window at -- destroy time. However, you might want to connect to the 'objectDestroy' -- signal of 'Object'. -- destroyEvent :: WidgetClass self => Signal self (EventM EAny Bool) destroyEvent = Signal (eventM "destroy_event" []) -- %hash c:c79e d:af3f -- | Instructs the widget to redraw. -- -- * The 'DrawWindow' that needs to be redrawn is available via -- 'eventWindow'. -- -- * The part that needs to be redrawn is available via 'eventArea' and -- 'eventRegion'. The options are, in order of efficiency: (a) redraw the -- entire window, (b) ask for the 'eventArea' and redraw that rectangle, (c) -- ask for the 'eventRegion' and redraw each of those rectangles. -- -- Only the exposed region will be updated; see also -- 'drawWindowBeginPaintRegion'. exposeEvent :: WidgetClass self => Signal self (EventM EExpose Bool) exposeEvent = Signal (eventM "expose_event" []) -- %hash c:5ccd d:af3f -- | A key has been depressed. Sets the widget's 'KeyPressMask' flag. -- keyPressEvent :: WidgetClass self => Signal self (EventM EKey Bool) keyPressEvent = Signal (eventM "key_press_event" [KeyPressMask]) -- %hash c:bd29 d:af3f -- | A key has been released. Sets the widget's 'KeyReleaseMask' flag. -- keyReleaseEvent :: WidgetClass self => Signal self (EventM EKey Bool) keyReleaseEvent = Signal (eventM "key_release_event" [KeyReleaseMask]) -- %hash c:602e d:af3f -- | The mouse pointer has entered the widget. Sets the widget's -- 'EnterNotifyMask' flag. -- enterNotifyEvent :: WidgetClass self => Signal self (EventM ECrossing Bool) enterNotifyEvent = Signal (eventM "enter_notify_event" [EnterNotifyMask]) -- %hash c:3bfb d:af3f -- | The mouse pointer has left the widget. Sets the widget's -- 'LeaveNotifyMask' flag. -- leaveNotifyEvent :: WidgetClass self => Signal self (EventM ECrossing Bool) leaveNotifyEvent = Signal (eventM "leave_notify_event" [LeaveNotifyMask]) -- %hash c:2b64 d:af3f -- | The size of the window has changed. -- configureEvent :: WidgetClass self => Signal self (EventM EConfigure Bool) configureEvent = Signal (eventM "configure_event" []) -- %hash c:427e d:af3f -- | The widget gets the input focus. Sets the widget's 'FocusChangeMask' flag. -- focusInEvent :: WidgetClass self => Signal self (EventM EFocus Bool) focusInEvent = Signal (eventM "focus_in_event" [FocusChangeMask]) -- %hash c:5281 d:af3f -- | The widget lost the input focus. Sets the widget's 'FocusChangeMask' flag. -- focusOutEvent :: WidgetClass self => Signal self (EventM EFocus Bool) focusOutEvent = Signal (eventM "focus_out_event" [FocusChangeMask]) -- %hash c:63c4 d:af3f -- | The window is put onto the screen. -- mapEvent :: WidgetClass self => Signal self (EventM EAny Bool) mapEvent = Signal (eventM "map_event" []) -- %hash c:342d d:af3f -- | The window is taken off the screen. -- unmapEvent :: WidgetClass self => Signal self (EventM EAny Bool) unmapEvent = Signal (eventM "unmap_event" []) -- %hash c:a1dd d:af3f -- | A 'DrawWindow' may be associated with a set of properties that are -- identified by a 'PropertyTag'. This event is triggered if a property is -- changed or deleted. Sets the widget's 'PropertyChangeMask' flag. -- _propertyNotifyEvent :: WidgetClass self => Signal self (EventM EProperty Bool) _propertyNotifyEvent = Signal (eventM "property_notify_event" [PropertyChangeMask]) {- not sure if these are useful -- %hash c:58cc d:af3f -- | -- selectionClearEvent :: WidgetClass self => Signal self ({-GdkEventSelection*-} Bool) selectionClearEvent = Signal (connect_{-GdkEventSelection*-}__BOOL "selection_clear_event") -- %hash c:4f92 d:af3f -- | -- selectionRequestEvent :: WidgetClass self => Signal self ({-GdkEventSelection*-} Bool) selectionRequestEvent = Signal (connect_{-GdkEventSelection*-}__BOOL "selection_request_event") -- %hash c:b842 d:af3f -- | -- selectionNotifyEvent :: WidgetClass self => Signal self ({-GdkEventSelection*-} Bool) selectionNotifyEvent = Signal (connect_{-GdkEventSelection*-}__BOOL "selection_notify_event") -} -- %hash c:b027 d:af3f -- | The pen of a graphics tablet was put down. Sets the widget's -- 'ProximityInMask' flag. -- proximityInEvent :: WidgetClass self => Signal self (EventM EProximity Bool) proximityInEvent = Signal (eventM "proximity_in_event" [ProximityInMask]) -- %hash c:faca d:af3f -- | The pen of a graphics tablet was lifted off the tablet. Sets the widget's -- 'ProximityOutMask' flag. -- proximityOutEvent :: WidgetClass self => Signal self (EventM EProximity Bool) proximityOutEvent = Signal (eventM "proximity_out_event" [ProximityOutMask]) -- %hash c:db2c d:af3f -- | Emitted when the window visibility status has changed. Sets the widget's -- 'VisibilityNotifyMask' flag. -- visibilityNotifyEvent :: WidgetClass self => Signal self (EventM EVisibility Bool) visibilityNotifyEvent = Signal (eventM "visibility_notify_event" [VisibilityNotifyMask]) {- -- %hash c:3f5 d:af3f -- | -- clientEvent :: WidgetClass self => Signal self ({-GdkEventClient*-} Bool) clientEvent = Signal (connect_{-GdkEventClient*-}__BOOL "client_event") -} -- %hash c:643c d:af3f -- | Generated when the area of a 'Drawable' being copied using, e.g. -- 'Graphics.UI.Gtk.Gdk.Drawable.drawDrawable', is completely available. -- noExposeEvent :: WidgetClass self => Signal self (EventM EAny Bool) noExposeEvent = Signal (eventM "no_expose_event" []) -- %hash c:63b6 d:af3f -- | Emitted when the state of the window changes, i.e. when it is minimized, -- moved to the top, etc. -- windowStateEvent :: WidgetClass self => Signal self (EventM EWindowState Bool) windowStateEvent = Signal (eventM "window_state_event" []) #if GTK_CHECK_VERSION(2,8,0) -- %hash c:502a d:e47a -- | Emitted when a pointer or keyboard grab on a window belonging to @widget@ -- gets broken. -- -- On X11, this happens when the grab window becomes unviewable (i.e. it or -- one of its ancestors is unmapped), or if the same application grabs the -- pointer or keyboard again. -- -- * Available since Gtk+ version 2.8 -- grabBrokenEvent :: WidgetClass self => Signal self (EventM EGrabBroken Bool) grabBrokenEvent = Signal (eventM "grab_broken_event" []) #endif -------------------- -- Deprecated Signals and Events #ifndef DISABLE_DEPRECATED event :: WidgetClass w => SignalName -> [EventMask] -> ConnectAfter -> w -> (Event -> IO Bool) -> IO (ConnectId w) event name eMask after obj fun = do id <- connect_BOXED__BOOL name marshalEvent after obj fun widgetAddEvents obj eMask return id -- | A Button was pressed. -- -- * This widget is part of a button which was just pressed. The event passed -- to the user function is a 'Graphics.UI.Gtk.Gdk.Events.Button' event. -- onButtonPress, afterButtonPress :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onButtonPress = event "button_press_event" [ButtonPressMask] False afterButtonPress = event "button_press_event" [ButtonPressMask] True -- | A Button was released. -- onButtonRelease, afterButtonRelease :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onButtonRelease = event "button_release_event" [ButtonReleaseMask] False afterButtonRelease = event "button_release_event" [ButtonReleaseMask] True -- | -- onClient, afterClient :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onClient = event "client_event" [] False afterClient = event "client_event" [] True -- | The widget's status has changed. -- onConfigure, afterConfigure :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onConfigure = event "configure_event" [] False afterConfigure = event "configure_event" [] True -- | This signal is emitted when the close icon on the -- surrounding window is pressed. The default action is to emit the -- @\"destroy\"@ signal. -- onDelete, afterDelete :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onDelete = event "delete_event" [] False afterDelete = event "delete_event" [] True -- | The widget will be destroyed. -- -- * The widget received a destroy event from the window manager. -- onDestroyEvent, afterDestroyEvent :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onDestroyEvent = event "destroy_event" [] False afterDestroyEvent = event "destroy_event" [] True -- | The default text direction was changed. -- onDirectionChanged, afterDirectionChanged :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onDirectionChanged = event "direction_changed" [] False afterDirectionChanged = event "direction_changed" [] True -- | Mouse cursor entered widget. -- -- * Contains a 'Crossing' event. -- onEnterNotify, afterEnterNotify :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onEnterNotify = event "enter_notify_event" [EnterNotifyMask] False afterEnterNotify = event "enter_notify_event" [EnterNotifyMask] True -- | Mouse cursor leaves widget. -- -- * Contains a 'Crossing' event. -- onLeaveNotify, afterLeaveNotify :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onLeaveNotify = event "leave_notify_event" [LeaveNotifyMask] False afterLeaveNotify = event "leave_notify_event" [LeaveNotifyMask] True -- | Instructs the widget to redraw. -- -- * This event is useful for the 'DrawingArea'. On receiving this signal -- the content of the passed Rectangle or Region needs to be redrawn. -- The return value should be 'True' if the region was completely redrawn -- and 'False' if other handlers in the chain should be invoked. -- If a client will redraw the whole area and is not interested in the -- extra information in 'Expose', it is more efficient -- to use 'onExposeRect'. -- -- * Widgets that are very expensive to re-render, such as an image editor, -- may prefer to use the 'onExpose' call back which delivers a -- 'Region' in addition to a 'Rectangle'. A 'Region' consists of several -- rectangles that need redrawing. The simpler 'onExposeRect' event encodes -- the area to be redrawn as a bounding rectangle which might be easier -- to deal with in a particular application. -- onExpose, afterExpose :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onExpose = event "expose_event" [] False afterExpose = event "expose_event" [] True -- | Expose event delivering a 'Rectangle'. -- onExposeRect, afterExposeRect :: WidgetClass w => w -> (Rectangle -> IO ()) -> IO (ConnectId w) onExposeRect w act = connect_BOXED__BOOL "expose_event" marshExposeRect False w (\r -> act r >> return True) afterExposeRect w act = connect_BOXED__BOOL "expose_event" marshExposeRect True w (\r -> act r >> return True) -- | This signal is called if the widget receives the input focus. -- onFocus, afterFocus :: WidgetClass w => w -> (DirectionType -> IO Bool) -> IO (ConnectId w) onFocus = connect_ENUM__BOOL "focus" False afterFocus = connect_ENUM__BOOL "focus" True -- | Widget gains input focus. -- onFocusIn, afterFocusIn :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onFocusIn = event "focus_in_event" [FocusChangeMask] False afterFocusIn = event "focus_in_event" [FocusChangeMask] True -- | Widget looses input focus. -- onFocusOut, afterFocusOut :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onFocusOut = event "focus_out_event" [FocusChangeMask] False afterFocusOut = event "focus_out_event" [FocusChangeMask] True -- | The widget is about to receive all events. -- -- * It is possible to redirect all input events to one widget to force the -- user to use only this widget. Such a situation is initiated by -- 'addGrab'. -- onGrabFocus, afterGrabFocus :: WidgetClass w => w -> IO () -> IO (ConnectId w) onGrabFocus = connect_NONE__NONE "grab_focus" False afterGrabFocus = connect_NONE__NONE "grab_focus" True -- | The widget will be destroyed. -- -- * This is the last signal this widget will receive. -- onDestroy, afterDestroy :: WidgetClass w => w -> (IO ()) -> IO (ConnectId w) onDestroy = connect_NONE__NONE "destroy" False afterDestroy = connect_NONE__NONE "destroy" True -- | The widget was asked to hide itself. -- -- * This signal is emitted each time 'widgetHide' is called. Use -- 'onUnmap' when your application needs to be informed -- when the widget is actually removed from screen. -- onHide, afterHide :: WidgetClass w => w -> IO () -> IO (ConnectId w) onHide = connect_NONE__NONE "hide" False afterHide = connect_NONE__NONE "hide" True -- | The toplevel window changed. -- -- * When a subtree of widgets is removed or added from a tree with a toplevel -- window this signal is emitted. It is emitted on each widget in the -- detached or attached subtree. -- onHierarchyChanged, afterHierarchyChanged :: WidgetClass w => w -> IO () -> IO (ConnectId w) onHierarchyChanged = connect_NONE__NONE "hierarchy_changed" False afterHierarchyChanged = connect_NONE__NONE "hierarchy_changed" True -- | A key was pressed. -- onKeyPress, afterKeyPress :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onKeyPress = event "key_press_event" [KeyPressMask] False afterKeyPress = event "key_press_event" [KeyPressMask] True -- | A key was released. -- onKeyRelease, afterKeyRelease :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onKeyRelease = event "key_release_event" [KeyReleaseMask] False afterKeyRelease = event "key_release_event" [KeyReleaseMask] True -- | -- onMnemonicActivate, afterMnemonicActivate :: WidgetClass w => w -> (Bool -> IO Bool) -> IO (ConnectId w) onMnemonicActivate = connect_BOOL__BOOL "mnemonic_activate" False afterMnemonicActivate = connect_BOOL__BOOL "mnemonic_activate" True -- | Track mouse movements. -- -- * If @hint@ is False, a callback for every movement of the mouse is -- generated. To avoid a backlog of mouse messages, it is usually sufficient -- to sent @hint@ to True, generating only one event. The -- application now has to state that it is ready for the next message by -- calling 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowGetPointer'. -- onMotionNotify, afterMotionNotify :: WidgetClass w => w -> Bool -> (Event -> IO Bool) -> IO (ConnectId w) onMotionNotify w hint = event "motion_notify_event" (if hint then [PointerMotionMask, PointerMotionHintMask] else [PointerMotionMask]) False w afterMotionNotify w hint = event "motion_notify_event" (if hint then [PointerMotionMask, PointerMotionHintMask] else [PointerMotionMask]) True w -- | -- onParentSet, afterParentSet :: (WidgetClass w, WidgetClass old) => w -> (old -> IO ()) -> IO (ConnectId w) onParentSet = connect_OBJECT__NONE "parent_set" False afterParentSet = connect_OBJECT__NONE "parent_set" True -- | -- onPopupMenu, afterPopupMenu :: WidgetClass w => w -> IO () -> IO (ConnectId w) onPopupMenu = connect_NONE__NONE "popup_menu" False afterPopupMenu = connect_NONE__NONE "popup_menu" True -- | The input device became active. -- -- * This event indicates that a pen of a graphics tablet or similar device is -- now touching the tablet. -- onProximityIn, afterProximityIn :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onProximityIn = event "proximity_in_event" [ProximityInMask] False afterProximityIn = event "proximity_in_event" [ProximityInMask] True -- | The input device became inactive. -- -- * The pen was removed from the graphics tablet's surface. -- onProximityOut, afterProximityOut :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onProximityOut = event "proximity_out_event" [ProximityOutMask] False afterProximityOut = event "proximity_out_event" [ProximityOutMask] True -- | This widget's drawing area is about to be -- destroyed. -- onRealize, afterRealize :: WidgetClass w => w -> IO () -> IO (ConnectId w) onRealize = connect_NONE__NONE "realize" False afterRealize = connect_NONE__NONE "realize" True -- | The mouse wheel has turned. -- -- * The 'Event' is always 'Scroll'. -- onScroll, afterScroll :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onScroll = event "scroll_event" [ScrollMask] False afterScroll = event "scroll_event" [ScrollMask] True -- | The widget was asked to show itself. -- -- * This signal is emitted each time 'widgetShow' is called. Use -- 'onMap' when your application needs to be informed when -- the widget is actually shown. -- onShow, afterShow :: WidgetClass w => w -> IO () -> IO (ConnectId w) onShow = connect_NONE__NONE "show" False afterShow = connect_NONE__NONE "show" True -- | Inform widget about the size it has. -- -- * After querying a widget for the size it wants to have (through emitting -- the @\"sizeRequest\"@ signal) a container will emit this signal to -- inform the widget about the real size it should occupy. -- onSizeAllocate, afterSizeAllocate :: WidgetClass w => w -> (Allocation -> IO ()) -> IO (ConnectId w) onSizeAllocate = connect_BOXED__NONE "size_allocate" peek False afterSizeAllocate = connect_BOXED__NONE "size_allocate" peek True -- | Query the widget for the size it likes to -- have. -- -- * A parent container emits this signal to its child to query the needed -- height and width of the child. There is not guarantee that the widget -- will actually get this area. -- onSizeRequest, afterSizeRequest :: WidgetClass w => w -> (IO Requisition) -> IO (ConnectId w) onSizeRequest w fun = connect_PTR__NONE "size_request" False w (\rqPtr -> do req <- fun unless (rqPtr==nullPtr) $ poke rqPtr req) afterSizeRequest w fun = connect_PTR__NONE "size_request" True w (\rqPtr -> do req <- fun unless (rqPtr==nullPtr) $ poke rqPtr req) -- | -- onStateChanged, afterStateChanged :: WidgetClass w => w -> (StateType -> IO ()) -> IO (ConnectId w) onStateChanged = connect_ENUM__NONE "state_changed" False afterStateChanged = connect_ENUM__NONE "state_changed" True -- | The widget was removed from screen. -- onUnmap, afterUnmap :: WidgetClass w => w -> IO () -> IO (ConnectId w) onUnmap = connect_NONE__NONE "unmap" False afterUnmap = connect_NONE__NONE "unmap" True -- | This widget's drawing area is about to be -- destroyed. -- onUnrealize, afterUnrealize :: WidgetClass w => w -> IO () -> IO (ConnectId w) onUnrealize = connect_NONE__NONE "unrealize" False afterUnrealize = connect_NONE__NONE "unrealize" True -- | -- onVisibilityNotify, afterVisibilityNotify :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onVisibilityNotify = event "visibility_notify_event" [VisibilityNotifyMask] False afterVisibilityNotify = event "visibility_notify_event" [VisibilityNotifyMask] True -- | -- onWindowState, afterWindowState :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) onWindowState = event "window_state_event" [] False afterWindowState = event "window_state_event" [] True #endif gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/0000755000000000000000000000000007346545000016753 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/Action.chs0000644000000000000000000003753307346545000020702 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Action -- -- Author : Duncan Coutts, Andy Stewart -- -- Created: 6 April 2005 -- -- Copyright (C) 2005 Duncan Coutts -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- An action which can be triggered by a menu or toolbar item -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ActionMenuToolbar.Action ( -- * Detail -- -- | Actions represent operations that the user can be perform, along with -- some information how it should be presented in the interface. Each action -- provides methods to create icons, menu items and toolbar items representing -- itself. -- -- As well as the callback that is called when the action gets activated, -- the following also gets associated with the action: -- -- * a name (not translated, for path lookup) -- -- * a label (translated, for display) -- -- * an accelerator -- -- * whether label indicates a stock id -- -- * a tooltip (optional, translated) -- -- * a toolbar label (optional, shorter than label) -- -- The action will also have some state information: -- -- * visible (shown\/hidden) -- -- * sensitive (enabled\/disabled) -- -- Apart from regular actions, there are toggle actions, which can be -- toggled between two states and radio actions, of which only one in a group -- can be in the \"active\" state. Other actions can be implemented as 'Action' -- subclasses. -- -- Each action can have one or more proxy menu item, toolbar button or other -- proxy widgets. Proxies mirror the state of the action (text label, tooltip, -- icon, visible, sensitive, etc), and should change when the action's state -- changes. When the proxy is activated, it should activate its action. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----Action -- | +----'ToggleAction' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types Action, ActionClass, castToAction, gTypeAction, toAction, -- * Constructors actionNew, -- * Methods actionGetName, actionIsSensitive, actionGetSensitive, #if GTK_CHECK_VERSION(2,6,0) actionSetSensitive, #endif actionIsVisible, actionGetVisible, #if GTK_CHECK_VERSION(2,6,0) actionSetVisible, #endif actionActivate, actionCreateMenuItem, actionCreateToolItem, #if GTK_MAJOR_VERSION < 3 actionConnectProxy, actionDisconnectProxy, #endif actionGetProxies, actionConnectAccelerator, actionDisconnectAccelerator, #if GTK_CHECK_VERSION(2,6,0) actionGetAccelPath, #endif actionSetAccelPath, actionSetAccelGroup, -- * Attributes actionName, actionLabel, actionShortLabel, actionTooltip, actionStockId, actionVisibleHorizontal, #if GTK_CHECK_VERSION(2,6,0) actionVisibleOverflown, #endif actionVisibleVertical, actionIsImportant, actionHideIfEmpty, #if GTK_CHECK_VERSION(2,6,0) actionSensitive, actionVisible, actionAccelPath, #endif #if GTK_CHECK_VERSION(2,20,0) actionAlwaysShowImage, #endif -- * Signals actionActivated, -- * Deprecated #ifndef DISABLE_DEPRECATED onActionActivate, afterActionActivate, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'Action' object. To add the action to a 'ActionGroup' and -- set the accelerator for the action, call -- 'Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup.actionGroupAddActionWithAccel'. -- See "Graphics.UI.Gtk.ActionMenuToolbar.UIManager#XML-UI" for information on -- allowed action names. -- actionNew :: GlibString string => string -- ^ @name@ - A unique name for the action -> string -- ^ @label@ - the label displayed in menu items and on -- buttons -> Maybe string -- ^ @tooltip@ - a tooltip for the action -> Maybe StockId -- ^ @stockId@ - the stock icon to display in widgets -- representing the action -> IO Action actionNew name label tooltip stockId = wrapNewGObject mkAction $ maybeWith withUTFString stockId $ \stockIdPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> withUTFString label $ \labelPtr -> withUTFString name $ \namePtr -> {# call gtk_action_new #} namePtr labelPtr tooltipPtr stockIdPtr -------------------- -- Methods -- | Returns the name of the action. -- actionGetName :: (ActionClass self, GlibString string) => self -> IO string actionGetName self = {# call gtk_action_get_name #} (toAction self) >>= peekUTFString -- | Returns whether the action is effectively sensitive. -- actionIsSensitive :: ActionClass self => self -> IO Bool -- ^ returns @True@ if the action and its associated action group -- are both sensitive. actionIsSensitive self = liftM toBool $ {# call gtk_action_is_sensitive #} (toAction self) -- | Returns whether the action itself is sensitive. Note that this doesn't -- necessarily mean effective sensitivity. See 'actionIsSensitive' for that. -- actionGetSensitive :: ActionClass self => self -> IO Bool -- ^ returns @True@ if the action itself is sensitive. actionGetSensitive self = liftM toBool $ {# call gtk_action_get_sensitive #} (toAction self) #if GTK_CHECK_VERSION(2,6,0) -- | Sets the sensitive property of the action to @sensitive@. Note that -- this doesn't necessarily mean effective sensitivity. See 'actionIsSensitive' -- for that. -- -- * Available since Gtk+ version 2.6 -- actionSetSensitive :: ActionClass self => self -> Bool -- ^ @sensitive@ - @True@ to make the action sensitive -> IO () actionSetSensitive self sensitive = {# call gtk_action_set_sensitive #} (toAction self) (fromBool sensitive) #endif -- | Returns whether the action is effectively visible. -- actionIsVisible :: ActionClass self => self -> IO Bool -- ^ returns @True@ if the action and its associated action group -- are both visible. actionIsVisible self = liftM toBool $ {# call gtk_action_is_visible #} (toAction self) -- | Returns whether the action itself is visible. Note that this doesn't -- necessarily mean effective visibility. See 'actionIsSensitive' for that. -- actionGetVisible :: ActionClass self => self -> IO Bool -- ^ returns @True@ if the action itself is visible. actionGetVisible self = liftM toBool $ {# call gtk_action_get_visible #} (toAction self) #if GTK_CHECK_VERSION(2,6,0) -- | Sets the visible property of the action to @visible@. Note that this -- doesn't necessarily mean effective visibility. See 'actionIsVisible' for -- that. -- -- * Available since Gtk+ version 2.6 -- actionSetVisible :: ActionClass self => self -> Bool -- ^ @visible@ - @True@ to make the action visible -> IO () actionSetVisible self visible = {# call gtk_action_set_visible #} (toAction self) (fromBool visible) #endif -- | Emits the \"activate\" signal on the specified action, if it isn't -- insensitive. This gets called by the proxy widgets when they get activated. -- -- It can also be used to manually activate an action. -- actionActivate :: ActionClass self => self -> IO () actionActivate self = {# call gtk_action_activate #} (toAction self) -- | Creates a menu item widget that proxies for the given action. -- actionCreateMenuItem :: ActionClass self => self -> IO Widget -- ^ returns a menu item connected to the action. actionCreateMenuItem self = makeNewObject mkWidget $ {# call gtk_action_create_menu_item #} (toAction self) -- | Creates a toolbar item widget that proxies for the given action. -- actionCreateToolItem :: ActionClass self => self -> IO Widget -- ^ returns a toolbar item connected to the action. actionCreateToolItem self = makeNewObject mkWidget $ {# call gtk_action_create_tool_item #} (toAction self) #if GTK_MAJOR_VERSION < 3 -- | Connects a widget to an action object as a proxy. Synchronises various -- properties of the action with the widget (such as label text, icon, tooltip, -- etc), and attaches a callback so that the action gets activated when the -- proxy widget does. -- -- If the widget is already connected to an action, it is disconnected -- first. -- -- Removed in Gtk3. actionConnectProxy :: (ActionClass self, WidgetClass proxy) => self -> proxy -- ^ @proxy@ - the proxy widget -> IO () actionConnectProxy self proxy = {# call gtk_action_connect_proxy #} (toAction self) (toWidget proxy) -- | Disconnects a proxy widget from an action. -- -- Removed in Gtk3. actionDisconnectProxy :: (ActionClass self, WidgetClass proxy) => self -> proxy -- ^ @proxy@ - the proxy widget -> IO () actionDisconnectProxy self proxy = {# call gtk_action_disconnect_proxy #} (toAction self) (toWidget proxy) #endif -- | Returns the proxy widgets for an action. -- actionGetProxies :: ActionClass self => self -> IO [Widget] actionGetProxies self = {# call gtk_action_get_proxies #} (toAction self) >>= readGSList >>= mapM (\elemPtr -> makeNewObject mkWidget (return elemPtr)) -- | Installs the accelerator for @action@ if @action@ has an accel path and -- group. See 'actionSetAccelPath' and 'actionSetAccelGroup' -- -- Since multiple proxies may independently trigger the installation of the -- accelerator, the @action@ counts the number of times this function has been -- called and doesn't remove the accelerator until -- 'actionDisconnectAccelerator' has been called as many times. -- actionConnectAccelerator :: ActionClass self => self -> IO () actionConnectAccelerator self = {# call gtk_action_connect_accelerator #} (toAction self) -- | Undoes the effect of one call to 'actionConnectAccelerator'. -- actionDisconnectAccelerator :: ActionClass self => self -> IO () actionDisconnectAccelerator self = {# call gtk_action_disconnect_accelerator #} (toAction self) #if GTK_CHECK_VERSION(2,6,0) -- | Returns the accel path for this action. -- -- * Available since Gtk+ version 2.6 -- actionGetAccelPath :: (ActionClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the accel path for this action, or -- @Nothing@ if none is set. actionGetAccelPath self = {# call gtk_action_get_accel_path #} (toAction self) >>= maybePeek peekUTFString #endif -- | Sets the accel path for this action. All proxy widgets associated with -- the action will have this accel path, so that their accelerators are -- consistent. -- actionSetAccelPath :: (ActionClass self, GlibString string) => self -> string -- ^ @accelPath@ - the accelerator path -> IO () actionSetAccelPath self accelPath = withUTFString accelPath $ \accelPathPtr -> {# call gtk_action_set_accel_path #} (toAction self) accelPathPtr -- | Sets the 'AccelGroup' in which the accelerator for this action will be -- installed. -- actionSetAccelGroup :: ActionClass self => self -> AccelGroup -> IO () actionSetAccelGroup self accelGroup = {# call gtk_action_set_accel_group #} (toAction self) accelGroup -------------------- -- Attributes -- | A unique name for the action. -- -- Default value: \"\" -- actionName :: GlibString string => ActionClass self => Attr self string actionName = newAttrFromStringProperty "name" -- | The label used for menu items and buttons that activate this action. -- -- Default value: \"\" -- actionLabel :: GlibString string => ActionClass self => Attr self string actionLabel = newAttrFromStringProperty "label" -- | A shorter label that may be used on toolbar buttons. -- -- Default value: \"\" -- actionShortLabel :: GlibString string => ActionClass self => Attr self string actionShortLabel = newAttrFromStringProperty "short-label" -- | A tooltip for this action. -- -- Default value: @Nothing@ -- actionTooltip :: GlibString string => ActionClass self => Attr self (Maybe string) actionTooltip = newAttrFromMaybeStringProperty "tooltip" -- | The stock icon displayed in widgets representing this action. -- -- Default value: @Nothing@ -- actionStockId :: GlibString string => ActionClass self => Attr self (Maybe string) actionStockId = newAttrFromMaybeStringProperty "stock_id" -- | Whether the toolbar item is visible when the toolbar is in a horizontal -- orientation. -- -- Default value: @True@ -- actionVisibleHorizontal :: ActionClass self => Attr self Bool actionVisibleHorizontal = newAttrFromBoolProperty "visible-horizontal" #if GTK_CHECK_VERSION(2,6,0) -- | When @True@, toolitem proxies for this action are represented in the -- toolbar overflow menu. -- -- Default value: @True@ -- -- * Available since Gtk+ version 2.6 -- actionVisibleOverflown :: ActionClass self => Attr self Bool actionVisibleOverflown = newAttrFromBoolProperty "visible-overflown" #endif -- | Whether the toolbar item is visible when the toolbar is in a vertical -- orientation. -- -- Default value: @True@ -- actionVisibleVertical :: ActionClass self => Attr self Bool actionVisibleVertical = newAttrFromBoolProperty "visible-vertical" -- | Whether the action is considered important. When @True@, toolitem proxies -- for this action show text in -- 'Graphics.UI.Gtk.MenuComboToolbar.Toolbar.ToolbarBothHoriz' mode. -- -- Default value: @False@ -- actionIsImportant :: ActionClass self => Attr self Bool actionIsImportant = newAttrFromBoolProperty "is-important" -- | When @True@, empty menu proxies for this action are hidden. -- -- Default value: @True@ -- actionHideIfEmpty :: ActionClass self => Attr self Bool actionHideIfEmpty = newAttrFromBoolProperty "hide-if-empty" #if GTK_CHECK_VERSION(2,6,0) -- | Whether the action is enabled. -- -- Default value: @True@ -- -- * Available since Gtk+ version 2.6 -- actionSensitive :: ActionClass self => Attr self Bool actionSensitive = newAttr actionGetSensitive actionSetSensitive -- | Whether the action is visible. -- -- Default value: @True@ -- -- * Available since Gtk+ version 2.6 -- actionVisible :: ActionClass self => Attr self Bool actionVisible = newAttr actionGetVisible actionSetVisible -- | \'accelPath\' property. See 'actionGetAccelPath' and 'actionSetAccelPath' -- -- * Available since Gtk+ version 2.6 -- actionAccelPath :: GlibString string => ActionClass self => ReadWriteAttr self (Maybe string) string actionAccelPath = newAttr actionGetAccelPath actionSetAccelPath #endif #if GTK_CHECK_VERSION(2,20,0) -- | If 'True', the action's menu item proxies will ignore the 'menuImages' setting and always show -- their image, if available. -- -- Use this property if the menu item would be useless or hard to use without their image. -- -- Default value: 'False' -- -- Since 2.20 actionAlwaysShowImage :: ActionClass self => Attr self Bool actionAlwaysShowImage = newAttrFromBoolProperty "always-show-image" #endif -------------------- -- Signals -- %hash c:4608 d:49a3 -- | The \"activate\" signal is emitted when the action is activated. -- actionActivated :: ActionClass self => Signal self (IO ()) actionActivated = Signal (connect_NONE__NONE "activate") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | The \"activate\" signal is emitted when the action is activated. -- onActionActivate, afterActionActivate :: ActionClass self => self -> IO () -> IO (ConnectId self) onActionActivate = connect_NONE__NONE "activate" False afterActionActivate = connect_NONE__NONE "activate" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs0000644000000000000000000004106107346545000021706 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ActionGroup -- -- Author : Duncan Coutts -- -- Created: 6 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) -- -- A group of actions -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup ( -- * Detail -- -- | Actions are organised into groups. An action group is essentially a map -- from names to 'Action' objects. -- -- All actions that would make sense to use in a particular context should -- be in a single group. Multiple action groups may be used for a particular -- user interface. In fact, it is expected that most nontrivial applications -- will make use of multiple groups. For example, in an application that can -- edit multiple documents, one group holding global actions (e.g. quit, about, -- new), and one group per document holding actions that act on that document -- (eg. save, cut\/copy\/paste, etc). Each window's menus would be constructed -- from a combination of two action groups. -- -- Accelerators are handled by the Gtk+ accelerator map. All actions are -- assigned an accelerator path (which normally has the form -- @\\/group-name\/action-name@) and a shortcut is associated with -- this accelerator path. All menuitems and toolitems take on this accelerator -- path. The Gtk+ accelerator map code makes sure that the correct shortcut is -- displayed next to the menu item. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----ActionGroup -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ActionGroup, ActionGroupClass, castToActionGroup, gTypeActionGroup, toActionGroup, ActionEntry(..), ToggleActionEntry(..), RadioActionEntry(..), -- * Constructors actionGroupNew, -- * Methods actionGroupGetName, actionGroupGetSensitive, actionGroupSetSensitive, actionGroupGetVisible, actionGroupSetVisible, actionGroupGetAction, actionGroupListActions, actionGroupAddAction, actionGroupAddActionWithAccel, actionGroupRemoveAction, actionGroupAddActions, actionGroupAddToggleActions, actionGroupAddRadioActions, actionGroupSetTranslateFunc, actionGroupSetTranslationDomain, #if GTK_CHECK_VERSION(2,6,0) actionGroupTranslateString, #endif -- * Attributes actionGroupName, actionGroupSensitive, actionGroupVisible, -- * Signals -- onConnectProxy, -- afterConnectProxy, -- onDisconnectProxy, -- afterDisconnectProxy, -- onPreActivate, -- afterPreActivate, -- onPostActivate, -- afterPostActivate, #endif ) where import Control.Monad (liftM, foldM, when) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} import System.Glib.Signals (on) import Graphics.UI.Gtk.ActionMenuToolbar.Action import Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction import Graphics.UI.Gtk.ActionMenuToolbar.RadioAction {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'ActionGroup' object. The name of the action group is used -- when associating keybindings with the actions. -- actionGroupNew :: GlibString string => string -- ^ @name@ - the name of the action group. -> IO ActionGroup actionGroupNew name = wrapNewGObject mkActionGroup $ withUTFString name $ \namePtr -> {# call gtk_action_group_new #} namePtr -------------------- -- Methods -- | Gets the name of the action group. -- actionGroupGetName :: GlibString string => ActionGroup -> IO string -- ^ returns the name of the action group. actionGroupGetName self = {# call gtk_action_group_get_name #} self >>= peekUTFString -- | Returns @True@ if the group is sensitive. The constituent actions can -- only be logically sensitive (see 'actionIsSensitive') if they are sensitive -- (see 'actionGetSensitive') and their group is sensitive. -- actionGroupGetSensitive :: ActionGroup -> IO Bool actionGroupGetSensitive self = liftM toBool $ {# call gtk_action_group_get_sensitive #} self -- | Changes the sensitivity of @actionGroup@ -- actionGroupSetSensitive :: ActionGroup -> Bool -> IO () actionGroupSetSensitive self sensitive = {# call gtk_action_group_set_sensitive #} self (fromBool sensitive) -- | Returns @True@ if the group is visible. The constituent actions can only -- be logically visible (see 'actionIsVisible') if they are visible (see -- 'actionGetVisible') and their group is visible. -- actionGroupGetVisible :: ActionGroup -> IO Bool actionGroupGetVisible self = liftM toBool $ {# call gtk_action_group_get_visible #} self -- | Changes the visible of @actionGroup@. -- actionGroupSetVisible :: ActionGroup -> Bool -> IO () actionGroupSetVisible self visible = {# call gtk_action_group_set_visible #} self (fromBool visible) -- | Looks up an action in the action group by name. -- actionGroupGetAction :: GlibString string => ActionGroup -> string -- ^ @actionName@ - the name of the action -> IO (Maybe Action) -- ^ returns the action, or @Nothing@ if no action by -- that name exists actionGroupGetAction self actionName = maybeNull (makeNewGObject mkAction) $ withUTFString actionName $ \actionNamePtr -> {# call gtk_action_group_get_action #} self actionNamePtr -- | Lists the actions in the action group. -- actionGroupListActions :: ActionGroup -> IO [Action] -- ^ returns a list of the action objects in the action group actionGroupListActions self = {# call gtk_action_group_list_actions #} self >>= fromGList >>= mapM (\elemPtr -> makeNewGObject mkAction (return elemPtr)) -- | Adds an action object to the action group. Note that this function does -- not set up the accel path of the action, which can lead to problems if a -- user tries to modify the accelerator of a menuitem associated with the -- action. Therefore you must either set the accel path yourself with -- 'actionSetAccelPath', or use @'actionGroupAddActionWithAccel' ... Nothing@. -- actionGroupAddAction :: ActionClass action => ActionGroup -> action -> IO () actionGroupAddAction self action = {# call gtk_action_group_add_action #} self (toAction action) -- | Adds an action object to the action group and sets up the accelerator. -- -- If @accelerator@ is @Nothing@, attempts to use the accelerator associated -- with the stock id of the action. -- -- Accel paths are set to @\\/group-name\/action-name@. -- actionGroupAddActionWithAccel :: (ActionClass action, GlibString string) => ActionGroup -> action -- ^ @action@ - the action to add -> Maybe string -- ^ @accelerator@ - the accelerator for the action, in the -- format understood by 'acceleratorParse', or \"\" for no -- accelerator, or @Nothing@ to use the stock accelerator -> IO () actionGroupAddActionWithAccel self action accelerator = maybeWith withUTFString accelerator $ \acceleratorPtr -> {# call gtk_action_group_add_action_with_accel #} self (toAction action) acceleratorPtr -- | Removes an action object from the action group. -- actionGroupRemoveAction :: ActionClass action => ActionGroup -> action -> IO () actionGroupRemoveAction self action = {# call gtk_action_group_remove_action #} self (toAction action) -- Note: for these next few functions we cannot use the C version because the -- callback doesn't allow for proper memory management. So like pygtk we -- implement them natively since they are only convenience functions after all. -- | A description of an action. data ActionEntry = ActionEntry { actionEntryName :: DefaultGlibString, actionEntryLabel :: DefaultGlibString, actionEntryStockId :: Maybe DefaultGlibString, actionEntryAccelerator :: Maybe DefaultGlibString, actionEntryTooltip :: Maybe DefaultGlibString, actionEntryCallback :: IO () } -- | This is a convenience function to create a number of actions and add them -- to the action group. -- -- The 'actionActivated' signals of the actions are connected to the callbacks -- and their accel paths are set to @\\/group-name\/action-name@. -- actionGroupAddActions :: ActionGroup -> [ActionEntry] -- ^ @entries@ - a list of action descriptions -> IO () actionGroupAddActions self entries = flip mapM_ entries $ \(ActionEntry name label stockId accelerator tooltip callback) -> do action <- actionNew name label tooltip stockId action `on` actionActivated $ callback actionGroupAddActionWithAccel self action accelerator -- | A description of an action for an entry that can be toggled. data ToggleActionEntry = ToggleActionEntry { toggleActionName :: DefaultGlibString, toggleActionLabel :: DefaultGlibString, toggleActionStockId :: Maybe DefaultGlibString, toggleActionAccelerator :: Maybe DefaultGlibString, toggleActionTooltip :: Maybe DefaultGlibString, toggleActionCallback :: IO (), toggleActionIsActive :: Bool } -- | This is a convenience function to create a number of toggle actions and -- add them to the action group. -- -- The 'actionActivated' signals of the actions are connected to the callbacks -- and their accel paths are set to @\\/group-name\/action-name@. -- actionGroupAddToggleActions :: ActionGroup -> [ToggleActionEntry] -- ^ @entries@ - a list of toggle action descriptions -> IO () actionGroupAddToggleActions self entries = flip mapM_ entries $ \(ToggleActionEntry name label stockId accelerator tooltip callback isActive) -> do action <- toggleActionNew name label tooltip stockId toggleActionSetActive action isActive action `on` actionActivated $ callback actionGroupAddActionWithAccel self action accelerator -- | A description of an action for an entry that provides a multiple choice. data RadioActionEntry = RadioActionEntry { radioActionName :: DefaultGlibString, radioActionLabel :: DefaultGlibString, radioActionStockId :: Maybe DefaultGlibString, radioActionAccelerator :: Maybe DefaultGlibString, radioActionTooltip :: Maybe DefaultGlibString, radioActionValue :: Int } -- | This is a convenience routine to create a group of radio actions and add -- them to the action group. -- -- The 'radioActionChanged' signal of the first radio action is connected to the -- @onChange@ callback and the accel paths of the actions are set to -- @\\/group-name\/action-name@. -- actionGroupAddRadioActions :: ActionGroup -> [RadioActionEntry] -- ^ @entries@ - a list of radio action descriptions -> Int -- ^ @value@ - the value of the action to activate -- initially, or -1 if no action should be activated -> (RadioAction -> IO ()) -- ^ @onChange@ - the callback for the changed signal -> IO () actionGroupAddRadioActions self entries initialValue onChange = do group <- foldM (\group (RadioActionEntry name label stockId accelerator tooltip value) -> do action <- radioActionNew name label tooltip stockId value case group of Nothing -> return () Just group -> radioActionSetGroup action group when (initialValue == value) (toggleActionSetActive action True) actionGroupAddActionWithAccel self action accelerator return (Just action)) Nothing entries case group of Nothing -> return () Just group -> do group `on` radioActionChanged $ onChange return () -- | Sets a function to be used for translating the @label@ and @tooltip@ of -- 'ActionEntry's added by 'actionGroupAddActions'. -- -- If you\'re using \'gettext\', it is enough to set the translation domain -- with 'actionGroupSetTranslationDomain'. -- actionGroupSetTranslateFunc :: GlibString string => ActionGroup -> (string -> IO string) -- ^ @(\label -> ...)@ - a translation function -> IO () actionGroupSetTranslateFunc self func = do funcPtr <- mkTranslateFunc $ \strPtr _ -> do str <- peekUTFString strPtr translatedStr <- func str newUTFString translatedStr {# call gtk_action_group_set_translate_func #} self funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr {#pointer TranslateFunc#} foreign import ccall "wrapper" mkTranslateFunc :: (CString -> Ptr () -> IO CString) -> IO TranslateFunc -- | Sets the translation domain and uses \'dgettext\' for translating the -- @label@ and @tooltip@ of 'ActionEntry's added by 'actionGroupAddActions'. -- -- If you\'re not using \'gettext\' for localization, see -- 'actionGroupSetTranslateFunc'. -- actionGroupSetTranslationDomain :: GlibString string => ActionGroup -> string -- ^ @domain@ - the translation domain to use for \'dgettext\' -- calls -> IO () actionGroupSetTranslationDomain self domain = withUTFString domain $ \domainPtr -> {# call gtk_action_group_set_translation_domain #} self domainPtr #if GTK_CHECK_VERSION(2,6,0) -- | Translates a string. -- -- * Available since Gtk+ version 2.6 -- actionGroupTranslateString :: GlibString string => ActionGroup -> string -- ^ @string@ - a string -> IO string -- ^ returns the translation of @string@ actionGroupTranslateString self string = withUTFString string $ \stringPtr -> {# call gtk_action_group_translate_string #} self stringPtr >>= peekUTFString #endif -------------------- -- Attributes -- | A name for the action group. -- -- Default value: \"\" -- actionGroupName :: GlibString string => Attr ActionGroup string actionGroupName = newAttrFromStringProperty "name" -- | Whether the action group is enabled. -- -- Default value: @True@ -- actionGroupSensitive :: Attr ActionGroup Bool actionGroupSensitive = newAttr actionGroupGetSensitive actionGroupSetSensitive -- | Whether the action group is visible. -- -- Default value: @True@ -- actionGroupVisible :: Attr ActionGroup Bool actionGroupVisible = newAttr actionGroupGetVisible actionGroupSetVisible -------------------- -- Signals {- -- | The connect_proxy signal is emitted after connecting a proxy to an action -- in the group. Note that the proxy may have been connected to a different -- action before. -- -- This is intended for simple customizations for which a custom action -- class would be too clumsy, e.g. showing tooltips for menuitems in the -- statusbar. -- onConnectProxy, afterConnectProxy :: ActionGroupClass self => self -> ({-GtkAction-} -> {-GtkWidget-} -> IO ()) -> IO (ConnectId self) onConnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "connect_proxy" False afterConnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "connect_proxy" True -- | The disconnect_proxy signal is emitted after disconnecting a proxy from -- an action in the group. -- onDisconnectProxy, afterDisconnectProxy :: ActionGroupClass self => self -> ({-GtkAction-} -> {-GtkWidget-} -> IO ()) -> IO (ConnectId self) onDisconnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "disconnect_proxy" False afterDisconnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "disconnect_proxy" True -- | The pre_activate signal is emitted just before the @action@ in the -- @actionGroup@ is activated -- -- This is intended for 'UIManager' to proxy the signal and provide global -- notification just before any action is activated. -- onPreActivate, afterPreActivate :: ActionGroupClass self => self -> ({-GtkAction-} -> IO ()) -> IO (ConnectId self) onPreActivate = connect_{-GtkAction-}__NONE "pre_activate" False afterPreActivate = connect_{-GtkAction-}__NONE "pre_activate" True -- | The post_activate signal is emitted just after the @action@ in the -- @actionGroup@ is activated -- -- This is intended for 'UIManager' to proxy the signal and provide global -- notification just after any action is activated. -- onPostActivate, afterPostActivate :: ActionGroupClass self => self -> ({-GtkAction-} -> IO ()) -> IO (ConnectId self) onPostActivate = connect_{-GtkAction-}__NONE "post_activate" False afterPostActivate = connect_{-GtkAction-}__NONE "post_activate" True -} #endif gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/RadioAction.chs0000644000000000000000000001515207346545000021652 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RadioAction -- -- Author : Duncan Coutts -- -- Created: 6 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. -- -- TODO -- I don't know what the element type of the group GSList is for -- radioActionSetGroup / radioActionGetGroup -- -- Also, the signals clash with those from other modules -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- An action of which only one in a group can be active -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ActionMenuToolbar.RadioAction ( -- * Detail -- -- | A 'RadioAction' is similar to 'RadioMenuItem'. A number of radio actions -- can be linked together so that only one may be active at any one time. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Action' -- | +----'ToggleAction' -- | +----RadioAction -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types RadioAction, RadioActionClass, castToRadioAction, gTypeRadioAction, toRadioAction, -- * Constructors radioActionNew, -- * Methods radioActionGetGroup, radioActionSetGroup, radioActionGetCurrentValue, -- * Attributes radioActionValueAttr, radioActionGroup, #if GTK_CHECK_VERSION(2,10,0) radioActionCurrentValue, #endif -- * Signals radioActionChanged, #ifndef DISABLE_DEPRECATED -- * Deprecated onRadioActionChanged, afterRadioActionChanged, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'RadioAction' object. To add the action to a 'ActionGroup' -- and set the accelerator for the action, call -- 'Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup.actionGroupAddActionWithAccel'. -- radioActionNew :: GlibString string => string -- ^ @name@ - A unique name for the action -> string -- ^ @label@ - The label displayed in menu items and on -- buttons -> Maybe string -- ^ @tooltip@ - A tooltip for this action -> Maybe StockId -- ^ @stockId@ - The stock icon to display in widgets -- representing this action -> Int -- ^ @value@ - The value which 'radioActionGetCurrentValue' -- should return if this action is selected. -> IO RadioAction radioActionNew name label tooltip stockId value = wrapNewGObject mkRadioAction $ maybeWith withUTFString stockId $ \stockIdPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> withUTFString label $ \labelPtr -> withUTFString name $ \namePtr -> {# call gtk_radio_action_new #} namePtr labelPtr tooltipPtr stockIdPtr (fromIntegral value) -------------------- -- Methods -- | Returns the list representing the radio group for this object -- radioActionGetGroup :: RadioActionClass self => self -> IO [RadioAction] -- ^ returns the members of the radio group radioActionGetGroup self = {# call unsafe gtk_radio_action_get_group #} (toRadioAction self) >>= readGSList >>= mapM (\elemPtr -> makeNewGObject mkRadioAction (return elemPtr)) -- | Sets the radio group for the radio action object. -- radioActionSetGroup :: (RadioActionClass self, RadioActionClass groupMember) => self -> groupMember -- ^ @groupMember@ - an existing member of the radio group -> IO () radioActionSetGroup self group = do groupPtr <- {# call unsafe gtk_radio_action_get_group #} (toRadioAction group) {# call gtk_radio_action_set_group #} (toRadioAction self) groupPtr -- | Obtains the value property of the currently active member of the group to -- which the action belongs. -- radioActionGetCurrentValue :: RadioActionClass self => self -> IO Int -- ^ returns the value of the currently active group member radioActionGetCurrentValue self = liftM fromIntegral $ {# call gtk_radio_action_get_current_value #} (toRadioAction self) -------------------- -- Attributes -- %hash d:1bcf -- | The value is an arbitrary integer which can be used as a convenient way -- to determine which action in the group is currently active in an ::activate -- or ::changed signal handler. See 'radioActionGetCurrentValue' and -- 'RadioActionEntry' for convenient ways to get and set -- this property. -- -- Default value: 0 -- radioActionValueAttr :: RadioActionClass self => Attr self Int radioActionValueAttr = newAttrFromIntProperty "value" -- %hash c:a380 -- | Sets a new group for a radio action. -- radioActionGroup :: RadioActionClass self => ReadWriteAttr self [RadioAction] RadioAction radioActionGroup = newAttr radioActionGetGroup radioActionSetGroup #if GTK_CHECK_VERSION(2,10,0) -- %hash c:4cec d:1710 -- | The value property of the currently active member of the group to which -- this action belongs. -- -- Default value: 0 -- -- * Available since Gtk+ version 2.10 -- radioActionCurrentValue :: RadioActionClass self => Attr self Int radioActionCurrentValue = newAttrFromIntProperty "current-value" #endif -- | The 'radioActionChanged' signal is emitted on every member of a radio group when the -- active member is changed. The signal gets emitted after the 'actionActivated' signals for the -- previous and current active members. -- radioActionChanged :: RadioActionClass self => Signal self (RadioAction -> IO ()) radioActionChanged = Signal (connect_OBJECT__NONE "changed") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | The changed signal is emitted on every member of a radio group when the -- active member is changed. The signal gets emitted after the activate -- signals for the previous and current active members. -- onRadioActionChanged, afterRadioActionChanged :: RadioActionClass self => self -> (RadioAction -> IO ()) -> IO (ConnectId self) onRadioActionChanged = connect_OBJECT__NONE "changed" False afterRadioActionChanged = connect_OBJECT__NONE "changed" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/RecentAction.chs0000644000000000000000000001061607346545000022034 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RecentAction -- -- Author : Andy Stewart -- -- Created: 24 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- An action of which represents a list of recently used files -- -- * Module available since Gtk+ version 2.12 -- module Graphics.UI.Gtk.ActionMenuToolbar.RecentAction ( -- * Detail -- -- | A 'RecentAction' represents a list of recently used files, which can be -- shown by widgets such as 'RecentChooserDialog' or 'RecentChooserMenu'. -- -- To construct a submenu showing recently used files, use a 'RecentAction' -- as the action for a \. To construct a menu toolbutton showing the -- recently used files in the popup menu, use a 'RecentAction' as the action -- for a \ element. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Action' -- | +----RecentAction -- @ #if GTK_CHECK_VERSION(2,12,0) -- * Types RecentAction, RecentActionClass, castToRecentAction, toRecentAction, -- * Constructors recentActionNew, recentActionNewForManager, -- * Attributes recentActionShowNumbers, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,12,0) -------------------- -- Constructors -- | Creates a new 'RecentAction' object. To add the action to a 'ActionGroup' -- and set the accelerator for the action, call -- 'actionGroupAddActionWithAccel'. -- recentActionNew :: GlibString string => string -- ^ @name@ - a unique name for the action -> Maybe string -- ^ @label@ - the label displayed in menu items and on buttons, or 'Nothing' -> Maybe string -- ^ @tooltip@ - a tooltip for the action, or 'Nothing' -> Maybe string -- ^ @stockId@ - the stock icon to display in widgets representing -- the action, or 'Nothing' -> IO RecentAction recentActionNew name label tooltip stockId = wrapNewGObject mkRecentAction $ liftM castPtr $ withUTFString name $ \namePtr -> maybeWith withUTFString label $ \labelPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> maybeWith withUTFString stockId $ \stockIdPtr -> {# call gtk_recent_action_new #} namePtr labelPtr tooltipPtr stockIdPtr -- | Creates a new 'RecentAction' object. To add the action to a 'ActionGroup' -- and set the accelerator for the action, call -- 'actionGroupAddActionWithAccel'. -- recentActionNewForManager :: (RecentManagerClass manager, GlibString string) => string -- ^ @name@ - a unique name for the action -> Maybe string -- ^ @label@ - the label displayed in menu items and on buttons, -- or 'Nothing' -> Maybe string -- ^ @tooltip@ - a tooltip for the action, or 'Nothing' -> Maybe string -- ^ @stockId@ - the stock icon to display in widgets representing -- the action, or 'Nothing' -> Maybe manager -- ^ @manager@ - a 'RecentManager', or 'Nothing' for the -- default 'RecentManager' -> IO RecentAction recentActionNewForManager name label tooltip stockId manager = wrapNewGObject mkRecentAction $ liftM castPtr $ withUTFString name $ \namePtr -> maybeWith withUTFString label $ \labelPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> maybeWith withUTFString stockId $ \stockIdPtr -> do {# call gtk_recent_action_new_for_manager #} namePtr labelPtr tooltipPtr stockIdPtr (maybe (RecentManager nullForeignPtr) toRecentManager manager) -------------------- -- Attributes -- | If recent items should be shown with numbers next to them. -- recentActionShowNumbers :: RecentActionClass self => Attr self Bool recentActionShowNumbers = newAttrFromBoolProperty "show-numbers" #endif gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/ToggleAction.chs0000644000000000000000000001353107346545000022034 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToggleAction -- -- Author : Duncan Coutts -- -- Created: 6 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) -- -- An action which can be toggled between two states -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction ( -- * Detail -- -- | A 'ToggleAction' corresponds roughly to a 'CheckMenuItem'. It has an -- \"active\" state specifying whether the action has been checked or not. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Action' -- | +----ToggleAction -- | +----'RadioAction' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ToggleAction, ToggleActionClass, castToToggleAction, gTypeToggleAction, toToggleAction, -- * Constructors toggleActionNew, -- * Methods toggleActionToggled, toggleActionSetActive, toggleActionGetActive, toggleActionSetDrawAsRadio, toggleActionGetDrawAsRadio, -- * Attributes toggleActionDrawAsRadio, #if GTK_CHECK_VERSION(2,10,0) toggleActionActive, #endif -- * Signals actionToggled, -- * Deprecated #ifndef DISABLE_DEPRECATED onActionToggled, afterActionToggled, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'ToggleAction' object. To add the action to a 'ActionGroup' -- and set the accelerator for the action, call -- 'Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup.actionGroupAddActionWithAccel'. -- toggleActionNew :: GlibString string => string -- ^ @name@ - A unique name for the action -> string -- ^ @label@ - The label displayed in menu items and on -- buttons -> Maybe string -- ^ @tooltip@ - A tooltip for the action -> Maybe StockId -- ^ @stockId@ - The stock icon to display in widgets -- representing the action -> IO ToggleAction toggleActionNew name label tooltip stockId = wrapNewGObject mkToggleAction $ maybeWith withUTFString stockId $ \stockIdPtr -> maybeWith withUTFString tooltip $ \tooltipPtr -> withUTFString label $ \labelPtr -> withUTFString name $ \namePtr -> {# call gtk_toggle_action_new #} namePtr labelPtr tooltipPtr stockIdPtr -------------------- -- Methods -- | Emits the \"toggled\" signal on the toggle action. -- toggleActionToggled :: ToggleActionClass self => self -> IO () toggleActionToggled self = {# call gtk_toggle_action_toggled #} (toToggleAction self) -- | Sets the checked state on the toggle action. -- toggleActionSetActive :: ToggleActionClass self => self -> Bool -- ^ @isActive@ - whether the action should be checked or not -> IO () toggleActionSetActive self isActive = {# call gtk_toggle_action_set_active #} (toToggleAction self) (fromBool isActive) -- | Returns the checked state of the toggle action. -- toggleActionGetActive :: ToggleActionClass self => self -> IO Bool toggleActionGetActive self = liftM toBool $ {# call gtk_toggle_action_get_active #} (toToggleAction self) -- | Sets whether the action should have proxies like a radio action. -- toggleActionSetDrawAsRadio :: ToggleActionClass self => self -> Bool -> IO () toggleActionSetDrawAsRadio self drawAsRadio = {# call gtk_toggle_action_set_draw_as_radio #} (toToggleAction self) (fromBool drawAsRadio) -- | Returns whether the action should have proxies like a radio action. -- toggleActionGetDrawAsRadio :: ToggleActionClass self => self -> IO Bool toggleActionGetDrawAsRadio self = liftM toBool $ {# call gtk_toggle_action_get_draw_as_radio #} (toToggleAction self) -------------------- -- Attributes -- | Whether the proxies for this action look like radio action proxies. -- -- Default value: @False@ -- toggleActionDrawAsRadio :: ToggleActionClass self => Attr self Bool toggleActionDrawAsRadio = newAttr toggleActionGetDrawAsRadio toggleActionSetDrawAsRadio #if GTK_CHECK_VERSION(2,10,0) -- %hash c:cd0e d:4024 -- | If the toggle action should be active in or not. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.10 -- toggleActionActive :: ToggleActionClass self => Attr self Bool toggleActionActive = newAttrFromBoolProperty "active" #endif -------------------- -- Signals -- %hash c:3829 d:af3f -- | -- actionToggled :: ToggleActionClass self => Signal self (IO ()) actionToggled = Signal (connect_NONE__NONE "toggled") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- %hash c:9cc4 onActionToggled :: ToggleActionClass self => self -> IO () -> IO (ConnectId self) onActionToggled = connect_NONE__NONE "toggled" False {-# DEPRECATED onActionToggled "instead of 'onActionToggled obj' use 'on obj actionToggled'" #-} -- %hash c:61e3 afterActionToggled :: ToggleActionClass self => self -> IO () -> IO (ConnectId self) afterActionToggled = connect_NONE__NONE "toggled" True {-# DEPRECATED afterActionToggled "instead of 'afterActionToggled obj' use 'after obj actionToggled'" #-} #endif #endif gtk-0.15.9/Graphics/UI/Gtk/ActionMenuToolbar/UIManager.chs0000644000000000000000000005442307346545000021272 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget UIManager -- -- Author : Duncan Coutts -- -- Created: 6 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. -- -- TODO -- check if uiManagerGetToplevels returns widgets derived from some common -- class, eg ToolItem (though it looks like it can return MenuBars too) -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Constructing menus and toolbars from an XML description -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ActionMenuToolbar.UIManager ( -- * Detail -- -- | A 'UIManager' constructs a user interface (menus and toolbars) from one -- or more UI definitions, which reference actions from one or more action -- groups. -- ** UI Definitions -- -- | #XML-UI# The UI definitions are specified in an XML format which can be roughly -- described by the following DTD. -- -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > action #IMPLIED > -- > action #IMPLIED > -- > action #IMPLIED > -- > action #IMPLIED -- > expand (true|false) #IMPLIED > -- > action #IMPLIED > -- > action #REQUIRED -- > position (top|bot) #IMPLIED > -- > action #REQUIRED -- > position (top|bot) #IMPLIED > -- > action #REQUIRED -- > position (top|bot) #IMPLIED > -- > action #REQUIRED > -- -- There are some additional restrictions beyond those specified in the DTD, -- e.g. every toolitem must have a toolbar in its anchestry and every menuitem -- must have a menubar or popup in its anchestry. Since a GMarkup -- parser is used to parse the UI description, it must not -- only be valid XML, but valid GMarkup. -- -- If a name is not specified, it defaults to the action. If an action is -- not specified either, the element name is used. The name and action -- attributes must not contain \'\/\' characters after parsing (since that -- would mess up path lookup) and must be usable as XML attributes when -- enclosed in doublequotes, thus they must not \'\"\' characters or references -- to the " entity. -- ** A UI definition -- | -- -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- The constructed widget hierarchy is very similar to the element tree of -- the XML, with the exception that placeholders are merged into their parents. -- The correspondence of XML elements to widgets should be almost obvious: -- -- [menubar] a 'MenuBar' -- -- [toolbar] a 'Toolbar' -- -- [popup] a toplevel 'Menu' -- -- [menu] a 'Menu' attached to a menuitem -- -- [menuitem] a 'MenuItem' subclass, the exact type depends on the action -- -- [toolitem] a 'ToolItem' subclass, the exact type depends on the action. -- Note that toolitem elements may contain a menu element, but only if their -- associated action specifies a 'MenuToolButton' as proxy. -- -- [separator] a 'SeparatorMenuItem' or 'SeparatorToolItem' -- -- [accelerator] a keyboard accelerator -- -- The \"position\" attribute determines where a constructed widget is -- positioned wrt. to its siblings in the partially constructed tree. If it is -- \"top\", the widget is prepended, otherwise it is appended. -- ** UI Merging -- -- | The most remarkable feature of 'UIManager' is that it can overlay a set -- of menuitems and toolitems over another one, and demerge them later. -- -- Merging is done based on the names of the XML elements. Each element is -- identified by a path which consists of the names of its ancestors, -- separated by slashes. For example, the menuitem named \"Left\" in the -- example above has the path @\/ui\/menubar\/JustifyMenu\/Left@ and the -- toolitem with the same name has path -- @\/ui\/toolbar1\/JustifyToolItems\/Left@. -- ** Accelerators -- -- | Every action has an accelerator path. Accelerators are installed together -- with menuitem proxies, but they can also be explicitly added with -- \ elements in the UI definition. This makes it possible to have -- accelerators for actions even if they have no visible proxies. -- ** Smart Separators -- -- | The separators created by 'UIManager' are \"smart\", i.e. they do not -- show up in the UI unless they end up between two visible menu or tool items. -- Separators which are located at the very beginning or end of the menu or -- toolbar containing them, or multiple separators next to each other, are -- hidden. This is a useful feature, since the merging of UI elements from -- multiple sources can make it hard or impossible to determine in advance -- whether a separator will end up in such an unfortunate position. -- -- For separators in toolbars, you can set @expand=\"true\"@ to turn them -- from a small, visible separator to an expanding, invisible one. Toolitems -- following an expanding separator are effectively right-aligned. -- ** Empty Menus -- -- | Submenus pose similar problems to separators inconnection with merging. -- It is impossible to know in advance whether they will end up empty after -- merging. 'UIManager' offers two ways to treat empty submenus: -- -- * make them disappear by hiding the menu item they\'re attached to -- -- * add an insensitive \"Empty\" item -- -- The behaviour is chosen based on the \"hide_if_empty\" property of the -- action to which the submenu is associated. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----UIManager -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types UIManager, UIManagerClass, castToUIManager, gTypeUIManager, toUIManager, UIManagerItemType(..), MergeId, -- * Constructors uiManagerNew, -- * Methods uiManagerSetAddTearoffs, uiManagerGetAddTearoffs, uiManagerInsertActionGroup, uiManagerRemoveActionGroup, uiManagerGetActionGroups, uiManagerGetAccelGroup, uiManagerGetWidget, uiManagerGetToplevels, uiManagerGetAction, uiManagerAddUiFromString, uiManagerAddUiFromFile, uiManagerNewMergeId, uiManagerAddUi, uiManagerRemoveUi, uiManagerGetUi, uiManagerEnsureUpdate, -- * Attributes uiManagerAddTearoffs, uiManagerUi, -- * Signals addWidget, actionsChanged, -- * Deprecated #ifndef DISABLE_DEPRECATED onAddWidget, afterAddWidget, onActionsChanged, afterActionsChanged, onConnectProxy, afterConnectProxy, onDisconnectProxy, afterDisconnectProxy, onPreActivate, afterPreActivate, onPostActivate, afterPostActivate, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags (Flags, fromFlags) import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -- | These enumeration values are used by 'uiManagerAddUi' to determine what UI -- element to create. -- {# enum UIManagerItemType {underscoreToCase} deriving (Bounded) #} instance Flags UIManagerItemType newtype MergeId = MergeId { fromMergeId :: {# type guint #}} -------------------- -- Constructors -- | Creates a new ui manager object. -- uiManagerNew :: IO UIManager uiManagerNew = wrapNewGObject mkUIManager $ {# call gtk_ui_manager_new #} -------------------- -- Methods -- | Returns an unused merge id, suitable for use with 'uiManagerAddUi'. -- uiManagerNewMergeId :: UIManager -> IO MergeId uiManagerNewMergeId self = liftM MergeId $ {# call gtk_ui_manager_new_merge_id #} self -- | Sets the \"add_tearoffs\" property, which controls whether menus -- generated by this 'UIManager' will have tearoff menu items. -- -- Note that this only affects regular menus. Generated popup menus never -- have tearoff menu items. -- uiManagerSetAddTearoffs :: UIManager -> Bool -- ^ @addTearoffs@ - whether tearoff menu items are added -> IO () uiManagerSetAddTearoffs self addTearoffs = {# call gtk_ui_manager_set_add_tearoffs #} self (fromBool addTearoffs) -- | Returns whether menus generated by this 'UIManager' will have tearoff -- menu items. -- uiManagerGetAddTearoffs :: UIManager -> IO Bool -- ^ returns whether tearoff menu items are added uiManagerGetAddTearoffs self = liftM toBool $ {# call gtk_ui_manager_get_add_tearoffs #} self -- | Inserts an action group into the list of action groups associated with -- @self@. Actions in earlier groups hide actions with the same name in later -- groups. -- uiManagerInsertActionGroup :: UIManager -> ActionGroup -- ^ @actionGroup@ - the action group to be inserted -> Int -- ^ @pos@ - the position at which the group will be inserted. -> IO () uiManagerInsertActionGroup self actionGroup pos = {# call gtk_ui_manager_insert_action_group #} self actionGroup (fromIntegral pos) -- | Removes an action group from the list of action groups associated with -- @self@. -- uiManagerRemoveActionGroup :: UIManager -> ActionGroup -- ^ @actionGroup@ - the action group to be removed -> IO () uiManagerRemoveActionGroup self actionGroup = {# call gtk_ui_manager_remove_action_group #} self actionGroup -- | Returns the list of action groups associated with the UI manager. -- uiManagerGetActionGroups :: UIManager -> IO [ActionGroup] uiManagerGetActionGroups self = {# call gtk_ui_manager_get_action_groups #} self >>= readGList >>= mapM (\elemPtr -> makeNewGObject mkActionGroup (return elemPtr)) -- | Returns the 'AccelGroup' associated with @self@. -- uiManagerGetAccelGroup :: UIManager -> IO AccelGroup -- ^ returns the 'AccelGroup'. uiManagerGetAccelGroup self = makeNewGObject mkAccelGroup $ {# call gtk_ui_manager_get_accel_group #} self -- | Looks up a widget by following a path. The path consists of the names -- specified in the XML description of the UI. separated by \'\/\'. Elements -- which don't have a name or action attribute in the XML (e.g. \) can -- be addressed by their XML element name (e.g. \"popup\"). The root element -- (\"\/ui\") can be omitted in the path. -- -- Note that the widget found by following a path that ends in a \ -- element is the menuitem to which the menu is attached, not the menu itself. -- uiManagerGetWidget :: GlibString string => UIManager -> string -- ^ @path@ - a path -> IO (Maybe Widget) -- ^ returns the widget found by following the path, or -- @Nothing@ if no widget was found. uiManagerGetWidget self path = maybeNull (makeNewObject mkWidget) $ withUTFString path $ \pathPtr -> {# call gtk_ui_manager_get_widget #} self pathPtr -- | Obtains a list of all toplevel widgets of the requested types. -- uiManagerGetToplevels :: UIManager -> [UIManagerItemType] -- ^ @types@ - specifies the types of toplevel -- widgets to include. Allowed types are -- 'UiManagerMenubar', 'UiManagerToolbar' and -- 'UiManagerPopup'. -> IO [Widget] -- ^ returns a list of all toplevel -- widgets of the requested types. uiManagerGetToplevels self types = {# call gtk_ui_manager_get_toplevels #} self ((fromIntegral . fromFlags) types) >>= fromGSList >>= mapM (\elemPtr -> makeNewObject mkWidget (return elemPtr)) -- | Looks up an action by following a path. See 'uiManagerGetWidget' for more -- information about paths. -- uiManagerGetAction :: GlibString string => UIManager -> string -- ^ @path@ - a path -> IO (Maybe Action) -- ^ returns the action whose proxy widget is found by -- following the path, or @Nothing@ if no widget was -- found. uiManagerGetAction self path = maybeNull (makeNewGObject mkAction) $ withUTFString path $ \pathPtr -> {# call gtk_ui_manager_get_action #} self pathPtr -- | Parses a string containing a UI definition and merges it with the current -- contents of @self@. An enclosing \ element is added if it is missing. -- -- If a parse error occurres, an exception is thrown. -- uiManagerAddUiFromString :: GlibString string => UIManager -> string -- ^ @buffer@ - the string to parse -> IO MergeId -- ^ returns The merge id for the merged UI. The merge id can be -- used to unmerge the UI with 'uiManagerRemoveUi'. uiManagerAddUiFromString self buffer = liftM MergeId $ propagateGError $ \errorPtr -> withUTFStringLen buffer $ \(bufferPtr, length) -> {# call gtk_ui_manager_add_ui_from_string #} self bufferPtr (fromIntegral length) errorPtr -- | Parses a file containing a UI definition and merges it with the current -- contents of @self@. -- -- If a parse or IO error occurres, an exception is thrown. -- uiManagerAddUiFromFile :: GlibString string => UIManager -> string -- ^ @filename@ - the name of the file to parse -> IO MergeId -- ^ returns The merge id for the merged UI. The merge id can be -- used to unmerge the UI with 'uiManagerRemoveUi'. uiManagerAddUiFromFile self filename = liftM MergeId $ propagateGError $ \errorPtr -> withUTFString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_ui_manager_add_ui_from_file_utf8 #} #else {# call gtk_ui_manager_add_ui_from_file #} #endif self filenamePtr errorPtr -- | Adds a UI element to the current contents of @self@. -- -- If @type@ is 'UiManagerAuto', Gtk+ inserts a menuitem, toolitem or -- separator if such an element can be inserted at the place determined by -- @path@. Otherwise @type@ must indicate an element that can be inserted at -- the place determined by @path@. -- -- If @path@ points to a menuitem or toolitem, the new element will be -- inserted before or after this item, depending on @top@. -- uiManagerAddUi :: GlibString string => UIManager -> MergeId -- ^ @mergeId@ - the merge id for the merged UI, see -- 'uiManagerNewMergeId' -> string -- ^ @path@ - a path -> string -- ^ @name@ - the name for the added UI element -> Maybe string -- ^ @action@ - the name of the action to be proxied, -- or @Nothing@ to add a separator -> [UIManagerItemType] -- ^ @type@ - the type of UI element to add. -> Bool -- ^ @top@ - if @True@, the UI element is added before -- its siblings, otherwise it is added after its -- siblings. -> IO () uiManagerAddUi self mergeId path name action type_ top = maybeWith withUTFString action $ \actionPtr -> withUTFString name $ \namePtr -> withUTFString path $ \pathPtr -> {# call gtk_ui_manager_add_ui #} self (fromMergeId mergeId) pathPtr namePtr actionPtr ((fromIntegral . fromFlags) type_) (fromBool top) -- | Unmerges the part of the UI manager's content identified by @mergeId@. -- uiManagerRemoveUi :: UIManager -> MergeId -- ^ @mergeId@ - a merge id as returned by -- 'uiManagerAddUiFromString' -> IO () uiManagerRemoveUi self mergeId = {# call gtk_ui_manager_remove_ui #} self (fromMergeId mergeId) -- | Creates a UI definition of the merged UI. -- uiManagerGetUi :: GlibString string => UIManager -> IO string -- ^ returns string containing an XML representation of the -- merged UI. uiManagerGetUi self = {# call gtk_ui_manager_get_ui #} self >>= readUTFString -- | Makes sure that all pending updates to the UI have been completed. -- -- This may occasionally be necessary, since 'UIManager' updates the UI in -- an idle function. A typical example where this function is useful is to -- enforce that the menubar and toolbar have been added to the main window -- before showing it: -- -- > do -- > containerAdd window vbox -- > onAddWidget merge (addWidget vbox) -- > uiManagerAddUiFromFile merge "my-menus" -- > uiManagerAddUiFromFile merge "my-toolbars" -- > uiManagerEnsureUpdate merge -- > widgetShow window -- uiManagerEnsureUpdate :: UIManager -> IO () uiManagerEnsureUpdate self = {# call gtk_ui_manager_ensure_update #} self -------------------- -- Attributes -- | The \"add-tearoffs\" property controls whether generated menus have -- tearoff menu items. -- -- Note that this only affects regular menus. Generated popup menus never -- have tearoff menu items. -- -- Default value: @False@ -- uiManagerAddTearoffs :: Attr UIManager Bool uiManagerAddTearoffs = newAttr uiManagerGetAddTearoffs uiManagerSetAddTearoffs -- | An XML string describing the merged UI. -- -- Default value: @\"\\\n\<\/ui\>\\n\"@ -- uiManagerUi :: GlibString string => ReadAttr UIManager string uiManagerUi = readAttrFromStringProperty "ui" -------------------- -- Signals -- %hash c:58ec d:2a79 -- | The add_widget signal is emitted for each generated menubar and toolbar. -- It is not emitted for generated popup menus, which can be obtained by -- 'uiManagerGetWidget'. -- addWidget :: UIManagerClass self => Signal self (Widget -> IO ()) addWidget = Signal (connect_OBJECT__NONE "add-widget") -- %hash c:2480 d:366c -- | The \"actions-changed\" signal is emitted whenever the set of actions -- changes. -- actionsChanged :: UIManagerClass self => Signal self (IO ()) actionsChanged = Signal (connect_NONE__NONE "actions-changed") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | The add_widget signal is emitted for each generated menubar and toolbar. -- It is not emitted for generated popup menus, which can be obtained by -- 'uiManagerGetWidget'. -- onAddWidget, afterAddWidget :: UIManagerClass self => self -> (Widget -> IO ()) -> IO (ConnectId self) onAddWidget = connect_OBJECT__NONE "add_widget" False afterAddWidget = connect_OBJECT__NONE "add_widget" True -- | The \"actions-changed\" signal is emitted whenever the set of actions -- changes. -- onActionsChanged, afterActionsChanged :: UIManagerClass self => self -> IO () -> IO (ConnectId self) onActionsChanged = connect_NONE__NONE "actions_changed" False afterActionsChanged = connect_NONE__NONE "actions_changed" True -- | The connect_proxy signal is emitted after connecting a proxy to an action -- in the group. -- -- This is intended for simple customizations for which a custom action -- class would be too clumsy, e.g. showing tooltips for menuitems in the -- statusbar. -- onConnectProxy, afterConnectProxy :: UIManagerClass self => self -> (Action -> Widget -> IO ()) -> IO (ConnectId self) onConnectProxy = connect_OBJECT_OBJECT__NONE "connect_proxy" False afterConnectProxy = connect_OBJECT_OBJECT__NONE "connect_proxy" True -- | The disconnect_proxy signal is emitted after disconnecting a proxy from -- an action in the group. -- onDisconnectProxy, afterDisconnectProxy :: UIManagerClass self => self -> (Action -> Widget -> IO ()) -> IO (ConnectId self) onDisconnectProxy = connect_OBJECT_OBJECT__NONE "disconnect_proxy" False afterDisconnectProxy = connect_OBJECT_OBJECT__NONE "disconnect_proxy" True -- | The pre_activate signal is emitted just before the @action@ is activated. -- -- This is intended for applications to get notification just before any -- action is activated. -- onPreActivate, afterPreActivate :: UIManagerClass self => self -> (Action -> IO ()) -> IO (ConnectId self) onPreActivate = connect_OBJECT__NONE "pre_activate" False afterPreActivate = connect_OBJECT__NONE "pre_activate" True -- | The post_activate signal is emitted just after the @action@ is activated. -- -- This is intended for applications to get notification just after any -- action is activated. -- onPostActivate, afterPostActivate :: UIManagerClass self => self -> (Action -> IO ()) -> IO (ConnectId self) onPostActivate = connect_OBJECT__NONE "post_activate" False afterPostActivate = connect_OBJECT__NONE "post_activate" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/0000755000000000000000000000000007346545000013366 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Builder.chs0000644000000000000000000002100607346545000015452 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) XML Interface Parser -- -- Author: John Millikin -- -- Created: 19 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. -- -- Notes: -- -- Like the @libglade@ bindings, this module does not support signal -- auto-connection. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Build an interface from an XML UI definition -- -- All functions in this module are only available in Gtk 2.12 or higher. -- module Graphics.UI.Gtk.Builder #if !GTK_CHECK_VERSION(2,12,0) () where #else ( -- * Detail -- -- A 'Builder' is an auxiliary object that reads textual descriptions of a -- user interface and instantiates the described objects. To pass a -- description to a 'Builder', perform 'builderAddFromFile' or -- 'builderAddFromString'. These computations can be performed multiple -- times; the builder merges the content of all descriptions. -- -- A 'Builder' holds a reference to all objects that it has constructed and -- drops these references when it is finalized. This finalization can cause -- the destruction of non-widget objects or widgets which are not contained -- in a toplevel window. For toplevel windows constructed by a builder, it -- is the responsibility of the user to perform 'widgetDestroy' to get rid -- of them and all the widgets they contain. -- -- The computations 'builderGetObject' and 'builderGetObjects' can be used -- to access the widgets in the interface by the names assigned to them -- inside the UI description. Toplevel windows returned by these functions -- will stay around until the user explicitly destroys them with -- 'widgetDestroy'. Other widgets will either be part of a larger hierarchy -- constructed by the builder (in which case you should not have to worry -- about their lifecycle), or without a parent, in which case they have to -- be added to some container to make use of them. Non-widget objects need -- to be reffed with 'objectRef' to keep them beyond the lifespan of the -- builder. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'GtkBuilder' -- @ -- * Types Builder , BuilderClass , castToBuilder , gTypeBuilder , toBuilder , BuilderError (..) -- * Constructing and adding objects , builderNew , builderAddFromFile , builderAddFromString #if GTK_CHECK_VERSION(2,14,0) , builderAddObjectsFromFile , builderAddObjectsFromString #endif -- * Retrieving objects , builderGetObject , builderGetObjects , builderGetObjectRaw , builderSetTranslationDomain , builderGetTranslationDomain ) where import Control.Exception (evaluate, throwIO, ErrorCall (..)) import System.Glib.FFI import System.Glib.GError import System.Glib.GList import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} {# enum GtkBuilderError as BuilderError {underscoreToCase} deriving (Show, Eq) #} --------------------------------------- -- Constructing and adding objects -- | Creates a new 'Builder' object. builderNew :: IO Builder builderNew = wrapNewGObject mkBuilder $ {# call unsafe builder_new #} -- | Parses a file containing a GtkBuilder UI definition and merges it with -- the current contents of the 'Builder'. -- -- * If an error occurs, the computation will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'BuilderError'. -- builderAddFromFile :: GlibFilePath fp => Builder -> fp -> IO () builderAddFromFile builder path = propagateGError $ \errPtrPtr -> withUTFFilePath path $ \pathPtr -> {# call unsafe builder_add_from_file #} builder pathPtr errPtrPtr >> return () -- | Parses a string containing a GtkBuilder UI definition and merges it -- with the current contents of the 'Builder'. -- -- * If an error occurs, the computation will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'BuilderError'. -- builderAddFromString :: GlibString string => Builder -> string -> IO () builderAddFromString builder str = propagateGError $ \errPtrPtr -> withUTFStringLen str $ \(strPtr, strLen) -> {# call unsafe builder_add_from_string #} builder strPtr (fromIntegral strLen) errPtrPtr >> return () #if GTK_CHECK_VERSION(2,14,0) -- | Parses a file containing a GtkBuilder UI definition building only -- the requested objects and merges them with the current contents of -- the 'Builder'. -- -- * If an error occurs, the computation will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'BuilderError'. -- builderAddObjectsFromFile :: (GlibString string, GlibFilePath fp) => Builder -> fp -> [string] -- ^ Object IDs -> IO () builderAddObjectsFromFile builder path ids = propagateGError $ \errPtrPtr -> withUTFFilePath path $ \pathPtr -> withUTFStringArray0 ids $ \idsPtr -> {# call unsafe builder_add_objects_from_file #} builder pathPtr idsPtr errPtrPtr >> return () -- | Parses a string containing a GtkBuilder UI definition building only -- the requested objects and merges them with the current contents of -- the 'Builder'. -- -- * If an error occurs, the computation will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'BuilderError'. -- builderAddObjectsFromString :: GlibString string => Builder -> string -> [string] -- ^ Object IDs -> IO () builderAddObjectsFromString builder str ids = propagateGError $ \errPtrPtr -> withUTFStringLen str $ \(strPtr, strLen) -> withUTFStringArray0 ids $ \idsPtr -> {# call unsafe builder_add_objects_from_string #} builder strPtr (fromIntegral strLen) idsPtr errPtrPtr >> return () #endif --------------------------------------- -- Retrieving objects -- | Gets the object with the given name. Note that this computation does -- not increment the reference count of the returned object. builderGetObjectRaw :: GlibString string => Builder -> string -- The ID of the object in the UI file, eg \"button1\". -> IO (Maybe GObject) builderGetObjectRaw builder name = withUTFString name $ \namePtr -> maybeNull (makeNewGObject mkGObject) $ {# call unsafe builder_get_object #} builder namePtr -- | Gets the object with the given name, with a conversion function. Note -- that this computation does not increment the reference count of the -- returned object. -- -- If the object with the given ID is not of the requested type, an -- exception will be thrown. -- builderGetObject :: (GObjectClass cls, GlibString string) => Builder -> (GObject -> cls) -- ^ A dynamic cast function which returns an object -- of the expected type, eg 'castToButton' -> string -- The ID of the object in the UI file, eg \"button1\". -> IO cls builderGetObject builder cast name = do raw <- builderGetObjectRaw builder name case raw of Just obj -> evaluate . cast $ obj Nothing -> throwIO . ErrorCall $ "Gtk.Builder.builderGetObject: no object named " ++ show name ++ " in the builder." -- | Gets all objects that have been constructed by builder. Note that this -- computation does not increment the reference counts of the returned -- objects. builderGetObjects :: Builder -> IO [GObject] builderGetObjects builder = {# call unsafe builder_get_objects #} builder >>= readGSList >>= mapM (makeNewGObject mkGObject . return) -- | Sets the translation domain of the 'Builder'. builderSetTranslationDomain :: GlibString string => Builder -> Maybe string -> IO () builderSetTranslationDomain builder domain = maybeWith withUTFString domain $ \domainPtr -> {# call unsafe builder_set_translation_domain #} builder domainPtr -- | Gets the translation domain of the 'Builder'. builderGetTranslationDomain :: GlibString string => Builder -> IO (Maybe string) builderGetTranslationDomain builder = {# call unsafe builder_get_translation_domain #} builder >>= maybePeek peekUTFString #endif gtk-0.15.9/Graphics/UI/Gtk/Buttons/0000755000000000000000000000000007346545000015024 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Buttons/Button.chs0000644000000000000000000004521107346545000017001 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Button -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget that creates a signal when clicked on -- module Graphics.UI.Gtk.Buttons.Button ( -- * Detail -- -- | The 'Button' widget is generally used to attach a function to that is -- called when the button is pressed. The various signals and how to use them -- are outlined below. -- -- The 'Button' widget can hold any valid child widget. That is it can hold -- most any other standard 'Widget'. The most commonly used child is the -- 'Label'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Button -- | +----'ToggleButton' -- | +----'ColorButton' -- | +----'FontButton' -- | +----'OptionMenu' -- @ -- * Types Button, ButtonClass, castToButton, gTypeButton, toButton, -- * Constructors buttonNew, buttonNewWithLabel, buttonNewWithMnemonic, buttonNewFromStock, -- * Methods buttonPressed, buttonReleased, buttonClicked, buttonEnter, buttonLeave, ReliefStyle(..), buttonSetRelief, buttonGetRelief, buttonSetLabel, buttonGetLabel, buttonSetUseStock, buttonGetUseStock, buttonSetUseUnderline, buttonGetUseUnderline, #if GTK_CHECK_VERSION(2,4,0) buttonSetFocusOnClick, buttonGetFocusOnClick, buttonSetAlignment, buttonGetAlignment, #endif #if GTK_CHECK_VERSION(2,6,0) buttonGetImage, buttonSetImage, #endif #if GTK_CHECK_VERSION(2,10,0) PositionType(..), buttonSetImagePosition, buttonGetImagePosition, #endif #if GTK_CHECK_VERSION(2,22,0) buttonGetEventWindow, #endif -- * Attributes buttonLabel, buttonUseUnderline, buttonUseStock, #if GTK_CHECK_VERSION(2,4,0) buttonFocusOnClick, #endif buttonRelief, #if GTK_CHECK_VERSION(2,4,0) buttonXalign, buttonYalign, #endif #if GTK_CHECK_VERSION(2,6,0) buttonImage, #endif #if GTK_CHECK_VERSION(2,10,0) buttonImagePosition, #endif -- * Signals buttonActivated, -- * Deprecated #ifndef DISABLE_DEPRECATED onButtonActivate, afterButtonActivate, onClicked, afterClicked, onEnter, afterEnter, onLeave, afterLeave, onPressed, afterPressed, onReleased, afterReleased #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (ReliefStyle(..), PositionType(..)) import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Button' widget. To add a child widget to the button, use -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd'. -- buttonNew :: IO Button buttonNew = makeNewObject mkButton $ liftM (castPtr :: Ptr Widget -> Ptr Button) $ {# call unsafe button_new #} -- | Creates a 'Button' widget with a 'Label' child containing the given text. -- buttonNewWithLabel :: GlibString string => string -- ^ @label@ - The text you want the 'Label' to hold. -> IO Button buttonNewWithLabel label = makeNewObject mkButton $ liftM (castPtr :: Ptr Widget -> Ptr Button) $ withUTFString label $ \labelPtr -> {# call unsafe button_new_with_label #} labelPtr -- | Creates a new 'Button' containing a label. If characters in @label@ are -- preceded by an underscore, they are underlined. If you need a literal -- underscore character in a label, use \'__\' (two underscores). The first -- underlined character represents a keyboard accelerator called a mnemonic. -- Pressing Alt and that key activates the button. -- buttonNewWithMnemonic :: GlibString string => string -- ^ @label@ - The text of the button, with an underscore in -- front of the mnemonic character -> IO Button buttonNewWithMnemonic label = makeNewObject mkButton $ liftM (castPtr :: Ptr Widget -> Ptr Button) $ withUTFString label $ \labelPtr -> {# call unsafe button_new_with_mnemonic #} labelPtr -- | Creates a new 'Button' containing the image and text from a stock item. -- -- If @stockId@ is unknown, then it will be treated as a mnemonic label (as -- for 'buttonNewWithMnemonic'). -- buttonNewFromStock :: StockId -- ^ @stockId@ - the name of the stock item -> IO Button buttonNewFromStock stockId = makeNewObject mkButton $ liftM (castPtr :: Ptr Widget -> Ptr Button) $ withUTFString stockId $ \stockIdPtr -> throwIfNull "buttonNewFromStock: Invalid stock identifier." $ {# call unsafe button_new_from_stock #} stockIdPtr -------------------- -- Methods -- | Emits the button pressed signal for the given 'Button'. -- buttonPressed :: ButtonClass self => self -> IO () buttonPressed self = {# call button_pressed #} (toButton self) -- | Emits the button released signal for the given 'Button'. -- buttonReleased :: ButtonClass self => self -> IO () buttonReleased self = {# call button_released #} (toButton self) -- | Emits the button clicked signal for the given 'Button'. -- -- This is similar to calling 'buttonPressed' and 'buttonReleased' in sequence. -- buttonClicked :: ButtonClass self => self -> IO () buttonClicked self = {# call button_clicked #} (toButton self) -- | Emit the cursor enters signal to the button. -- buttonEnter :: ButtonClass self => self -> IO () buttonEnter self = {# call button_enter #} (toButton self) -- | Emit the cursor leaves signal to the button. -- buttonLeave :: ButtonClass self => self -> IO () buttonLeave self = {# call button_leave #} (toButton self) -- | Sets the relief style of the edges of the given 'Button' widget. Three -- styles exist, 'ReliefNormal', 'ReliefHalf', 'ReliefNone'. The default style -- is, as one can guess, 'ReliefNormal'. -- buttonSetRelief :: ButtonClass self => self -> ReliefStyle -- ^ @newstyle@ - The 'ReliefStyle' as described above. -> IO () buttonSetRelief self newstyle = {# call button_set_relief #} (toButton self) ((fromIntegral . fromEnum) newstyle) -- | Returns the current relief style of the given 'Button'. -- buttonGetRelief :: ButtonClass self => self -> IO ReliefStyle -- ^ returns The current 'ReliefStyle' buttonGetRelief self = liftM (toEnum . fromIntegral) $ {# call unsafe button_get_relief #} (toButton self) -- | Sets the text of the label of the button. This text is also used -- to select the stock item if 'buttonSetUseStock' is used. -- -- This will also clear any previously set labels. -- buttonSetLabel :: (ButtonClass self, GlibString string) => self -> string -> IO () buttonSetLabel self label = withUTFString label $ \labelPtr -> {# call button_set_label #} (toButton self) labelPtr -- | Gets the text from the label of the button, as set by -- 'buttonSetLabel'. If the label text has not been set the return value will -- be @\"\"@. -- This will be the case if you create an empty button with 'buttonNew' to use -- as a container. -- buttonGetLabel :: (ButtonClass self, GlibString string) => self -> IO string buttonGetLabel self = do strPtr <- {# call unsafe button_get_label #} (toButton self) if strPtr==nullPtr then return "" else peekUTFString strPtr -- | If true, the label set on the button is used as a stock id to select the -- stock item for the button. -- -- Setting this property to @True@ will make the button lookup its label in -- the table of stock items. If there is a match, the button will use the -- stock item instead of the label. You need to set this flag before you -- change the label. -- buttonSetUseStock :: ButtonClass self => self -> Bool -- ^ @useStock@ - @True@ if the button should use a stock item -> IO () buttonSetUseStock self useStock = {# call button_set_use_stock #} (toButton self) (fromBool useStock) -- | Returns whether the button label is a stock item. -- buttonGetUseStock :: ButtonClass self => self -> IO Bool -- ^ returns @True@ if the button label is used to select a stock -- item instead of being used directly as the label text. buttonGetUseStock self = liftM toBool $ {# call unsafe button_get_use_stock #} (toButton self) -- | If true, an underline in the text of the button label indicates the next -- character should be used for the mnemonic accelerator key. -- -- Setting this property will make the button join any underline character -- into the following letter and inserting this letter as a keyboard shortcut. -- You need to set this flag before you change the label. -- buttonSetUseUnderline :: ButtonClass self => self -> Bool -- ^ @useUnderline@ - @True@ if underlines in the text indicate -- mnemonics -> IO () buttonSetUseUnderline self useUnderline = {# call button_set_use_underline #} (toButton self) (fromBool useUnderline) -- | Returns whether an embedded underline in the button label indicates a -- mnemonic. See 'buttonSetUseUnderline'. -- buttonGetUseUnderline :: ButtonClass self => self -> IO Bool -- ^ returns @True@ if an embedded underline in the button label -- indicates the mnemonic accelerator keys. buttonGetUseUnderline self = liftM toBool $ {# call unsafe button_get_use_underline #} (toButton self) #if GTK_CHECK_VERSION(2,4,0) -- | Sets whether the button will grab focus when it is clicked with the -- mouse. Making mouse clicks not grab focus is useful in places like toolbars -- where you don't want the keyboard focus removed from the main area of the -- application. -- -- * Available since Gtk version 2.4 -- buttonSetFocusOnClick :: ButtonClass self => self -> Bool -- ^ @focusOnClick@ - whether the button grabs focus when clicked -- with the mouse -> IO () buttonSetFocusOnClick self focusOnClick = {# call unsafe button_set_focus_on_click #} (toButton self) (fromBool focusOnClick) -- | Returns whether the button grabs focus when it is clicked with the mouse. -- See 'buttonSetFocusOnClick'. -- -- * Available since Gtk version 2.4 -- buttonGetFocusOnClick :: ButtonClass self => self -> IO Bool -- ^ returns @True@ if the button grabs focus when it is clicked -- with the mouse. buttonGetFocusOnClick self = liftM toBool $ {# call unsafe button_get_focus_on_click #} (toButton self) -- | Sets the alignment of the child. This has no effect unless the child -- derives from 'Misc' or 'Alignment'. -- -- * Available since Gtk version 2.4 -- buttonSetAlignment :: ButtonClass self => self -> (Float, Float) -- ^ @(xalign, yalign)@ - the horizontal position of the -- child (0.0 is left aligned, 1.0 is right aligned) and -- the vertical position of the child (0.0 is top aligned, -- 1.0 is bottom aligned) -> IO () buttonSetAlignment self (xalign, yalign) = {# call unsafe button_set_alignment #} (toButton self) (realToFrac xalign) (realToFrac yalign) -- | Gets the alignment of the child in the button. -- -- * Available since Gtk version 2.4 -- buttonGetAlignment :: ButtonClass self => self -> IO (Float, Float) -- ^ @(xalign, yalign)@ - horizontal and vertical -- alignment buttonGetAlignment self = alloca $ \xalignPtr -> alloca $ \yalignPtr -> do {# call unsafe button_get_alignment #} (toButton self) xalignPtr yalignPtr xalign <- peek xalignPtr yalign <- peek yalignPtr return (realToFrac xalign, realToFrac yalign) #endif #if GTK_CHECK_VERSION(2,6,0) -- | Gets the widget that is currently set as the image of the button. This may -- have been explicitly set by 'buttonSetImage' or constructed by -- 'buttonNewFromStock'. -- -- * Available since Gtk+ version 2.6 -- buttonGetImage :: ButtonClass self => self -> IO (Maybe Widget) -- ^ a 'Widget' or @Nothing@ in case there is no image buttonGetImage self = maybeNull (makeNewObject mkWidget) $ {# call gtk_button_get_image #} (toButton self) -- | Set the image of the button to the given widget. Note that it depends on -- the \"gtk-button-images\" setting whether the image will be displayed or not. -- -- * Available since Gtk+ version 2.6 -- buttonSetImage :: (ButtonClass self, WidgetClass image) => self -> image -- ^ a widget to set as the image for the button -> IO () buttonSetImage self image = {# call gtk_button_set_image #} (toButton self) (toWidget image) #endif #if GTK_CHECK_VERSION(2,10,0) -- %hash c:e7a6 d:7a76 -- | Sets the position of the image relative to the text inside the button. -- -- * Available since Gtk+ version 2.10 -- buttonSetImagePosition :: ButtonClass self => self -> PositionType -- ^ @position@ - the position -> IO () buttonSetImagePosition self position = {# call gtk_button_set_image_position #} (toButton self) ((fromIntegral . fromEnum) position) -- %hash c:3841 d:1f6a -- | Gets the position of the image relative to the text inside the button. -- -- * Available since Gtk+ version 2.10 -- buttonGetImagePosition :: ButtonClass self => self -> IO PositionType -- ^ returns the position buttonGetImagePosition self = liftM (toEnum . fromIntegral) $ {# call gtk_button_get_image_position #} (toButton self) #endif #if GTK_CHECK_VERSION(2,22,0) -- | Returns the button's event window if it is realized, 'Nothing' otherwise. -- -- * Available since Gtk+ version 2.22 -- buttonGetEventWindow :: ButtonClass self => self -> IO (Maybe DrawWindow) -- ^ returns button's event window or 'Nothing' buttonGetEventWindow self = maybeNull (makeNewGObject mkDrawWindow) $ {#call gtk_button_get_event_window #} (toButton self) #endif -------------------- -- Attributes -- | Text of the label widget inside the button, if the button contains a -- label widget. -- -- Default value: @\"\"@ -- buttonLabel :: (ButtonClass self, GlibString string) => Attr self string buttonLabel = newAttr buttonGetLabel buttonSetLabel -- | If set, an underline in the text indicates the next character should be -- used for the mnemonic accelerator key. -- -- Default value: @False@ -- buttonUseUnderline :: ButtonClass self => Attr self Bool buttonUseUnderline = newAttr buttonGetUseUnderline buttonSetUseUnderline -- | If set, the label is used to pick a stock item instead of being -- displayed. -- -- Default value: @False@ -- buttonUseStock :: ButtonClass self => Attr self Bool buttonUseStock = newAttr buttonGetUseStock buttonSetUseStock #if GTK_CHECK_VERSION(2,4,0) -- | Whether the button grabs focus when it is clicked with the mouse. -- -- Default value: @True@ -- buttonFocusOnClick :: ButtonClass self => Attr self Bool buttonFocusOnClick = newAttr buttonGetFocusOnClick buttonSetFocusOnClick #endif -- | The border relief style. -- -- Default value: 'ReliefNormal' -- buttonRelief :: ButtonClass self => Attr self ReliefStyle buttonRelief = newAttr buttonGetRelief buttonSetRelief #if GTK_CHECK_VERSION(2,4,0) -- | If the child of the button is a 'Misc' or 'Alignment', this property can -- be used to control it's horizontal alignment. 0.0 is left aligned, 1.0 is -- right aligned. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- buttonXalign :: ButtonClass self => Attr self Float buttonXalign = newAttrFromFloatProperty "xalign" -- | If the child of the button is a 'Misc' or 'Alignment', this property can -- be used to control it's vertical alignment. 0.0 is top aligned, 1.0 is -- bottom aligned. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- buttonYalign :: ButtonClass self => Attr self Float buttonYalign = newAttrFromFloatProperty "yalign" #endif #if GTK_CHECK_VERSION(2,6,0) -- | Child widget to appear next to the button text. -- -- * Available since Gtk version 2.6 -- buttonImage :: (ButtonClass self, WidgetClass image) => ReadWriteAttr self (Maybe Widget) image buttonImage = newAttr buttonGetImage buttonSetImage #endif #if GTK_CHECK_VERSION(2,10,0) -- %hash c:20f4 d:8ca6 -- | The position of the image relative to the text inside the button. -- -- Default value: 'PosLeft' -- -- * Available since Gtk+ version 2.10 -- buttonImagePosition :: ButtonClass self => Attr self PositionType buttonImagePosition = newAttrFromEnumProperty "image-position" {# call pure unsafe gtk_position_type_get_type #} #endif -------------------- -- Signals -- %hash c:b660 d:ab72 -- | Emitted when the button has been activated (pressed and released). -- buttonActivated :: ButtonClass self => Signal self (IO ()) buttonActivated = Signal (connect_NONE__NONE "clicked") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | The button has been depressed (but not -- necessarily released yet). See @clicked@ signal. -- onButtonActivate, afterButtonActivate :: ButtonClass b => b -> IO () -> IO (ConnectId b) onButtonActivate = connect_NONE__NONE "activate" False afterButtonActivate = connect_NONE__NONE "activate" True -- | The button was clicked. This is only emitted if -- the mouse cursor was over the button when it was released. -- onClicked, afterClicked :: ButtonClass b => b -> IO () -> IO (ConnectId b) onClicked = connect_NONE__NONE "clicked" False afterClicked = connect_NONE__NONE "clicked" True -- | The cursor enters the button box. -- onEnter, afterEnter :: ButtonClass b => b -> IO () -> IO (ConnectId b) onEnter = connect_NONE__NONE "enter" False afterEnter = connect_NONE__NONE "enter" True -- | The cursor leaves the button box. -- onLeave, afterLeave :: ButtonClass b => b -> IO () -> IO (ConnectId b) onLeave = connect_NONE__NONE "leave" False afterLeave = connect_NONE__NONE "leave" True -- | The button is pressed. -- onPressed, afterPressed :: ButtonClass b => b -> IO () -> IO (ConnectId b) onPressed = connect_NONE__NONE "pressed" False afterPressed = connect_NONE__NONE "pressed" True -- | The button is released. -- onReleased, afterReleased :: ButtonClass b => b -> IO () -> IO (ConnectId b) onReleased = connect_NONE__NONE "released" False afterReleased = connect_NONE__NONE "released" True #endif gtk-0.15.9/Graphics/UI/Gtk/Buttons/CheckButton.chs0000644000000000000000000000642607346545000017744 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CheckButton -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Create widgets with a discrete toggle button -- module Graphics.UI.Gtk.Buttons.CheckButton ( -- * Detail -- -- | A 'CheckButton' places a discrete 'ToggleButton' next to a widget, -- (usually a 'Label'). See the section on 'ToggleButton' widgets for more -- information about toggle\/check buttons. -- -- The important signal (\'toggled\') is also inherited from 'ToggleButton'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----'ToggleButton' -- | +----CheckButton -- | +----'RadioButton' -- @ -- * Types CheckButton, CheckButtonClass, castToCheckButton, gTypeCheckButton, toCheckButton, -- * Constructors checkButtonNew, checkButtonNewWithLabel, checkButtonNewWithMnemonic, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'CheckButton'. -- checkButtonNew :: IO CheckButton checkButtonNew = makeNewObject mkCheckButton $ liftM (castPtr :: Ptr Widget -> Ptr CheckButton) $ {# call unsafe check_button_new #} -- | Creates a new 'CheckButton' with a 'Label' to the right of it. -- checkButtonNewWithLabel :: GlibString string => string -- ^ @label@ - the text for the check button. -> IO CheckButton checkButtonNewWithLabel label = makeNewObject mkCheckButton $ liftM (castPtr :: Ptr Widget -> Ptr CheckButton) $ withUTFString label $ \labelPtr -> {# call unsafe check_button_new_with_label #} labelPtr -- | Creates a new 'CheckButton' containing a label. The label will be created -- using 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic', so underscores -- in @label@ indicate the mnemonic for the check button. -- checkButtonNewWithMnemonic :: GlibString string => string -- ^ @label@ - The text of the button, with an underscore -- in front of the mnemonic character -> IO CheckButton checkButtonNewWithMnemonic label = makeNewObject mkCheckButton $ liftM (castPtr :: Ptr Widget -> Ptr CheckButton) $ withUTFString label $ \labelPtr -> {# call unsafe check_button_new_with_mnemonic #} labelPtr gtk-0.15.9/Graphics/UI/Gtk/Buttons/LinkButton.chs0000644000000000000000000001135107346545000017615 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget LinkButton -- -- Author : Andy Stewart -- -- Created: 22 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Create buttons bound to a URL -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Buttons.LinkButton ( -- * Detail -- -- | A 'LinkButton' is a 'Button' with a hyperlink, similar to the one used by -- web browsers, which triggers an action when clicked. It is useful to show -- quick links to resources. -- -- A link button is created by calling either 'linkButtonNew' or -- 'linkButtonNewWithLabel'. If using the former, the URI you pass to the -- constructor is used as a label for the widget. -- -- The URI bound to a 'LinkButton' can be set specifically using -- \"set linkButton [linkButtonURI := uri]\", and retrieved using \"uri <- get linkButton linkButtonURI\". -- -- 'LinkButton' offers a global hook, which is called when the used clicks -- on it: see 'linkButtonSetURIHook'. -- -- 'LinkButton' was added in Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----LinkButton -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types LinkButton, LinkButtonClass, castToLinkButton, toLinkButton, -- * Constructors linkButtonNew, linkButtonNewWithLabel, -- * Methods #if GTK_MAJOR_VERSION < 3 linkButtonSetUriHook, #endif -- * Attributes linkButtonURI, #if GTK_CHECK_VERSION(2,14,0) linkButtonVisited, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Constructors -- | Creates a new 'LinkButton' with the URI as its text. -- linkButtonNew :: GlibString string => string -- ^ @uri@ - a valid URI -> IO LinkButton linkButtonNew uri = makeNewObject mkLinkButton $ liftM (castPtr :: Ptr Widget -> Ptr LinkButton) $ withUTFString uri $ \uriPtr -> {# call gtk_link_button_new #} uriPtr -- | Creates a new 'LinkButton' containing a label. -- linkButtonNewWithLabel :: GlibString string => string -- ^ @uri@ - a valid URI -> string -- ^ @label@ - the text of the button -> IO LinkButton linkButtonNewWithLabel uri label = makeNewObject mkLinkButton $ liftM (castPtr :: Ptr Widget -> Ptr LinkButton) $ withUTFString label $ \labelPtr -> withUTFString uri $ \uriPtr -> {# call gtk_link_button_new_with_label #} uriPtr labelPtr -------------------- -- Methods #if GTK_MAJOR_VERSION < 3 -- | Sets @func@ as the function that should be invoked every time a user -- clicks a 'LinkButton'. This function is called before every callback -- registered for the 'buttonClicked' signal. -- -- If no uri hook has been set, Gtk+ defaults to calling 'showURI'. -- -- Removed in Gtk3. linkButtonSetUriHook :: (String -> IO ()) -> IO () linkButtonSetUriHook func = do pfPtr <- mkLinkButtonUriFunc $ \_ cstr _ -> do str <- peekCString cstr func str {# call link_button_set_uri_hook #} pfPtr (castFunPtrToPtr pfPtr) destroyFunPtr freeHaskellFunPtr pfPtr {#pointer LinkButtonUriFunc#} foreign import ccall "wrapper" mkLinkButtonUriFunc :: (Ptr LinkButton -> CString -> Ptr () -> IO ()) -> IO LinkButtonUriFunc #endif -------------------- -- Attributes -- | The URI bound to this button. -- -- Default value: \"\" -- -- * Available since Gtk+ version 2.10 -- linkButtonURI :: (LinkButtonClass self, GlibString string) => Attr self string linkButtonURI = newAttrFromStringProperty "uri" #if GTK_CHECK_VERSION(2,14,0) -- | The 'visited' state of this button. A visited link is drawn in a different color. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.14 -- linkButtonVisited :: LinkButtonClass self => Attr self Bool linkButtonVisited = newAttrFromBoolProperty "visited" #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Buttons/RadioButton.chs0000644000000000000000000003020707346545000017757 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RadioButton -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- Note: -- -- No function that directly accesses the group is bound. This is due to the -- difficulties assuring that these groups are valid as the group is a plain -- GSList from Glib. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A choice from multiple check buttons -- module Graphics.UI.Gtk.Buttons.RadioButton ( -- * Detail -- -- | A single radio button performs the same basic function as a -- 'CheckButton', as its position in the object hierarchy reflects. It is only -- when multiple radio buttons are grouped together that they become a -- different user interface component in their own right. -- -- Every radio button is a member of some group of radio buttons. When one -- is selected, all other radio buttons in the same group are deselected. A -- 'RadioButton' is one way of giving the user a choice from many options. -- -- Radio button widgets are created with 'radioButtonNew'. -- Optionally, 'radioButtonNewWithLabel' can be used if you want a -- text label on the radio button. -- -- For the radio button functions that take an existing group, the groups are -- represented by any of their members. So when adding widgets to an existing -- group of radio buttons, use 'radioButtonNewFromWidget' with a 'RadioButton' -- that is already a member of the group. The convenience function -- 'radioButtonNewWithLabelFromWidget' is also provided. -- -- To remove a 'RadioButton' from one group and make it part of a new one, -- use 'radioButtonSetGroup'. -- -- * How to create a group of two radio buttons. -- -- > -- > createRadioButtons :: IO () -- > createRadioButtons = do -- > window <- windowNew -- > box <- vBoxNew True 2 -- > -- > -- Create a radio button with a Entry widget -- > radio1 <- radioButtonNew -- > entry <- entryNew -- > containerAdd radio1 entry -- > -- > -- Create a radio button with a label -- > radio2 <- radioButtonNewWithLabelFromWidget -- > radio1 "I'm the second radio button." -- > -- > -- Pack them into a box, then show all the widgets -- > boxPackStart box radio1 PackGrow 2 -- > boxPackStart box radio2 PackGrow 2 -- > containerAdd window box -- > widgetShowAll window -- > -- -- When an unselected button in the group is clicked the clicked button -- receives the \"toggled\" signal, as does the previously selected button. -- Inside the \"toggled\" handler, -- 'Graphics.UI.Gtk.Buttons.ToggleButton.toggleButtonGetActive' can be used to -- determine if the button has been selected or deselected. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----'ToggleButton' -- | +----'CheckButton' -- | +----RadioButton -- @ -- * Types RadioButton, RadioButtonClass, castToRadioButton, gTypeRadioButton, toRadioButton, -- * Constructors radioButtonNew, radioButtonNewWithLabel, radioButtonNewWithMnemonic, radioButtonNewFromWidget, radioButtonNewWithLabelFromWidget, radioButtonNewWithMnemonicFromWidget, -- * Compatibility aliases radioButtonNewJoinGroup, radioButtonNewJoinGroupWithLabel, radioButtonNewJoinGroupWithMnemonic, -- * Methods radioButtonSetGroup, radioButtonGetGroup, -- * Attributes radioButtonGroup, -- * Signals #if GTK_CHECK_VERSION(2,4,0) groupChanged, #endif -- * Deprecated #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,4,0) onGroupChanged, afterGroupChanged, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'RadioButton' with a new group. To be of any practical -- value, a widget should then be packed into the radio button. -- radioButtonNew :: IO RadioButton radioButtonNew = makeNewObject mkRadioButton $ liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ {# call unsafe radio_button_new #} nullPtr -- | Creates a new 'RadioButton' with a text label. -- radioButtonNewWithLabel :: GlibString string => string -> IO RadioButton radioButtonNewWithLabel label = makeNewObject mkRadioButton $ liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ withUTFString label $ \labelPtr -> {# call unsafe radio_button_new_with_label #} nullPtr labelPtr -- | Creates a new 'RadioButton' containing a label. The label will be created -- using 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic', -- so underscores in @label@ indicate the mnemonic -- for the button. -- radioButtonNewWithMnemonic :: GlibString string => string -- ^ @label@ - the text of the button, with an underscore -- in front of the mnemonic character -> IO RadioButton radioButtonNewWithMnemonic label = makeNewObject mkRadioButton $ liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ withUTFString label $ \labelPtr -> {# call unsafe radio_button_new_with_mnemonic #} nullPtr labelPtr -- | Creates a new 'RadioButton', adding it to the same group as the group to -- which @groupMember@ belongs. As with 'radioButtonNew', a widget should be -- packed into the radio button. -- radioButtonNewFromWidget :: RadioButton -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> IO RadioButton radioButtonNewFromWidget group = makeNewObject mkRadioButton $ liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ {# call radio_button_new_from_widget #} group -- | Creates a new 'RadioButton' with a text label, adding it to the same group -- as the group to which @groupMember@ belongs. -- radioButtonNewWithLabelFromWidget :: GlibString string => RadioButton -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> string -- ^ @label@ - a text string to display next to the radio -- button. -> IO RadioButton radioButtonNewWithLabelFromWidget group label = makeNewObject mkRadioButton $ liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ withUTFString label $ \labelPtr -> {# call radio_button_new_with_label_from_widget #} group labelPtr -- | Creates a new 'RadioButton' containing a label, adding it to the same group -- as the group to which @groupMember@ belongs. The label will be created using -- 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic', -- so underscores in @label@ indicate the mnemonic for the button. -- radioButtonNewWithMnemonicFromWidget :: GlibString string => RadioButton -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> string -- ^ @label@ - the text of the button, with an underscore -- in front of the mnemonic character -> IO RadioButton radioButtonNewWithMnemonicFromWidget group label = makeNewObject mkRadioButton $ liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $ withUTFString label $ \labelPtr -> {# call radio_button_new_with_mnemonic_from_widget #} group labelPtr -- | Alias for 'radioButtonNewFromWidget'. radioButtonNewJoinGroup :: RadioButton -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> IO RadioButton radioButtonNewJoinGroup = radioButtonNewFromWidget {-# DEPRECATED radioButtonNewJoinGroup "use radioButtonNewFromWidget instead" #-} -- | Alias for 'radioButtonNewWithLabelFromWidget'. radioButtonNewJoinGroupWithLabel :: GlibString string => RadioButton -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> string -- ^ @label@ - a text string to display next to the radio -- button. -> IO RadioButton radioButtonNewJoinGroupWithLabel = radioButtonNewWithLabelFromWidget {-# DEPRECATED radioButtonNewJoinGroupWithLabel "use radioButtonNewWithLabelFromWidget instead" #-} -- | Alias for 'radioButtonNewWithMnemonicFromWidget'. radioButtonNewJoinGroupWithMnemonic :: GlibString string => RadioButton -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> string -- ^ @label@ - the text of the button, with an underscore -- in front of the mnemonic character -> IO RadioButton radioButtonNewJoinGroupWithMnemonic = radioButtonNewWithMnemonicFromWidget {-# DEPRECATED radioButtonNewJoinGroupWithMnemonic "use radioButtonNewWithMnemonicFromWidget instead" #-} -------------------- -- Methods -- | Sets a 'RadioButton's group. It should be noted that this does not -- change the layout of your interface in any way, so if you are changing the -- group, it is likely you will need to re-arrange the user interface to -- reflect these changes. -- radioButtonSetGroup :: RadioButton -> RadioButton -- ^ @groupMember@ - a member of an existing radio button group, -- to which this radio button will be added. -> IO () radioButtonSetGroup self group = {# call unsafe gtk_radio_button_get_group #} group >>= \groupGSList -> {# call gtk_radio_button_set_group #} self groupGSList -- | Retrieves the group assigned to a radio button. -- radioButtonGetGroup :: RadioButton -> IO [RadioButton] -- ^ returns a list containing all the radio buttons -- in the same group as this radio button. radioButtonGetGroup self = {# call unsafe gtk_radio_button_get_group #} self >>= readGSList >>= mapM (\elemPtr -> makeNewObject mkRadioButton (return elemPtr)) -------------------- -- Attributes -- | Sets a new group for a radio button. -- radioButtonGroup :: ReadWriteAttr RadioButton [RadioButton] RadioButton radioButtonGroup = newAttr radioButtonGetGroup radioButtonSetGroup -------------------- -- Signals #if GTK_CHECK_VERSION(2,4,0) -- %hash c:be94 d:a584 -- | Emitted when the group of radio buttons that a radio button belongs to -- changes. This is emitted when a radio button switches from being alone to -- being part of a group of 2 or more buttons, or vice-versa, and when a -- button is moved from one group of 2 or more buttons to a different one, but -- not when the composition of the group that a button belongs to changes. -- -- * Available since Gtk+ version 2.4 -- groupChanged :: RadioButtonClass self => Signal self (IO ()) groupChanged = Signal (connect_NONE__NONE "group-changed") #endif -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,4,0) -- | Emitted when the group of radio buttons that a radio button belongs to -- changes. This is emitted when a radio button switches from being alone to -- being part of a group of 2 or more buttons, or vice-versa, and when a -- button is moved from one group of 2 or more buttons to a different one, but -- not when the composition of the group that a button belongs to changes. -- onGroupChanged, afterGroupChanged :: RadioButtonClass self => self -> IO () -> IO (ConnectId self) onGroupChanged = connect_NONE__NONE "group-changed" False afterGroupChanged = connect_NONE__NONE "group-changed" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Buttons/ScaleButton.chs0000644000000000000000000001657107346545000017760 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ScaleButton -- -- Author : Andy Stewart -- -- Created: 22 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A button which pops up a scale -- -- * Module available since Gtk+ version 2.12 -- module Graphics.UI.Gtk.Buttons.ScaleButton ( -- * Detail -- -- | 'ScaleButton' provides a button which pops up a scale widget. This kind -- of widget is commonly used for volume controls in multimedia applications, -- and Gtk+ provides a 'VolumeButton' subclass that is tailored for this use -- case. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----ScaleButton -- | +----'VolumeButton' -- @ #if GTK_CHECK_VERSION(2,12,0) -- * Types ScaleButton, ScaleButtonClass, castToScaleButton, toScaleButton, -- * Constructors scaleButtonNew, -- * Methods scaleButtonSetIcons, #if GTK_CHECK_VERSION(2,14,0) scaleButtonGetPopup, scaleButtonGetPlusButton, scaleButtonGetMinusButton, #endif -- * Attributes scaleButtonValue, scaleButtonSize, scaleButtonAdjustment, scaleButtonIcons, -- * Signals scaleButtonPopdown, scaleButtonPopup, scaleButtonValueChanged, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.General.Structs (IconSize(..)) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,12,0) -------------------- -- Interfaces -- instance OrientableClass ScaleButton -------------------- -- Constructors -- | Creates a 'ScaleButton', with a range between @min@ and @max@, with a -- stepping of @step@. -- scaleButtonNew :: GlibString string => IconSize -- ^ @size@ - a stock icon size -> Double -- ^ @min@ - the minimum value of the scale (usually 0) -> Double -- ^ @max@ - the maximum value of the scale (usually 100) -> Double -- ^ @step@ - the stepping of value when a scroll-wheel event, or -- up\/down arrow event occurs (usually 2) -> [string] -- ^ @icons@ -> IO ScaleButton scaleButtonNew size min max step icons = makeNewObject mkScaleButton $ liftM (castPtr :: Ptr Widget -> Ptr ScaleButton) $ withUTFStringArray0 icons $ \iconsPtr -> {# call gtk_scale_button_new #} ((fromIntegral . fromEnum) size) (realToFrac min) (realToFrac max) (realToFrac step) iconsPtr -------------------- -- Methods -- | Sets the icons to be used by the scale button. For details, see the "icons" property. scaleButtonSetIcons :: (ScaleButtonClass self, GlibString string) => self -> [string] -- ^ @icons@ -> IO () scaleButtonSetIcons self icons = withUTFStringArray0 icons $ \iconsPtr -> {# call gtk_scale_button_set_icons #} (toScaleButton self) iconsPtr #if GTK_CHECK_VERSION(2,14,0) -- | Retrieves the popup of the 'ScaleButton'. -- -- * Available since Gtk+ version 2.14 -- scaleButtonGetPopup :: ScaleButtonClass self => self -> IO Widget -- ^ returns the popup of the 'ScaleButton' scaleButtonGetPopup self = makeNewObject mkWidget $ {# call gtk_scale_button_get_popup #} (toScaleButton self) -- | Retrieves the plus button of the 'ScaleButton'. -- -- * Available since Gtk+ version 2.14 -- scaleButtonGetPlusButton :: ScaleButtonClass self => self -> IO Widget -- ^ returns the plus button of the 'ScaleButton'. scaleButtonGetPlusButton self = makeNewObject mkWidget $ {# call gtk_scale_button_get_plus_button #} (toScaleButton self) -- | Retrieves the minus button of the 'ScaleButton'. -- -- * Available since Gtk+ version 2.14 -- scaleButtonGetMinusButton :: ScaleButtonClass self => self -> IO Widget -- ^ returns the minus button of the 'ScaleButton'. scaleButtonGetMinusButton self = makeNewObject mkWidget $ {# call gtk_scale_button_get_minus_button #} (toScaleButton self) #endif -------------------- -- Attributes -- | The value of the scale. -- -- Default value: 0 scaleButtonValue :: ScaleButtonClass self => Attr self Double scaleButtonValue = newAttrFromDoubleProperty "value" -- | The icon size. -- -- Default value: ''IconSizeSmallToolbar'' scaleButtonSize :: ScaleButtonClass self => Attr self IconSize scaleButtonSize = newAttrFromEnumProperty "size" {# call pure unsafe gtk_icon_size_get_type #} -- | The 'Adjustment' that contains the current value of this scale button object. scaleButtonAdjustment :: ScaleButtonClass self => Attr self Adjustment scaleButtonAdjustment = newAttrFromObjectProperty "adjustment" {# call pure unsafe gtk_adjustment_get_type #} -- | The names of the icons to be used by the scale button. The first item in the array will be used in -- the button when the current value is the lowest value, the second item for the highest value. All -- the subsequent icons will be used for all the other values, spread evenly over the range of values. -- -- If there's only one icon name in the icons array, it will be used for all the values. If only two -- icon names are in the icons array, the first one will be used for the bottom 50% of the scale, and -- the second one for the top 50%. -- -- It is recommended to use at least 3 icons so that the 'ScaleButton' reflects the current value of -- the scale better for the users. -- -- Since 2.12 scaleButtonIcons :: (ScaleButtonClass self, GlibString string) => ReadWriteAttr self [string] (Maybe [string]) scaleButtonIcons = newAttr (objectGetPropertyBoxedOpaque (peekUTFStringArray0 . castPtr) gtype "search-path") (objectSetPropertyBoxedOpaque (\dirs f -> maybeWith withUTFStringArray0 dirs (f . castPtr)) gtype "search-path") where gtype = {#call pure g_strv_get_type#} -------------------- -- Signals -- | The 'scaleButtonValueChanged' signal is emitted when the value field has changed. -- scaleButtonValueChanged :: ScaleButtonClass self => Signal self (Double -> IO ()) scaleButtonValueChanged = Signal (connect_DOUBLE__NONE "value_changed") -- | The 'popup' signal is a keybinding signal which gets emitted to popup the scale widget. -- -- The default bindings for this signal are Space, Enter and Return. scaleButtonPopup :: ScaleButtonClass self => Signal self (IO ()) scaleButtonPopup = Signal (connect_NONE__NONE "popup") -- | The 'popdown' signal is a keybinding signal which gets emitted to popdown the scale widget. -- -- The default binding for this signal is Escape. scaleButtonPopdown :: ScaleButtonClass self => Signal self (IO ()) scaleButtonPopdown = Signal (connect_NONE__NONE "popdown") #endif gtk-0.15.9/Graphics/UI/Gtk/Buttons/ToggleButton.chs0000644000000000000000000002220207346545000020136 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToggleButton -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Create buttons which retain their state -- module Graphics.UI.Gtk.Buttons.ToggleButton ( -- * Detail -- -- | A 'ToggleButton' is a 'Button' which will remain \'pressed-in\' when -- clicked. Clicking again will cause the toggle button to return to its normal -- state. -- -- A toggle button is created by calling either 'toggleButtonNew' or -- 'toggleButtonNewWithLabel'. If using the former, it is advisable to pack a -- widget, (such as a 'Label' and\/or a 'Pixmap'), into the toggle button's -- container. (See 'Button' for more information). -- -- The state of a 'ToggleButton' can be set specifically using -- 'toggleButtonSetActive', and retrieved using 'toggleButtonGetActive'. -- -- To simply switch the state of a toggle button, use 'toggleButtonToggled'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----ToggleButton -- | +----'CheckButton' -- @ -- * Types ToggleButton, ToggleButtonClass, castToToggleButton, gTypeToggleButton, toToggleButton, -- * Constructors toggleButtonNew, toggleButtonNewWithLabel, toggleButtonNewWithMnemonic, -- * Methods toggleButtonSetMode, toggleButtonGetMode, toggleButtonToggled, toggleButtonGetActive, toggleButtonSetActive, toggleButtonGetInconsistent, toggleButtonSetInconsistent, -- * Attributes toggleButtonActive, toggleButtonInconsistent, toggleButtonDrawIndicator, toggleButtonMode, -- * Signals toggled, -- * Deprecated #ifndef DISABLE_DEPRECATED -- * Signals onToggled, afterToggled, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new toggle button. A widget should be packed into the button, -- as in 'Graphics.UI.Gtk.Buttons.Button.buttonNew'. -- toggleButtonNew :: IO ToggleButton toggleButtonNew = makeNewObject mkToggleButton $ liftM (castPtr :: Ptr Widget -> Ptr ToggleButton) $ {# call unsafe toggle_button_new #} -- | Creates a new toggle button with a text label. -- toggleButtonNewWithLabel :: GlibString string => string -- ^ @label@ - a string containing the message to be -- placed in the toggle button. -> IO ToggleButton toggleButtonNewWithLabel label = makeNewObject mkToggleButton $ liftM (castPtr :: Ptr Widget -> Ptr ToggleButton) $ withUTFString label $ \labelPtr -> {# call unsafe toggle_button_new_with_label #} labelPtr -- | Creates a new 'ToggleButton' containing a label. The label will be -- created using 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic', -- so underscores in @label@ indicate the -- mnemonic for the button. -- toggleButtonNewWithMnemonic :: GlibString string => string -- ^ @label@ - the text of the button, with an underscore -- in front of the mnemonic character -> IO ToggleButton toggleButtonNewWithMnemonic label = makeNewObject mkToggleButton $ liftM (castPtr :: Ptr Widget -> Ptr ToggleButton) $ withUTFString label $ \labelPtr -> {# call unsafe toggle_button_new_with_mnemonic #} labelPtr -------------------- -- Methods -- | Sets whether the button is displayed as a separate indicator and label. -- You can call this function on a 'CheckButton' or a 'RadioButton' with @False@ -- to make the button look like a normal button. -- -- This function only affects instances of classes like 'CheckButton' and -- 'RadioButton' that derive from 'ToggleButton', not instances of -- 'ToggleButton' itself. -- toggleButtonSetMode :: ToggleButtonClass self => self -> Bool -- ^ @drawIndicator@ - if @True@, draw the button as a separate -- indicator and label; if @False@, draw the button like a normal -- button -> IO () toggleButtonSetMode self drawIndicator = {# call toggle_button_set_mode #} (toToggleButton self) (fromBool drawIndicator) -- | Retrieves whether the button is displayed as a separate indicator and -- label. See 'toggleButtonSetMode'. -- toggleButtonGetMode :: ToggleButtonClass self => self -> IO Bool -- ^ returns @True@ if the togglebutton is drawn as a separate -- indicator and label. toggleButtonGetMode self = liftM toBool $ {# call unsafe toggle_button_get_mode #} (toToggleButton self) -- | Emits the toggled signal on the 'ToggleButton'. There is no good reason -- for an application ever to call this function. -- toggleButtonToggled :: ToggleButtonClass self => self -> IO () toggleButtonToggled self = {# call toggle_button_toggled #} (toToggleButton self) -- | Queries a 'ToggleButton' and returns its current state. Returns @True@ if -- the toggle button is pressed in and @False@ if it is raised. -- toggleButtonGetActive :: ToggleButtonClass self => self -> IO Bool toggleButtonGetActive self = liftM toBool $ {# call unsafe toggle_button_get_active #} (toToggleButton self) -- | Sets the status of the toggle button. Set to @True@ if you want the -- 'ToggleButton' to be \'pressed in\', and @False@ to raise it. This action -- causes the toggled signal to be emitted. -- toggleButtonSetActive :: ToggleButtonClass self => self -> Bool -- ^ @isActive@ - @True@ or @False@. -> IO () toggleButtonSetActive self isActive = {# call toggle_button_set_active #} (toToggleButton self) (fromBool isActive) -- | Gets the value set by 'toggleButtonSetInconsistent'. -- toggleButtonGetInconsistent :: ToggleButtonClass self => self -> IO Bool -- ^ returns @True@ if the button is displayed as inconsistent, -- @False@ otherwise toggleButtonGetInconsistent self = liftM toBool $ {# call unsafe toggle_button_get_inconsistent #} (toToggleButton self) -- | If the user has selected a range of elements (such as some text or -- spreadsheet cells) that are affected by a toggle button, and the current -- values in that range are inconsistent, you may want to display the toggle in -- an \"in between\" state. This function turns on \"in between\" display. -- Normally you would turn off the inconsistent state again if the user toggles -- the toggle button. This has to be done manually, -- 'toggleButtonSetInconsistent' only affects visual appearance, it doesn't -- affect the semantics of the button. -- toggleButtonSetInconsistent :: ToggleButtonClass self => self -> Bool -- ^ @setting@ - @True@ if state is inconsistent -> IO () toggleButtonSetInconsistent self setting = {# call toggle_button_set_inconsistent #} (toToggleButton self) (fromBool setting) -------------------- -- Attributes -- | If the toggle button should be pressed in or not. -- -- Default value: @False@ -- toggleButtonActive :: ToggleButtonClass self => Attr self Bool toggleButtonActive = newAttr toggleButtonGetActive toggleButtonSetActive -- | If the toggle button is in an \"in between\" state. -- -- Default value: @False@ -- toggleButtonInconsistent :: ToggleButtonClass self => Attr self Bool toggleButtonInconsistent = newAttr toggleButtonGetInconsistent toggleButtonSetInconsistent -- | If the toggle part of the button is displayed. -- -- Default value: @False@ -- toggleButtonDrawIndicator :: ToggleButtonClass self => Attr self Bool toggleButtonDrawIndicator = newAttrFromBoolProperty "draw-indicator" -- | \'mode\' property. See 'toggleButtonGetMode' and 'toggleButtonSetMode' -- toggleButtonMode :: ToggleButtonClass self => Attr self Bool toggleButtonMode = newAttr toggleButtonGetMode toggleButtonSetMode -------------------- -- Signals -- %hash c:467 d:227e -- | Should be connected if you wish to perform an action whenever the -- 'ToggleButton''s state is changed. -- toggled :: ToggleButtonClass self => Signal self (IO ()) toggled = Signal (connect_NONE__NONE "toggled") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | Whenever the state of the button is changed, the toggled signal is -- emitted. -- onToggled, afterToggled :: ToggleButtonClass self => self -> IO () -> IO (ConnectId self) onToggled = connect_NONE__NONE "toggled" False afterToggled = connect_NONE__NONE "toggled" True #endif gtk-0.15.9/Graphics/UI/Gtk/Buttons/VolumeButton.chs0000644000000000000000000000436607346545000020177 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VolumeButton -- -- Author : Andy Stewart -- -- Created: 22 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A button which pops up a volume control -- -- * Module available since Gtk+ version 2.12 -- module Graphics.UI.Gtk.Buttons.VolumeButton ( -- * Detail -- -- | 'VolumeButton' is a subclass of 'ScaleButton' that has been tailored for -- use as a volume control widget with suitable icons, tooltips and accessible -- labels. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----'ScaleButton' -- | +----VolumeButton -- @ #if GTK_CHECK_VERSION(2,12,0) -- * Types VolumeButton, VolumeButtonClass, castToVolumeButton, toVolumeButton, -- * Constructors volumeButtonNew, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,12,0) -------------------- -- Constructors -- | Creates a 'VolumeButton', with a range between 0.0 and 1.0, with a -- stepping of 0.02. Volume values can be obtained and modified using the -- functions from 'ScaleButton'. -- volumeButtonNew :: IO VolumeButton volumeButtonNew = makeNewObject mkVolumeButton $ liftM (castPtr :: Ptr Widget -> Ptr VolumeButton) $ {# call gtk_volume_button_new #} #endif gtk-0.15.9/Graphics/UI/Gtk/Cairo.chs0000644000000000000000000001316607346545000015131 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Cairo GDK integration -- -- Author : Duncan Coutts -- -- Created: 17 August 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. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- -- Gtk specific functions to for rendering with Cairo. -- -- Cairo is a graphics library that supports vector graphics and image -- compositing that can be used with Gdk. -- The Cairo API is an addition to Gdk\/Gtk (rather than a replacement). -- Cairo rendering can be performed on any 'Graphics.UI.Gtk.Gdk.Drawable' -- by calling 'renderWithDrawable'. The functions in this module provide -- ways of drawing Gtk specific elements, such as 'Pixbuf's or text -- laid out with Pango. -- -- All functions in this module are only available in Gtk 2.8 or higher. -- module Graphics.UI.Gtk.Cairo ( #if GTK_CHECK_VERSION(2,8,0) -- * Global Cairo settings. cairoFontMapGetDefault, cairoFontMapSetResolution, cairoFontMapGetResolution, cairoCreateContext, cairoContextSetResolution, cairoContextGetResolution, cairoContextSetFontOptions, cairoContextGetFontOptions, -- * Functions for the 'Render' monad. #if GTK_MAJOR_VERSION < 3 renderWithDrawable, #else getClipRectangle, renderWithDrawWindow, #endif region, setSourceColor, setSourcePixbuf, rectangle, updateContext, createLayout, updateLayout, showGlyphString, showLayoutLine, showLayout, glyphStringPath, layoutLinePath, layoutPath #endif ) where import Control.Exception (bracket) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 {#import Graphics.UI.Gtk.Gdk.Region#} (Region(..)) #endif {#import Graphics.Rendering.Pango.Cairo#} #if GTK_CHECK_VERSION(2,8,0) #if GTK_MAJOR_VERSION < 3 {#import Graphics.Rendering.Cairo.Types#} as Cairo hiding (Region) #else {#import Graphics.Rendering.Cairo.Types#} as Cairo #endif import qualified Graphics.Rendering.Cairo.Internal as Cairo.Internal import Graphics.Rendering.Cairo.Internal (Render(Render)) import Control.Monad.Reader import Graphics.UI.Gtk.General.Structs (Rectangle(..)) #endif import Control.Monad (unless, liftM) {# context lib="gdk" prefix="gdk" #} -------------------- -- Methods #if GTK_CHECK_VERSION(2,8,0) #if GTK_MAJOR_VERSION < 3 -- | Creates a Cairo context for drawing to a 'Drawable'. -- -- Removed in Gtk3. renderWithDrawable :: DrawableClass drawable => drawable -- ^ @drawable@ - a 'Drawable' -> Render a -- ^ A newly created Cairo context. -> IO a renderWithDrawable drawable m = bracket (liftM Cairo.Cairo $ {#call unsafe gdk_cairo_create#} (toDrawable drawable)) (\context -> do status <- Cairo.Internal.status context Cairo.Internal.destroy context unless (status == Cairo.StatusSuccess) $ fail =<< Cairo.Internal.statusToString status) (\context -> runReaderT (Cairo.Internal.runRender m) context) #endif #if GTK_MAJOR_VERSION >= 3 -- | Creates a Cairo context for drawing to a 'DrawWindow'. renderWithDrawWindow :: DrawWindowClass drawWindow => drawWindow -- ^ @drawWindow@ - a 'DrawWindow' -> Render a -- ^ A newly created Cairo context. -> IO a renderWithDrawWindow drawWindow m = bracket (liftM Cairo.Cairo $ {#call unsafe gdk_cairo_create#} (toDrawWindow drawWindow)) (\context -> do status <- Cairo.Internal.status context Cairo.Internal.destroy context unless (status == Cairo.StatusSuccess) $ fail =<< Cairo.Internal.statusToString status) (\context -> runReaderT (Cairo.Internal.runRender m) context) -- | Compute a bounding box in user coordinates covering the area inside -- the current clip. It rounds the bounding box to integer coordinates. -- Returns 'Nothing' indicating if a clip area doesn't exist. getClipRectangle :: Render (Maybe Rectangle) getClipRectangle = Render $ do cr <- ask liftIO $ alloca $ \rectPtr -> do ok <- {# call unsafe gdk_cairo_get_clip_rectangle #} cr (castPtr rectPtr) if ok /= 0 then fmap Just (peek rectPtr) else return Nothing #endif -- | Sets the given pixbuf as the source pattern for the Cairo context. The -- pattern has an extend mode of 'ExtendNone' and is aligned so that the -- origin of pixbuf is @(x, y)@. -- setSourcePixbuf :: Pixbuf -> Double -- ^ x -> Double -- ^ y -> Render () setSourcePixbuf pixbuf pixbufX pixbufY = Render $ do cr <- ask liftIO $ {# call unsafe gdk_cairo_set_source_pixbuf #} cr pixbuf (realToFrac pixbufX) (realToFrac pixbufY) -- | Adds the given region to the current path of the 'Render' context. rectangle :: Rectangle -> Render () rectangle rect = Render $ do cr <- ask liftIO $ with rect $ \ rectPtr -> {# call unsafe gdk_cairo_rectangle #} cr (castPtr rectPtr) -- | Adds the given region to the current path of the 'Render' context. region :: Region -> Render () region region = Render $ do cr <- ask liftIO $ {# call unsafe gdk_cairo_region #} cr region #endif gtk-0.15.9/Graphics/UI/Gtk/Display/0000755000000000000000000000000007346545000014773 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Display/AccelLabel.chs0000644000000000000000000001101207346545000017434 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget AccelLabel -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A label which displays an accelerator key on the right of the text -- module Graphics.UI.Gtk.Display.AccelLabel ( -- * Detail -- -- | The 'AccelLabel' widget is a subclass of 'Label' that also displays an -- accelerator key on the right of the label text, e.g. \'Ctl+S\'. It is -- commonly used in menus to show the keyboard short-cuts for commands. -- -- The accelerator key to display is not set explicitly. Instead, the -- 'AccelLabel' displays the accelerators which have been added to a particular -- widget. This widget is set by calling 'accelLabelSetAccelWidget'. -- -- For example, a 'MenuItem' widget may have an accelerator added to emit -- the \"activate\" signal when the \'Ctl+S\' key combination is pressed. A -- 'AccelLabel' is created and added to the 'MenuItem', and -- 'accelLabelSetAccelWidget' is called with the 'MenuItem' as the second -- argument. The 'AccelLabel' will now display \'Ctl+S\' after its label. -- -- Note that creating a 'MenuItem' with -- 'Graphics.UI.Gtk.MenuComboToolbar.MenuItem.menuItemNewWithLabel' (or one of -- the similar functions for 'CheckMenuItem' and 'RadioMenuItem') automatically -- adds a 'AccelLabel' to the 'MenuItem' and calls 'accelLabelSetAccelWidget' -- to set it up for you. -- -- An 'AccelLabel' will only display accelerators which have -- 'Graphics.UI.Gtk.Abstract.Widget.AccelVisible' -- set (see 'Graphics.UI.Gtk.Abstract.Widget.AccelFlags'). -- A 'AccelLabel' can display multiple accelerators and -- even signal names, though it is almost always used to display just one -- accelerator key. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Misc' -- | +----'Label' -- | +----AccelLabel -- @ -- * Types AccelLabel, AccelLabelClass, castToAccelLabel, gTypeAccelLabel, toAccelLabel, -- * Constructors accelLabelNew, -- * Methods accelLabelSetAccelWidget, accelLabelGetAccelWidget, -- * Attributes accelLabelAccelWidget, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'AccelLabel'. -- accelLabelNew :: GlibString string => string -- ^ @string@ - the label string. -> IO AccelLabel accelLabelNew string = makeNewObject mkAccelLabel $ liftM (castPtr :: Ptr Widget -> Ptr AccelLabel) $ withUTFString string $ \stringPtr -> {# call unsafe accel_label_new #} stringPtr -------------------- -- Methods -- | Sets the widget to be monitored by this accelerator label. -- accelLabelSetAccelWidget :: (AccelLabelClass self, WidgetClass accelWidget) => self -> accelWidget -- ^ @accelWidget@ - the widget to be monitored. -> IO () accelLabelSetAccelWidget self accelWidget = {# call accel_label_set_accel_widget #} (toAccelLabel self) (toWidget accelWidget) -- | Fetches the widget monitored by this accelerator label. See -- 'accelLabelSetAccelWidget'. -- accelLabelGetAccelWidget :: AccelLabelClass self => self -> IO (Maybe Widget) -- ^ returns the object monitored by the accelerator -- label, or @Nothing@. accelLabelGetAccelWidget self = maybeNull (makeNewObject mkWidget) $ {# call unsafe accel_label_get_accel_widget #} (toAccelLabel self) -------------------- -- Attributes -- | The widget to be monitored for accelerator changes. -- accelLabelAccelWidget :: (AccelLabelClass self, WidgetClass accelWidget) => ReadWriteAttr self (Maybe Widget) accelWidget accelLabelAccelWidget = newAttr accelLabelGetAccelWidget accelLabelSetAccelWidget gtk-0.15.9/Graphics/UI/Gtk/Display/Image.chs0000644000000000000000000003273307346545000016524 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Image -- -- Author : Axel Simon -- -- Created: 23 May 2001 -- -- Copyright (C) 2001-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. -- -- TODO -- -- Figure out what other functions are useful within Haskell. Maybe we should -- support loading Pixmaps without exposing them. -- -- Because Haskell is not the best language to modify large images directly -- only functions are bound that allow loading images from disc or by stock -- names. -- -- Another function for extracting the 'Pixbuf' is added for -- 'CellRenderer'. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget displaying an image -- module Graphics.UI.Gtk.Display.Image ( -- * Detail -- -- | The 'Image' widget displays an image. Various kinds of object can be -- displayed as an image; most typically, you would load a 'Pixbuf' (\"pixel -- buffer\") from a file, and then display that. There's a convenience function -- to do this, 'imageNewFromFile', used as follows: If the file isn't loaded -- successfully, the image will contain a \"broken image\" icon similar to that -- used in many web browsers. If you want to handle errors in loading the file -- yourself, for example by displaying an error message, then load the image -- with 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNewFromFile', then create the -- 'Image' with 'imageNewFromPixbuf'. -- -- > image <- imageNewFromFile "myfile.png" -- -- The image file may contain an animation, if so the 'Image' will display -- an animation ('PixbufAnimation') instead of a static image. -- -- 'Image' is a subclass of 'Misc', which implies that you can align it -- (center, left, right) and add padding to it, using 'Misc' methods. -- -- 'Image' is a \"no window\" widget (has no 'DrawWindow' of its own), so by -- default does not receive events. If you want to receive events on the image, -- such as button clicks, place the image inside a 'EventBox', then connect to -- the event signals on the event box. -- -- When handling events on the event box, keep in mind that coordinates in -- the image may be different from event box coordinates due to the alignment -- and padding settings on the image (see 'Misc'). The simplest way to solve -- this is to set the alignment to 0.0 (left\/top), and set the padding to -- zero. Then the origin of the image will be the same as the origin of the -- event box. -- -- Sometimes an application will want to avoid depending on external data -- files, such as image files. Gtk+ comes with a program to avoid this, called -- gdk-pixbuf-csource. This program allows you to convert an image into a C -- variable declaration, which can then be loaded into a 'Pixbuf' using -- 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNewFromInline'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Misc' -- | +----Image -- @ -- * Types Image, ImageClass, castToImage, gTypeImage, toImage, ImageType(..), -- * Constructors imageNewFromFile, imageNewFromPixbuf, imageNewFromAnimation, imageNewFromStock, imageNew, #if GTK_CHECK_VERSION(2,6,0) imageNewFromIconName, #endif -- * Methods imageGetPixbuf, imageSetFromPixbuf, imageSetFromAnimation, imageSetFromFile, imageSetFromStock, #if GTK_CHECK_VERSION(2,6,0) imageSetFromIconName, imageSetPixelSize, imageGetPixelSize, #endif #if GTK_CHECK_VERSION(2,8,0) imageClear, #endif -- * Icon Sizes IconSize(..), -- * Attributes imagePixbuf, #if GTK_MAJOR_VERSION < 3 imagePixmap, imageMask, #endif imageAnimation, imageImage, imageFile, imageStock, imageIconSize, #if GTK_CHECK_VERSION(2,6,0) imagePixelSize, #endif #if GTK_CHECK_VERSION(2,6,0) imageIconName, #endif imageStorageType, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.StockItems import Graphics.UI.Gtk.General.Structs (IconSize(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Types -- | Describes the image data representation used by a 'Image'. If you want to -- get the image from the widget, you can only get the currently-stored -- representation. e.g. if the 'imageStorageType' is 'ImagePixbuf', -- then you can call 'imageGetPixbuf' but not 'imageGetStock'. For empty -- images, you can request any storage type (call any of the "get" functions), -- but they will all return @Nothing@. -- {# enum ImageType {underscoreToCase} deriving (Show, Eq) #} -------------------- -- Constructors -- | Creates a new 'Image' displaying the file @filename@. If the file isn't -- found or can't be loaded, the resulting 'Image' will display a \"broken -- image\" icon. -- -- If the file contains an animation, the image will contain an animation. -- -- If you need to detect failures to load the file, use -- 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNewFromFile' -- to load the file yourself, then create the 'Image' from the pixbuf. (Or for -- animations, use -- 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufAnimationNewFromFile'). -- -- The storage type ('imageGetStorageType') of the returned image is not -- defined, it will be whatever is appropriate for displaying the file. -- imageNewFromFile :: GlibFilePath fp => fp -> IO Image imageNewFromFile filename = makeNewObject mkImage $ liftM (castPtr :: Ptr Widget -> Ptr Image) $ withUTFFilePath filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call unsafe gtk_image_new_from_file_utf8 #} #else {# call unsafe gtk_image_new_from_file #} #endif filenamePtr -- | Creates a new 'Image' displaying a 'Pixbuf'. -- -- Note that this function just creates an 'Image' from the pixbuf. The -- 'Image' created will not react to state changes. Should you want that, you -- should use 'imageNewFromIconSet'. -- imageNewFromPixbuf :: Pixbuf -> IO Image imageNewFromPixbuf pixbuf = makeNewObject mkImage $ liftM (castPtr :: Ptr Widget -> Ptr Image) $ {# call unsafe image_new_from_pixbuf #} pixbuf imageNewFromAnimation :: (PixbufAnimationClass animation) => animation -> IO Image imageNewFromAnimation pba = makeNewObject mkImage $ liftM (castPtr :: Ptr Widget -> Ptr Image) $ {# call unsafe image_new_from_animation #} (toPixbufAnimation pba) -- | Creates a 'Image' displaying a stock icon. If the stock icon name isn't -- known, the image will be empty. -- imageNewFromStock :: StockId -- ^ @stockId@ - a stock icon name -> IconSize -- ^ @size@ - a stock icon size -> IO Image imageNewFromStock stockId size = makeNewObject mkImage $ liftM (castPtr :: Ptr Widget -> Ptr Image) $ withUTFString stockId $ \stockIdPtr -> {# call unsafe image_new_from_stock #} stockIdPtr ((fromIntegral . fromEnum) size) -- | Creates a new empty 'Image' widget. -- imageNew :: IO Image imageNew = makeNewObject mkImage $ liftM (castPtr :: Ptr Widget -> Ptr Image) $ {# call gtk_image_new #} #if GTK_CHECK_VERSION(2,6,0) -- | Creates a 'Image' displaying an icon from the current icon theme. If the -- icon name isn't known, a \"broken image\" icon will be displayed instead. If -- the current icon theme is changed, the icon will be updated appropriately. -- -- * Available since Gtk+ version 2.6 -- imageNewFromIconName :: GlibString string => string -- ^ @iconName@ - an icon name -> IconSize -- ^ @size@ - a stock icon size -> IO Image imageNewFromIconName iconName size = makeNewObject mkImage $ liftM (castPtr :: Ptr Widget -> Ptr Image) $ withUTFString iconName $ \iconNamePtr -> {# call gtk_image_new_from_icon_name #} iconNamePtr ((fromIntegral . fromEnum) size) #endif -------------------- -- Methods -- | Gets the 'Pixbuf' being displayed by the 'Image'. The storage type of the -- image must be 'ImageEmpty' or 'ImagePixbuf' (see 'imageGetStorageType'). -- imageGetPixbuf :: Image -> IO Pixbuf imageGetPixbuf self = makeNewGObject mkPixbuf $ liftM castPtr $ throwIfNull "Image.imageGetPixbuf: The image contains no Pixbuf object." $ {# call unsafe image_get_pixbuf #} self -- | Overwrite the current content of the 'Image' with a new 'Pixbuf'. -- imageSetFromPixbuf :: Image -> Pixbuf -> IO () imageSetFromPixbuf self pixbuf = {# call unsafe gtk_image_set_from_pixbuf #} self pixbuf imageSetFromAnimation :: (PixbufAnimationClass animation) => Image -> animation -> IO () imageSetFromAnimation self pba = {# call unsafe gtk_image_set_from_animation #} self (toPixbufAnimation pba) -- | See 'imageNewFromFile' for details. -- imageSetFromFile :: GlibFilePath fp => Image -> fp -> IO () imageSetFromFile self filename = withUTFFilePath filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_image_set_from_file_utf8 #} #else {# call gtk_image_set_from_file #} #endif self filenamePtr -- | See 'imageNewFromStock' for details. -- imageSetFromStock :: Image -> StockId -- ^ @stockId@ - a stock icon name -> IconSize -- ^ @size@ - a stock icon size -> IO () imageSetFromStock self stockId size = withUTFString stockId $ \stockIdPtr -> {# call gtk_image_set_from_stock #} self stockIdPtr ((fromIntegral . fromEnum) size) #if GTK_CHECK_VERSION(2,6,0) -- | See 'imageNewFromIconName' for details. -- -- * Available since Gtk+ version 2.6 -- imageSetFromIconName :: GlibString string => Image -> string -- ^ @iconName@ - an icon name -> IconSize -- ^ @size@ - an icon size -> IO () imageSetFromIconName self iconName size = withUTFString iconName $ \iconNamePtr -> {# call gtk_image_set_from_icon_name #} self iconNamePtr ((fromIntegral . fromEnum) size) -- | Sets the pixel size to use for named icons. If the pixel size is set to a -- @value \/= -1@, it is used instead of the icon size set by -- 'imageSetFromIconName'. -- -- * Available since Gtk+ version 2.6 -- imageSetPixelSize :: Image -> Int -- ^ @pixelSize@ - the new pixel size -> IO () imageSetPixelSize self pixelSize = {# call gtk_image_set_pixel_size #} self (fromIntegral pixelSize) -- | Gets the pixel size used for named icons. -- -- * Available since Gtk+ version 2.6 -- imageGetPixelSize :: Image -> IO Int imageGetPixelSize self = liftM fromIntegral $ {# call gtk_image_get_pixel_size #} self #endif #if GTK_CHECK_VERSION(2,8,0) -- | Resets the image to be empty. -- -- * Available since Gtk+ version 2.8 -- imageClear :: Image -> IO () imageClear self = {# call gtk_image_clear #} self #endif -------------------- -- Attributes -- | A 'Pixbuf' to display. -- imagePixbuf :: PixbufClass pixbuf => ReadWriteAttr Image Pixbuf pixbuf imagePixbuf = newAttrFromObjectProperty "pixbuf" {# call pure unsafe gdk_pixbuf_get_type #} imageAnimation :: (PixbufClass pixbuf, PixbufAnimationClass animation) => ReadWriteAttr Image animation pixbuf imageAnimation = newAttrFromObjectProperty "pixbuf-animation" {# call pure unsafe gdk_pixbuf_get_type #} #if GTK_MAJOR_VERSION < 3 -- | A 'Pixmap' to display. -- imagePixmap :: PixmapClass pixmap => ReadWriteAttr Image Pixmap pixmap imagePixmap = newAttrFromObjectProperty "pixmap" {# call pure unsafe gdk_pixmap_get_type #} -- | Mask bitmap to use with 'Image' or 'Pixmap'. -- imageMask :: PixmapClass pixmap => ReadWriteAttr Image Pixmap pixmap imageMask = newAttrFromObjectProperty "mask" {# call pure unsafe gdk_pixmap_get_type #} #endif -- | A 'Image' to display. -- imageImage :: ImageClass image => ReadWriteAttr Image Image image imageImage = newAttrFromObjectProperty "image" {# call pure unsafe gtk_image_get_type #} -- | Filename to load and display. -- -- Default value: \"\" -- imageFile :: GlibString string => Attr Image string imageFile = newAttrFromStringProperty "file" -- | Stock ID for a stock image to display. -- -- Default value: \"\" -- imageStock :: GlibString string => Attr Image string imageStock = newAttrFromStringProperty "stock" -- | Symbolic size to use for stock icon, icon set or named icon. -- -- Allowed values: >= 0 -- -- Default value: 4 -- imageIconSize :: Attr Image Int imageIconSize = newAttrFromIntProperty "icon-size" #if GTK_CHECK_VERSION(2,6,0) -- | The pixel-size property can be used to specify a fixed size overriding -- the icon-size property for images of type 'ImageIconName'. -- -- Allowed values: >= -1 -- -- Default value: -1 -- imagePixelSize :: Attr Image Int imagePixelSize = newAttr imageGetPixelSize imageSetPixelSize #endif #if GTK_CHECK_VERSION(2,6,0) -- | The name of the icon in the icon theme. If the icon theme is changed, the -- image will be updated automatically. -- -- Default value: \"\" -- imageIconName :: GlibString string => Attr Image string imageIconName = newAttrFromStringProperty "icon-name" #endif -- | The representation being used for image data. -- -- Default value: 'ImageEmpty' -- imageStorageType :: ReadAttr Image ImageType imageStorageType = readAttrFromEnumProperty "storage-type" {# call pure unsafe gtk_image_type_get_type #} gtk-0.15.9/Graphics/UI/Gtk/Display/InfoBar.chs0000644000000000000000000002003207346545000017007 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget InfoBar -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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. -- -- The following varargs functions can't bound: -- -- gtk_info_bar_new_with_buttons -- gtk_info_bar_add_buttons -- -- Use 'infoBarAddButton' replace. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Report important messages to the user -- module Graphics.UI.Gtk.Display.InfoBar ( -- * Detail -- -- | 'InfoBar' is a widget that can be used to show messages to the user -- without showing a dialog. It is often temporarily shown at the top or bottom -- of a document. In contrast to 'Dialog', which has a horizontal action area -- at the bottom, 'InfoBar' has a vertical action area at the side. -- -- The API of 'InfoBar' is very similar to 'Dialog', allowing you to add -- buttons to the action area with 'infoBarAddButton'. -- The sensitivity of action widgets can be controlled -- with 'infoBarSetResponseSensitive'. To add widgets to the main content area -- of a 'InfoBar', use 'infoBarGetContentArea' and add your widgets to the -- container. -- -- Similar to 'MessageDialog', the contents of a 'InfoBar' can by classified -- as error message, warning, informational message, etc, by using -- 'infoBarSetMessageType'. Gtk+ uses the message type to determine the -- background color of the message area. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'HBox' -- | +----InfoBar -- @ #if GTK_CHECK_VERSION(2,18,0) -- * Types InfoBar, InfoBarClass, castToInfoBar, toInfoBar, -- * Constructors infoBarNew, -- * Methods infoBarAddActionWidget, infoBarAddButton, infoBarSetResponseSensitive, infoBarSetDefaultResponse, infoBarEmitResponse, infoBarGetActionArea, infoBarGetContentArea, -- * Attributes infoBarMessageType, -- * Signals infoBarResponse, infoBarClose, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.Windows.MessageDialog#} (MessageType) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Interfaces -- instance BuildableClass InfoBar -------------------- -- Constructors #if GTK_CHECK_VERSION(2,18,0) -- | Creates a new 'InfoBar' object. -- -- * Available since Gtk+ version 2.18 -- infoBarNew :: IO InfoBar infoBarNew = makeNewObject mkInfoBar $ liftM (castPtr :: Ptr Widget -> Ptr InfoBar) $ {# call gtk_info_bar_new #} -------------------- -- Methods -- | Add an activatable widget to the action area of a 'InfoBar', connecting a signal handler that will -- emit the "response" signal on the message area when the widget is activated. The widget is appended -- to the end of the message areas action area. -- -- * Available since Gtk+ version 2.18 -- infoBarAddActionWidget :: (InfoBarClass self, WidgetClass child) => self -> child -- ^ @child@ - an activatable widget -> Int -- ^ @responseId@ - response ID for @child@ -> IO () infoBarAddActionWidget self child responseId = {# call gtk_info_bar_add_action_widget #} (toInfoBar self) (toWidget child) (fromIntegral responseId) -- | Adds a button with the given text (or a stock button, if buttonText is a -- stock ID) and sets things up so that clicking the button will emit the -- \"response\" signal with the given responseId. The button is appended to -- the end of the info bars's action area. The button widget is returned, but -- usually you don't need it. -- -- * Available since Gtk+ version 2.18 -- infoBarAddButton :: (InfoBarClass self, GlibString string) => self -> string -- ^ @buttonText@ - text of button, or stock ID -> Int -- ^ @responseId@ - response ID for the button -> IO Button -- ^ returns the button widget that was added infoBarAddButton self buttonText responseId = makeNewObject mkButton $ withUTFString buttonText $ \buttonTextPtr -> liftM (castPtr :: Ptr Widget -> Ptr Button) $ {# call gtk_info_bar_add_button #} (toInfoBar self) buttonTextPtr (fromIntegral responseId) -- | Calls 'widgetSetSensitive' for each widget in the -- info bars's action area with the given responseId. A convenient way to -- sensitize\/desensitize dialog buttons. -- -- * Available since Gtk+ version 2.18 -- infoBarSetResponseSensitive :: InfoBarClass self => self -> Int -- ^ @responseId@ - a response ID -> Bool -- ^ @setting@ - @True@ for sensitive -> IO () infoBarSetResponseSensitive self responseId setting = {# call gtk_info_bar_set_response_sensitive #} (toInfoBar self) (fromIntegral responseId) (fromBool setting) -- | Sets the last widget in the info bar's action area with the given -- responseId as the default widget for the dialog. Pressing \"Enter\" -- normally activates the default widget. -- -- * Available since Gtk+ version 2.18 -- infoBarSetDefaultResponse :: InfoBarClass self => self -> Int -- ^ @responseId@ - a response ID -> IO () infoBarSetDefaultResponse self responseId = {# call gtk_info_bar_set_default_response #} (toInfoBar self) (fromIntegral responseId) -- | Emits the \'response\' signal with the given @responseId@. -- -- * Available since Gtk+ version 2.18 -- infoBarEmitResponse :: InfoBarClass self => self -> Int -- ^ @responseId@ - a response ID -> IO () infoBarEmitResponse self responseId = {# call gtk_info_bar_response #} (toInfoBar self) (fromIntegral responseId) -- | Returns the action area of @infoBar@. -- -- * Available since Gtk+ version 2.18 -- infoBarGetActionArea :: InfoBarClass self => self -> IO Widget -- ^ returns the action area. infoBarGetActionArea self = makeNewObject mkWidget $ {# call gtk_info_bar_get_action_area #} (toInfoBar self) -- | Returns the content area of @infoBar@. -- -- * Available since Gtk+ version 2.18 -- infoBarGetContentArea :: InfoBarClass self => self -> IO Widget -- ^ returns the content area. infoBarGetContentArea self = makeNewObject mkWidget $ {# call gtk_info_bar_get_content_area #} (toInfoBar self) -------------------- -- Attributes -- | The type of the message. -- -- The type is used to determine the colors to use in the info bar. -- -- If the type is 'MessageOther', no info bar is painted but the colors are still set. -- -- Default value: 'MessageInfo' -- -- * Available since Gtk+ version 2.18 -- infoBarMessageType :: InfoBarClass self => Attr self MessageType infoBarMessageType = newAttrFromEnumProperty "message-type" {# call pure unsafe gtk_message_type_get_type #} -------------------- -- Signals -- | The 'close' signal is a keybinding signal which gets emitted when the user uses a keybinding to -- dismiss the info bar. -- -- The default binding for this signal is the Escape key. -- -- Since 2.18 infoBarClose :: InfoBarClass self => Signal self (IO ()) infoBarClose = Signal (connect_NONE__NONE "close") -- | Emitted when an action widget is clicked or the application programmer -- calls 'dialogResponse'. The @responseId@ depends on which action widget was -- clicked. -- -- * Available since Gtk+ version 2.18 -- infoBarResponse :: InfoBarClass self => Signal self (Int -> IO ()) infoBarResponse = Signal (connect_INT__NONE "response") #endif gtk-0.15.9/Graphics/UI/Gtk/Display/Label.chs0000644000000000000000000010316607346545000016520 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Label -- -- Author : Manuel M. T. Chakravarty, Axel Simon, Andy Stewart -- -- Created: 2 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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) -- -- A widget that displays a small to medium amount of text -- module Graphics.UI.Gtk.Display.Label ( -- * Detail -- -- | The 'Label' widget displays a small amount of text. As the name implies, -- most labels are used to label another widget such as a 'Button', a -- 'MenuItem', or a 'OptionMenu'. -- ** Mnemonics -- -- | Labels may contain mnemonics. Mnemonics are underlined characters in the -- label, used for keyboard navigation. Mnemonics are created by providing a -- string with an underscore before the mnemonic character, such as -- @\"_File\"@, to the functions 'labelNewWithMnemonic' or -- 'labelSetTextWithMnemonic'. -- -- Mnemonics automatically activate any activatable widget the label is -- inside, such as a 'Button'; if the label is not inside the mnemonic's target -- widget, you have to tell the label about the target using -- 'labelSetMnemonicWidget'. Here's a simple example where the label is inside -- a button: There's a convenience function to create buttons with a mnemonic -- label already inside: To create a mnemonic for a widget alongside the label, -- such as a 'Entry', you have to point the label at the entry with -- 'labelSetMnemonicWidget': -- -- > -- Pressing Alt+H will activate this button -- > button <- buttonNew -- > label <- labelNewWithMnemonic "_Hello" -- > containerAdd button label -- -- > -- Pressing Alt+H will activate this button -- > button <- buttonNewWithMnemonic "_Hello" -- -- > -- Pressing Alt+H will focus the entry -- > entry <- entryNew -- > label <- labelNewWithMnemonic "_Hello" -- > labelSetMnemonicWidget label entry -- ** Markup (styled text) -- -- | To make it easy to format text in a label (changing colors, fonts, etc.), -- label text can be provided in a simple markup format. Here's how to create a -- label with a small font: (See complete documentation of available tags in -- the Pango manual.) -- -- > label <- labelNew Nothing -- > labelSetMarkup label "Small text" -- -- The markup passed to 'labelSetMarkup' must be valid; for example, literal -- \<\/>\/& characters must be escaped as @\"<\"@, @\">\"@, and -- @\"&@\". If you pass -- text obtained from the user, file, or a network to 'labelSetMarkup', you\'ll -- want to escape it with 'Graphics.Rendering.Pango.Layout.escapeMarkup'. -- ** Selectable labels -- -- | Labels can be made selectable with 'labelSetSelectable'. Selectable -- labels allow the user to copy the label contents to the clipboard. Only -- labels that contain useful-to-copy information - such as error messages - -- should be made selectable. -- ** Text layout -- -- | A label can contain any number of paragraphs, but will have performance -- problems if it contains more than a small number. Paragraphs are separated -- by newlines or other paragraph separators understood by Pango. -- -- Labels can automatically wrap text if you call 'labelSetLineWrap'. -- -- 'labelSetJustify' sets how the lines in a label align with one another. -- If you want to set how the label as a whole aligns in its available space, -- see 'Graphics.UI.Gtk.Abstract.Misc.miscSetAlignment'. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Misc' -- | +----Label -- | +----'AccelLabel' -- | +----'TipsQuery' -- @ -- * Types Label, LabelClass, castToLabel, gTypeLabel, toLabel, -- * Constructors labelNew, labelNewWithMnemonic, -- * Methods labelSetText, labelSetLabel, labelSetTextWithMnemonic, labelSetMarkup, labelSetMarkupWithMnemonic, labelSetMnemonicWidget, labelGetMnemonicWidget, KeyVal, labelGetMnemonicKeyval, labelSetUseMarkup, labelGetUseMarkup, labelSetUseUnderline, labelGetUseUnderline, labelGetText, labelGetLabel, labelSetAttributes, labelGetAttributes, labelSetPattern, Justification(..), labelSetJustify, labelGetJustify, labelGetLayout, labelSetLineWrap, labelGetLineWrap, labelSetLineWrapMode, labelGetLineWrapMode, labelSetSelectable, labelGetSelectable, labelSelectRegion, labelGetSelectionBounds, labelGetLayoutOffsets, #if GTK_CHECK_VERSION(2,6,0) labelSetEllipsize, labelGetEllipsize, labelSetWidthChars, labelGetWidthChars, labelSetMaxWidthChars, labelGetMaxWidthChars, labelSetSingleLineMode, labelGetSingleLineMode, labelSetAngle, labelGetAngle, #endif -- * Attributes labelLabel, labelUseMarkup, labelUseUnderline, labelJustify, labelWrap, labelWrapMode, labelSelectable, labelMnemonicWidget, labelMnemonicKeyval, labelPattern, labelCursorPosition, labelSelectionBound, #if GTK_CHECK_VERSION(2,6,0) labelEllipsize, labelWidthChars, labelSingleLineMode, labelAngle, labelAttributes, labelMaxWidthChars, #endif labelLineWrap, labelText, -- * Signals labelActiveCurrentLink, labelActiveLink, labelCopyClipboard, labelMoveCursor, labelPopulatePopup ) where import Control.Monad (liftM) import Data.Text (Text) import qualified Data.Text as T (pack) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.Rendering.Pango.Layout#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.Rendering.Pango.Attributes ( withAttrList, fromAttrList) import Graphics.UI.Gtk.Gdk.Keys (KeyVal) import Graphics.UI.Gtk.General.Enums (Justification(..), MovementStep (..)) {#import Graphics.Rendering.Pango.BasicTypes#} (PangoLayout(PangoLayout), makeNewPangoString, PangoString(..) ) import Graphics.Rendering.Pango.Types (mkPangoLayoutRaw, PangoLayoutRaw) import Graphics.Rendering.Pango.Enums (PangoAttribute) import Data.IORef ( newIORef ) {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new label with the given text inside it. You can pass @Nothing@ -- to get an empty label widget. -- labelNew :: GlibString string => Maybe string -> IO Label labelNew str = makeNewObject mkLabel $ liftM (castPtr :: Ptr Widget -> Ptr Label) $ maybeWith withUTFString str $ \strPtr -> {# call label_new #} strPtr -- | Creates a new 'Label', containing the text in @str@. -- -- If characters in @str@ are preceded by an underscore, they are -- underlined. If you need a literal underscore character in a label, use -- \'__\' (two underscores). The first underlined character represents a -- keyboard accelerator called a mnemonic. The mnemonic key can be used to -- activate another widget, chosen automatically, or explicitly using -- 'labelSetMnemonicWidget'. -- -- If 'labelSetMnemonicWidget' is not called, then the first activatable -- ancestor of the 'Label' will be chosen as the mnemonic widget. For instance, -- if the label is inside a button or menu item, the button or menu item will -- automatically become the mnemonic widget and be activated by the mnemonic. -- labelNewWithMnemonic :: GlibString string => string -- ^ @str@ - The text of the label, with an underscore in front -- of the mnemonic character -> IO Label labelNewWithMnemonic str = makeNewObject mkLabel $ liftM (castPtr :: Ptr Widget -> Ptr Label) $ withUTFString str $ \strPtr -> {# call label_new_with_mnemonic #} strPtr -------------------- -- Methods -- | Sets the text within the 'Label' widget. It overwrites any text that was -- there before. -- -- This will also clear any previously set mnemonic accelerators. -- labelSetText :: (LabelClass self, GlibString string) => self -> string -> IO () labelSetText self str = withUTFString str $ \strPtr -> {# call label_set_text #} (toLabel self) strPtr -- | Sets the text of the label. The label is interpreted as including -- embedded underlines and\/or Pango markup depending on the markup and -- underline properties. -- labelSetLabel :: (LabelClass self, GlibString string) => self -> string -> IO () labelSetLabel self str = withUTFString str $ \strPtr -> {# call label_set_label #} (toLabel self) strPtr -- | Sets a PangoAttrList; the attributes in the list are applied to the label -- text. -- -- Note: The attributes set with this function will be applied and merged with -- any other attributes previously effected by way of the 'labelUseUnderline' or -- 'labelUseMarkup' properties. While it is not recommended to mix markup strings -- with manually set attributes, if you must; know that the attributes will be -- applied to the label after the markup string is parsed. -- labelSetAttributes :: LabelClass self => self -> [PangoAttribute] -- ^ @attr@ 'PangoAttribute' -> IO () labelSetAttributes self attrs = do (txt :: Text) <- labelGetText self ps <- makeNewPangoString txt withAttrList ps attrs $ \alPtr -> {#call unsafe label_set_attributes #} (toLabel self) alPtr -- | Gets the attribute list that was set on the label using 'labelSetAttributes', if any. -- This function does not reflect attributes that come from the labels markup (see 'labelSetMarkup'). -- If you want to get the effective attributes for the label, use 'layoutGetAttributes' ('labelGetLayout' (label)). -- labelGetAttributes :: LabelClass self => self -> IO [PangoAttribute] -- ^ return the attribute list, or Empty if none was set. labelGetAttributes self = do (txt :: Text) <- labelGetText self (PangoString correct _ _ ) <- makeNewPangoString txt attrListPtr <- {# call unsafe label_get_attributes #} (toLabel self) attr <- fromAttrList correct attrListPtr return $ concat attr -- | Parses @str@ which is marked up with the Pango text markup language, -- as defined in "Graphics.Rendering.Pango.Markup", -- setting the label's text and attribute list based on the parse results. If -- the @str@ is external data, you may need to escape it. -- labelSetMarkup :: (LabelClass self, GlibString markup) => self -> markup -- ^ @str@ - a markup string (see Pango markup format) -> IO () labelSetMarkup self str = withUTFString str $ \strPtr -> {# call label_set_markup #} (toLabel self) strPtr -- | Parses @str@ which is marked up with the Pango text markup language, -- as defined in "Graphics.Rendering.Pango.Markup", -- setting the label's text and attribute list based on the parse results. If -- characters in @str@ are preceded by an underscore, they are underlined -- indicating that they represent a keyboard accelerator called a mnemonic. -- -- The mnemonic key can be used to activate another widget, chosen -- automatically, or explicitly using 'labelSetMnemonicWidget'. -- labelSetMarkupWithMnemonic :: (LabelClass self, GlibString markup) => self -> markup -- ^ @str@ - a markup string (see Pango markup format) -> IO () labelSetMarkupWithMnemonic self str = withUTFString str $ \strPtr -> {# call label_set_markup_with_mnemonic #} (toLabel self) strPtr -- | Underline parts of the text, odd indices of the list represent underlined -- parts. -- labelSetPattern :: LabelClass l => l -> [Int] -> IO () labelSetPattern self list = withUTFString (T.pack str) $ {# call label_set_pattern #} (toLabel self) where str = concat $ zipWith replicate list (cycle ['_',' ']) -- | Sets the alignment of the lines in the text of the label relative to each -- other. 'JustifyLeft' is the default value when the widget is first created -- with 'labelNew'. If you instead want to set the alignment of the label as a -- whole, use 'Graphics.UI.Gtk.Abstract.Misc.miscSetAlignment' instead. -- 'labelSetJustify' has no effect on labels containing only a single line. -- labelSetJustify :: LabelClass self => self -> Justification -> IO () labelSetJustify self jtype = {# call label_set_justify #} (toLabel self) ((fromIntegral . fromEnum) jtype) -- | Returns the justification of the label. See 'labelSetJustify'. -- labelGetJustify :: LabelClass self => self -> IO Justification labelGetJustify self = liftM (toEnum . fromIntegral) $ {# call unsafe label_get_justify #} (toLabel self) -- | Gets the 'PangoLayout' used to display the label. The layout is useful to -- e.g. convert text positions to pixel positions, in combination with -- 'labelGetLayoutOffsets'. -- labelGetLayout :: LabelClass self => self -> IO PangoLayout labelGetLayout self = do plr <- makeNewGObject mkPangoLayoutRaw $ {# call unsafe label_get_layout #} (toLabel self) (txt :: Text) <- labelGetText self ps <- makeNewPangoString txt psRef <- newIORef ps return (PangoLayout psRef plr) -- | Toggles line wrapping within the 'Label' widget. @True@ makes it break -- lines if text exceeds the widget's size. @False@ lets the text get cut off -- by the edge of the widget if it exceeds the widget size. -- labelSetLineWrap :: LabelClass self => self -> Bool -- ^ @wrap@ - the setting -> IO () labelSetLineWrap self wrap = {# call label_set_line_wrap #} (toLabel self) (fromBool wrap) -- | Returns whether lines in the label are automatically wrapped. See -- 'labelSetLineWrap'. -- labelGetLineWrap :: LabelClass self => self -> IO Bool -- ^ returns @True@ if the lines of the label are automatically -- wrapped. labelGetLineWrap self = liftM toBool $ {# call unsafe label_get_line_wrap #} (toLabel self) -- | If line wrapping is on (see 'labelSetLineWrap') this controls how the line wrapping is done. -- The default is 'WrapWholeWords' which means wrap on word boundaries. -- -- * Available since Gtk+ version 2.10 -- labelSetLineWrapMode :: LabelClass self => self -> LayoutWrapMode -- ^ @wrapMode@ - the line wrapping mode -> IO () labelSetLineWrapMode self wrapMode = {# call label_set_line_wrap_mode #} (toLabel self) (fromIntegral (fromEnum wrapMode)) -- | Returns line wrap mode used by the label. See 'labelSetLineWrapMode'. -- -- * Available since Gtk+ version 2.10 -- labelGetLineWrapMode :: LabelClass self => self -> IO LayoutWrapMode -- ^ return the line wrapping mode labelGetLineWrapMode self = liftM (toEnum . fromIntegral) $ {# call label_get_line_wrap_mode #} (toLabel self) -- | Obtains the coordinates where the label will draw the 'PangoLayout' -- representing the text in the label; useful to convert mouse events into -- coordinates inside the 'PangoLayout', e.g. to take some action if some part -- of the label is clicked. Of course you will need to create a 'EventBox' to -- receive the events, and pack the label inside it, since labels are a -- \'NoWindow\' widget. -- labelGetLayoutOffsets :: LabelClass self => self -> IO (Int, Int) labelGetLayoutOffsets self = alloca $ \xPtr -> alloca $ \yPtr -> do {# call unsafe label_get_layout_offsets #} (toLabel self) xPtr yPtr x <- peek xPtr y <- peek yPtr return (fromIntegral x, fromIntegral y) -- | If the label has been set so that it has an mnemonic key this function -- returns the keyval used for the mnemonic accelerator. -- labelGetMnemonicKeyval :: LabelClass self => self -> IO KeyVal labelGetMnemonicKeyval self = liftM fromIntegral $ {# call unsafe label_get_mnemonic_keyval #} (toLabel self) -- | Gets whether the text selectable. -- labelGetSelectable :: LabelClass self => self -> IO Bool -- ^ returns @True@ if the user can copy text from the label labelGetSelectable self = liftM toBool $ {# call unsafe label_get_selectable #} (toLabel self) -- | Sets whether the text of the label contains markup in Pango's text markup -- language. See 'labelSetMarkup'. -- labelSetUseMarkup :: LabelClass self => self -> Bool -- ^ @setting@ - @True@ if the label's text should be parsed for -- markup. -> IO () labelSetUseMarkup self setting = {# call label_set_use_markup #} (toLabel self) (fromBool setting) -- | Returns whether the label's text is interpreted as marked up with the -- Pango text markup language. See 'labelSetUseMarkup'. -- labelGetUseMarkup :: LabelClass self => self -> IO Bool -- ^ returns @True@ if the label's text will be parsed for markup. labelGetUseMarkup self = liftM toBool $ {# call unsafe label_get_use_markup #} (toLabel self) -- | If @True@, an underline in the text indicates the next character should be -- used for the mnemonic accelerator key. -- labelSetUseUnderline :: LabelClass self => self -> Bool -> IO () labelSetUseUnderline self useUnderline = {# call label_set_use_underline #} (toLabel self) (fromBool useUnderline) -- | Returns whether an embedded underline in the label indicates a mnemonic. -- See 'labelSetUseUnderline'. -- labelGetUseUnderline :: LabelClass self => self -> IO Bool labelGetUseUnderline self = liftM toBool $ {# call unsafe label_get_use_underline #} (toLabel self) -- | Gets the text from a label widget, as displayed on the screen. This -- does not include any embedded underlines indicating mnemonics or Pango -- markup. (See 'labelGetLabel') -- labelGetText :: (LabelClass self, GlibString string) => self -> IO string labelGetText self = {# call unsafe label_get_text #} (toLabel self) >>= peekUTFString -- | Gets the text from a label widget including any embedded underlines -- indicating mnemonics and Pango markup. (See 'labelGetText'). -- labelGetLabel :: (LabelClass self, GlibString string) => self -> IO string labelGetLabel self = {# call unsafe label_get_label #} (toLabel self) >>= peekUTFString -- | Selects a range of characters in the label, if the label is selectable. -- See 'labelSetSelectable'. If the label is not selectable, this function has -- no effect. If @startOffset@ or @endOffset@ are -1, then the end of the label -- will be substituted. -- labelSelectRegion :: LabelClass self => self -> Int -- ^ @startOffset@ - start offset -> Int -- ^ @endOffset@ - end offset -> IO () labelSelectRegion self startOffset endOffset = {# call label_select_region #} (toLabel self) (fromIntegral startOffset) (fromIntegral endOffset) -- | Gets the selected range of characters in the label, if any. If there is -- a range selected the result is the start and end of the selection as -- character offsets. -- labelGetSelectionBounds :: LabelClass self => self -> IO (Maybe (Int, Int)) labelGetSelectionBounds self = alloca $ \startPtr -> alloca $ \endPtr -> do isSelection <- liftM toBool $ {# call unsafe label_get_selection_bounds #} (toLabel self) startPtr endPtr if isSelection then do start <- peek startPtr end <- peek endPtr return $ Just $ (fromIntegral start, fromIntegral end) else return Nothing -- | If the label has been set so that it has an mnemonic key (using i.e. -- 'labelSetMarkupWithMnemonic', 'labelSetTextWithMnemonic', -- 'labelNewWithMnemonic' or the \"use_underline\" property) the label can be -- associated with a widget that is the target of the mnemonic. When the label -- is inside a widget (like a 'Button' or a 'Notebook' tab) it is automatically -- associated with the correct widget, but sometimes (i.e. when the target is a -- 'Entry' next to the label) you need to set it explicitly using this -- function. -- -- The target widget will be accelerated by emitting \"mnemonic_activate\" -- on it. The default handler for this signal will activate the widget if there -- are no mnemonic collisions and toggle focus between the colliding widgets -- otherwise. -- labelSetMnemonicWidget :: (LabelClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the target 'Widget' -> IO () labelSetMnemonicWidget self widget = {# call unsafe label_set_mnemonic_widget #} (toLabel self) (toWidget widget) -- | Retrieves the target of the mnemonic (keyboard shortcut) of this label. -- See 'labelSetMnemonicWidget'. -- labelGetMnemonicWidget :: LabelClass self => self -> IO (Maybe Widget) -- ^ returns the target of the label's mnemonic, or -- @Nothing@ if none has been set and the default -- algorithm will be used. labelGetMnemonicWidget self = maybeNull (makeNewObject mkWidget) $ {# call unsafe label_get_mnemonic_widget #} (toLabel self) -- | Selectable labels allow the user to select text from the label, for -- copy-and-paste. -- labelSetSelectable :: LabelClass self => self -> Bool -- ^ @setting@ - @True@ to allow selecting text in the label -> IO () labelSetSelectable self setting = {# call unsafe label_set_selectable #} (toLabel self) (fromBool setting) -- | Sets the label's text from the given string. If characters in the string are -- preceded by an underscore, they are underlined indicating that they -- represent a keyboard accelerator called a mnemonic. The mnemonic key can be -- used to activate another widget, chosen automatically, or explicitly using -- 'labelSetMnemonicWidget'. -- labelSetTextWithMnemonic :: (LabelClass self, GlibString string) => self -> string -> IO () labelSetTextWithMnemonic self str = withUTFString str $ \strPtr -> {# call label_set_text_with_mnemonic #} (toLabel self) strPtr #if GTK_CHECK_VERSION(2,6,0) -- | Sets the mode used to ellipsize (add an ellipsis: \"...\") to the text if -- there is not enough space to render the entire string. -- -- * Available since Gtk+ version 2.6 -- labelSetEllipsize :: LabelClass self => self -> EllipsizeMode -- ^ @mode@ - a 'EllipsizeMode' -> IO () labelSetEllipsize self mode = {# call gtk_label_set_ellipsize #} (toLabel self) ((fromIntegral . fromEnum) mode) -- | Sets the desired width in characters of @label@ to @nChars@. -- -- * Available since Gtk+ version 2.6 -- labelSetWidthChars :: LabelClass self => self -> Int -- ^ @nChars@ - the new desired width, in characters. -> IO () labelSetWidthChars self nChars = {# call gtk_label_set_width_chars #} (toLabel self) (fromIntegral nChars) -- | Sets the desired maximum width in characters of @label@ to @nChars@. -- -- * Available since Gtk+ version 2.6 -- labelSetMaxWidthChars :: LabelClass self => self -> Int -- ^ @nChars@ - the new desired maximum width, in characters. -> IO () labelSetMaxWidthChars self nChars = {# call gtk_label_set_max_width_chars #} (toLabel self) (fromIntegral nChars) -- | Returns the ellipsizing position of the label. See 'labelSetEllipsize'. -- -- * Available since Gtk+ version 2.6 -- labelGetEllipsize :: LabelClass self => self -> IO EllipsizeMode -- ^ returns 'EllipsizeMode' labelGetEllipsize self = liftM (toEnum . fromIntegral) $ {# call gtk_label_get_ellipsize #} (toLabel self) -- | Retrieves the desired width of @label@, in characters. See -- 'labelSetWidthChars'. -- -- * Available since Gtk+ version 2.6 -- labelGetWidthChars :: LabelClass self => self -> IO Int -- ^ returns the width of the label in characters. labelGetWidthChars self = liftM fromIntegral $ {# call gtk_label_get_width_chars #} (toLabel self) -- | Retrieves the desired maximum width of @label@, in characters. See -- 'labelSetWidthChars'. -- -- * Available since Gtk+ version 2.6 -- labelGetMaxWidthChars :: LabelClass self => self -> IO Int -- ^ returns the maximum width of the label in characters. labelGetMaxWidthChars self = liftM fromIntegral $ {# call gtk_label_get_max_width_chars #} (toLabel self) -- | Returns whether the label is in single line mode. -- -- * Available since Gtk+ version 2.6 -- labelGetSingleLineMode :: LabelClass self => self -> IO Bool -- ^ returns @True@ when the label is in single line mode. labelGetSingleLineMode self = liftM toBool $ {# call gtk_label_get_single_line_mode #} (toLabel self) -- | Gets the angle of rotation for the label. See gtk_label_set_angle. -- -- * Available since Gtk+ version 2.6 -- labelGetAngle :: LabelClass self => self -> IO Double -- ^ returns the angle of rotation for the label labelGetAngle self = liftM realToFrac $ {# call gtk_label_get_angle #} (toLabel self) -- | Sets whether the label is in single line mode. -- -- * Available since Gtk+ version 2.6 -- labelSetSingleLineMode :: LabelClass self => self -> Bool -- ^ @singleLineMode@ - @True@ if the label should be in single line -- mode -> IO () labelSetSingleLineMode self singleLineMode = {# call gtk_label_set_single_line_mode #} (toLabel self) (fromBool singleLineMode) -- | Sets the angle of rotation for the label. An angle of 90 reads from from -- bottom to top, an angle of 270, from top to bottom. The angle setting for -- the label is ignored if the label is selectable, wrapped, or ellipsized. -- -- * Available since Gtk+ version 2.6 -- labelSetAngle :: LabelClass self => self -> Double -- ^ @angle@ - the angle that the baseline of the label makes with -- the horizontal, in degrees, measured counterclockwise -> IO () labelSetAngle self angle = {# call gtk_label_set_angle #} (toLabel self) (realToFrac angle) #endif -------------------- -- Attributes -- | The text of the label. -- labelLabel :: (LabelClass self, GlibString string) => Attr self string labelLabel = newAttr labelGetLabel labelSetLabel -- | The text of the label includes XML markup. See pango_parse_markup(). -- -- Default value: @False@ -- labelUseMarkup :: LabelClass self => Attr self Bool labelUseMarkup = newAttr labelGetUseMarkup labelSetUseMarkup -- | If set, an underline in the text indicates the next character should be -- used for the mnemonic accelerator key. -- -- Default value: @False@ -- labelUseUnderline :: LabelClass self => Attr self Bool labelUseUnderline = newAttr labelGetUseUnderline labelSetUseUnderline -- | The alignment of the lines in the text of the label relative to each -- other. This does NOT affect the alignment of the label within its -- allocation. -- -- Default value: 'JustifyLeft' -- labelJustify :: LabelClass self => Attr self Justification labelJustify = newAttr labelGetJustify labelSetJustify -- | If set, wrap lines if the text becomes too wide. -- -- Default value: @False@ -- labelWrap :: LabelClass self => Attr self Bool labelWrap = newAttrFromBoolProperty "wrap" -- | If line wrapping is on (see the 'labelWrap' property) this controls how the line wrapping is done. -- The default is 'WrapWholeWords', which means wrap on word boundaries. -- -- Default value: 'WrapWholeWords' -- -- * Available since Gtk+ version 2.10 -- labelWrapMode :: LabelClass self => Attr self LayoutWrapMode labelWrapMode = newAttrFromEnumProperty "wrap-mode" {# call pure unsafe gtk_label_get_type #} -- | Whether the label text can be selected with the mouse. -- -- Default value: @False@ -- labelSelectable :: LabelClass self => Attr self Bool labelSelectable = newAttr labelGetSelectable labelSetSelectable -- | The widget to be activated when the label's mnemonic key is pressed. -- labelMnemonicWidget :: (LabelClass self, WidgetClass widget) => ReadWriteAttr self (Maybe Widget) widget labelMnemonicWidget = newAttr labelGetMnemonicWidget labelSetMnemonicWidget -- | The mnemonic accelerator key for this label. -- -- Default value: 16777215 -- labelMnemonicKeyval :: LabelClass self => ReadAttr self Int labelMnemonicKeyval = readAttrFromIntProperty "mnemonic-keyval" -- | A string with _ characters in positions correspond to characters in the text to underline. -- -- Default value: "\\" -- labelPattern :: (LabelClass self, GlibString string) => WriteAttr self string labelPattern = writeAttrFromStringProperty "pattern" -- | The current position of the insertion cursor in chars. -- -- Allowed values: >= 0 -- -- Default value: 0 -- labelCursorPosition :: LabelClass self => ReadAttr self Int labelCursorPosition = readAttrFromIntProperty "cursor-position" -- | The position of the opposite end of the selection from the cursor in -- chars. -- -- Allowed values: >= 0 -- -- Default value: 0 -- labelSelectionBound :: LabelClass self => ReadAttr self Int labelSelectionBound = readAttrFromIntProperty "selection-bound" #if GTK_CHECK_VERSION(2,6,0) -- | The preferred place to ellipsize the string, if the label does not have -- enough room to display the entire string, specified as a 'EllipsizeMode'. -- -- Note that setting this property to a value other than 'EllipsizeNone' has -- the side-effect that the label requests only enough space to display the -- ellipsis \"...\". In particular, this means that ellipsizing labels don't -- work well in notebook tabs, unless the tab's tab-expand property is set to -- @True@. Other means to set a label's width are -- 'Graphics.UI.Gtk.Abstract.Widget.widgetSetSizeRequest' and -- 'labelSetWidthChars'. -- -- Default value: 'EllipsizeNone' -- labelEllipsize :: LabelClass self => Attr self EllipsizeMode labelEllipsize = newAttr labelGetEllipsize labelSetEllipsize -- | The desired width of the label, in characters. If this property is set to -- -1, the width will be calculated automatically, otherwise the label will -- request either 3 characters or the property value, whichever is greater. If -- the width-chars property is set to a positive value, then the -- max-width-chars property is ignored. -- -- Allowed values: >= -1 -- -- Default value: -1 -- labelWidthChars :: LabelClass self => Attr self Int labelWidthChars = newAttr labelGetWidthChars labelSetWidthChars -- | Whether the label is in single line mode. In single line mode, the height -- of the label does not depend on the actual text, it is always set to ascent -- + descent of the font. This can be an advantage in situations where resizing -- the label because of text changes would be distracting, e.g. in a statusbar. -- -- Default value: @False@ -- labelSingleLineMode :: LabelClass self => Attr self Bool labelSingleLineMode = newAttr labelGetSingleLineMode labelSetSingleLineMode -- | The angle that the baseline of the label makes with the horizontal, in -- degrees, measured counterclockwise. An angle of 90 reads from from bottom to -- top, an angle of 270, from top to bottom. Ignored if the label is -- selectable, wrapped, or ellipsized. -- -- Allowed values: [0,360] -- -- Default value: 0 -- labelAngle :: LabelClass self => Attr self Double labelAngle = newAttr labelGetAngle labelSetAngle -- | A list of style attributes to apply to the text of the label. labelAttributes :: LabelClass self => Attr self [PangoAttribute] labelAttributes = newAttr labelGetAttributes labelSetAttributes -- | The desired maximum width of the label, in characters. If this property -- is set to -1, the width will be calculated automatically, otherwise the -- label will request space for no more than the requested number of -- characters. If the width-chars property is set to a positive value, then the -- max-width-chars property is ignored. -- -- Allowed values: >= -1 -- -- Default value: -1 -- labelMaxWidthChars :: LabelClass self => Attr self Int labelMaxWidthChars = newAttr labelGetMaxWidthChars labelSetMaxWidthChars #endif -- | \'lineWrap\' property. See 'labelGetLineWrap' and 'labelSetLineWrap' -- labelLineWrap :: LabelClass self => Attr self Bool labelLineWrap = newAttr labelGetLineWrap labelSetLineWrap -- | \'text\' property. See 'labelGetText' and 'labelSetText' -- labelText :: (LabelClass self, GlibString string) => Attr self string labelText = newAttr labelGetText labelSetText -------------------- -- Signals -- | The 'labelActiveCurrentLink' signal a keybinding signal which gets emitted when the user activates -- a link in the label. labelActiveCurrentLink :: LabelClass self => Signal self (IO ()) labelActiveCurrentLink = Signal (connect_NONE__NONE "activate-current-link") -- | The 'labelActiveLink' signal is emitted when a URI is activated. Default is to use showURI. labelActiveLink :: (LabelClass self, GlibString string) => Signal self (string -> IO ()) labelActiveLink = Signal (connect_GLIBSTRING__NONE "activate-link") -- | The 'labelCopyClipboard' signal is a keybinding signal which gets emitted to copy the selection to the -- clipboard. labelCopyClipboard :: LabelClass self => Signal self (IO ()) labelCopyClipboard = Signal (connect_NONE__NONE "copy-clipboard") -- | The 'labelMoveCursor' signal is a keybinding signal which gets emitted when the user initiates a cursor -- movement. If the cursor is not visible in label, this signal causes the viewport to be moved -- instead. -- -- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to -- control the cursor programmatically. -- -- The default bindings for this signal come in two variants, the variant with the Shift modifier -- extends the selection, the variant without the Shift modifier does not. There are too many key -- combinations to list them all here. -- -- * Arrow keys move by individual characters\/lines -- * Ctrl-arrow key combinations move by words\/paragraphs -- * Home\/End keys move to the ends of the buffer labelMoveCursor :: LabelClass self => Signal self (MovementStep -> Int -> Bool -> IO ()) labelMoveCursor = Signal (connect_ENUM_INT_BOOL__NONE "move-cursor") -- | The 'labelPopulatePopup' signal gets emitted before showing the context menu of the label. -- -- If you need to add items to the context menu, connect to this signal and append your menuitems to -- the menu. labelPopulatePopup :: LabelClass self=> Signal self (Menu -> IO ()) labelPopulatePopup = Signal (connect_OBJECT__NONE "populate-popup") gtk-0.15.9/Graphics/UI/Gtk/Display/ProgressBar.chs0000644000000000000000000002352707346545000017734 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ProgressBar -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget which indicates progress visually -- module Graphics.UI.Gtk.Display.ProgressBar ( -- * Detail -- -- | The 'ProgressBar' is typically used to display the progress of a long -- running operation. It provides a visual clue that processing is underway. -- The 'ProgressBar' can be used in two different modes: percentage mode and -- activity mode. -- -- When an application can determine how much work needs to take place (e.g. -- read a fixed number of bytes from a file) and can monitor its progress, it -- can use the 'ProgressBar' in percentage mode and the user sees a growing bar -- indicating the percentage of the work that has been completed. In this mode, -- the application is required to call 'progressBarSetFraction' periodically to -- update the progress bar. -- -- When an application has no accurate way of knowing the amount of work to -- do, it can use the 'ProgressBar' in activity mode, which shows activity by a -- block moving back and forth within the progress area. In this mode, the -- application is required to call 'progressBarPulse' periodically to update the -- progress bar. -- -- There is quite a bit of flexibility provided to control the appearance of -- the 'ProgressBar'. Functions are provided to control the orientation of the -- bar, optional text can be displayed along with the bar, and the step size -- used in activity mode can be set. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----ProgressBar -- @ -- * Types ProgressBar, ProgressBarClass, castToProgressBar, gTypeProgressBar, toProgressBar, -- * Constructors progressBarNew, -- * Methods progressBarPulse, progressBarSetText, progressBarSetFraction, progressBarSetPulseStep, progressBarGetFraction, progressBarGetPulseStep, progressBarGetText, #if GTK_MAJOR_VERSION < 3 ProgressBarOrientation(..), progressBarSetOrientation, progressBarGetOrientation, #endif #if GTK_CHECK_VERSION(2,6,0) progressBarSetEllipsize, progressBarGetEllipsize, #endif -- * Attributes #if GTK_MAJOR_VERSION < 3 progressBarOrientation, #endif progressBarDiscreteBlocks, progressBarFraction, progressBarPulseStep, progressBarText, #if GTK_CHECK_VERSION(2,6,0) progressBarEllipsize, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Enums (ProgressBarOrientation(..)) #endif #if GTK_CHECK_VERSION(2,6,0) import Graphics.Rendering.Pango.Enums (EllipsizeMode(..)) #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'ProgressBar'. -- progressBarNew :: IO ProgressBar progressBarNew = makeNewObject mkProgressBar $ liftM (castPtr :: Ptr Widget -> Ptr ProgressBar) $ {# call unsafe progress_bar_new #} -------------------- -- Methods -- | Indicates that some progress is made, but you don't know how much. Causes -- the progress bar to enter \"activity mode\", where a block bounces back and -- forth. Each call to 'progressBarPulse' causes the block to move by a little -- bit (the amount of movement per pulse is determined by -- 'progressBarSetPulseStep'). -- progressBarPulse :: ProgressBarClass self => self -> IO () progressBarPulse self = {# call unsafe progress_bar_pulse #} (toProgressBar self) -- | Causes the given @text@ to appear superimposed on the progress bar. -- progressBarSetText :: (ProgressBarClass self, GlibString string) => self -> string -> IO () progressBarSetText self text = withUTFString text $ \textPtr -> {# call unsafe progress_bar_set_text #} (toProgressBar self) textPtr -- | Causes the progress bar to \"fill in\" the given fraction of the bar. The -- fraction should be between 0.0 and 1.0, inclusive. -- progressBarSetFraction :: ProgressBarClass self => self -> Double -- ^ @fraction@ - fraction of the task that's been completed -> IO () progressBarSetFraction self fraction = {# call unsafe progress_bar_set_fraction #} (toProgressBar self) (realToFrac fraction) -- | Sets the fraction of total progress bar length to move the bouncing block -- for each call to 'progressBarPulse'. -- progressBarSetPulseStep :: ProgressBarClass self => self -> Double -- ^ @fraction@ - fraction between 0.0 and 1.0 -> IO () progressBarSetPulseStep self fraction = {# call unsafe progress_bar_set_pulse_step #} (toProgressBar self) (realToFrac fraction) -- | Returns the current fraction of the task that's been completed. -- progressBarGetFraction :: ProgressBarClass self => self -> IO Double -- ^ returns a fraction from 0.0 to 1.0 progressBarGetFraction self = liftM realToFrac $ {# call unsafe progress_bar_get_fraction #} (toProgressBar self) -- | Retrieves the pulse step set with 'progressBarSetPulseStep' -- progressBarGetPulseStep :: ProgressBarClass self => self -> IO Double -- ^ returns a fraction from 0.0 to 1.0 progressBarGetPulseStep self = liftM realToFrac $ {# call unsafe progress_bar_get_pulse_step #} (toProgressBar self) -- | Retrieves the text displayed superimposed on the progress bar, if any, -- otherwise @Nothing@. -- progressBarGetText :: (ProgressBarClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns text, or @Nothing@ progressBarGetText self = {# call unsafe progress_bar_get_text #} (toProgressBar self) >>= maybePeek peekUTFString #if GTK_MAJOR_VERSION < 3 -- | Causes the progress bar to switch to a different orientation -- (left-to-right, right-to-left, top-to-bottom, or bottom-to-top). -- progressBarSetOrientation :: ProgressBarClass self => self -> ProgressBarOrientation -> IO () progressBarSetOrientation self orientation = {# call progress_bar_set_orientation #} (toProgressBar self) ((fromIntegral . fromEnum) orientation) -- | Retrieves the current progress bar orientation. -- progressBarGetOrientation :: ProgressBarClass self => self -> IO ProgressBarOrientation progressBarGetOrientation self = liftM (toEnum . fromIntegral) $ {# call unsafe progress_bar_get_orientation #} (toProgressBar self) #endif #if GTK_CHECK_VERSION(2,6,0) -- | Sets the mode used to ellipsize (add an ellipsis: \"...\") the text if -- there is not enough space to render the entire string. -- -- * Available since Gtk+ version 2.6 -- progressBarSetEllipsize :: ProgressBarClass self => self -> EllipsizeMode -> IO () progressBarSetEllipsize self mode = {# call gtk_progress_bar_set_ellipsize #} (toProgressBar self) ((fromIntegral . fromEnum) mode) -- | Returns the ellipsizing position of the progressbar. See -- 'progressBarSetEllipsize'. -- -- * Available since Gtk+ version 2.6 -- progressBarGetEllipsize :: ProgressBarClass self => self -> IO EllipsizeMode progressBarGetEllipsize self = liftM (toEnum . fromIntegral) $ {# call gtk_progress_bar_get_ellipsize #} (toProgressBar self) #endif -------------------- -- Attributes #if GTK_MAJOR_VERSION < 3 -- | Orientation and growth direction of the progress bar. -- -- Default value: 'ProgressLeftToRight' -- -- Removed in Gtk3. progressBarOrientation :: ProgressBarClass self => Attr self ProgressBarOrientation progressBarOrientation = newAttr progressBarGetOrientation progressBarSetOrientation #endif -- | The number of discrete blocks in a progress bar (when shown in the -- discrete style). -- -- Allowed values: >= 2 -- -- Default value: 10 -- progressBarDiscreteBlocks :: ProgressBarClass self => Attr self Int progressBarDiscreteBlocks = newAttrFromUIntProperty "discrete-blocks" -- | The fraction of total work that has been completed. -- -- Allowed values: [0,1] -- -- Default value: 0 -- progressBarFraction :: ProgressBarClass self => Attr self Double progressBarFraction = newAttr progressBarGetFraction progressBarSetFraction -- | The fraction of total progress to move the bouncing block when pulsed. -- -- Allowed values: [0,1] -- -- Default value: 0.1 -- progressBarPulseStep :: ProgressBarClass self => Attr self Double progressBarPulseStep = newAttr progressBarGetPulseStep progressBarSetPulseStep -- | Text to be displayed in the progress bar. -- -- Default value: \"%P %%\" -- progressBarText :: (ProgressBarClass self, GlibString string) => ReadWriteAttr self (Maybe string) string progressBarText = newAttr progressBarGetText progressBarSetText #if GTK_CHECK_VERSION(2,6,0) -- | The preferred place to ellipsize the string, if the progressbar does not -- have enough room to display the entire string, specified as a -- 'EllipsizeMode'. -- -- Note that setting this property to a value other than 'EllipsizeNone' has -- the side-effect that the progressbar requests only enough space to display -- the ellipsis \"...\". Another means to set a progressbar's width is -- 'Graphics.UI.Gtk.Abstract.Widget.widgetSetSizeRequest'. -- -- Default value: 'EllipsizeNone' -- progressBarEllipsize :: ProgressBarClass self => Attr self EllipsizeMode progressBarEllipsize = newAttr progressBarGetEllipsize progressBarSetEllipsize #endif gtk-0.15.9/Graphics/UI/Gtk/Display/Spinner.chs0000644000000000000000000000474607346545000017123 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Spinner -- -- Author : Andy Stewart -- -- Created: 17 Aug 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Report messages of minor importance to the user -- module Graphics.UI.Gtk.Display.Spinner ( #if GTK_CHECK_VERSION(2,20,0) -- * Detail -- -- | A 'Spinner' widget displays an icon-size spinning animation. It is often used as an alternative to -- a 'ProgressBar' for displaying indefinite activity, instead of actual progress. -- -- To start the animation, use 'spinnerStart'. -- * Types Spinner, SpinnerClass, castToSpinner, gTypeSpinner, toSpinner, -- * Constructors spinnerNew, -- * Methods spinnerStart, spinnerStop, -- * Attributes spinnerActive, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,20,0) -------------------- -- Constructors -- | Returns a new spinner widget. Not yet started. spinnerNew :: IO Spinner spinnerNew = makeNewObject mkSpinner $ liftM (castPtr :: Ptr Widget -> Ptr Spinner) $ {# call unsafe spinner_new #} -------------------- -- Methods -- | Starts the animation of the spinner. spinnerStart :: SpinnerClass spinner => spinner -> IO () spinnerStart spinner = {#call spinner_start #} (toSpinner spinner) -- | Stops the animation of the spinner. spinnerStop :: SpinnerClass spinner => spinner -> IO () spinnerStop spinner = {#call spinner_stop #} (toSpinner spinner) -------------------- -- Attributes -- | Whether the spinner is active. -- -- Default value: 'False' spinnerActive :: SpinnerClass spinner => Attr spinner Bool spinnerActive = newAttrFromBoolProperty "active" #endif gtk-0.15.9/Graphics/UI/Gtk/Display/StatusIcon.chs0000644000000000000000000006740207346545000017577 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget StatusIcon -- -- Author : Andrea Vezzosi, Andy Stewart -- -- Created: 19 July 2007 -- -- Copyright (C) 2007 Axel Simon -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Display an icon in the system tray -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Display.StatusIcon ( -- * Detail -- -- | The \"system tray\" or notification area is normally used for transient -- icons that indicate some special state. For example, a system tray icon -- might appear to tell the user that they have new mail, or have an incoming -- instant message, or something along those lines. The basic idea is that -- creating an icon in the notification area is less annoying than popping up a -- dialog. -- -- A 'StatusIcon' object can be used to display an icon in a \"system -- tray\". The icon can have a tooltip, and the user can interact with it by -- activating it or popping up a context menu. Critical information should not -- solely be displayed in a 'StatusIcon', since it may not be visible (e.g. -- when the user doesn't have a notification area on his panel). This can be -- checked with 'statusIconIsEmbedded'. -- -- On X11, the implementation follows the freedesktop.org \"System Tray\" -- specification. Implementations of the \"tray\" side of this specification -- can be found e.g. in the GNOME and KDE panel applications. -- -- Note that a 'StatusIcon' is /not/ a widget, but just a 'GObject'. Making -- it a widget would be impractical, since the system tray on Win32 doesn't -- allow to embed arbitrary widgets. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----StatusIcon -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types StatusIcon, StatusIconClass, castToStatusIcon, gTypeStatusIcon, toStatusIcon, -- * Constructors statusIconNew, statusIconNewFromPixbuf, statusIconNewFromFile, statusIconNewFromStock, statusIconNewFromIconName, -- * Methods statusIconSetFromPixbuf, statusIconSetFromFile, statusIconSetFromStock, statusIconSetFromIconName, statusIconGetStorageType, statusIconGetPixbuf, statusIconGetStock, statusIconGetIconName, statusIconGetSize, #if GTK_MAJOR_VERSION < 3 statusIconSetTooltip, #endif statusIconSetVisible, statusIconGetVisible, #if GTK_MAJOR_VERSION < 3 statusIconSetBlinking, statusIconGetBlinking, #endif statusIconIsEmbedded, statusIconPositionMenu, statusIconGetGeometry, #if GTK_CHECK_VERSION(2,12,0) statusIconSetScreen, statusIconGetScreen, #endif #if GTK_CHECK_VERSION(2,16,0) statusIconSetTooltipText, statusIconGetTooltipText, statusIconSetTooltipMarkup, statusIconGetTooltipMarkup, statusIconSetHasTooltip, statusIconGetHasTooltip, #endif #if GTK_CHECK_VERSION(2,18,0) statusIconSetTitle, statusIconGetTitle, #endif #if GTK_CHECK_VERSION(2,20,0) statusIconSetName, #endif -- * Attributes statusIconPixbuf, statusIconFile, statusIconStock, statusIconIconName, statusIconStorageType, statusIconSize, #if GTK_MAJOR_VERSION < 3 statusIconBlinking, #endif statusIconVisible, #if GTK_CHECK_VERSION(2,12,0) statusIconScreen, #endif #if GTK_CHECK_VERSION(2,16,0) statusIconTooltipText, statusIconTooltipMarkup, statusIconHasTooltip, #endif #if GTK_CHECK_VERSION(2,18,0) statusIconTitle, #endif -- * Signals statusIconSizeChanged, statusIconActivated, statusIconActivate, statusIconPopupMenu, -- * Deprecated #ifndef DISABLE_DEPRECATED onActivate, afterActivate, onPopupMenu, afterPopupMenu, onSizeChanged, afterSizeChanged, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.Enums#} import Graphics.UI.Gtk.General.Structs {#import Graphics.UI.Gtk.Display.Image#} (ImageType) {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems import Graphics.UI.Gtk.Gdk.Events {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Constructors -- %hash c:2fb1 d:9bd6 -- | Creates an empty status icon object. -- statusIconNew :: IO StatusIcon statusIconNew = wrapNewGObject mkStatusIcon $ {# call gtk_status_icon_new #} -- %hash c:3318 d:cd70 -- | Creates a status icon displaying @pixbuf@. -- -- The image will be scaled down to fit in the available space in the -- notification area, if necessary. -- statusIconNewFromPixbuf :: Pixbuf -- ^ @pixbuf@ - a 'Pixbuf' -> IO StatusIcon statusIconNewFromPixbuf pixbuf = wrapNewGObject mkStatusIcon $ {# call gtk_status_icon_new_from_pixbuf #} pixbuf -- %hash c:325a d:6c24 -- | Creates a status icon displaying the file @filename@. -- -- The image will be scaled down to fit in the available space in the -- notification area, if necessary. -- statusIconNewFromFile :: GlibString string => string -- ^ @filename@ - a filename -> IO StatusIcon statusIconNewFromFile filename = wrapNewGObject mkStatusIcon $ withUTFString filename $ \filenamePtr -> {# call gtk_status_icon_new_from_file #} filenamePtr -- %hash c:784f d:88a3 | Creates a status icon displaying a stock -- icon. Sample stock icon names are 'stockOpen', 'stockQuit'. You can -- register your own stock icon names, see -- 'Graphics.UI.Gtk.General.IconFactory.iconFactoryAddDefault' and -- 'Graphics.UI.Gtk.General.IconFactory.iconFactoryAdd'. -- statusIconNewFromStock :: StockId -- ^ @stockId@ - a stock icon id -> IO StatusIcon statusIconNewFromStock stockId = wrapNewGObject mkStatusIcon $ withUTFString stockId $ \stockIdPtr -> {# call gtk_status_icon_new_from_stock #} stockIdPtr -- %hash c:6e1b d:8731 -- | Creates a status icon displaying an icon from the current icon theme. If -- the current icon theme is changed, the icon will be updated appropriately. -- statusIconNewFromIconName :: GlibString string => string -- ^ @iconName@ - an icon name -> IO StatusIcon statusIconNewFromIconName iconName = wrapNewGObject mkStatusIcon $ withUTFString iconName $ \iconNamePtr -> {# call gtk_status_icon_new_from_icon_name #} iconNamePtr -------------------- -- Methods -- %hash c:2256 d:12b2 -- | Makes @statusIcon@ display @pixbuf@. See 'statusIconNewFromPixbuf' for -- details. -- statusIconSetFromPixbuf :: StatusIconClass self => self -> Pixbuf -- ^ @pixbuf@ - a 'Pixbuf' -> IO () statusIconSetFromPixbuf self pixbuf = {# call gtk_status_icon_set_from_pixbuf #} (toStatusIcon self) pixbuf -- %hash c:c2c0 d:c0f8 -- | Makes @statusIcon@ display the file @filename@. See -- 'statusIconNewFromFile' for details. -- statusIconSetFromFile :: (StatusIconClass self, GlibString string) => self -> string -- ^ @filename@ - a filename -> IO () statusIconSetFromFile self filename = withUTFString filename $ \filenamePtr -> {# call gtk_status_icon_set_from_file #} (toStatusIcon self) filenamePtr -- %hash c:d755 d:8fa3 -- | Makes @statusIcon@ display the stock icon with the id @stockId@. See -- 'statusIconNewFromStock' for details. -- statusIconSetFromStock :: StatusIconClass self => self -> StockId -- ^ @stockId@ - a stock icon id -> IO () statusIconSetFromStock self stockId = withUTFString stockId $ \stockIdPtr -> {# call gtk_status_icon_set_from_stock #} (toStatusIcon self) stockIdPtr -- %hash c:b501 d:3ded -- | Makes @statusIcon@ display the icon named @iconName@ from the current -- icon theme. See 'statusIconNewFromIconName' for details. -- statusIconSetFromIconName :: (StatusIconClass self, GlibString string) => self -> string -- ^ @iconName@ - an icon name -> IO () statusIconSetFromIconName self iconName = withUTFString iconName $ \iconNamePtr -> {# call gtk_status_icon_set_from_icon_name #} (toStatusIcon self) iconNamePtr -- %hash c:6317 d:d3c5 -- | Gets the type of representation being used by the 'StatusIcon' to store -- image data. If the 'StatusIcon' has no image data, the return value will be -- 'Graphics.UI.Gtk.Display.Image.ImageEmpty'. -- statusIconGetStorageType :: StatusIconClass self => self -> IO ImageType -- ^ returns the image representation being used statusIconGetStorageType self = liftM (toEnum . fromIntegral) $ {# call gtk_status_icon_get_storage_type #} (toStatusIcon self) -- %hash c:cd8a d:9fed | Gets the 'Pixbuf' being displayed by the -- 'StatusIcon'. The storage type of the status icon must be -- 'Graphics.UI.Gtk.Display.Image.ImageEmpty' or -- 'Graphics.UI.Gtk.Display.Image.ImagePixbuf' (see -- 'statusIconGetStorageType'). The caller of this function does not -- own a reference to the returned pixbuf. -- statusIconGetPixbuf :: StatusIconClass self => self -> IO (Maybe Pixbuf) -- ^ returns the displayed pixbuf, or @Nothing@ if the -- image is empty. statusIconGetPixbuf self = do ptr <- {# call gtk_status_icon_get_pixbuf #} (toStatusIcon self) maybePeek (makeNewGObject mkPixbuf . return) ptr -- %hash c:ecce d:448 | Gets the id of the stock icon being displayed -- by the 'StatusIcon'. The storage type of the status icon must be -- 'Graphics.UI.Gtk.Display.Image.ImageEmpty' or -- 'Graphics.UI.Gtk.Display.Image.ImageStock' (see -- 'statusIconGetStorageType'). The returned string is owned by the -- 'StatusIcon' and should not be freed or modified. -- statusIconGetStock :: StatusIconClass self => self -> IO (Maybe StockId) -- ^ returns stock id of the displayed stock icon, or @Nothing@ -- if the image is empty. statusIconGetStock self = {# call gtk_status_icon_get_stock #} (toStatusIcon self) >>= maybePeek peekUTFString -- %hash c:6e6b d:273e | Gets the name of the icon being displayed by -- the 'StatusIcon'. The storage type of the status icon must be -- 'Graphics.UI.Gtk.Display.Image.ImageEmpty' or -- 'Graphics.UI.Gtk.Display.Image.ImageIconName' (see -- 'statusIconGetStorageType'). The returned string is owned by the -- 'StatusIcon' and should not be freed or modified. -- statusIconGetIconName :: (StatusIconClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns name of the displayed icon, or @Nothing@ -- if the image is empty. statusIconGetIconName self = {# call gtk_status_icon_get_icon_name #} (toStatusIcon self) >>= maybePeek peekUTFString -- %hash c:b1db d:b874 -- | Gets the size in pixels that is available for the image. Stock icons and -- named icons adapt their size automatically if the size of the notification -- area changes. For other storage types, the 'sizeChanged' signal can be used -- to react to size changes. -- statusIconGetSize :: StatusIconClass self => self -> IO Int -- ^ returns the size that is available for the image statusIconGetSize self = liftM fromIntegral $ {# call gtk_status_icon_get_size #} (toStatusIcon self) #if GTK_MAJOR_VERSION < 3 -- %hash c:7644 d:d87b -- | Sets the tooltip of the status icon. -- -- Removed in Gtk3. statusIconSetTooltip :: (StatusIconClass self, GlibString string) => self -> string -- ^ @tooltipText@ - the tooltip text -> IO () statusIconSetTooltip self tooltipText = withUTFString tooltipText $ \tooltipTextPtr -> {# call gtk_status_icon_set_tooltip #} (toStatusIcon self) tooltipTextPtr #endif -- %hash c:7bd8 d:74fd -- | Shows or hides a status icon. -- statusIconSetVisible :: StatusIconClass self => self -> Bool -- ^ @visible@ - @True@ to show the status icon, @False@ to hide it -> IO () statusIconSetVisible self visible = {# call gtk_status_icon_set_visible #} (toStatusIcon self) (fromBool visible) -- %hash c:e90c d:6c0b -- | Returns whether the status icon is visible or not. Note that being -- visible does not guarantee that the user can actually see the icon, see also -- 'statusIconIsEmbedded'. -- statusIconGetVisible :: StatusIconClass self => self -> IO Bool -- ^ returns @True@ if the status icon is visible statusIconGetVisible self = liftM toBool $ {# call gtk_status_icon_get_visible #} (toStatusIcon self) #if GTK_MAJOR_VERSION < 3 -- %hash c:aa47 d:3980 -- | Makes the status icon start or stop blinking. Note that blinking user -- interface elements may be problematic for some users, and thus may be turned -- off, in which case this setting has no effect. -- -- Removed in Gtk3. statusIconSetBlinking :: StatusIconClass self => self -> Bool -- ^ @blinking@ - @True@ to turn blinking on, @False@ to turn it off -> IO () statusIconSetBlinking self blinking = {# call gtk_status_icon_set_blinking #} (toStatusIcon self) (fromBool blinking) -- %hash c:2168 d:3189 -- | Returns whether the icon is blinking, see 'statusIconSetBlinking'. -- -- Removed in Gtk3. statusIconGetBlinking :: StatusIconClass self => self -> IO Bool -- ^ returns @True@ if the icon is blinking statusIconGetBlinking self = liftM toBool $ {# call gtk_status_icon_get_blinking #} (toStatusIcon self) #endif -- %hash c:ffa d:8c83 -- | Returns whether the status icon is embedded in a notification area. -- statusIconIsEmbedded :: StatusIconClass self => self -> IO Bool -- ^ returns @True@ if the status icon is embedded in a -- notification area. statusIconIsEmbedded self = liftM toBool $ {# call gtk_status_icon_is_embedded #} (toStatusIcon self) -- %hash c:6a16 d:99ad -- | Menu positioning function to use with 'menuPopup' to position @menu@ -- aligned to the status icon @userData@. -- statusIconPositionMenu :: (MenuClass menu, StatusIconClass self) => menu -- ^ @menu@ - the 'Menu' -> self -- ^ @userData@ - the status icon to position the -- menu on -> IO (Int,Int,Bool) -- ^ @(x,y,pushIn)@ - -- @(x,y)@ - coordinates. -- @pushIn@ - whether the menu should be -- pushed in to be completely inside the screen -- instead of just clamped to the size to the -- screen. statusIconPositionMenu menu userData = alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \pushInPtr -> do {# call gtk_status_icon_position_menu #} (toMenu menu) xPtr yPtr pushInPtr (castPtr . unsafeForeignPtrToPtr . unStatusIcon $ toStatusIcon userData) x <- peek xPtr y <- peek yPtr pushIn <- peek pushInPtr return (fromIntegral x, fromIntegral y, toBool pushIn) -- FIXME: it's a partial binding, the potentially returned Screen is ignored -- %hash c:7939 d:5ea -- | Obtains information about the location of the status icon on screen. This -- information can be used to e.g. position popups like notification bubbles. -- -- Note that some platforms do not allow Gtk+ to provide this information, -- and even on platforms that do allow it, the information is not reliable -- unless the status icon is embedded in a notification area, see -- 'statusIconIsEmbedded'. -- statusIconGetGeometry :: StatusIconClass self => self -> IO (Maybe (Rectangle,Orientation)) statusIconGetGeometry self = alloca $ \recPtr -> alloca $ \orPtr -> (liftM toBool $ {# call gtk_status_icon_get_geometry #} (toStatusIcon self) nullPtr (castPtr recPtr) orPtr) >>= \b -> if b then do rec_ <- peek recPtr or <- peek orPtr return $ Just (rec_,toEnum $ fromIntegral or) else return Nothing #if GTK_CHECK_VERSION(2,12,0) -- | Sets the 'Screen' where status icon is displayed; if the icon is already -- mapped, it will be unmapped, and then remapped on the new screen. -- statusIconSetScreen :: (StatusIconClass self, ScreenClass screen) => self -> Maybe screen -> IO () statusIconSetScreen self screen = {# call gtk_status_icon_set_screen #} (toStatusIcon self) (maybe (Screen nullForeignPtr) toScreen screen) -- | Returns the 'Screen' associated with the status icon. -- statusIconGetScreen :: StatusIconClass self => self -> IO (Maybe Screen) statusIconGetScreen self = maybeNull (makeNewGObject mkScreen) $ {# call gtk_status_icon_get_screen #} (toStatusIcon self) #endif #if GTK_CHECK_VERSION(2,16,0) -- | Sets text as the contents of the tooltip. -- -- This function will take care of setting "has-tooltip" to 'True' and of the default -- handler for the "query-tooltip" signal. -- -- See also the "tooltip-text" property and 'tooltipSetText'. -- statusIconSetTooltipText :: (StatusIconClass self, GlibString string) => self -> Maybe string -> IO () statusIconSetTooltipText self text = maybeWith withUTFString text $ \textPtr -> {# call gtk_status_icon_set_tooltip_text #} (toStatusIcon self) textPtr -- | Gets the contents of the tooltip for status icon. -- statusIconGetTooltipText :: (StatusIconClass self, GlibString string) => self -> IO (Maybe string) statusIconGetTooltipText self = {# call gtk_status_icon_get_tooltip_text #} (toStatusIcon self) >>= maybePeek peekUTFString -- | Sets markup as the contents of the tooltip, which is marked up with the -- Pango text markup language. -- -- This function will take care of setting 'statusIconHasTooltip' to 'True' and of the default -- handler for the 'queryTooltip' signal. -- -- See also the 'tooltipMarkup' property and 'tooltipSetMarkup'. -- statusIconSetTooltipMarkup :: (StatusIconClass self, GlibString string) => self -> Maybe string -> IO () statusIconSetTooltipMarkup self markup = maybeWith withUTFString markup $ \markupPtr -> {# call gtk_status_icon_set_tooltip_markup #} (toStatusIcon self) markupPtr -- | Gets the contents of the tooltip for status icon. -- statusIconGetTooltipMarkup :: (StatusIconClass self, GlibString string) => self -> IO (Maybe string) statusIconGetTooltipMarkup self = {# call gtk_status_icon_get_tooltip_markup #} (toStatusIcon self) >>= maybePeek peekUTFString -- | Sets the has-tooltip property on the status icon to @hasTooltip@. -- See 'statusIconHasTooltip' for more information. -- statusIconSetHasTooltip :: StatusIconClass self => self -> Bool -> IO () statusIconSetHasTooltip self hasTooltip = {# call gtk_status_icon_set_has_tooltip #} (toStatusIcon self) (fromBool hasTooltip) -- | Returns the current value of the has-tooltip property. See 'statusIconHasTooltip' for more information. -- statusIconGetHasTooltip :: StatusIconClass self => self -> IO Bool statusIconGetHasTooltip self = liftM toBool $ {# call gtk_status_icon_get_has_tooltip #} (toStatusIcon self) #endif #if GTK_CHECK_VERSION(2,18,0) -- | Sets the title of this tray icon. This should be a short, human-readable, localized -- string describing the tray icon. It may be used by tools like screen readers to -- render the tray icon. -- statusIconSetTitle :: (StatusIconClass self, GlibString string) => self -> Maybe string -> IO () statusIconSetTitle self title = maybeWith withUTFString title $ \titlePtr -> {# call gtk_status_icon_set_title #} (toStatusIcon self) titlePtr -- | Gets the title of this tray icon. See 'statusIconSetTitle'. -- statusIconGetTitle :: (StatusIconClass self, GlibString string) => self -> IO (Maybe string) statusIconGetTitle self = {# call gtk_status_icon_get_title #} (toStatusIcon self) >>= maybePeek peekUTFString #endif #if GTK_CHECK_VERSION(2,20,0) -- | Sets the name of this tray icon. This should be a string identifying this icon. It is may be used -- for sorting the icons in the tray and will not be shown to the user. statusIconSetName :: (StatusIconClass self, GlibString string) => self -> string -> IO () statusIconSetName self name = withUTFString name $ \ namePtr -> {#call gtk_status_icon_set_name #} (toStatusIcon self) namePtr #endif -------------------- -- Attributes -- %hash c:575d d:54e3 -- | A 'Pixbuf' to display. -- statusIconPixbuf :: StatusIconClass self => Attr self Pixbuf statusIconPixbuf = newAttrFromObjectProperty "pixbuf" {# call pure unsafe gdk_pixbuf_get_type #} -- %hash c:6783 d:d235 -- | Filename to load and display. -- -- Default value: @Nothing@ -- statusIconFile :: (StatusIconClass self, GlibString string) => WriteAttr self (Maybe string) statusIconFile = writeAttrFromMaybeStringProperty "file" -- %hash c:3fc3 d:7ec1 -- | Stock ID for a stock image to display. -- -- Default value: @Nothing@ -- statusIconStock :: (StatusIconClass self, GlibString string) => Attr self (Maybe string) statusIconStock = newAttrFromMaybeStringProperty "stock" -- %hash c:3502 d:9b7a -- | The name of the icon from the icon theme. -- -- Default value: @Nothing@ -- statusIconIconName :: (StatusIconClass self, GlibString string) => Attr self (Maybe string) statusIconIconName = newAttrFromMaybeStringProperty "icon-name" -- %hash c:570e d:983f -- | The representation being used for image data. -- -- Default value: 'Graphics.UI.Gtk.Display.Image.ImageEmpty' -- statusIconStorageType :: StatusIconClass self => ReadAttr self ImageType statusIconStorageType = readAttrFromEnumProperty "storage-type" {# call pure unsafe gtk_image_type_get_type #} -- %hash c:10be d:4621 -- | The size of the icon. -- -- Allowed values: >= 0 -- -- Default value: 0 -- statusIconSize :: StatusIconClass self => ReadAttr self Int statusIconSize = readAttrFromIntProperty "size" #if GTK_MAJOR_VERSION < 3 -- %hash c:eb d:655d -- | Whether or not the status icon is blinking. -- -- Default value: @False@ -- -- Removed in Gtk3. statusIconBlinking :: StatusIconClass self => Attr self Bool statusIconBlinking = newAttrFromBoolProperty "blinking" #endif -- %hash c:4e2b d:7712 -- | Whether or not the status icon is visible. -- -- Default value: @True@ -- statusIconVisible :: StatusIconClass self => Attr self Bool statusIconVisible = newAttrFromBoolProperty "visible" #if GTK_CHECK_VERSION(2,12,0) -- | The screen where this status icon will be displayed. statusIconScreen :: StatusIconClass self => Attr self Screen statusIconScreen = newAttrFromObjectProperty "screen" {# call pure unsafe gdk_screen_get_type #} #endif #if GTK_CHECK_VERSION(2,16,0) -- | Sets the text of tooltip to be the given string. -- -- Also see 'tooltipSetText'. -- -- This is a convenience property which will take care of getting the tooltip -- shown if the given value is not 'Nothing'. "has-tooltip" will automatically -- be set to 'True' and the default handler for the "query-tooltip" signal will -- take care of displaying the tooltip. -- -- Note that some platforms have limitations on the length of tooltips that -- they allow on status icons, e.g. Windows only shows the first 64 characters. -- -- Default value: 'Nothing' statusIconTooltipText :: (StatusIconClass self, GlibString string) => Attr self (Maybe string) statusIconTooltipText = newAttrFromMaybeStringProperty "tooltip-text" -- | Sets the text of tooltip to be the given string, which is marked up with the -- Pango text markup language. Also see 'tooltipSetMarkup'. -- -- This is a convenience property which will take care of getting the tooltip -- shown if the given value is not 'Nothing'. "has-tooltip" will automatically -- be set to 'True' and the default handler for the "query-tooltip" signal will -- take care of displaying the tooltip. -- -- On some platforms, embedded markup will be ignored. -- -- Default value: 'Nothing' statusIconTooltipMarkup :: (StatusIconClass self, GlibString string) => Attr self (Maybe string) statusIconTooltipMarkup = newAttrFromMaybeStringProperty "tooltip-markup" -- | Enables or disables the emission of "query-tooltip" on status_icon. A value -- of 'True' indicates that status_icon can have a tooltip, in this case the status -- icon will be queried using "query-tooltip" to determine whether it will provide -- a tooltip or not. -- -- Note that setting this property to 'True' for the first time will change the -- event masks of the windows of this status icon to include leave-notify and -- motion-notify events. This will not be undone when the property is set to -- 'False' again. -- -- Whether this property is respected is platform dependent. For plain text -- tooltips, use "tooltip-text" in preference. -- -- Default value: 'False' statusIconHasTooltip :: StatusIconClass self => Attr self Bool statusIconHasTooltip = newAttrFromBoolProperty "has-tooltip" #endif #if GTK_CHECK_VERSION(2,18,0) -- | The title of this tray icon. This should be a short, human-readable, -- localized string describing the tray icon. It may be used by tools -- like screen readers to render the tray icon. -- -- Default value: 'Nothing' statusIconTitle :: (StatusIconClass self, GlibString string) => Attr self (Maybe string) statusIconTitle = newAttrFromMaybeStringProperty "title" #endif -------------------- -- Signals -- %hash c:969a d:71d0 -- | Gets emitted when the size available for the image changes, e.g. because -- the notification area got resized. -- statusIconSizeChanged :: StatusIconClass self => Signal self (Int -> IO Bool) statusIconSizeChanged = Signal (connect_INT__BOOL "size-changed") -- | Gets emitted when the user activates the status icon. -- If and how status icons can activated is platform-dependent. statusIconActivated :: StatusIconClass self => Signal self (IO ()) statusIconActivated = Signal (connect_NONE__NONE "activate") -- | Deprecated. See 'statusIconActivated'. statusIconActivate :: StatusIconClass self => Signal self (IO ()) statusIconActivate = statusIconActivated -- | Gets emitted when the user brings up the context menu -- of the status icon. Whether status icons can have context -- menus and how these are activated is platform-dependent. -- -- The 'MouseButton' and 'TimeStamp' parameters should be -- passed as the last to arguments to 'Graphics.UI.Gtk.menuPopup'. statusIconPopupMenu :: StatusIconClass self => Signal self (Maybe MouseButton -> TimeStamp -> IO ()) statusIconPopupMenu = Signal wrap wrap flag self f = connect_WORD_WORD__NONE "popup_menu" flag self (\m t -> f (toMB m) (fromIntegral t)) where toMB 0 = Nothing toMB n = Just . toEnum . fromIntegral $ n -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- %hash c:bd32 onActivate :: StatusIconClass self => self -> IO () -> IO (ConnectId self) onActivate = connect_NONE__NONE "activate" False {-# DEPRECATED onActivate "instead of 'onActivate obj' use 'on obj activate'" #-} -- %hash c:a571 afterActivate :: StatusIconClass self => self -> IO () -> IO (ConnectId self) afterActivate = connect_NONE__NONE "activate" True {-# DEPRECATED afterActivate "instead of 'afterActivate obj' use 'after obj activate'" #-} -- %hash c:44a5 onPopupMenu :: StatusIconClass self => self -> (Maybe MouseButton -> TimeStamp -> IO ()) -> IO (ConnectId self) onPopupMenu = wrap False {-# DEPRECATED onPopupMenu "instead of 'onPopupMenu obj' use 'on obj popupMenu'" #-} -- %hash c:1904 afterPopupMenu :: StatusIconClass self => self -> (Maybe MouseButton -> TimeStamp -> IO ()) -> IO (ConnectId self) afterPopupMenu = wrap True {-# DEPRECATED afterPopupMenu "instead of 'afterPopupMenu obj' use 'after obj popupMenu'" #-} -- %hash c:e226 onSizeChanged :: StatusIconClass self => self -> (Int -> IO Bool) -> IO (ConnectId self) onSizeChanged = connect_INT__BOOL "size_changed" False {-# DEPRECATED onSizeChanged "instead of 'onSizeChanged obj' use 'on obj sizeChanged'" #-} -- %hash c:ec65 afterSizeChanged :: StatusIconClass self => self -> (Int -> IO Bool) -> IO (ConnectId self) afterSizeChanged = connect_INT__BOOL "size_changed" True {-# DEPRECATED afterSizeChanged "instead of 'afterSizeChanged obj' use 'after obj sizeChanged'" #-} #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Display/Statusbar.chs0000644000000000000000000002240307346545000017443 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Statusbar -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Report messages of minor importance to the user -- module Graphics.UI.Gtk.Display.Statusbar ( -- * Detail -- -- | A 'Statusbar' is usually placed along the bottom of an application's main -- 'Window'. It may provide a regular commentary of the application's status -- (as is usually the case in a web browser, for example), or may be used to -- simply output a message when the status changes, (when an upload is complete -- in an FTP client, for example). It may also have a resize grip (a triangular -- area in the lower right corner) which can be clicked on to resize the window -- containing the statusbar. -- -- Status bars in Gtk+ maintain a stack of messages. The message at the top -- of the each bar's stack is the one that will currently be displayed. -- -- Any messages added to a statusbar's stack must specify a /context_id/ -- that is used to uniquely identify the source of a message. This context_id -- can be generated by 'statusbarGetContextId', given a message and the -- statusbar that it will be added to. Note that messages are stored in a -- stack, and when choosing which message to display, the stack structure is -- adhered to, regardless of the context identifier of a message. -- -- Status bars are created using 'statusbarNew'. -- -- Messages are added to the bar's stack with 'statusbarPush'. -- -- The message at the top of the stack can be removed using 'statusbarPop'. -- A message can be removed from anywhere in the stack if its message_id was -- recorded at the time it was added. This is done using 'statusbarRemove'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'HBox' -- | +----Statusbar -- @ -- * Types Statusbar, StatusbarClass, castToStatusbar, gTypeStatusbar, toStatusbar, ContextId, MessageId, -- * Constructors statusbarNew, -- * Methods statusbarGetContextId, statusbarPush, statusbarPop, statusbarRemove, #if GTK_MAJOR_VERSION < 3 statusbarSetHasResizeGrip, statusbarGetHasResizeGrip, #endif #if GTK_CHECK_VERSION(2,20,0) statusbarGetMessageArea, #endif #if GTK_CHECK_VERSION(2,22,0) statusbarRemoveAll, #endif -- * Attributes #if GTK_MAJOR_VERSION < 3 statusbarHasResizeGrip, #endif -- * Signals textPopped, textPushed, -- * Deprecated #ifndef DISABLE_DEPRECATED onTextPopped, afterTextPopped, onTextPushed, afterTextPushed, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString #if GTK_MAJOR_VERSION < 3 import System.Glib.Attributes #endif import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Statusbar' ready for messages. -- statusbarNew :: IO Statusbar statusbarNew = makeNewObject mkStatusbar $ liftM (castPtr :: Ptr Widget -> Ptr Statusbar) $ {# call unsafe statusbar_new #} -------------------- -- Methods type ContextId = {#type guint#} -- | Returns a new context identifier, given a description of the actual -- context. This id can be used to later remove entries form the Statusbar. -- statusbarGetContextId :: (StatusbarClass self, GlibString string) => self -> string -- ^ @contextDescription@ - textual description of what context the -- new message is being used in. -> IO ContextId -- ^ returns an id that can be used to later remove entries -- ^ from the Statusbar. statusbarGetContextId self contextDescription = withUTFString contextDescription $ \contextDescriptionPtr -> {# call unsafe statusbar_get_context_id #} (toStatusbar self) contextDescriptionPtr newtype MessageId = MessageId {#type guint#} -- | Pushes a new message onto the Statusbar's stack. It will -- be displayed as long as it is on top of the stack. -- statusbarPush :: (StatusbarClass self, GlibString string) => self -> ContextId -- ^ @contextId@ - the message's context id, as returned by -- 'statusbarGetContextId'. -> string -- ^ @text@ - the message to add to the statusbar. -> IO MessageId -- ^ returns the message's new message id for use with -- 'statusbarRemove'. statusbarPush self contextId text = liftM MessageId $ withUTFString text $ \textPtr -> {# call statusbar_push #} (toStatusbar self) contextId textPtr -- | Removes the topmost message that has the correct context. -- statusbarPop :: StatusbarClass self => self -> ContextId -- ^ @contextId@ - the context identifier used when the -- message was added. -> IO () statusbarPop self contextId = {# call statusbar_pop #} (toStatusbar self) contextId -- | Forces the removal of a message from a statusbar's stack. The exact -- @contextId@ and @messageId@ must be specified. -- statusbarRemove :: StatusbarClass self => self -> ContextId -- ^ @contextId@ - a context identifier. -> MessageId -- ^ @messageId@ - a message identifier, as returned by -- 'statusbarPush'. -> IO () statusbarRemove self contextId (MessageId messageId) = {# call statusbar_remove #} (toStatusbar self) contextId messageId #if GTK_MAJOR_VERSION < 3 -- | Sets whether the statusbar has a resize grip. @True@ by default. -- statusbarSetHasResizeGrip :: StatusbarClass self => self -> Bool -> IO () statusbarSetHasResizeGrip self setting = {# call statusbar_set_has_resize_grip #} (toStatusbar self) (fromBool setting) -- | Returns whether the statusbar has a resize grip. -- statusbarGetHasResizeGrip :: StatusbarClass self => self -> IO Bool statusbarGetHasResizeGrip self = liftM toBool $ {# call unsafe statusbar_get_has_resize_grip #} (toStatusbar self) #endif #if GTK_CHECK_VERSION(2,20,0) -- | Retrieves the box containing the label widget. statusbarGetMessageArea :: StatusbarClass self => self -> IO Box statusbarGetMessageArea self = makeNewObject mkBox $ liftM (castPtr :: Ptr Widget -> Ptr Box) $ {# call unsafe gtk_statusbar_get_message_area #} (toStatusbar self) #endif #if GTK_CHECK_VERSION(2,22,0) -- | Forces the removal of all messages from a statusbar's stack with the exact @contextId@. -- -- * Available since Gtk+ version 2.22 -- statusbarRemoveAll :: StatusbarClass self => self -> ContextId -- ^ @contextId@ a context identifier -> IO () statusbarRemoveAll self contextId = {#call gtk_statusbar_remove_all #} (toStatusbar self) contextId #endif -------------------- -- Attributes #if GTK_MAJOR_VERSION < 3 -- | Whether the statusbar has a grip for resizing the toplevel window. -- -- Default value: @True@ -- -- Removed in Gtk3. statusbarHasResizeGrip :: StatusbarClass self => Attr self Bool statusbarHasResizeGrip = newAttr statusbarGetHasResizeGrip statusbarSetHasResizeGrip #endif -------------------- -- Signals -- %hash c:4eb7 d:d0ef -- | Is emitted whenever a new message gets pushed onto a statusbar's stack. -- textPushed :: (StatusbarClass self, GlibString string) => Signal self (ContextId -> string -> IO ()) textPushed = Signal (\a self user -> connect_WORD_GLIBSTRING__NONE "text-pushed" a self (\w s -> user (fromIntegral w) s)) -- %hash c:2614 d:c1d2 -- | Is emitted whenever a new message is popped off a statusbar's stack. -- textPopped :: (StatusbarClass self, GlibString string) => Signal self (ContextId -> string -> IO ()) textPopped = Signal (\a self user -> connect_WORD_GLIBSTRING__NONE "text-popped" a self (\w s -> user (fromIntegral w) s)) -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | Called if a message is removed. -- onTextPopped, afterTextPopped :: (StatusbarClass self, GlibString string) => self -> (ContextId -> string -> IO ()) -> IO (ConnectId self) onTextPopped self user = connect_WORD_GLIBSTRING__NONE "text-popped" False self (user . fromIntegral) afterTextPopped self user = connect_WORD_GLIBSTRING__NONE "text-popped" True self (user . fromIntegral) -- | Called if a message is pushed on top of the -- stack. -- onTextPushed, afterTextPushed :: (StatusbarClass self, GlibString string) => self -> (ContextId -> string -> IO ()) -> IO (ConnectId self) onTextPushed self user = connect_WORD_GLIBSTRING__NONE "text-pushed" False self (user . fromIntegral) afterTextPushed self user = connect_WORD_GLIBSTRING__NONE "text-pushed" True self (user . fromIntegral) #endif gtk-0.15.9/Graphics/UI/Gtk/Embedding/0000755000000000000000000000000007346545000015244 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Embedding/Embedding.hsc0000644000000000000000000000276307346545000017631 0ustar0000000000000000-- -*-haskell-*- #include #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) Widget Socket -- -- Author : Axel Simon -- -- Created: 20 January 2003 -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- module Graphics.UI.Gtk.Embedding.Embedding ( #if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) && GTK_MAJOR_VERSION < 3 socketHasPlug, #endif ) where #if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) && GTK_MAJOR_VERSION < 3 import System.Glib.FFI import Graphics.UI.Gtk.Types import Graphics.UI.Gtk.Embedding.Types -- | Test if a Plug is connected to the socket. -- socketHasPlug :: SocketClass s => s -> IO Bool socketHasPlug socket = do plugPtr <- withForeignPtr (unSocket (toSocket socket)) #{peek GtkSocket, plug_window} return (plugPtr/=nullPtr) #endif gtk-0.15.9/Graphics/UI/Gtk/Embedding/Plug.chs0000644000000000000000000001421607346545000016656 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Plug -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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) -- -- Toplevel for embedding into other processes -- module Graphics.UI.Gtk.Embedding.Plug ( -- * Detail -- -- | Together with 'Socket', 'Plug' provides the ability to embed widgets from -- one process into another process in a fashion that is transparent to the -- user. One process creates a 'Socket' widget and, passes the ID of that -- widgets window to the other process, which then creates a 'Plug' with that -- window ID. Any widgets contained in the 'Plug' then will appear inside the -- first applications window. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----Plug -- @ #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) -- * Types Plug, PlugClass, castToPlug, gTypePlug, toPlug, NativeWindowId, -- * Constructors plugNew, #if GTK_CHECK_VERSION(2,2,0) plugNewForDisplay, #endif -- * Methods plugGetId, #if GTK_CHECK_VERSION(2,14,0) plugGetEmbedded, plugGetSocketWindow, #endif -- * Attributes plugAttrEmbedded, plugAttrSocketWindow, -- * Signals plugEmbedded, #endif ) where #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) import Control.Monad (liftM) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Embedding.Types#} {#import Graphics.UI.Gtk.Signals#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Embedding.Embedding #endif import Graphics.UI.Gtk.General.Structs {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new plug widget inside the 'Socket' identified by @socketId@. -- If @socketId@ is @Nothing@, the plug is left \"unplugged\" and can later be -- plugged into a 'Socket' by 'Graphics.UI.Gtk.Embedding.Socket.socketAddId'. -- -- If a NativeWindowId is supplied the foreign application window will -- immediately appear in this 'Plug' once it is shown. If @Nothing@ is passed -- then a 'NativeWindowId' can be extracted from this 'Plug' using 'plugGetId' -- and be passed to the application which is to be embedded. -- plugNew :: Maybe NativeWindowId -- ^ @socketId@ - the window ID of the socket, or -- @Nothing@. -> IO Plug plugNew socketId = makeNewObject mkPlug $ liftM (castPtr :: Ptr Widget -> Ptr Plug) $ {# call unsafe plug_new #} (fromNativeWindowId (fromMaybe nativeWindowIdNone socketId)) #if GTK_CHECK_VERSION(2,2,0) -- | Create a new plug widget inside the 'Socket' identified by socket_id. -- -- * Available since Gtk+ version 2.2 -- plugNewForDisplay :: Display -- ^ @display@ - the 'Display' on which @socketId@ is -- displayed -> Maybe NativeWindowId -- ^ @socketId@ - the XID of the socket's window. -> IO Plug plugNewForDisplay display socketId = makeNewObject mkPlug $ liftM (castPtr :: Ptr Widget -> Ptr Plug) $ {# call gtk_plug_new_for_display #} display (fromNativeWindowId (fromMaybe nativeWindowIdNone socketId)) #endif -------------------- -- Methods -- | Gets the window ID of a 'Plug' widget, which can then be used to embed -- this window inside another window, for instance with -- 'Graphics.UI.Gtk.Embedding.Socket.socketAddId'. -- plugGetId :: PlugClass self => self -> IO NativeWindowId -- ^ returns the window ID for the plug plugGetId self = liftM toNativeWindowId $ {# call unsafe plug_get_id #} (toPlug self) #if GTK_CHECK_VERSION(2,14,0) -- | Determines whether the plug is embedded in a socket. -- -- * Available since Gtk+ version 2.14 -- plugGetEmbedded :: PlugClass self => self -> IO Bool -- ^ returns @True@ if the plug is embedded in a socket plugGetEmbedded self = liftM toBool $ {# call gtk_plug_get_embedded #} (toPlug self) -- | Retrieves the socket the plug is embedded in. -- -- * Available since Gtk+ version 2.14 -- plugGetSocketWindow :: PlugClass self => self -> IO (Maybe DrawWindow) -- ^ returns the window of the socket plugGetSocketWindow self = maybeNull (makeNewGObject mkDrawWindow) $ {# call gtk_plug_get_socket_window #} (toPlug self) #endif -------------------- -- Attributes -- | @True@ if the plug is embedded in a socket. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.12 -- plugAttrEmbedded :: PlugClass self => ReadAttr self Bool plugAttrEmbedded = readAttrFromBoolProperty "embedded" -- | The window of the socket the plug is embedded in. -- -- * Available since Gtk+ version 2.14 -- plugAttrSocketWindow :: PlugClass self => ReadAttr self (Maybe DrawWindow) plugAttrSocketWindow = readAttrFromMaybeObjectProperty "socket-window" #if GTK_MAJOR_VERSION < 3 {# call pure unsafe gdk_window_object_get_type #} #else {# call pure unsafe gdk_window_get_type #} #endif -------------------- -- Signals -- | Gets emitted when the plug becomes embedded in a socket and when the -- embedding ends. -- plugEmbedded :: PlugClass self => Signal self (IO ()) plugEmbedded = Signal (connect_NONE__NONE "embedded") #endif gtk-0.15.9/Graphics/UI/Gtk/Embedding/Socket.chs0000644000000000000000000002032107346545000017171 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Socket -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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) -- -- Container for widgets from other processes -- module Graphics.UI.Gtk.Embedding.Socket ( -- * Detail -- -- | Together with 'Plug', 'Socket' provides the ability to embed widgets from -- one process into another process in a fashion that is transparent to the -- user. One process creates a 'Socket' widget and, passes the that widget's -- window ID to the other process, which then creates a 'Plug' with that window -- ID. Any widgets contained in the 'Plug' then will appear inside the first -- applications window. -- -- The socket's window ID is obtained by using 'socketGetId'. Before using -- this function, the socket must have been realized, and for hence, have been -- added to its parent. -- -- * Obtaining the window ID of a socket. -- -- > socket <- socketNew -- > widgetShow socket -- > containerAdd parent socket -- > -- > -- The following call is only necessary if one of -- > -- the ancestors of the socket is not yet visible. -- > -- -- > widgetRealize socket -- > socketId <- socketGetId socket -- > putStrLn ("The ID of the sockets window is " ++ show socketId) -- -- Note that if you pass the window ID of the socket to another process that -- will create a plug in the socket, you must make sure that the socket widget -- is not destroyed until that plug is created. Violating this rule will cause -- unpredictable consequences, the most likely consequence being that the plug -- will appear as a separate toplevel window. You can check if the plug has -- been created by calling 'socketHasPlug'. -- If this returns @True@, then the plug has been successfully created inside -- of the socket. -- -- When Gtk+ is notified that the embedded window has been destroyed, then -- it will destroy the socket as well. You should always, therefore, be -- prepared for your sockets to be destroyed at any time when the main event -- loop is running. -- -- The communication between a 'Socket' and a 'Plug' follows the XEmbed -- protocol. This protocol has also been implemented in other toolkits, e.g. -- Qt, allowing the same level of integration when embedding a Qt widget in -- Gtk+ or vice versa. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Socket -- @ #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) -- * Types Socket, SocketClass, castToSocket, gTypeSocket, toSocket, NativeWindowId, -- * Constructors socketNew, -- * Methods socketHasPlug, socketAddId, socketGetId, #if GTK_CHECK_VERSION(2,14,0) socketGetPlugWindow, #endif -- * Signals socketPlugAdded, socketPlugRemoved, -- * Deprecated #ifndef DISABLE_DEPRECATED onPlugAdded, afterPlugAdded, onPlugRemoved, afterPlugRemoved, #endif #endif ) where #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) import Control.Monad (liftM) import Data.Maybe (isJust) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Embedding.Types#} {#import Graphics.UI.Gtk.Signals#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Embedding.Embedding #endif import Graphics.UI.Gtk.General.Structs {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new empty 'Socket'. -- -- 'Socket' is a 'Container' for foreign applications that support the XEMBED -- protocol. To connect two applications the 'NativeWindowId' has to be passed -- either from this socket to the other application's 'Plug' or vice versa. -- socketNew :: IO Socket socketNew = makeNewObject mkSocket $ liftM (castPtr :: Ptr Widget -> Ptr Socket) $ {# call unsafe socket_new #} -------------------- -- Methods -- | Adds an XEMBED client, such as a 'Plug', to the 'Socket'. The client may -- be in the same process or in a different process. -- -- To embed a 'Plug' in a 'Socket', you can either create the 'Plug' with -- @Graphics.UI.Gtk.Embedding.Plug.plugNew Nothing@, call -- 'Graphics.UI.Gtk.Embedding.Plug.plugGetId' to get the window ID of the -- plug, and then pass that to the 'socketAddId', or you can call -- 'socketGetId' to get the window ID for the socket, and call -- 'Graphics.UI.Gtk.Embedding.Plug.plugNew' passing in that ID. -- -- The 'Socket' must have already be added into a toplevel window before you -- can make this call. -- socketAddId :: SocketClass self => self -> NativeWindowId -- ^ @windowId@ - the window ID of a client -- participating in the XEMBED protocol. -> IO () socketAddId self windowId = {# call unsafe socket_add_id #} (toSocket self) (fromNativeWindowId windowId) -- | Gets the window ID of a 'Socket' widget, which can then be used to create -- a client embedded inside the socket, for instance with -- 'Graphics.UI.Gtk.Embedding.Plug.plugNew'. -- -- The 'Socket' must have already be added into a toplevel window before you -- can make this call. -- socketGetId :: SocketClass self => self -> IO NativeWindowId socketGetId self = liftM toNativeWindowId $ {# call unsafe socket_get_id #} (toSocket self) #if GTK_CHECK_VERSION(2,14,0) -- | Retrieves the window of the plug. Use this to check if the plug has been -- created inside of the socket. -- -- * Available since Gtk+ version 2.14 -- socketGetPlugWindow :: SocketClass self => self -> IO (Maybe DrawWindow) -- ^ returns the window of the plug if available, -- or Nothing socketGetPlugWindow self = maybeNull (makeNewGObject mkDrawWindow) $ {# call gtk_socket_get_plug_window #} (toSocket self) #if GTK_MAJOR_VERSION >= 3 socketHasPlug :: SocketClass s => s -> IO Bool socketHasPlug = liftM isJust . socketGetPlugWindow #endif #endif -------------------- -- Signals -- | This signal is emitted when a client is successfully added to the socket. -- socketPlugAdded :: SocketClass self => Signal self (IO ()) socketPlugAdded = Signal (connect_NONE__NONE "plug-added") -- | This signal is emitted when a client is removed from the socket. The -- default action is to destroy the 'Socket' widget, so if you want to reuse it -- you must add a signal handler that returns @True@. -- socketPlugRemoved :: SocketClass self => Signal self (IO Bool) socketPlugRemoved = Signal (connect_NONE__BOOL "plug-removed") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED onPlugAdded :: SocketClass self => self -> IO () -> IO (ConnectId self) onPlugAdded = connect_NONE__NONE "plug-added" False {-# DEPRECATED onPlugAdded "instead of 'onPlugAdded obj' use 'on obj socketPlugAdded'" #-} afterPlugAdded :: SocketClass self => self -> IO () -> IO (ConnectId self) afterPlugAdded = connect_NONE__NONE "plug-added" True {-# DEPRECATED afterPlugAdded "instead of 'afterPlugAdded obj' use 'after obj socketPlugAdded'" #-} onPlugRemoved :: SocketClass self => self -> IO Bool -> IO (ConnectId self) onPlugRemoved = connect_NONE__BOOL "plug-removed" False {-# DEPRECATED onPlugRemoved "instead of 'onPlugRemoved obj' use 'on obj socketPlugRemoved'" #-} afterPlugRemoved :: SocketClass self => self -> IO Bool -> IO (ConnectId self) afterPlugRemoved = connect_NONE__BOOL "plug-removed" True {-# DEPRECATED afterPlugRemoved "instead of 'afterPlugRemoved obj' use 'after obj socketPlugRemoved'" #-} #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Embedding/Types.chs0000644000000000000000000001011207346545000017042 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Hamish Mackenzie -- -- Copyright (C) 2001-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 -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- module Graphics.UI.Gtk.Embedding.Types ( #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) Socket(Socket), SocketClass, toSocket, mkSocket, unSocket, castToSocket, gTypeSocket, Plug(Plug), PlugClass, toPlug, mkPlug, unPlug, castToPlug, gTypePlug, #endif ) where #if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) import Foreign.ForeignPtr (ForeignPtr, castForeignPtr) -- TODO work around cpphs https://ghc.haskell.org/trac/ghc/ticket/13553 #if __GLASGOW_HASKELL__ >= 707 || __GLASGOW_HASKELL__ == 0 import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) #else import Foreign.ForeignPtr (unsafeForeignPtrToPtr) #endif import Foreign.C.Types (CULong(..), CUInt(..), CULLong(..)) import System.Glib.GType (GType, typeInstanceIsA) {#import System.Glib.GObject#} import Graphics.UI.Gtk.General.Threading {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -- The usage of foreignPtrToPtr should be safe as the evaluation will only be -- forced if the object is used afterwards -- castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String -> (obj -> obj') castTo gtype objTypeName obj = case toGObject obj of gobj@(GObject objFPtr) | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype -> unsafeCastGObject gobj | otherwise -> error $ "Cannot cast object to " ++ objTypeName -- ****************************************************************** Socket {#pointer *GtkSocket as Socket foreign newtype #} deriving (Eq,Ord) mkSocket = (Socket, objectUnrefFromMainloop) unSocket (Socket o) = o class ContainerClass o => SocketClass o toSocket :: SocketClass o => o -> Socket toSocket = unsafeCastGObject . toGObject instance SocketClass Socket instance ContainerClass Socket instance WidgetClass Socket #if GTK_MAJOR_VERSION < 3 instance ObjectClass Socket #endif instance GObjectClass Socket where toGObject = GObject . castForeignPtr . unSocket unsafeCastGObject = Socket . castForeignPtr . unGObject castToSocket :: GObjectClass obj => obj -> Socket castToSocket = castTo gTypeSocket "Socket" gTypeSocket :: GType gTypeSocket = {# call fun unsafe gtk_socket_get_type #} -- ****************************************************************** Plug {#pointer *GtkPlug as Plug foreign newtype #} deriving (Eq,Ord) mkPlug = (Plug, objectUnrefFromMainloop) unPlug (Plug o) = o class WindowClass o => PlugClass o toPlug :: PlugClass o => o -> Plug toPlug = unsafeCastGObject . toGObject instance PlugClass Plug instance WindowClass Plug instance BinClass Plug instance ContainerClass Plug instance WidgetClass Plug #if GTK_MAJOR_VERSION < 3 instance ObjectClass Plug #endif instance GObjectClass Plug where toGObject = GObject . castForeignPtr . unPlug unsafeCastGObject = Plug . castForeignPtr . unGObject castToPlug :: GObjectClass obj => obj -> Plug castToPlug = castTo gTypePlug "Plug" gTypePlug :: GType gTypePlug = {# call fun unsafe plug_get_type #} #endif gtk-0.15.9/Graphics/UI/Gtk/Entry/0000755000000000000000000000000007346545000014467 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Entry/Editable.chs0000644000000000000000000003245307346545000016706 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface Editable -- -- Author : Axel Simon, Duncan Coutts -- -- Created: 30 July 2004 -- -- Copyright (C) 1999-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Interface for text-editing widgets -- module Graphics.UI.Gtk.Entry.Editable ( -- * Detail -- -- | The 'Editable' interface is an interface which should be implemented by -- text editing widgets, such as 'Entry'. -- It contains functions for generically manipulating an editable -- widget, a large number of action signals used for key bindings, and several -- signals that an application can connect to to modify the behavior of a -- widget. -- -- * Class Hierarchy -- | -- @ -- | GInterface -- | +----Editable -- @ -- * Types Editable, EditableClass, castToEditable, gTypeEditable, toEditable, -- * Methods editableSelectRegion, editableGetSelectionBounds, editableInsertText, editableDeleteText, editableGetChars, editableCutClipboard, editableCopyClipboard, editablePasteClipboard, editableDeleteSelection, editableSetEditable, editableGetEditable, editableSetPosition, editableGetPosition, -- * Attributes editablePosition, editableEditable, -- * Signals editableChanged, deleteText, insertText, stopDeleteText, stopInsertText, -- * Deprecated #ifndef DISABLE_DEPRECATED onEditableChanged, afterEditableChanged, onDeleteText, afterDeleteText, onInsertText, afterInsertText #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Selects a region of text. The characters that are selected are those -- characters at positions from @startPos@ up to, but not including @endPos@. -- If @endPos@ is negative, then the the characters selected will be those -- characters from @startPos@ to the end of the text. -- -- Calling this function with @start@=1 and @end@=4 it will mark \"ask\" in -- the string \"Haskell\". -- editableSelectRegion :: EditableClass self => self -> Int -- ^ @start@ - the starting position. -> Int -- ^ @end@ - the end position. -> IO () editableSelectRegion self start end = {# call editable_select_region #} (toEditable self) (fromIntegral start) (fromIntegral end) -- | Gets the current selection bounds, if there is a selection. -- editableGetSelectionBounds :: EditableClass self => self -> IO (Int,Int) -- ^ @(start, end)@ - the starting and end positions. This -- pair is not ordered. The @end@ index represents the -- position of the cursor. The @start@ index is the other end -- of the selection. If both numbers are equal there is in -- fact no selection. editableGetSelectionBounds self = alloca $ \startPtr -> alloca $ \endPtr -> do {# call unsafe editable_get_selection_bounds #} (toEditable self) startPtr endPtr start <- liftM fromIntegral $ peek startPtr end <- liftM fromIntegral $ peek endPtr return (start,end) -- | Inserts text at a given position. -- editableInsertText :: (EditableClass self, GlibString string) => self -> string -- ^ @newText@ - the text to insert. -> Int -- ^ @position@ - the position at which to insert the text. -> IO Int -- ^ returns the position after the newly inserted text. editableInsertText self newText position = with (fromIntegral position) $ \positionPtr -> withUTFStringLen newText $ \(newTextPtr, newTextLength) -> do {# call editable_insert_text #} (toEditable self) newTextPtr (fromIntegral newTextLength) positionPtr position <- peek positionPtr return (fromIntegral position) -- | Deletes a sequence of characters. The characters that are deleted are -- those characters at positions from @startPos@ up to, but not including -- @endPos@. If @endPos@ is negative, then the the characters deleted will be -- those characters from @startPos@ to the end of the text. -- editableDeleteText :: EditableClass self => self -> Int -- ^ @startPos@ - the starting position. -> Int -- ^ @endPos@ - the end position. -> IO () editableDeleteText self startPos endPos = {# call editable_delete_text #} (toEditable self) (fromIntegral startPos) (fromIntegral endPos) -- | Retrieves a sequence of characters. The characters that are retrieved are -- those characters at positions from @startPos@ up to, but not including -- @endPos@. If @endPos@ is negative, then the the characters retrieved will be -- those characters from @startPos@ to the end of the text. -- editableGetChars :: (EditableClass self, GlibString string) => self -> Int -- ^ @startPos@ - the starting position. -> Int -- ^ @endPos@ - the end position. -> IO string -- ^ returns the characters in the indicated region. editableGetChars self startPos endPos = {# call unsafe editable_get_chars #} (toEditable self) (fromIntegral startPos) (fromIntegral endPos) >>= readUTFString -- | Causes the characters in the current selection to be copied to the -- clipboard and then deleted from the widget. -- editableCutClipboard :: EditableClass self => self -> IO () editableCutClipboard self = {# call editable_cut_clipboard #} (toEditable self) -- | Causes the characters in the current selection to be copied to the -- clipboard. -- editableCopyClipboard :: EditableClass self => self -> IO () editableCopyClipboard self = {# call editable_copy_clipboard #} (toEditable self) -- | Causes the contents of the clipboard to be pasted into the given widget -- at the current cursor position. -- editablePasteClipboard :: EditableClass self => self -> IO () editablePasteClipboard self = {# call editable_paste_clipboard #} (toEditable self) -- | Deletes the current contents of the widgets selection and disclaims the -- selection. -- editableDeleteSelection :: EditableClass self => self -> IO () editableDeleteSelection self = {# call editable_delete_selection #} (toEditable self) -- | Sets the cursor position. -- editableSetPosition :: EditableClass self => self -> Int -- ^ @position@ - the position of the cursor. The cursor is -- displayed before the character with the given (base 0) index in -- the widget. The value must be less than or equal to the number of -- characters in the widget. A value of -1 indicates that the -- position should be set after the last character in the entry. -> IO () editableSetPosition self position = {# call editable_set_position #} (toEditable self) (fromIntegral position) -- | Retrieves the current cursor position. -- editableGetPosition :: EditableClass self => self -> IO Int -- ^ returns the position of the cursor. The cursor is displayed -- before the character with the given (base 0) index in the widget. -- The value will be less than or equal to the number of characters -- in the widget. Note that this position is in characters, not in -- bytes. editableGetPosition self = liftM fromIntegral $ {# call unsafe editable_get_position #} (toEditable self) -- | Determines if the user can edit the text in the editable widget or not. -- editableSetEditable :: EditableClass self => self -> Bool -- ^ @isEditable@ - @True@ if the user is allowed to edit the text -- in the widget. -> IO () editableSetEditable self isEditable = {# call editable_set_editable #} (toEditable self) (fromBool isEditable) -- | Retrieves whether the text is editable. See 'editableSetEditable'. -- editableGetEditable :: EditableClass self => self -> IO Bool editableGetEditable self = liftM toBool $ {# call editable_get_editable #} (toEditable self) -------------------- -- Attributes -- | \'position\' property. See 'editableGetPosition' and -- 'editableSetPosition' -- editablePosition :: EditableClass self => Attr self Int editablePosition = newAttr editableGetPosition editableSetPosition -- | \'editable\' property. See 'editableGetEditable' and -- 'editableSetEditable' -- editableEditable :: EditableClass self => Attr self Bool editableEditable = newAttr editableGetEditable editableSetEditable -------------------- -- Signals -- | The 'editableChanged' signal is emitted at the end of a single -- user-visible operation on the contents of the 'Editable'. -- -- * For instance, a paste operation that replaces the contents of the -- selection will cause only one signal emission (even though it is -- implemented by first deleting the selection, then inserting the new -- content, and may cause multiple 'insertText' signals to be -- emitted). -- editableChanged :: EditableClass ec => Signal ec (IO ()) editableChanged = Signal (connect_NONE__NONE "changed") -- | Emitted when a piece of text is deleted from the 'Editable' widget. -- -- * See 'insertText' for information on how to use this signal. -- deleteText :: EditableClass self => Signal self (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@ deleteText = Signal (connect_INT_INT__NONE "delete-text") -- | Stop the current signal that deletes text. stopDeleteText :: EditableClass self => ConnectId self -> IO () stopDeleteText (ConnectId _ obj) = signalStopEmission obj "delete-text" -- | Emitted when a piece of text is inserted into the 'Editable' widget. -- -- * The connected signal receives the text that is inserted, together with -- the position in the entry widget. The return value should be the position -- in the entry widget that lies past the recently inserted text (i.e. -- you should return the given position plus the length of the string). -- -- * To modify the text that the user inserts, you need to connect to this -- signal, modify the text the way you want and then call -- 'editableInsertText'. To avoid that this signal handler is called -- recursively, you need to temporarily block it using -- 'signalBlock'. After the default signal -- handler has inserted your modified text, it is important that you -- prevent the default handler from being executed again when this signal -- handler returns. To stop the current signal, use 'stopInsertText'. -- The following code is an example of how to turn all input into uppercase: -- -- > idRef <- newIORef undefined -- > id <- entry `on` insertText $ \str pos -> do -- > id <- readIORef idRef -- > signalBlock id -- > pos' <- editableInsertText entry (map toUpper str) pos -- > signalUnblock id -- > stopInsertText id -- > return pos' -- > writeIORef idRef id -- -- Note that binding 'insertText' using 'after' is not very useful, except to -- track editing actions. -- insertText :: (EditableClass self, GlibString string) => Signal self (string -> Int -> IO Int) insertText = Signal $ \after obj handler -> connect_PTR_INT_PTR__NONE "insert-text" after obj (\strPtr strLen posPtr -> do str <- if strLen<0 then peekUTFString strPtr else peekUTFStringLen (strPtr, strLen) pos <- peek (posPtr :: Ptr {#type gint#}) pos' <- handler str (fromIntegral pos) poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos') ) -- | Stop the current signal that inserts text. stopInsertText :: EditableClass self => ConnectId self -> IO () stopInsertText (ConnectId _ obj) = signalStopEmission obj "insert-text" #ifndef DISABLE_DEPRECATED -------------------- -- Deprecated Signals onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () -> IO (ConnectId ec) onEditableChanged = connect_NONE__NONE "changed" False afterEditableChanged = connect_NONE__NONE "changed" True onDeleteText, afterDeleteText :: EditableClass self => self -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@ -> IO (ConnectId self) onDeleteText = connect_INT_INT__NONE "delete_text" False afterDeleteText = connect_INT_INT__NONE "delete_text" True onInsertText, afterInsertText :: (EditableClass self, GlibString string) => self -> (string -> Int -> IO Int) -> IO (ConnectId self) onInsertText obj handler = connect_PTR_INT_PTR__NONE "insert_text" False obj (\strPtr strLen posPtr -> do str <- if strLen<0 then peekUTFString strPtr else peekUTFStringLen (strPtr, strLen) pos <- peek (posPtr :: Ptr {#type gint#}) pos' <- handler str (fromIntegral pos) poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos') ) afterInsertText obj handler = connect_PTR_INT_PTR__NONE "insert_text" True obj (\strPtr strLen posPtr -> do str <- if strLen<0 then peekUTFString strPtr else peekUTFStringLen (strPtr, strLen) pos <- peek (posPtr :: Ptr {#type gint#}) pos' <- handler str (fromIntegral pos) poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos') ) #endif gtk-0.15.9/Graphics/UI/Gtk/Entry/Entry.chs0000644000000000000000000007077607346545000016310 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Entry -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A single line text entry field -- module Graphics.UI.Gtk.Entry.Entry ( -- * Detail -- -- | The 'Entry' widget is a single line text entry widget. A fairly large set -- of key bindings are supported by default. If the entered text is longer than -- the allocation of the widget, the widget will scroll so that the cursor -- position is visible. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Entry -- | +----'SpinButton' -- @ -- * Types Entry, EntryClass, castToEntry, gTypeEntry, toEntry, -- * Constructors entryNew, #if GTK_CHECK_VERSION(2,18,0) entryNewWithBuffer, #endif -- * Methods entrySetText, entryGetText, #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED entryAppendText, entryPrependText, #endif #endif entrySetVisibility, entryGetVisibility, entrySetInvisibleChar, entryGetInvisibleChar, entrySetMaxLength, entryGetMaxLength, entryGetActivatesDefault, entrySetActivatesDefault, entryGetHasFrame, entrySetHasFrame, entryGetWidthChars, entrySetWidthChars, #if GTK_CHECK_VERSION(3,2,0) entrySetPlaceholderText, entryGetPlaceholderText, #endif #if GTK_CHECK_VERSION(2,4,0) entrySetAlignment, entryGetAlignment, entrySetCompletion, entryGetCompletion, #endif #if GTK_CHECK_VERSION (2,18,0) entryGetBuffer, entrySetBuffer, #endif #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,20,0) entryGetIconWindow, entryGetTextWindow, #endif #endif #if GTK_CHECK_VERSION(2,22,0) entryImContextFilterKeypress, entryResetImContext, #endif -- * Attributes entryCursorPosition, entrySelectionBound, entryEditable, entryMaxLength, entryVisibility, entryHasFrame, entryInvisibleChar, entryActivatesDefault, entryWidthChars, entryScrollOffset, entryText, #if GTK_CHECK_VERSION(3,2,0) entryPlaceholderText, #endif #if GTK_CHECK_VERSION(2,4,0) entryXalign, entryAlignment, entryCompletion, #endif #if GTK_CHECK_VERSION (2,18,0) entryBuffer, #endif -- * Signals entryActivated, entryActivate, entryBackspace, entryCopyClipboard, entryCutClipboard, entryPasteClipboard, entryDeleteFromCursor, entryInsertAtCursor, entryMoveCursor, entryPopulatePopup, entryToggleOverwirte, entryToggleOverwrite, #if GTK_CHECK_VERSION(2,20,0) entryPreeditChanged, #endif #if GTK_CHECK_VERSION(2,16,0) entryIconPress, entryIconRelease, #endif -- * Deprecated #ifndef DISABLE_DEPRECATED onEntryActivate, afterEntryActivate, onCopyClipboard, afterCopyClipboard, onCutClipboard, afterCutClipboard, onPasteClipboard, afterPasteClipboard, onToggleOverwrite, afterToggleOverwrite, #endif ) where import Control.Monad (liftM) import Control.Monad.Reader (runReaderT) import Data.Char (ord, chr) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.General.Enums (DeleteType (..), MovementStep (..) #if GTK_CHECK_VERSION(2,16,0) , EntryIconPosition (..) #endif ) import Graphics.UI.Gtk.Gdk.EventM (EventM, EButton, EKey) import Control.Monad.Reader ( ask ) import Control.Monad.Trans ( liftIO ) #if GTK_CHECK_VERSION (2,18,0) import Graphics.UI.Gtk.Entry.EntryBuffer #endif {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Interfaces instance EditableClass Entry -------------------- -- Constructors -- | Creates a new 'Entry' widget. -- entryNew :: IO Entry entryNew = makeNewObject mkEntry $ liftM (castPtr :: Ptr Widget -> Ptr Entry) $ {# call unsafe entry_new #} #if GTK_CHECK_VERSION(2,18,0) -- | Creates a new 'Entry' widget backed by a particular 'EntryBuffer'. One -- buffer can be shared among many widgets. -- entryNewWithBuffer :: EntryBufferClass buffer => buffer -> IO Entry entryNewWithBuffer buffer = makeNewObject mkEntry $ liftM (castPtr :: Ptr Widget -> Ptr Entry) $ {# call unsafe entry_new_with_buffer #} (toEntryBuffer buffer) -------------------- -- Methods -- Although the documentation doesn't say one way or the other, a look at the -- source indicates that gtk_entry_get_buffer doesn't increment the reference -- count of the GtkEntryBuffer it returns, so, like textViewGetBuffer, we must -- increment it ourselves. -- | Get the 'EntryBuffer' object which holds the text for this widget. entryGetBuffer :: EntryClass self => self -> IO EntryBuffer entryGetBuffer self = makeNewGObject mkEntryBuffer $ {# call gtk_entry_get_buffer #} (toEntry self) -- | Set the 'EntryBuffer' object which holds the text for this widget. entrySetBuffer :: (EntryClass self, EntryBufferClass buffer) => self -> buffer -> IO () entrySetBuffer self = {# call gtk_entry_set_buffer #} (toEntry self) . toEntryBuffer #endif -- | Sets the text in the widget to the given value, replacing the current -- contents. -- entrySetText :: (EntryClass self, GlibString string) => self -> string -> IO () entrySetText self text = withUTFString text $ \textPtr -> {# call entry_set_text #} (toEntry self) textPtr -- | Retrieves the contents of the entry widget. -- See also 'Graphics.UI.Gtk.Display.Entry.Editable.editableGetChars'. -- entryGetText :: (EntryClass self, GlibString string) => self -> IO string entryGetText self = {# call entry_get_text #} (toEntry self) >>= peekUTFString #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Appends the given text to the contents of the widget. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. entryAppendText :: (EntryClass self, GlibString string) => self -> string -> IO () entryAppendText self text = withUTFString text $ \textPtr -> {# call entry_append_text #} (toEntry self) textPtr -- | Prepends the given text to the contents of the widget. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. entryPrependText :: (EntryClass self, GlibString string) => self -> string -> IO () entryPrependText self text = withUTFString text $ \textPtr -> {# call entry_prepend_text #} (toEntry self) textPtr #endif #endif -- | Sets whether the contents of the entry are visible or not. When -- visibility is set to @False@, characters are displayed as the invisible -- char, and will also appear that way when the text in the entry widget is -- copied elsewhere. -- -- The default invisible char is the asterisk \'*\', but it can be changed -- with 'entrySetInvisibleChar'. -- entrySetVisibility :: EntryClass self => self -> Bool -- ^ @visible@ - @True@ if the contents of the entry are displayed -- as plaintext. -> IO () entrySetVisibility self visible = {# call entry_set_visibility #} (toEntry self) (fromBool visible) -- | Retrieves whether the text in @entry@ is visible. See -- 'entrySetVisibility'. -- entryGetVisibility :: EntryClass self => self -> IO Bool -- ^ returns @True@ if the text is currently visible entryGetVisibility self = liftM toBool $ {# call entry_get_visibility #} (toEntry self) -- | Sets the character to use in place of the actual text when -- 'entrySetVisibility' has been called to set text visibility to @False@. i.e. -- this is the character used in \"password mode\" to show the user how many -- characters have been typed. The default invisible char is an asterisk -- (\'*\'). If you set the invisible char to @\'\\0\'@, then the user will get -- no feedback at all; there will be no text on the screen as they type. -- entrySetInvisibleChar :: EntryClass self => self -> Char -> IO () entrySetInvisibleChar self ch = {# call unsafe entry_set_invisible_char #} (toEntry self) ((fromIntegral . ord) ch) -- | Retrieves the character displayed in place of the real characters for -- entries with visisbility set to false. See 'entrySetInvisibleChar'. -- entryGetInvisibleChar :: EntryClass self => self -> IO Char -- ^ returns the current invisible char, or @\'\\0\'@, if the -- entry does not show invisible text at all. entryGetInvisibleChar self = liftM (chr . fromIntegral) $ {# call unsafe entry_get_invisible_char #} (toEntry self) -- | Sets the maximum allowed length of the contents of the widget. If the -- current contents are longer than the given length, then they will be -- truncated to fit. -- entrySetMaxLength :: EntryClass self => self -> Int -- ^ @max@ - the maximum length of the entry, or 0 for no maximum. -- (other than the maximum length of entries.) The value passed in -- will be clamped to the range 0-65536. -> IO () entrySetMaxLength self max = {# call entry_set_max_length #} (toEntry self) (fromIntegral max) -- | Retrieves the maximum allowed length of the text in @entry@. See -- 'entrySetMaxLength'. -- entryGetMaxLength :: EntryClass self => self -> IO Int -- ^ returns the maximum allowed number of characters in 'Entry', -- or 0 if there is no maximum. entryGetMaxLength self = liftM fromIntegral $ {# call unsafe entry_get_max_length #} (toEntry self) -- | Query whether pressing return will activate the default widget. -- entryGetActivatesDefault :: EntryClass self => self -> IO Bool -- ^ returns @True@ if the entry will activate the default widget entryGetActivatesDefault self = liftM toBool $ {# call unsafe entry_get_activates_default #} (toEntry self) -- | If @setting@ is @True@, pressing Enter in the @entry@ will activate the -- default widget for the window containing the entry. This usually means that -- the dialog box containing the entry will be closed, since the default widget -- is usually one of the dialog buttons. -- -- (For experts: if @setting@ is @True@, the entry calls -- 'Graphics.UI.Gtk.Windows.Window.windowActivateDefault' on the window -- containing the entry, in the default -- handler for the \"activate\" signal.) -- -- This setting is useful in 'Dialog' boxes where enter should press the -- default button. -- entrySetActivatesDefault :: EntryClass self => self -> Bool -- ^ @setting@ - @True@ to activate window's default widget on Enter -- keypress -> IO () entrySetActivatesDefault self setting = {# call entry_set_activates_default #} (toEntry self) (fromBool setting) -- | Query if the text 'Entry' is displayed with a frame around it. -- entryGetHasFrame :: EntryClass self => self -> IO Bool -- ^ returns whether the entry has a beveled frame entryGetHasFrame self = liftM toBool $ {# call unsafe entry_get_has_frame #} (toEntry self) -- | Sets whether the entry has a beveled frame around it. -- entrySetHasFrame :: EntryClass self => self -> Bool -> IO () entrySetHasFrame self setting = {# call entry_set_has_frame #} (toEntry self) (fromBool setting) -- | Gets the value set by 'entrySetWidthChars'. -- entryGetWidthChars :: EntryClass self => self -> IO Int -- ^ returns number of chars to request space for, or negative if -- unset entryGetWidthChars self = liftM fromIntegral $ {# call unsafe entry_get_width_chars #} (toEntry self) -- | Changes the size request of the entry to be about the right size for -- @nChars@ characters. Note that it changes the size /request/, the size can -- still be affected by how you pack the widget into containers. If @nChars@ is -- -1, the size reverts to the default entry size. -- -- This setting is only considered when the widget formulates its size -- request. Make sure that it is not mapped (shown) before you change this -- value. -- entrySetWidthChars :: EntryClass self => self -> Int -- ^ @nChars@ - width in chars -> IO () entrySetWidthChars self nChars = {# call entry_set_width_chars #} (toEntry self) (fromIntegral nChars) #if GTK_CHECK_VERSION(3,2,0) -- | Sets text to be displayed in entry when it is empty and unfocused. -- This can be used to give a visual hint of the expected contents of the `Entry`. -- -- Note that since the placeholder text gets removed when the entry received -- focus, using this feature is a bit problematic if the entry is given the -- initial focus in a window. Sometimes this can be worked around by delaying -- the initial focus setting until the first key event arrives. -- -- * Available since Gtk version 3.2 -- entrySetPlaceholderText :: (EntryClass self, GlibString text) => self -> Maybe text -- ^ @text@ a string to be displayed when entry is empty an unfocused, or `Nothing` -> IO () entrySetPlaceholderText self text = maybeWith withUTFString text $ \ textPtr -> {# call entry_set_placeholder_text #} (toEntry self) textPtr -- | Retrieves the text that will be displayed when entry is empty and unfocused. -- -- * Available since Gtk version 3.2 -- entryGetPlaceholderText :: (EntryClass self, GlibString text) => self -> IO (Maybe text) -- ^ returns placeholder text entryGetPlaceholderText self = {# call unsafe entry_get_placeholder_text #} (toEntry self) >>= maybePeek peekUTFString #endif #if GTK_CHECK_VERSION(2,4,0) -- | Sets the alignment for the contents of the entry. This controls the -- horizontal positioning of the contents when the displayed text is shorter -- than the width of the entry. -- -- * Available since Gtk version 2.4 -- entrySetAlignment :: EntryClass self => self -> Float -- ^ @xalign@ - The horizontal alignment, from 0 (left) to 1 -- (right). Reversed for RTL layouts -> IO () entrySetAlignment self xalign = {# call entry_set_alignment #} (toEntry self) (realToFrac xalign) -- | Gets the value set by 'entrySetAlignment'. -- -- * Available since Gtk version 2.4 -- entryGetAlignment :: EntryClass self => self -> IO Float -- ^ returns the alignment entryGetAlignment self = liftM realToFrac $ {# call unsafe entry_get_alignment #} (toEntry self) -- | Sets the auxiliary completion object to use with the entry. All further -- configuration of the completion mechanism is done on completion using the -- 'EntryCompletion' API. -- -- * Available since Gtk version 2.4 -- entrySetCompletion :: EntryClass self => self -> EntryCompletion -> IO () entrySetCompletion self completion = {# call gtk_entry_set_completion #} (toEntry self) completion -- | Returns the auxiliary completion object currently in use by the entry. -- -- * Available since Gtk version 2.4 -- entryGetCompletion :: EntryClass self => self -> IO EntryCompletion -- ^ returns The auxiliary completion object currently -- in use by @entry@. entryGetCompletion self = makeNewGObject mkEntryCompletion $ {# call gtk_entry_get_completion #} (toEntry self) #endif #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,20,0) -- | Returns the 'Window' which contains the entry's icon at @iconPos@. This function is useful when -- drawing something to the entry in an 'eventExpose' callback because it enables the callback to -- distinguish between the text window and entry's icon windows. -- -- See also 'entryGetTextWindow'. -- Removed in Gtk3. entryGetIconWindow :: EntryClass self => self -> EntryIconPosition -- ^ @iconPos@ Icon position -> IO DrawWindow -- ^ returns the entry's icon window at @iconPos@. entryGetIconWindow entry iconPos = makeNewGObject mkDrawWindow $ {#call gtk_entry_get_icon_window #} (toEntry entry) ((fromIntegral . fromEnum) iconPos) -- | Returns the 'Window' which contains the text. This function is useful when drawing something to the -- entry in an 'eventExpose' callback because it enables the callback to distinguish between the text -- window and entry's icon windows. -- -- See also 'entryGetIconWindow'. -- Removed in Gtk3. entryGetTextWindow :: EntryClass self => self -> IO DrawWindow -- ^ returns the entry's text window. entryGetTextWindow entry = makeNewGObject mkDrawWindow $ {#call gtk_entry_get_text_window #} (toEntry entry) #endif #endif #if GTK_CHECK_VERSION(2,22,0) -- | Allow the 'Entry' input method to internally handle key press and release events. If this function -- returns 'True', then no further processing should be done for this key event. See -- 'imContextFilterKeypress'. -- -- Note that you are expected to call this function from your handler when overriding key event -- handling. This is needed in the case when you need to insert your own key handling between the input -- method and the default key event handling of the 'Entry'. See 'textViewResetImContext' for -- an example of use. -- -- * Available since Gtk+ version 2.22 -- entryImContextFilterKeypress :: EntryClass self => self -> EventM EKey Bool entryImContextFilterKeypress self = do ptr <- ask liftIO $ liftM toBool $ {# call gtk_entry_im_context_filter_keypress #} (toEntry self) (castPtr ptr) -- | Reset the input method context of the entry if needed. -- -- This can be necessary in the case where modifying the buffer would confuse on-going input method -- behavior. -- -- * Available since Gtk+ version 2.22 -- entryResetImContext :: EntryClass self => self -> IO () entryResetImContext self = {#call gtk_entry_reset_im_context #} (toEntry self) #endif -------------------- -- Attributes -- | The current position of the insertion cursor in chars. -- -- Allowed values: [0,65535] -- -- Default value: 0 -- entryCursorPosition :: EntryClass self => ReadAttr self Int entryCursorPosition = readAttrFromIntProperty "cursor-position" -- | The position of the opposite end of the selection from the cursor in -- chars. -- -- Allowed values: [0,65535] -- -- Default value: 0 -- entrySelectionBound :: EntryClass self => ReadAttr self Int entrySelectionBound = readAttrFromIntProperty "selection-bound" -- | Whether the entry contents can be edited. -- -- Default value: @True@ -- entryEditable :: EntryClass self => Attr self Bool entryEditable = newAttrFromBoolProperty "editable" -- | Maximum number of characters for this entry. Zero if no maximum. -- -- Allowed values: [0,65535] -- -- Default value: 0 -- entryMaxLength :: EntryClass self => Attr self Int entryMaxLength = newAttr entryGetMaxLength entrySetMaxLength -- | @False@ displays the \"invisible char\" instead of the actual text -- (password mode). -- -- Default value: @True@ -- entryVisibility :: EntryClass self => Attr self Bool entryVisibility = newAttr entryGetVisibility entrySetVisibility -- | @False@ removes outside bevel from entry. -- -- Default value: @True@ -- entryHasFrame :: EntryClass self => Attr self Bool entryHasFrame = newAttr entryGetHasFrame entrySetHasFrame -- | The character to use when masking entry contents (in \"password mode\"). -- -- Default value: \'*\' -- entryInvisibleChar :: EntryClass self => Attr self Char entryInvisibleChar = newAttr entryGetInvisibleChar entrySetInvisibleChar -- | Whether to activate the default widget (such as the default button in a -- dialog) when Enter is pressed. -- -- Default value: @False@ -- entryActivatesDefault :: EntryClass self => Attr self Bool entryActivatesDefault = newAttr entryGetActivatesDefault entrySetActivatesDefault -- | Number of characters to leave space for in the entry. -- -- Allowed values: >= -1 -- -- Default value: -1 -- entryWidthChars :: EntryClass self => Attr self Int entryWidthChars = newAttr entryGetWidthChars entrySetWidthChars -- | Number of pixels of the entry scrolled off the screen to the left. -- -- Allowed values: >= 0 -- -- Default value: 0 -- entryScrollOffset :: EntryClass self => ReadAttr self Int entryScrollOffset = readAttrFromIntProperty "scroll-offset" -- | The contents of the entry. -- -- Default value: \"\" -- entryText :: (EntryClass self, GlibString string) => Attr self string entryText = newAttr entryGetText entrySetText #if GTK_CHECK_VERSION(3,2,0) -- | The text that will be displayed in the `Entry` when it is empty and unfocused. -- -- Default value: Nothing -- entryPlaceholderText :: (EntryClass self, GlibString text) => Attr self (Maybe text) entryPlaceholderText = newAttr entryGetPlaceholderText entrySetPlaceholderText #endif #if GTK_CHECK_VERSION(2,4,0) -- | The horizontal alignment, from 0 (left) to 1 (right). Reversed for RTL -- layouts. -- -- Allowed values: [0,1] -- -- Default value: 0 -- entryXalign :: EntryClass self => Attr self Float entryXalign = newAttrFromFloatProperty "xalign" -- | \'alignment\' property. See 'entryGetAlignment' and 'entrySetAlignment' -- entryAlignment :: EntryClass self => Attr self Float entryAlignment = newAttr entryGetAlignment entrySetAlignment -- | \'completion\' property. See 'entryGetCompletion' and -- 'entrySetCompletion' -- entryCompletion :: EntryClass self => Attr self EntryCompletion entryCompletion = newAttr entryGetCompletion entrySetCompletion #endif #if GTK_CHECK_VERSION(2,18,0) -- | The buffer being displayed. -- entryBuffer :: (EntryClass self, EntryBufferClass buffer) => ReadWriteAttr self EntryBuffer buffer entryBuffer = newAttr entryGetBuffer entrySetBuffer #endif -------------------- -- Signals -- | A keybinding signal which gets emitted when the user activates the entry. -- -- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to -- control activation programmatically. entryActivated :: EntryClass ec => Signal ec (IO ()) entryActivated = Signal (connect_NONE__NONE "activate") -- | Deprecated. See 'entryActivated'. entryActivate :: EntryClass ec => Signal ec (IO ()) entryActivate = entryActivated -- | The 'entryBackspace' signal is a keybinding signal which gets emitted when the user asks for it. -- -- The default bindings for this signal are Backspace and Shift-Backspace. entryBackspace :: EntryClass ec => Signal ec (IO ()) entryBackspace = Signal (connect_NONE__NONE "backspace") -- | The 'entryCopyClipboard' signal is a keybinding signal which gets emitted to copy the selection to the -- clipboard. -- -- The default bindings for this signal are Ctrl-c and Ctrl-Insert. entryCopyClipboard :: EntryClass ec => Signal ec (IO ()) entryCopyClipboard = Signal (connect_NONE__NONE "copy-clipboard") -- | The 'entryCutClipboard' signal is a keybinding signal which gets emitted to cut the selection to the -- clipboard. -- -- The default bindings for this signal are Ctrl-x and Shift-Delete. entryCutClipboard :: EntryClass ec => Signal ec (IO ()) entryCutClipboard = Signal (connect_NONE__NONE "cut-clipboard") -- | The 'entryDeleteFromCursor' signal is a keybinding signal which gets emitted when the user initiates a -- text deletion. -- -- If the type is 'DeleteChars', GTK+ deletes the selection if there is one, otherwise it deletes -- the requested number of characters. -- -- The default bindings for this signal are Delete for deleting a character and Ctrl-Delete for -- deleting a word. entryDeleteFromCursor :: EntryClass ec => Signal ec (DeleteType -> Int -> IO ()) entryDeleteFromCursor = Signal (connect_ENUM_INT__NONE "delete-from-cursor") -- | The 'entryInsertAtCursor' signal is a keybinding signal which gets emitted when the user initiates the -- insertion of a fixed string at the cursor. entryInsertAtCursor :: (EntryClass ec, GlibString string) => Signal ec (string -> IO ()) entryInsertAtCursor = Signal (connect_GLIBSTRING__NONE "insert-at-cursor") -- | The 'entryMoveCursor' signal is a keybinding signal which gets emitted when the user initiates a cursor -- movement. If the cursor is not visible in entry, this signal causes the viewport to be moved -- instead. -- -- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to -- control the cursor programmatically. -- -- The default bindings for this signal come in two variants, the variant with the Shift modifier -- extends the selection, the variant without the Shift modifier does not. There are too many key -- combinations to list them all here. -- -- * Arrow keys move by individual characters\/lines -- * Ctrl-arrow key combinations move by words\/paragraphs -- * Home\/End keys move to the ends of the buffer entryMoveCursor :: EntryClass ec => Signal ec (MovementStep -> Int -> Bool -> IO ()) entryMoveCursor = Signal (connect_ENUM_INT_BOOL__NONE "move-cursor") -- | The 'entryPasteClipboard' signal is a keybinding signal which gets emitted to paste the contents of the -- clipboard into the text view. -- -- The default bindings for this signal are Ctrl-v and Shift-Insert. entryPasteClipboard :: EntryClass ec => Signal ec (IO ()) entryPasteClipboard = Signal (connect_NONE__NONE "paste-clipboard") -- | The 'entryPopulatePopup' signal gets emitted before showing the context menu of the entry. -- -- If you need to add items to the context menu, connect to this signal and append your menuitems to -- the menu. entryPopulatePopup :: EntryClass ec => Signal ec (Menu -> IO ()) entryPopulatePopup = Signal (connect_OBJECT__NONE "populate-popup") #if GTK_CHECK_VERSION(2,20,0) -- | If an input method is used, the typed text will not immediately be committed to the buffer. So if -- you are interested in the text, connect to this signal. entryPreeditChanged :: (EntryClass ec, GlibString string) => Signal ec (string -> IO ()) entryPreeditChanged = Signal (connect_GLIBSTRING__NONE "preedit-changed") #endif #if GTK_CHECK_VERSION(2,16,0) -- | The 'iconPress' signal is emitted when an activatable icon is clicked. -- entryIconPress :: EntryClass ec => Signal ec (EntryIconPosition -> EventM EButton ()) entryIconPress = Signal $ \after obj f -> connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f) -- | The 'iconRelease' signal is emitted on the button release from a mouse click over an activatable -- icon. -- entryIconRelease :: EntryClass ec => Signal ec (EntryIconPosition -> EventM EButton ()) entryIconRelease = Signal $ \after obj f -> connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f) #endif {-# DEPRECATED entryToggleOverwirte "Use entryToggleOverwrite" #-} entryToggleOverwirte :: EntryClass ec => Signal ec (IO ()) entryToggleOverwirte = entryToggleOverwrite -- | The 'entryToggleOverwrite' signal is a keybinding signal which gets emitted to toggle the overwrite mode -- of the entry. -- The default bindings for this signal is Insert. -- entryToggleOverwrite :: EntryClass ec => Signal ec (IO ()) entryToggleOverwrite = Signal (connect_NONE__NONE "toggle-overwrite") #ifndef DISABLE_DEPRECATED -- | Emitted when the user presses return within -- the 'Entry' field. -- onEntryActivate, afterEntryActivate :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onEntryActivate = connect_NONE__NONE "activate" False afterEntryActivate = connect_NONE__NONE "activate" True -- | Emitted when the current selection has been -- copied to the clipboard. -- onCopyClipboard, afterCopyClipboard :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onCopyClipboard = connect_NONE__NONE "copy_clipboard" False afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True -- | Emitted when the current selection has been -- cut to the clipboard. -- onCutClipboard, afterCutClipboard :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onCutClipboard = connect_NONE__NONE "cut_clipboard" False afterCutClipboard = connect_NONE__NONE "cut_clipboard" True -- | Emitted when the current selection has -- been pasted from the clipboard. -- onPasteClipboard, afterPasteClipboard :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onPasteClipboard = connect_NONE__NONE "paste_clipboard" False afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True -- | Emitted when the user changes from -- overwriting to inserting. -- onToggleOverwrite, afterToggleOverwrite :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True #endif gtk-0.15.9/Graphics/UI/Gtk/Entry/EntryBuffer.chs0000644000000000000000000001570007346545000017424 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget EntryBuffer -- -- Author : Andy Stewart -- -- Created: 22 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Text buffer for 'Entry' -- -- * Module available since Gtk+ version 2.18 -- module Graphics.UI.Gtk.Entry.EntryBuffer ( -- * Detail -- -- | The 'EntryBuffer' class contains the actual text displayed in a 'Entry' -- widget. -- -- A single 'EntryBuffer' object can be shared by multiple 'Entry' widgets -- which will then share the same text content, but not the cursor position, -- visibility attributes, icon etc. -- -- 'EntryBuffer' may be derived from. Such a derived class might allow text -- to be stored in an alternate location, such as non-pageable memory, useful -- in the case of important passwords. Or a derived class could integrate with -- an application's concept of undo\/redo. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----EntryBuffer -- @ #if GTK_CHECK_VERSION(2,18,0) -- * Types EntryBuffer, EntryBufferClass, castToEntryBuffer, toEntryBuffer, -- * Constructors entryBufferNew, -- * Methods entryBufferGetBytes, entryBufferInsertText, entryBufferDeleteText, entryBufferEmitDeletedText, entryBufferEmitInsertedText, -- * Attributes entryBufferText, entryBufferLength, entryBufferMaxLength, -- * Signals entryBufferInsertedText, entryBufferDeletedText, #endif ) where import Control.Monad (liftM) import Data.Maybe (fromJust) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,18,0) -------------------- -- Constructors -- | Create a new 'EntryBuffer' object. -- -- Optionally, specify initial text to set in the buffer. -- -- * Available since Gtk+ version 2.18 -- entryBufferNew :: GlibString string => Maybe string -- ^ @initialChars@ - initial buffer text or 'Nothing' -> IO EntryBuffer entryBufferNew initialChars = wrapNewGObject mkEntryBuffer $ maybeWith withUTFString initialChars $ \initialCharsPtr -> do let chars = if initialCharsPtr == nullPtr then (-1) else stringLength $ fromJust initialChars {# call gtk_entry_buffer_new #} initialCharsPtr (fromIntegral chars) -------------------- -- Methods -- | Retrieves the length in bytes of the buffer. See 'entryBufferGetLength'. -- -- * Available since Gtk+ version 2.18 -- entryBufferGetBytes :: EntryBufferClass self => self -> IO Int -- ^ returns The byte length of the buffer. entryBufferGetBytes self = liftM fromIntegral $ {# call gtk_entry_buffer_get_bytes #} (toEntryBuffer self) -- | Inserts @chars@ into the contents of the buffer, -- at position @position@. -- -- * Available since Gtk+ version 2.18 -- entryBufferInsertText :: (EntryBufferClass self, GlibString string) => self -> Int -- ^ @position@ - the position at which to insert text. -> string -- ^ @chars@ - the text to insert into the buffer. -> IO Int -- ^ returns The number of characters actually inserted. entryBufferInsertText self position chars = liftM fromIntegral $ withUTFStringLen chars $ \ (charsPtr, len) -> {# call gtk_entry_buffer_insert_text #} (toEntryBuffer self) (fromIntegral position) charsPtr (fromIntegral len) -- | Deletes a sequence of characters from the buffer. @nChars@ characters are -- deleted starting at @position@. If @nChars@ is negative, then all characters -- until the end of the text are deleted. -- -- * Available since Gtk+ version 2.18 -- entryBufferDeleteText :: EntryBufferClass self => self -> Int -- ^ @position@ - position at which to delete text -> Int -- ^ @nChars@ - number of characters to delete -> IO Int -- ^ returns The number of characters deleted. entryBufferDeleteText self position nChars = liftM fromIntegral $ {# call gtk_entry_buffer_delete_text #} (toEntryBuffer self) (fromIntegral position) (fromIntegral nChars) -- | Used when subclassing 'EntryBuffer' -- -- * Available since Gtk+ version 2.18 -- entryBufferEmitDeletedText :: EntryBufferClass self => self -> Int -- ^ @position@ - position at which text was deleted -> Int -- ^ @nChars@ - number of characters deleted -> IO () entryBufferEmitDeletedText self position nChars = {# call gtk_entry_buffer_emit_deleted_text #} (toEntryBuffer self) (fromIntegral position) (fromIntegral nChars) -- | Used when subclassing 'EntryBuffer' -- -- * Available since Gtk+ version 2.18 -- entryBufferEmitInsertedText :: (EntryBufferClass self, GlibString string) => self -> Int -- ^ @position@ - position at which text was inserted -> string -- ^ @chars@ - text that was inserted -> Int -- ^ @nChars@ - number of characters inserted -> IO () entryBufferEmitInsertedText self position chars nChars = withUTFString chars $ \charsPtr -> {# call gtk_entry_buffer_emit_inserted_text #} (toEntryBuffer self) (fromIntegral position) charsPtr (fromIntegral nChars) -------------------- -- Attributes -- | The contents of the buffer. -- -- Default value: \"\" -- -- * Available since Gtk+ version 2.18 -- entryBufferText :: (EntryBufferClass self, GlibString string) => Attr self string entryBufferText = newAttrFromStringProperty "text" -- | The length of the text in buffer. -- -- Allowed values: <= 65535 -- -- Default value: 0 -- -- * Available since Gtk+ version 2.18 -- entryBufferLength :: EntryBufferClass self => ReadAttr self Int entryBufferLength = readAttrFromIntProperty "length" -- | The maximum length of the text in the buffer. -- -- Allowed values: [0,65535] -- -- Default value: 0 -- -- * Available since Gtk+ version 2.18 -- entryBufferMaxLength :: EntryBufferClass self => Attr self Int entryBufferMaxLength = newAttrFromIntProperty "max-length" -------------------- -- Signals -- | -- -- * Available since Gtk+ version 2.18 -- entryBufferInsertedText :: (EntryBufferClass self, GlibString string) => Signal self (Int -> string -> Int -> IO ()) entryBufferInsertedText = Signal (connect_INT_GLIBSTRING_INT__NONE "inserted_text") -- | -- -- * Available since Gtk+ version 2.18 -- entryBufferDeletedText :: EntryBufferClass self => Signal self (Int -> Int -> IO ()) entryBufferDeletedText = Signal (connect_INT_INT__NONE "deleted_text") #endif gtk-0.15.9/Graphics/UI/Gtk/Entry/EntryCompletion.chs0000644000000000000000000005167307346545000020335 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget EntryCompletion -- -- Author : Duncan Coutts -- -- Created: 24 April 2004 -- -- Copyright (C) 2004-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) -- -- Completion functionality for 'Entry' -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Entry.EntryCompletion ( -- * Detail -- -- | 'EntryCompletion' is an auxiliary object to be used in conjunction with -- 'Entry' to provide the completion functionality. It implements the -- 'CellLayout' interface, to allow the user to add extra cells to the -- 'TreeView' with completion matches. -- -- \"Completion functionality\" means that when the user modifies the -- text in the entry, 'EntryCompletion' checks which rows in the model -- match the current content of the entry, and displays a list of -- matches. By default, the matching is done by comparing the entry -- text case-insensitively against the text in a model (see -- 'Graphics.UI.Gtk.Entry.entryCompletionSetTextModel'), but this can -- be overridden with a custom match function (see -- 'entryCompletionSetMatchFunc'). -- -- When the user selects a completion, the content of the entry is updated. -- By default, the content of the entry is replaced by the text column of the -- model, but this can be overridden by connecting to the 'matchSelected' -- signal and updating the entry in the signal handler. Note that you should -- return @True@ from the signal handler to suppress the default behaviour. -- -- To add completion functionality to an entry, use -- 'Graphics.UI.Gtk.Entry.Entry.entrySetCompletion'. -- -- In addition to regular completion matches, which will be inserted into -- the entry when they are selected, 'EntryCompletion' also allows to display -- \"actions\" in the popup window. Their appearance is similar to menu items, -- to differentiate them clearly from completion strings. When an action is -- selected, the 'completionActionActivated' signal is emitted. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----EntryCompletion -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types EntryCompletion, EntryCompletionClass, castToEntryCompletion, gTypeEntryCompletion, toEntryCompletion, -- * Constructors entryCompletionNew, -- * Methods entryCompletionGetEntry, entryCompletionSetModel, entryCompletionGetModel, entryCompletionSetTextModel, entryCompletionSetMatchFunc, entryCompletionSetMinimumKeyLength, entryCompletionGetMinimumKeyLength, entryCompletionComplete, entryCompletionInsertActionText, entryCompletionInsertActionMarkup, entryCompletionDeleteAction, entryCompletionSetTextColumn, #if GTK_CHECK_VERSION(2,6,0) entryCompletionInsertPrefix, entryCompletionGetTextColumn, entryCompletionSetInlineCompletion, entryCompletionGetInlineCompletion, entryCompletionSetPopupCompletion, entryCompletionGetPopupCompletion, #endif #if GTK_CHECK_VERSION(2,8,0) entryCompletionSetPopupSetWidth, entryCompletionGetPopupSetWidth, entryCompletionSetPopupSingleMatch, entryCompletionGetPopupSingleMatch, #endif -- * Attributes entryCompletionModel, entryCompletionMinimumKeyLength, #if GTK_CHECK_VERSION(2,6,0) entryCompletionTextColumn, entryCompletionInlineCompletion, entryCompletionPopupCompletion, #endif #if GTK_CHECK_VERSION(2,8,0) entryCompletionPopupSetWidth, entryCompletionPopupSingleMatch, #endif -- * Signals #if GTK_CHECK_VERSION(2,6,0) insertPrefix, #endif completionActionActivated, matchSelected, -- * Deprecated #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,6,0) onInsertPrefix, afterInsertPrefix, #endif onActionActivated, afterActionActivated, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.ModelView.Types#} (TreeIter, peekTreeIter, TypedTreeModelClass) {#import Graphics.UI.Gtk.ModelView.CustomStore#} (customStoreSetColumn) {#import Graphics.UI.Gtk.ModelView.TreeModel#} (ColumnId(..), makeColumnIdString, columnIdToNumber) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'EntryCompletion' object. -- entryCompletionNew :: IO EntryCompletion entryCompletionNew = wrapNewGObject mkEntryCompletion $ {# call gtk_entry_completion_new #} -------------------- -- Methods -- | Gets the entry @completion@ has been attached to. -- entryCompletionGetEntry :: EntryCompletion -> IO (Maybe Entry) -- ^ returns the entry @completion@ has been attached to. entryCompletionGetEntry self = maybeNull (makeNewObject mkEntry) $ liftM (castPtr :: Ptr Widget -> Ptr Entry) $ {# call gtk_entry_completion_get_entry #} self -- | Sets the model for a 'EntryCompletion'. If @completion@ already has a -- model set, it will remove it before setting the new model. If model is -- @Nothing@, then it will unset the model. -- entryCompletionSetModel :: TreeModelClass model => EntryCompletion -> Maybe model -- ^ @model@ - The 'TreeModel'. -> IO () entryCompletionSetModel self model = {# call gtk_entry_completion_set_model #} self (maybe (TreeModel nullForeignPtr) toTreeModel model) -- | Returns the model the 'EntryCompletion' is using as data source. Returns -- @Nothing@ if the model is unset. -- entryCompletionGetModel :: EntryCompletion -> IO (Maybe TreeModel) -- ^ returns A 'TreeModel', or @Nothing@ if none is -- currently being used. entryCompletionGetModel self = maybeNull (makeNewGObject mkTreeModel) $ {# call gtk_entry_completion_get_model #} self -- | Convenience function for setting up the most used case of this code: a -- completion list with just strings. This function will set up @completion@ to -- have a list displaying all (and just) strings in the completion list, and to -- get those strings from @model@. This functions creates and adds a -- 'CellRendererText' which retrieves its content from the given model. -- entryCompletionSetTextModel :: (TreeModelClass (model string), TypedTreeModelClass model, GlibString string) => EntryCompletion -- ^ @completion@ -> model string -- ^ the model containing 'string's -> IO () entryCompletionSetTextModel self model = do let strCol = makeColumnIdString 0 customStoreSetColumn model strCol id set self [entryCompletionTextColumn := strCol] -- | Sets the match function for @completion@ to be @func@. The match function -- is used to determine if a row should or should not be in the completion -- list. -- -- * The passed-in function decides whether the row indicated by the -- 'TreeIter' matches a given key, and should be displayed as a possible -- completion for key. Note that the key is normalized and case-folded. -- Normalization will standardizing such issues as whether a character -- with an accent is represented as a base character and combining accent -- or as a single precomposed character. If this is not appropriate you -- can extract the original text from the entry. -- entryCompletionSetMatchFunc :: GlibString string => EntryCompletion -> (string -> TreeIter -> IO Bool) -> IO () entryCompletionSetMatchFunc ec handler = do hPtr <- mkHandler_GtkEntryCompletionMatchFunc (\_ keyPtr iterPtr _ -> do key <- peekUTFString keyPtr iter <- peek iterPtr liftM fromBool $ handler key iter) {# call gtk_entry_completion_set_match_func #} ec (castFunPtr hPtr) (castFunPtrToPtr hPtr) destroyFunPtr ------------------------------------------------- -- Callback stuff for entryCompletionSetMatchFunc -- type GtkEntryCompletionMatchFunc = Ptr EntryCompletion -> --GtkEntryCompletion *completion Ptr CChar -> --const gchar *key Ptr TreeIter -> --GtkTreeIter *iter Ptr () -> --gpointer user_data IO {#type gboolean#} foreign import ccall "wrapper" mkHandler_GtkEntryCompletionMatchFunc :: GtkEntryCompletionMatchFunc -> IO (FunPtr GtkEntryCompletionMatchFunc) -- | Requires the length of the search key for @completion@ to be at least -- @length@. This is useful for long lists, where completing using a small key -- takes a lot of time and will come up with meaningless results anyway (ie, a -- too large dataset). -- entryCompletionSetMinimumKeyLength :: EntryCompletion -> Int -- ^ @length@ - The minimum length of the key in order to -- start completing. -> IO () entryCompletionSetMinimumKeyLength self length = {# call gtk_entry_completion_set_minimum_key_length #} self (fromIntegral length) -- | Returns the minimum key length as set for @completion@. -- entryCompletionGetMinimumKeyLength :: EntryCompletion -> IO Int -- ^ returns The currently used minimum key length. entryCompletionGetMinimumKeyLength self = liftM fromIntegral $ {# call gtk_entry_completion_get_minimum_key_length #} self -- | Requests a completion operation, or in other words a refiltering of the -- current list with completions, using the current key. The completion list -- view will be updated accordingly. -- entryCompletionComplete :: EntryCompletion -> IO () entryCompletionComplete self = {# call gtk_entry_completion_complete #} self -- | Inserts an action in @completion@'s action item list at position @index@ -- with text @text@. If you want the action item to have markup, use -- 'entryCompletionInsertActionMarkup'. -- entryCompletionInsertActionText :: GlibString string => EntryCompletion -> Int -- ^ @index@ - The index of the item to insert. -> string -- ^ @text@ - Text of the item to insert. -> IO () entryCompletionInsertActionText self index text = withUTFString text $ \textPtr -> {# call gtk_entry_completion_insert_action_text #} self (fromIntegral index) textPtr -- | Inserts an action in @completion@'s action item list at position @index@ -- with markup @markup@. -- entryCompletionInsertActionMarkup :: GlibString string => EntryCompletion -> Int -- ^ @index@ - The index of the item to insert. -> string -- ^ @markup@ - Markup of the item to insert. -> IO () entryCompletionInsertActionMarkup self index markup = withUTFString markup $ \markupPtr -> {# call gtk_entry_completion_insert_action_markup #} self (fromIntegral index) markupPtr -- | Deletes the action at @index@ from @completion@'s action list. -- entryCompletionDeleteAction :: EntryCompletion -> Int -- ^ @index@ - The index of the item to Delete. -> IO () entryCompletionDeleteAction self index = {# call gtk_entry_completion_delete_action #} self (fromIntegral index) -- | Convenience function for setting up the most used case of this code: a -- completion list with just strings. This function will set up @completion@ to -- have a list displaying all (and just) strings in the completion list, and to -- get those strings from @column@ in the model of @completion@. -- -- This functions creates and adds a 'CellRendererText' for the selected -- column. -- entryCompletionSetTextColumn :: GlibString string => EntryCompletion -> ColumnId row string -- ^ @column@ - The column in the model of @completion@ to -- get strings from. -> IO () entryCompletionSetTextColumn self column = {# call gtk_entry_completion_set_text_column #} self ((fromIntegral . columnIdToNumber) column) #if GTK_CHECK_VERSION(2,6,0) -- | Requests a prefix insertion. -- -- * Available since Gtk+ version 2.6 -- entryCompletionInsertPrefix :: EntryCompletion -> IO () entryCompletionInsertPrefix self = {# call gtk_entry_completion_insert_prefix #} self -- | Returns the column in the model of the completion to get strings from. -- -- * Available since Gtk+ version 2.6 -- entryCompletionGetTextColumn :: GlibString string => EntryCompletion -> IO (ColumnId row string) -- ^ returns the column containing the strings entryCompletionGetTextColumn self = liftM (makeColumnIdString . fromIntegral) $ {# call gtk_entry_completion_get_text_column #} self -- | Sets whether the common prefix of the possible completions should be -- automatically inserted in the entry. -- -- * Available since Gtk+ version 2.6 -- entryCompletionSetInlineCompletion :: EntryCompletion -> Bool -- ^ @inlineCompletion@ - @True@ to do inline completion -> IO () entryCompletionSetInlineCompletion self inlineCompletion = {# call gtk_entry_completion_set_inline_completion #} self (fromBool inlineCompletion) -- | Returns whether the common prefix of the possible completions should be -- automatically inserted in the entry. -- -- * Available since Gtk+ version 2.6 -- entryCompletionGetInlineCompletion :: EntryCompletion -> IO Bool -- ^ returns @True@ if inline completion is turned on entryCompletionGetInlineCompletion self = liftM toBool $ {# call gtk_entry_completion_get_inline_completion #} self -- | Sets whether the completions should be presented in a popup window. -- -- * Available since Gtk+ version 2.6 -- entryCompletionSetPopupCompletion :: EntryCompletion -> Bool -- ^ @popupCompletion@ - @True@ to do popup completion -> IO () entryCompletionSetPopupCompletion self popupCompletion = {# call gtk_entry_completion_set_popup_completion #} self (fromBool popupCompletion) -- | Returns whether the completions should be presented in a popup window. -- -- * Available since Gtk+ version 2.6 -- entryCompletionGetPopupCompletion :: EntryCompletion -> IO Bool -- ^ returns @True@ if popup completion is turned on entryCompletionGetPopupCompletion self = liftM toBool $ {# call gtk_entry_completion_get_popup_completion #} self #endif #if GTK_CHECK_VERSION(2,8,0) -- | Sets whether the completion popup window will be resized to be the same -- width as the entry. -- -- * Available since Gtk+ version 2.8 -- entryCompletionSetPopupSetWidth :: EntryCompletion -> Bool -- ^ @popupSetWidth@ - @True@ to make the width of the -- popup the same as the entry -> IO () entryCompletionSetPopupSetWidth self popupSetWidth = {# call gtk_entry_completion_set_popup_set_width #} self (fromBool popupSetWidth) -- | Returns whether the completion popup window will be resized to the width -- of the entry. -- -- * Available since Gtk+ version 2.8 -- entryCompletionGetPopupSetWidth :: EntryCompletion -> IO Bool -- ^ returns @True@ if the popup window will be resized to -- the width of the entry entryCompletionGetPopupSetWidth self = liftM toBool $ {# call gtk_entry_completion_get_popup_set_width #} self -- | Sets whether the completion popup window will appear even if there is -- only a single match. You may want to set this to @False@ if you are using -- inline completion. -- -- * Available since Gtk+ version 2.8 -- entryCompletionSetPopupSingleMatch :: EntryCompletion -> Bool -- ^ @popupSingleMatch@ - @True@ if the popup should -- appear even for a single match -> IO () entryCompletionSetPopupSingleMatch self popupSingleMatch = {# call gtk_entry_completion_set_popup_single_match #} self (fromBool popupSingleMatch) -- | Returns whether the completion popup window will appear even if there is -- only a single match. -- -- * Available since Gtk+ version 2.8 -- entryCompletionGetPopupSingleMatch :: EntryCompletion -> IO Bool -- ^ returns @True@ if the popup window will appear -- regardless of the number of matches. entryCompletionGetPopupSingleMatch self = liftM toBool $ {# call gtk_entry_completion_get_popup_single_match #} self #endif -------------------- -- Attributes -- | The model to find matches in. -- entryCompletionModel :: TreeModelClass model => ReadWriteAttr EntryCompletion (Maybe TreeModel) (Maybe model) entryCompletionModel = newAttr entryCompletionGetModel entryCompletionSetModel -- | Minimum length of the search key in order to look up matches. -- -- Allowed values: >= 0 -- -- Default value: 1 -- entryCompletionMinimumKeyLength :: Attr EntryCompletion Int entryCompletionMinimumKeyLength = newAttr entryCompletionGetMinimumKeyLength entryCompletionSetMinimumKeyLength #if GTK_CHECK_VERSION(2,6,0) -- | The column of the model containing the strings. -- -- Default value: 'Graphics.UI.Gtk.ModelView.CustomStore.invalidColumnId' -- entryCompletionTextColumn :: GlibString string => Attr EntryCompletion (ColumnId row string) entryCompletionTextColumn = newAttr entryCompletionGetTextColumn entryCompletionSetTextColumn -- | Determines whether the common prefix of the possible completions should -- be inserted automatically in the entry. Note that this requires text-column -- to be set, even if you are using a custom match function. -- -- Default value: @False@ -- entryCompletionInlineCompletion :: Attr EntryCompletion Bool entryCompletionInlineCompletion = newAttr entryCompletionGetInlineCompletion entryCompletionSetInlineCompletion -- | Determines whether the possible completions should be shown in a popup -- window. -- -- Default value: @True@ -- entryCompletionPopupCompletion :: Attr EntryCompletion Bool entryCompletionPopupCompletion = newAttr entryCompletionGetPopupCompletion entryCompletionSetPopupCompletion #endif #if GTK_CHECK_VERSION(2,8,0) -- | Determines whether the completions popup window will be resized to the -- width of the entry. -- -- Default value: @True@ -- entryCompletionPopupSetWidth :: Attr EntryCompletion Bool entryCompletionPopupSetWidth = newAttr entryCompletionGetPopupSetWidth entryCompletionSetPopupSetWidth -- | Determines whether the completions popup window will shown for a single -- possible completion. You probably want to set this to @False@ if you are -- using inline completion. -- -- Default value: @True@ -- entryCompletionPopupSingleMatch :: Attr EntryCompletion Bool entryCompletionPopupSingleMatch = newAttr entryCompletionGetPopupSingleMatch entryCompletionSetPopupSingleMatch #endif -------------------- -- Signals #if GTK_CHECK_VERSION(2,6,0) -- %hash c:f4eb d:9ccf -- | Gets emitted when the inline autocompletion is triggered. The default -- behaviour is to make the entry display the whole prefix and select the newly -- inserted part. -- -- Applications may connect to this signal in order to insert only a smaller -- part of the @prefix@ into the entry - e.g. the entry used in the -- 'FileChooser' inserts only the part of the prefix up to the next \'\/\'. -- -- * Available since Gtk+ version 2.6 -- insertPrefix :: (EntryCompletionClass self, GlibString string) => Signal self (string -> IO Bool) insertPrefix = Signal (connect_GLIBSTRING__BOOL "insert-prefix") #endif -- %hash c:d50e d:ad7e -- | Gets emitted when a match from the list is selected. The default -- behaviour is to replace the contents of the entry with the contents of the -- text column in the row pointed to by @iter@. -- matchSelected :: EntryCompletionClass self => Signal self (TreeModel -> TreeIter -> IO Bool) matchSelected = Signal (connect_OBJECT_BOXED__BOOL "match-selected" peekTreeIter) -- %hash c:21ac d:2cbc -- | Gets emitted when an action is activated. -- completionActionActivated :: EntryCompletionClass self => Signal self (Int -> IO ()) completionActionActivated = Signal (connect_INT__NONE "action-activated") #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,6,0) -- | Gets emitted when the inline autocompletion is triggered. The default -- behaviour is to make the entry display the whole prefix and select the newly -- inserted part. -- -- Applications may connect to this signal in order to insert only a smaller -- part of the @prefix@ into the entry - e.g. the entry used in the -- 'FileChooser' inserts only the part of the prefix up to the next \'\/\'. -- onInsertPrefix, afterInsertPrefix :: (EntryCompletionClass self, GlibString string) => self -> (string -> IO Bool) -> IO (ConnectId self) onInsertPrefix = connect_GLIBSTRING__BOOL "insert_prefix" False afterInsertPrefix = connect_GLIBSTRING__BOOL "insert_prefix" True #endif -- | Gets emitted when an action is activated. -- onActionActivated, afterActionActivated :: EntryCompletionClass self => self -> (Int -> IO ()) -> IO (ConnectId self) onActionActivated = connect_INT__NONE "action_activated" False afterActionActivated = connect_INT__NONE "action_activated" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Entry/HScale.chs0000644000000000000000000000577707346545000016345 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HScale -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A horizontal slider widget for selecting a value from a range -- module Graphics.UI.Gtk.Entry.HScale ( -- * Detail -- -- | The 'HScale' widget is used to allow the user to select a value using a -- horizontal slider. To create one, use 'hScaleNewWithRange'. -- -- The position to show the current value, and the number of decimal places -- shown can be set using the parent 'Scale' class's functions. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Range' -- | +----'Scale' -- | +----HScale -- @ -- * Types HScale, HScaleClass, castToHScale, gTypeHScale, toHScale, -- * Constructors hScaleNew, hScaleNewWithRange, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'HScale'. -- hScaleNew :: Adjustment -- ^ @adjustment@ - the 'Adjustment' which sets the range of -- the scale. -> IO HScale hScaleNew adjustment = makeNewObject mkHScale $ liftM (castPtr :: Ptr Widget -> Ptr HScale) $ {# call unsafe hscale_new #} adjustment -- | Creates a new horizontal scale widget that lets the user input a number -- between @min@ and @max@ (including @min@ and @max@) with the increment -- @step@. @step@ must be nonzero; it's the distance the slider moves when -- using the arrow keys to adjust the scale value. -- -- Note that the way in which the precision is derived works best if @step@ -- is a power of ten. If the resulting precision is not suitable for your -- needs, use 'Graphics.UI.Gtk.Abstract.Scale.scaleSetDigits' to correct it. -- hScaleNewWithRange :: Double -- ^ @min@ - minimum value -> Double -- ^ @max@ - maximum value -> Double -- ^ @step@ - step increment (tick size) used with keyboard -- shortcuts -> IO HScale hScaleNewWithRange min max step = makeNewObject mkHScale $ liftM (castPtr :: Ptr Widget -> Ptr HScale) $ {# call unsafe hscale_new_with_range #} (realToFrac min) (realToFrac max) (realToFrac step) gtk-0.15.9/Graphics/UI/Gtk/Entry/SpinButton.chs0000644000000000000000000004073207346545000017301 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget SpinButton -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Retrieve an integer or floating-point number from the user -- module Graphics.UI.Gtk.Entry.SpinButton ( -- * Detail -- -- | A 'SpinButton' is an ideal way to allow the user to set the value of some -- attribute. Rather than having to directly type a number into a 'Entry', -- 'SpinButton' allows the user to click on one of two arrows to increment or -- decrement the displayed value. A value can still be typed in, with the bonus -- that it can be checked to ensure it is in a given range. -- -- The main properties of a 'SpinButton' are through a 'Adjustment'. See the -- 'Adjustment' section for more details about an adjustment's properties. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Entry' -- | +----SpinButton -- @ -- * Types SpinButton, SpinButtonClass, castToSpinButton, gTypeSpinButton, toSpinButton, -- * Constructors spinButtonNew, spinButtonNewWithRange, -- * Methods spinButtonConfigure, spinButtonSetAdjustment, spinButtonGetAdjustment, spinButtonSetDigits, spinButtonGetDigits, spinButtonSetIncrements, spinButtonGetIncrements, spinButtonSetRange, spinButtonGetRange, spinButtonGetValue, spinButtonGetValueAsInt, spinButtonSetValue, SpinButtonUpdatePolicy(..), spinButtonSetUpdatePolicy, spinButtonGetUpdatePolicy, spinButtonSetNumeric, spinButtonGetNumeric, SpinType(..), spinButtonSpin, spinButtonSetWrap, spinButtonGetWrap, spinButtonSetSnapToTicks, spinButtonGetSnapToTicks, spinButtonUpdate, -- * Attributes spinButtonAdjustment, spinButtonClimbRate, spinButtonDigits, spinButtonSnapToTicks, spinButtonNumeric, spinButtonWrap, spinButtonUpdatePolicy, spinButtonValue, -- * Signals onInput, afterInput, onOutput, afterOutput, onValueSpinned, afterValueSpinned ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Structs (inputError) import Graphics.UI.Gtk.General.Enums (SpinButtonUpdatePolicy(..), SpinType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Interfaces instance EditableClass SpinButton -------------------- -- Constructors -- | Creates a new 'SpinButton'. -- spinButtonNew :: Adjustment -- ^ @adjustment@ - the 'Adjustment' object that this spin -- button should use. -> Double -- ^ @climbRate@ - specifies how much the spin button -- changes when an arrow is clicked on. -> Int -- ^ @digits@ - the number of decimal places to display. -> IO SpinButton spinButtonNew adjustment climbRate digits = makeNewObject mkSpinButton $ liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $ {# call spin_button_new #} adjustment (realToFrac climbRate) (fromIntegral digits) -- | This is a convenience constructor that allows creation of a numeric -- 'SpinButton' without manually creating an adjustment. The value is initially -- set to the minimum value and a page increment of 10 * @step@ is the default. -- The precision of the spin button is equivalent to the precision of @step@. -- -- Note that the way in which the precision is derived works best if @step@ -- is a power of ten. If the resulting precision is not suitable for your -- needs, use 'spinButtonSetDigits' to correct it. -- spinButtonNewWithRange :: Double -- ^ @min@ - Minimum allowable value -> Double -- ^ @max@ - Maximum allowable value -> Double -- ^ @step@ - Increment added or subtracted by spinning the -- widget -> IO SpinButton spinButtonNewWithRange min max step = makeNewObject mkSpinButton $ liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $ {# call unsafe spin_button_new_with_range #} (realToFrac min) (realToFrac max) (realToFrac step) -------------------- -- Methods -- | Changes the properties of an existing spin button. The adjustment, climb -- rate, and number of decimal places are all changed accordingly, after this -- function call. -- spinButtonConfigure :: SpinButtonClass self => self -> Adjustment -- ^ @adjustment@ - a 'Adjustment'. -> Double -- ^ @climbRate@ - the new climb rate. -> Int -- ^ @digits@ - the number of decimal places to display in the -- spin button. -> IO () spinButtonConfigure self adjustment climbRate digits = {# call spin_button_configure #} (toSpinButton self) adjustment (realToFrac climbRate) (fromIntegral digits) -- | Replaces the 'Adjustment' associated with the spin button. -- spinButtonSetAdjustment :: SpinButtonClass self => self -> Adjustment -- ^ @adjustment@ - a 'Adjustment' to replace the existing -- adjustment -> IO () spinButtonSetAdjustment self adjustment = {# call spin_button_set_adjustment #} (toSpinButton self) adjustment -- | Get the adjustment associated with a 'SpinButton' -- spinButtonGetAdjustment :: SpinButtonClass self => self -> IO Adjustment -- ^ returns the 'Adjustment' of @spinButton@ spinButtonGetAdjustment self = makeNewObject mkAdjustment $ {# call unsafe spin_button_get_adjustment #} (toSpinButton self) -- | Set the precision to be displayed by @spinButton@. Up to 20 digit -- precision is allowed. -- spinButtonSetDigits :: SpinButtonClass self => self -> Int -- ^ @digits@ - the number of digits after the decimal point to be -- displayed for the spin button's value -> IO () spinButtonSetDigits self digits = {# call spin_button_set_digits #} (toSpinButton self) (fromIntegral digits) -- | Fetches the precision of @spinButton@. See 'spinButtonSetDigits'. -- spinButtonGetDigits :: SpinButtonClass self => self -> IO Int -- ^ returns the current precision spinButtonGetDigits self = liftM fromIntegral $ {# call spin_button_get_digits #} (toSpinButton self) -- | Sets the step and page increments for the spin button. This affects how -- quickly the value changes when the spin button's arrows are activated. -- spinButtonSetIncrements :: SpinButtonClass self => self -> Double -- ^ @step@ - increment applied for a button 1 press. -> Double -- ^ @page@ - increment applied for a button 2 press. -> IO () spinButtonSetIncrements self step page = {# call spin_button_set_increments #} (toSpinButton self) (realToFrac step) (realToFrac page) -- | Gets the current step and page the increments used by the spin button. See -- 'spinButtonSetIncrements'. -- spinButtonGetIncrements :: SpinButtonClass self => self -> IO (Double, Double) -- ^ @(step, page)@ - step increment and page increment spinButtonGetIncrements self = alloca $ \stepPtr -> alloca $ \pagePtr -> do {# call unsafe spin_button_get_increments #} (toSpinButton self) stepPtr pagePtr step <- peek stepPtr page <- peek pagePtr return (realToFrac step, realToFrac page) -- | Sets the minimum and maximum allowable values for the spin button -- spinButtonSetRange :: SpinButtonClass self => self -> Double -- ^ @min@ - minimum allowable value -> Double -- ^ @max@ - maximum allowable value -> IO () spinButtonSetRange self min max = {# call spin_button_set_range #} (toSpinButton self) (realToFrac min) (realToFrac max) -- | Gets the range allowed for the spin button. See 'spinButtonSetRange'. -- spinButtonGetRange :: SpinButtonClass self => self -> IO (Double, Double) -- ^ @(min, max)@ - minimum and maximum allowed value spinButtonGetRange self = alloca $ \minPtr -> alloca $ \maxPtr -> do {# call unsafe spin_button_get_range #} (toSpinButton self) minPtr maxPtr min <- peek minPtr max <- peek maxPtr return (realToFrac min, realToFrac max) -- | Get the value of the spin button as a floating point value. -- spinButtonGetValue :: SpinButtonClass self => self -> IO Double spinButtonGetValue self = liftM realToFrac $ {# call unsafe spin_button_get_value #} (toSpinButton self) -- | Get the value of the spin button as an integral value. -- spinButtonGetValueAsInt :: SpinButtonClass self => self -> IO Int spinButtonGetValueAsInt self = liftM fromIntegral $ {# call unsafe spin_button_get_value_as_int #} (toSpinButton self) -- | Set the value of the spin button. -- spinButtonSetValue :: SpinButtonClass self => self -> Double -> IO () spinButtonSetValue self value = {# call spin_button_set_value #} (toSpinButton self) (realToFrac value) -- | Sets the update behavior of a spin button. This determines whether the -- spin button is always updated or only when a valid value is set. -- spinButtonSetUpdatePolicy :: SpinButtonClass self => self -> SpinButtonUpdatePolicy -- ^ @policy@ - a 'SpinButtonUpdatePolicy' value -> IO () spinButtonSetUpdatePolicy self policy = {# call spin_button_set_update_policy #} (toSpinButton self) ((fromIntegral . fromEnum) policy) -- | Gets the update behavior of a spin button. See -- 'spinButtonSetUpdatePolicy'. -- spinButtonGetUpdatePolicy :: SpinButtonClass self => self -> IO SpinButtonUpdatePolicy -- ^ returns the current update policy spinButtonGetUpdatePolicy self = liftM (toEnum . fromIntegral) $ {# call unsafe spin_button_get_update_policy #} (toSpinButton self) -- | Sets the flag that determines if non-numeric text can be typed into the -- spin button. -- spinButtonSetNumeric :: SpinButtonClass self => self -> Bool -- ^ @numeric@ - flag indicating if only numeric entry is allowed. -> IO () spinButtonSetNumeric self numeric = {# call spin_button_set_numeric #} (toSpinButton self) (fromBool numeric) -- | Returns whether non-numeric text can be typed into the spin button. See -- 'spinButtonSetNumeric'. -- spinButtonGetNumeric :: SpinButtonClass self => self -> IO Bool -- ^ returns @True@ if only numeric text can be entered spinButtonGetNumeric self = liftM toBool $ {# call unsafe spin_button_get_numeric #} (toSpinButton self) -- | Increment or decrement a spin button's value in a specified direction by -- a specified amount. -- spinButtonSpin :: SpinButtonClass self => self -> SpinType -- ^ @direction@ - a 'SpinType' indicating the direction to spin. -> Double -- ^ @increment@ - step increment to apply in the specified -- direction. -> IO () spinButtonSpin self direction increment = {# call spin_button_spin #} (toSpinButton self) ((fromIntegral . fromEnum) direction) (realToFrac increment) -- | Sets the flag that determines if a spin button value wraps around to the -- opposite limit when the upper or lower limit of the range is exceeded. -- spinButtonSetWrap :: SpinButtonClass self => self -> Bool -- ^ @wrap@ - a flag indicating if wrapping behavior is performed. -> IO () spinButtonSetWrap self wrap = {# call spin_button_set_wrap #} (toSpinButton self) (fromBool wrap) -- | Returns whether the spin button's value wraps around to the opposite -- limit when the upper or lower limit of the range is exceeded. See -- 'spinButtonSetWrap'. -- spinButtonGetWrap :: SpinButtonClass self => self -> IO Bool -- ^ returns @True@ if the spin button wraps around spinButtonGetWrap self = liftM toBool $ {# call spin_button_get_wrap #} (toSpinButton self) -- | Sets the policy as to whether values are corrected to the nearest step -- increment when a spin button is activated after providing an invalid value. -- spinButtonSetSnapToTicks :: SpinButtonClass self => self -> Bool -- ^ @snapToTicks@ - a flag indicating if invalid values should be -- corrected. -> IO () spinButtonSetSnapToTicks self snapToTicks = {# call spin_button_set_snap_to_ticks #} (toSpinButton self) (fromBool snapToTicks) -- | Returns whether the values are corrected to the nearest step. See -- 'spinButtonSetSnapToTicks'. -- spinButtonGetSnapToTicks :: SpinButtonClass self => self -> IO Bool -- ^ returns @True@ if values are snapped to the nearest step. spinButtonGetSnapToTicks self = liftM toBool $ {# call unsafe spin_button_get_snap_to_ticks #} (toSpinButton self) -- | Manually force an update of the spin button. -- spinButtonUpdate :: SpinButtonClass self => self -> IO () spinButtonUpdate self = {# call spin_button_update #} (toSpinButton self) -------------------- -- Attributes -- | The adjustment that holds the value of the spinbutton. -- spinButtonAdjustment :: SpinButtonClass self => Attr self Adjustment spinButtonAdjustment = newAttr spinButtonGetAdjustment spinButtonSetAdjustment -- | The acceleration rate when you hold down a button. -- -- Allowed values: >= 0 -- -- Default value: 0 -- spinButtonClimbRate :: SpinButtonClass self => Attr self Double spinButtonClimbRate = newAttrFromDoubleProperty "climb-rate" -- | The number of decimal places to display. -- -- Allowed values: \<= 20 -- -- Default value: 0 -- spinButtonDigits :: SpinButtonClass self => Attr self Int spinButtonDigits = newAttr spinButtonGetDigits spinButtonSetDigits -- | Whether erroneous values are automatically changed to a spin button's -- nearest step increment. -- -- Default value: @False@ -- spinButtonSnapToTicks :: SpinButtonClass self => Attr self Bool spinButtonSnapToTicks = newAttr spinButtonGetSnapToTicks spinButtonSetSnapToTicks -- | Whether non-numeric characters should be ignored. -- -- Default value: @False@ -- spinButtonNumeric :: SpinButtonClass self => Attr self Bool spinButtonNumeric = newAttr spinButtonGetNumeric spinButtonSetNumeric -- | Whether a spin button should wrap upon reaching its limits. -- -- Default value: @False@ -- spinButtonWrap :: SpinButtonClass self => Attr self Bool spinButtonWrap = newAttr spinButtonGetWrap spinButtonSetWrap -- | Whether the spin button should update always, or only when the value is -- legal. -- -- Default value: 'UpdateAlways' -- spinButtonUpdatePolicy :: SpinButtonClass self => Attr self SpinButtonUpdatePolicy spinButtonUpdatePolicy = newAttr spinButtonGetUpdatePolicy spinButtonSetUpdatePolicy -- | Reads the current value, or sets a new value. -- -- Default value: 0 -- spinButtonValue :: SpinButtonClass self => Attr self Double spinButtonValue = newAttr spinButtonGetValue spinButtonSetValue -------------------- -- Signals -- | Install a custom input handler. -- -- * This signal is called upon each time the value of the SpinButton is set -- by spinButtonSetValue. The function can return Nothing if the value is no -- good. -- onInput, afterInput :: SpinButtonClass sb => sb -> (IO (Maybe Double)) -> IO (ConnectId sb) onInput sb user = connect_PTR__INT "input" False sb $ \dPtr -> do mVal <- user case mVal of (Just val) -> do poke dPtr ((realToFrac val)::{#type gdouble#}) return 0 Nothing -> return (fromIntegral inputError) afterInput sb user = connect_PTR__INT "input" True sb $ \dPtr -> do mVal <- user case mVal of (Just val) -> do poke dPtr ((realToFrac val)::{#type gdouble#}) return 0 Nothing -> return (fromIntegral inputError) -- | Install a custom output handler. -- -- * This handler makes it possible to query the current value and to render -- something completely different to the screen using entrySetText. The -- return value must be False in order to let the default output routine run -- after this signal returns. -- onOutput, afterOutput :: SpinButtonClass sb => sb -> IO Bool -> IO (ConnectId sb) onOutput = connect_NONE__BOOL "output" False afterOutput = connect_NONE__BOOL "output" True -- | The value of the spin button has changed. -- onValueSpinned, afterValueSpinned :: SpinButtonClass sb => sb -> IO () -> IO (ConnectId sb) onValueSpinned = connect_NONE__NONE "value-changed" False afterValueSpinned = connect_NONE__NONE "value-changed" True gtk-0.15.9/Graphics/UI/Gtk/Entry/VScale.chs0000644000000000000000000000577107346545000016355 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VScale -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A vertical slider widget for selecting a value from a range -- module Graphics.UI.Gtk.Entry.VScale ( -- * Detail -- -- | The 'VScale' widget is used to allow the user to select a value using a -- vertical slider. To create one, use 'vScaleNewWithRange'. -- -- The position to show the current value, and the number of decimal places -- shown can be set using the parent 'Scale' class's functions. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Range' -- | +----'Scale' -- | +----VScale -- @ -- * Types VScale, VScaleClass, castToVScale, gTypeVScale, toVScale, -- * Constructors vScaleNew, vScaleNewWithRange, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'VScale'. -- vScaleNew :: Adjustment -- ^ @adjustment@ - the 'Adjustment' which sets the range of -- the scale. -> IO VScale vScaleNew adjustment = makeNewObject mkVScale $ liftM (castPtr :: Ptr Widget -> Ptr VScale) $ {# call unsafe vscale_new #} adjustment -- | Creates a new vertical scale widget that lets the user input a number -- between @min@ and @max@ (including @min@ and @max@) with the increment -- @step@. @step@ must be nonzero; it's the distance the slider moves when -- using the arrow keys to adjust the scale value. -- -- Note that the way in which the precision is derived works best if @step@ -- is a power of ten. If the resulting precision is not suitable for your -- needs, use 'Graphics.UI.Gtk.Abstract.Scale.scaleSetDigits' to correct it. -- vScaleNewWithRange :: Double -- ^ @min@ - minimum value -> Double -- ^ @max@ - maximum value -> Double -- ^ @step@ - step increment (tick size) used with keyboard -- shortcuts -> IO VScale vScaleNewWithRange min max step = makeNewObject mkVScale $ liftM (castPtr :: Ptr Widget -> Ptr VScale) $ {# call unsafe vscale_new_with_range #} (realToFrac min) (realToFrac max) (realToFrac step) gtk-0.15.9/Graphics/UI/Gtk/Gdk/0000755000000000000000000000000007346545000014073 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Gdk/AppLaunchContext.chs0000644000000000000000000001130007346545000020005 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget AppLaunchContext -- -- Author : Andy Stewart -- -- Created: 30 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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 Graphics.UI.Gtk.Gdk.AppLaunchContext ( #if GTK_CHECK_VERSION(2,14,0) -- * Types AppLaunchContext, AppLaunchContextClass, castToAppLaunchContext, gTypeAppLaunchContext, toAppLaunchContext, -- * Constructors appLaunchContextNew, -- * Methods appLaunchContextSetDisplay, appLaunchContextSetScreen, appLaunchContextSetDesktop, appLaunchContextSetTimestamp, appLaunchContextSetIconName, #ifdef HAVE_GIO appLaunchContextSetIcon, #endif #endif ) where import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Gdk.EventM (TimeStamp) {#import Graphics.UI.Gtk.Types#} #ifdef HAVE_GIO {#import System.GIO.Types#} (Icon (..), IconClass, toIcon) #endif {# context lib="gdk" prefix="gdk" #} #if GTK_CHECK_VERSION(2,14,0) -------------------- -- Constructors -- | Creates a new 'AppLaunchContext'. appLaunchContextNew :: IO AppLaunchContext appLaunchContextNew = wrapNewGObject mkAppLaunchContext $ {# call gdk_app_launch_context_new #} -------------------- -- Methods -- | Sets the workspace on which applications will be launched when using this context when running under -- a window manager that supports multiple workspaces, as described in the Extended Window Manager -- Hints. -- -- When the workspace is not specified or desktop is set to -1, it is up to the window manager to pick -- one, typically it will be the current workspace. appLaunchContextSetDesktop :: AppLaunchContext -> Int -> IO () appLaunchContextSetDesktop self desktop = {# call gdk_app_launch_context_set_desktop #} self (fromIntegral desktop) -- | Sets the display on which applications will be launched when using this context. See also -- 'appLaunchContextSetScreen'. appLaunchContextSetDisplay :: AppLaunchContext -> Display -> IO () appLaunchContextSetDisplay self display = {# call gdk_app_launch_context_set_display #} self display #ifdef HAVE_GIO -- | Sets the icon for applications that are launched with this context. -- -- Window Managers can use this information when displaying startup notification. appLaunchContextSetIcon :: IconClass icon => AppLaunchContext -> icon -> IO () appLaunchContextSetIcon self icon = {# call gdk_app_launch_context_set_icon #} self (toIcon icon) #endif -- | Sets the icon for applications that are launched with this context. The @iconName@ will be -- interpreted in the same way as the Icon field in desktop files. See also -- 'appLaunchContextSetIcon'. -- -- If both icon and @iconName@ are set, the @iconName@ takes priority. If neither icon or @iconName@ is -- set, the icon is taken from either the file that is passed to launched application or from the -- GAppInfo for the launched application itself. appLaunchContextSetIconName :: GlibString string => AppLaunchContext -> string -> IO () appLaunchContextSetIconName self iconName = withUTFString iconName $ \iconNamePtr -> {# call gdk_app_launch_context_set_icon_name #} self iconNamePtr -- | Sets the screen on which applications will be launched when using this context. See also -- 'appLaunchContextSetDisplay'. -- -- If both screen and display are set, the screen takes priority. If neither screen or display are set, -- the default screen and display are used. appLaunchContextSetScreen :: AppLaunchContext -> Screen -> IO () appLaunchContextSetScreen self screen = {# call gdk_app_launch_context_set_screen #} self screen -- | Sets the timestamp of context. The timestamp should ideally be taken from the event that triggered -- the launch. -- -- Window managers can use this information to avoid moving the focus to the newly launched application -- when the user is busy typing in another window. This is also known as 'focus stealing prevention'. appLaunchContextSetTimestamp :: AppLaunchContext -> TimeStamp -> IO () appLaunchContextSetTimestamp self timestamp = {# call gdk_app_launch_context_set_timestamp #} self (fromIntegral timestamp) #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/Cursor.chs0000644000000000000000000001444007346545000016052 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Cursor -- -- Author : Bit Connor -- Andy Stewart -- -- Created: 18 November 2007 -- -- Copyright (C) 2007 Bit Connor -- Copyright (C) 2009 Andy Stewart -- -- 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) -- -- Cursors | Standard and pixmap cursors. -- module Graphics.UI.Gtk.Gdk.Cursor ( -- * Types Cursor(..), -- * Enums CursorType(..), -- * Constructors cursorNew, -- * Methods #if GTK_MAJOR_VERSION < 3 cursorNewFromPixmap, #endif cursorNewFromPixbuf, cursorNewFromName, cursorNewForDisplay, cursorGetDisplay, cursorGetImage ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Structs (Color) #endif {#import Graphics.UI.Gtk.Types#} hiding (Arrow) {#context lib="gdk" prefix ="gdk"#} -------------------- -- Types {#pointer *GdkCursor as Cursor foreign newtype #} -------------------- -- Enums -- | Cursor types. {#enum GdkCursorType as CursorType {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Utils makeNewCursor :: Ptr Cursor -> IO Cursor makeNewCursor rPtr = do cursor <- newForeignPtr rPtr cursor_unref return (Cursor cursor) foreign import ccall unsafe "&gdk_cursor_unref" cursor_unref :: FinalizerPtr Cursor -------------------- -- Constructors -- | Creates a new cursor from the set of builtin cursors for the default display. -- See 'cursorNewForDisplay'. -- To make the cursor invisible, use 'BlankCursor'. cursorNew :: CursorType -- ^ @cursorType@ cursor to create -> IO Cursor -- ^ return a new 'Cursor' cursorNew cursorType = do cursorPtr <- {#call cursor_new#} $fromIntegral (fromEnum cursorType) makeNewCursor cursorPtr -------------------- -- Methods #if GTK_MAJOR_VERSION < 3 -- | Creates a new cursor from a given pixmap and mask. Both the pixmap and -- mask must have a depth of 1 (i.e. each pixel has only 2 values - on or off). -- The standard cursor size is 16 by 16 pixels. -- -- Removed in Gtk3. cursorNewFromPixmap :: Pixmap -- ^ @source@ - the pixmap specifying the cursor. -> Pixmap -- ^ @mask@ - the pixmap specifying the mask, which must be the -- same size as source. -> Color -- ^ @fg@ - the foreground color, used for the bits in the source -- which are 1. The color does not have to be allocated first. -> Color -- ^ @bg@ - the background color, used for the bits in the source -- which are 0. The color does not have to be allocated first. -> Int -- ^ @x@ - the horizontal offset of the \'hotspot\' of the cursor. -> Int -- ^ @y@ - the vertical offset of the \'hotspot\' of the cursor. -> IO Cursor cursorNewFromPixmap source mask fg bg x y = with fg $ \fgPtr -> with bg $ \bgPtr -> do rPtr <- {# call unsafe cursor_new_from_pixmap #} source mask (castPtr fgPtr) (castPtr bgPtr) (fromIntegral x) (fromIntegral y) makeNewCursor rPtr #endif -- | Creates a new cursor from a pixbuf. -- Not all GDK backends support RGBA cursors. If they are not supported, a monochrome approximation will be displayed. -- The functions 'displaySupportsCursorAlpha' and 'displaySupportsCursorColor' can be used to determine whether RGBA cursors are supported; -- 'displayGetDefaultCursorSize' and 'displayGetMaximalCursorSize' give information about cursor sizes. -- -- On the X backend, support for RGBA cursors requires a sufficiently new version of the X Render extension. -- cursorNewFromPixbuf :: Display -- ^ @display@ the 'Display' for which the cursor will be created -> Pixbuf -- ^ @pixbuf@ the 'Pixbuf' containing the cursor image -> Int -- ^ @x@ the horizontal offset of the 'hotspot' of the cursor. -> Int -- ^ @y@ the vertical offset of the 'hotspot' of the cursor. -> IO Cursor -- ^ return a new 'Cursor'. cursorNewFromPixbuf display pixbuf x y = do cursorPtr <- {#call cursor_new_from_pixbuf#} display pixbuf (fromIntegral x) (fromIntegral y) makeNewCursor cursorPtr -- | Creates a new cursor by looking up name in the current cursor theme. cursorNewFromName :: GlibString string => Display -- ^ @display@ the 'Display' for which the cursor will be created -> string -- ^ @name@ the name of the cursor -> IO (Maybe Cursor) -- ^ return a new 'Cursor', or @Nothing@ if there is no cursor with the given name cursorNewFromName display name = withUTFString name $ \namePtr -> do cursorPtr <- {#call cursor_new_from_name#} display namePtr if cursorPtr == nullPtr then return Nothing else liftM Just $ makeNewCursor cursorPtr -- | Creates a new cursor from the set of builtin cursors. cursorNewForDisplay :: Display -- ^ @display@ the 'Display' for which the cursor will be created -> CursorType -- ^ @cursorType@ cursor to create -> IO Cursor -- ^ return a new 'Cursor' cursorNewForDisplay display cursorType = do cursorPtr <- {#call cursor_new_for_display#} display $fromIntegral (fromEnum cursorType) makeNewCursor cursorPtr -- | Returns the display on which the GdkCursor is defined. cursorGetDisplay :: Cursor -- ^ @cursor@ 'Cursor' -> IO Display -- ^ return the 'Display' associated to cursor cursorGetDisplay cursor = makeNewGObject mkDisplay $ {#call cursor_get_display#} cursor -- | Returns a 'Pixbuf' with the image used to display the cursor. -- Note that depending on the capabilities of the windowing system and on the cursor, GDK may not be able to obtain the image data. -- In this case, @Nothing@ is returned. cursorGetImage :: Cursor -- ^ @cursor@ 'Cursor' -> IO (Maybe Pixbuf) -- ^ a 'Pixbuf' representing cursor, or @Nothing@ cursorGetImage cursor = maybeNull (makeNewGObject mkPixbuf) $ {#call cursor_get_image#} cursor gtk-0.15.9/Graphics/UI/Gtk/Gdk/Display.chs0000644000000000000000000004512107346545000016202 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Display - a description of a keyboard/mouse/monitors combination -- -- Author : Axel Simon -- -- Created: 22 October 2009 -- -- Copyright (C) 2009 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) -- -- Controls the keyboard\/mouse\/monitors combination. -- -- * Module available since Gdk version 2.2 -- module Graphics.UI.Gtk.Gdk.Display ( -- * Detail -- -- | 'Display' objects purpose are two fold: -- -- * To grab\/ungrab keyboard focus and mouse pointer -- -- * To manage and provide information about the 'Screen'(s) available for -- this 'Display' -- -- 'Display' objects are the GDK representation of the X Display which can -- be described as /a workstation consisting of a keyboard a pointing device -- (such as a mouse) and one or more screens/. It is used to open and keep -- track of various 'Screen' objects currently instantiated by the application. -- It is also used to grab and release the keyboard and the mouse pointer. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----Display -- @ #if GTK_CHECK_VERSION(2,2,0) -- * Types Display, DisplayClass, castToDisplay, gTypeDisplay, toDisplay, -- * Methods displayOpen, displayGetDefault, displayGetName, displayGetNScreens, displayGetScreen, displayGetDefaultScreen, displayPointerUngrab, displayKeyboardUngrab, displayPointerIsGrabbed, displayBeep, displaySync, #if GTK_CHECK_VERSION(2,4,0) displayFlush, #endif displayClose, displayListDevices, displaySetDoubleClickTime, #if GTK_CHECK_VERSION(2,4,0) displaySetDoubleClickDistance, #endif displayGetPointer, displayGetWindowAtPointer, #if GTK_CHECK_VERSION(2,8,0) displayWarpPointer, #endif #if GTK_CHECK_VERSION(2,4,0) displaySupportsCursorColor, displaySupportsCursorAlpha, displayGetDefaultCursorSize, displayGetMaximalCursorSize, displayGetDefaultGroup, #if GTK_CHECK_VERSION(2,6,0) displaySupportsSelectionNotification, displayRequestSelectionNotification, displaySupportsClipboardPersistence, displayStoreClipboard, #if GTK_CHECK_VERSION(2,10,0) displaySupportsShapes, displaySupportsInputShapes, #if GTK_CHECK_VERSION(2,12,0) displaySupportsComposite, #endif #endif #endif #endif -- * Signals displayClosed, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import System.Glib.GList {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Signals import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.General.DNDTypes (SelectionTag, TargetTag, Atom(..)) {# context lib="gdk" prefix="gdk" #} #if GTK_CHECK_VERSION(2,2,0) -------------------- -- Methods -- | Opens a display. -- displayOpen :: GlibString string => string -- ^ @displayName@ - the name of the display to open -> IO (Maybe Display) -- ^ returns a 'Display', or @Nothing@ if the display -- could not be opened. displayOpen displayName = maybeNull (wrapNewGObject mkDisplay) $ withUTFString displayName $ \displayNamePtr -> {# call gdk_display_open #} displayNamePtr -- | Gets the default 'Display'. This is a convenience function for -- @displayManagerGetDefaultDisplay displayManagerGet@. -- displayGetDefault :: IO (Maybe Display) -- ^ returns a 'Display', or @Nothing@ if there is no -- default display. displayGetDefault = maybeNull (makeNewGObject mkDisplay) $ {# call gdk_display_get_default #} -- | Gets the name of the display. -- displayGetName :: GlibString string => Display -> IO string -- ^ returns a string representing the display name displayGetName self = {# call gdk_display_get_name #} self >>= peekUTFString -- | Gets the number of screen managed by the @display@. -- displayGetNScreens :: Display -> IO Int -- ^ returns number of screens. displayGetNScreens self = liftM fromIntegral $ {# call gdk_display_get_n_screens #} self -- | Returns a screen object for one of the screens of the display. -- displayGetScreen :: Display -> Int -- ^ @screenNum@ - the screen number -> IO Screen -- ^ returns the 'Screen' object displayGetScreen self screenNum = makeNewGObject mkScreen $ {# call gdk_display_get_screen #} self (fromIntegral screenNum) -- | Get the default 'Screen' for @display@. -- displayGetDefaultScreen :: Display -> IO Screen -- ^ returns the default 'Screen' object for @display@ displayGetDefaultScreen self = makeNewGObject mkScreen $ {# call gdk_display_get_default_screen #} self -- | Release any pointer grab. -- displayPointerUngrab :: Display -> TimeStamp -- ^ @time@ - a timestamp (e.g. 'currentTime'). -> IO () displayPointerUngrab self time = {# call gdk_display_pointer_ungrab #} self (fromIntegral time) -- | Release any keyboard grab -- displayKeyboardUngrab :: Display -> TimeStamp -- ^ @time@ - a timestamp (e.g 'currentTime'). -> IO () displayKeyboardUngrab self time = {# call gdk_display_keyboard_ungrab #} self (fromIntegral time) -- | Test if the pointer is grabbed. -- displayPointerIsGrabbed :: Display -> IO Bool -- ^ returns @True@ if an active X pointer grab is in effect displayPointerIsGrabbed self = liftM toBool $ {# call gdk_display_pointer_is_grabbed #} self -- | Emits a short beep on @display@ -- displayBeep :: Display -> IO () displayBeep self = {# call gdk_display_beep #} self -- | Flushes any requests queued for the windowing system and waits until all -- requests have been handled. This is often used for making sure that the -- display is synchronized with the current state of the program. Calling -- 'displaySync' before 'errorTrapPop' makes sure that any errors generated -- from earlier requests are handled before the error trap is removed. -- -- This is most useful for X11. On windowing systems where requests are -- handled synchronously, this function will do nothing. -- displaySync :: Display -> IO () displaySync self = {# call gdk_display_sync #} self #if GTK_CHECK_VERSION(2,4,0) -- | Flushes any requests queued for the windowing system; this happens -- automatically when the main loop blocks waiting for new events, but if your -- application is drawing without returning control to the main loop, you may -- need to call this function explicitly. A common case where this function -- needs to be called is when an application is executing drawing commands from -- a thread other than the thread where the main loop is running. -- -- This is most useful for X11. On windowing systems where requests are -- handled synchronously, this function will do nothing. -- -- * Available since Gdk version 2.4 -- displayFlush :: Display -> IO () displayFlush self = {# call gdk_display_flush #} self #endif -- | Closes the connection to the windowing system for the given display, and -- cleans up associated resources. -- displayClose :: Display -> IO () displayClose self = {# call gdk_display_close #} self -- | Returns the list of available input devices attached to @display@. -- displayListDevices :: Display -> IO [Device] -- ^ returns a list of 'Device' displayListDevices self = {# call gdk_display_list_devices #} self >>= readGList >>= mapM (makeNewGObject mkDevice . return) -- | Sets the double click time (two clicks within this time interval count as -- a double click and result in an 'eventButton' where 'eventClick' is -- 'DoubleClick'). Applications should /not/ set this, it is a global -- user-configured setting. -- displaySetDoubleClickTime :: Display -> Int -- ^ @msec@ - double click time in milliseconds (thousandths of a -- second) -> IO () displaySetDoubleClickTime self msec = {# call gdk_display_set_double_click_time #} self (fromIntegral msec) #if GTK_CHECK_VERSION(2,4,0) -- | Sets the double click distance (two clicks within this distance count as -- a double click and result in an 'eventButton' where 'eventClick' is -- 'DoubleClick'). See also 'displaySetDoubleClickTime'. Applications should -- /not/ set this, it is a global user-configured setting. -- -- * Available since Gdk version 2.4 -- displaySetDoubleClickDistance :: Display -> Int -- ^ @distance@ - distance in pixels -> IO () displaySetDoubleClickDistance self distance = {# call gdk_display_set_double_click_distance #} self (fromIntegral distance) #endif -- | Gets the current location of the pointer and the current modifier mask -- for a given display. -- displayGetPointer :: Display -> IO (Screen, [Modifier], Int, Int) -- ^ @(s, m, x, y)@ - the screen @s@, the modifier mask @m@ and the @x@ and -- @y@ coordinates of the pointer displayGetPointer self = alloca $ \sPtr -> alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \mPtr -> {# call gdk_display_get_pointer #} self (castPtr sPtr) xPtr yPtr mPtr >> makeNewGObject mkScreen (peek sPtr) >>= \s -> peek xPtr >>= \x -> peek yPtr >>= \y -> peek mPtr >>= \m -> return (s, toFlags (fromIntegral m), fromIntegral x, fromIntegral y) -- | Obtains the window underneath the mouse pointer, returning the location -- of the pointer in that window in @winX@, @winY@ for @screen@. Returns -- @Nothing@ if -- the window under the mouse pointer is not known to GDK (for example, belongs -- to another application). -- displayGetWindowAtPointer :: Display -> IO (Maybe (DrawWindow, Int, Int)) -- ^ @(screen, winX, winY)@ returns the window under the mouse -- pointer, or @Nothing@. The @winX@ and @winY@ denote the pointer location -- relative to the window origin displayGetWindowAtPointer self = alloca $ \winXPtr -> alloca $ \winYPtr -> do wPtr <- {# call gdk_display_get_window_at_pointer #} self winXPtr winYPtr if wPtr==nullPtr then return Nothing else peek winXPtr >>= \winX -> peek winYPtr >>= \winY -> makeNewGObject mkDrawWindow (return wPtr) >>= \win -> return (Just (win, fromIntegral winX, fromIntegral winY)) {- not worth the trouble -- | This function allows for hooking into the operation of getting the -- current location of the pointer on a particular display. This is only useful -- for such low-level tools as an event recorder. Applications should never -- have any reason to use this facility. -- displaySetPointerHooks :: Display -> {-const-GdkDisplayPointerHooks*-} -- ^ @newHooks@ - a table of pointers to -- functions for getting quantities -- related to the current pointer -- position, or {@NULL@, FIXME: this -- should probably be converted to a -- Maybe data type} to restore the -- default table. -> IO {-GdkDisplayPointerHooks*-} -- ^ returns the previous pointer hook -- table displaySetPointerHooks self newHooks = {# call gdk_display_set_pointer_hooks #} self {-newHooks-} -} #if GTK_CHECK_VERSION(2,8,0) -- | Moves the pointer of @display@ to the point @x@,@y@ on the screen -- @screen@, unless the pointer is confined to a window by a grab, in which -- case it will be moved as far as allowed by the grab. Warping the pointer -- creates events as if the user had moved the mouse instantaneously to the -- destination. -- -- Note that the pointer should normally be under the control of the user. -- This function was added to cover some rare use cases like keyboard -- navigation support for the color picker in the 'ColorSelectionDialog'. -- -- * Available since Gdk version 2.8 -- displayWarpPointer :: Display -> Screen -- ^ @screen@ - the screen of @display@ to warp the pointer to -> Int -- ^ @x@ - the x coordinate of the destination -> Int -- ^ @y@ - the y coordinate of the destination -> IO () displayWarpPointer self screen x y = {# call gdk_display_warp_pointer #} self screen (fromIntegral x) (fromIntegral y) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Returns @True@ if multicolored cursors are supported on @display@. -- Otherwise, cursors have only a foreground and a background color. -- -- * Available since Gdk version 2.4 -- displaySupportsCursorColor :: Display -> IO Bool -- ^ returns whether cursors can have multiple colors. displaySupportsCursorColor self = liftM toBool $ {# call gdk_display_supports_cursor_color #} self -- | Returns @True@ if cursors can use an 8bit alpha channel on @display@. -- Otherwise, cursors are restricted to bilevel alpha (i.e. a mask). -- -- * Available since Gdk version 2.4 -- displaySupportsCursorAlpha :: Display -> IO Bool -- ^ returns whether cursors can have alpha channels. displaySupportsCursorAlpha self = liftM toBool $ {# call gdk_display_supports_cursor_alpha #} self -- | Returns the default size to use for cursors on @display@. -- -- * Available since Gdk version 2.4 -- displayGetDefaultCursorSize :: Display -> IO Int -- ^ returns the default cursor size. displayGetDefaultCursorSize self = liftM fromIntegral $ {# call gdk_display_get_default_cursor_size #} self -- | Gets the maximal size to use for cursors on @display@. -- -- * Available since Gdk version 2.4 -- displayGetMaximalCursorSize :: Display -> IO (Int, Int) -- ^ @(width, height)@ -- maximal @width@ and @height@ of the cursor displayGetMaximalCursorSize self = alloca $ \widthPtr -> alloca $ \heightPtr -> {# call gdk_display_get_maximal_cursor_size #} self widthPtr heightPtr >> peek widthPtr >>= \width -> peek heightPtr >>= \height -> return (fromIntegral width, fromIntegral height) -- | Returns the default group leader window for all toplevel windows on -- @display@. This window is implicitly created by GDK. See 'windowSetGroup'. -- -- * Available since Gdk version 2.4 -- displayGetDefaultGroup :: Display -> IO DrawWindow -- ^ returns The default group leader window for @display@ displayGetDefaultGroup self = makeNewGObject mkDrawWindow $ {# call gdk_display_get_default_group #} self #if GTK_CHECK_VERSION(2,6,0) -- | Returns whether 'EOwnerChange' events will be -- sent when the owner of a selection changes. -- -- * Available since Gdk version 2.6 -- displaySupportsSelectionNotification :: Display -> IO Bool -- ^ returns whether 'EOwnerChange' -- events will be sent. displaySupportsSelectionNotification self = liftM toBool $ {# call gdk_display_supports_selection_notification #} self -- | Request 'EOwnerChange' events for ownership -- changes of the selection named by the given atom. -- -- * Available since Gdk version 2.6 -- displayRequestSelectionNotification :: Display -> SelectionTag -- ^ @selection@ - the 'Atom' naming -- the selection for which ownership change notification is -- requested -> IO Bool -- ^ returns whether 'EOwnerChange' -- events will be sent. displayRequestSelectionNotification self (Atom selection) = liftM toBool $ {# call gdk_display_request_selection_notification #} self selection -- | Returns whether the speicifed display supports clipboard persistence; -- i.e. if it's possible to store the clipboard data after an application has -- quit. On X11 this checks if a clipboard daemon is running. -- -- * Available since Gdk version 2.6 -- displaySupportsClipboardPersistence :: Display -> IO Bool -- ^ returns @True@ if the display supports clipboard persistence. displaySupportsClipboardPersistence self = liftM toBool $ {# call gdk_display_supports_clipboard_persistence #} self -- | Issues a request to the clipboard manager to store the clipboard data. On -- X11, this is a special program that works according to the freedesktop -- clipboard specification, available at -- http:\/\/www.freedesktop.org\/Standards\/clipboard-manager-spec. -- -- * Available since Gdk version 2.6 -- displayStoreClipboard :: Display -> DrawWindow -- ^ @clipboardWindow@ - a 'DrawWindow' belonging to -- the clipboard owner -> Word32 -- ^ @time@ - a timestamp -> (Maybe [TargetTag]) -- ^ @targets@ - an array of targets that should be -- saved, or @Nothing@ if all available -- targets should be saved. -> IO () displayStoreClipboard self clipboardWindow time (Just targets) = withArrayLen (map (\(Atom a) -> a) targets) $ \nTargets tPtr -> {# call gdk_display_store_clipboard #} self clipboardWindow (fromIntegral time) tPtr (fromIntegral nTargets) displayStoreClipboard self clipboardWindow time Nothing = {# call gdk_display_store_clipboard #} self clipboardWindow (fromIntegral time) nullPtr 0 #if GTK_CHECK_VERSION(2,10,0) -- | Returns @True@ if 'windowShapeCombineMask' can be used to create shaped -- windows on @display@. -- -- * Available since Gdk version 2.10 -- displaySupportsShapes :: Display -> IO Bool -- ^ returns @True@ if shaped windows are supported displaySupportsShapes self = liftM toBool $ {# call gdk_display_supports_shapes #} self -- | Returns @True@ if 'windowInputShapeCombineMask' can be used to modify the -- input shape of windows on @display@. -- -- * Available since Gdk version 2.10 -- displaySupportsInputShapes :: Display -> IO Bool -- ^ returns @True@ if windows with modified input shape are -- supported displaySupportsInputShapes self = liftM toBool $ {# call gdk_display_supports_input_shapes #} self #if GTK_CHECK_VERSION(2,12,0) -- | Returns @True@ if 'windowSetComposited' can be used to redirect drawing -- on the window using compositing. -- -- Currently this only works on X11 with XComposite and XDamage extensions -- available. -- -- * Available since Gdk version 2.12 -- displaySupportsComposite :: Display -> IO Bool -- ^ returns @True@ if windows may be composited. displaySupportsComposite self = liftM toBool $ {# call gdk_display_supports_composite #} self #endif #endif #endif #endif -------------------- -- Signals -- | The 'displayClosed' signal is emitted when the connection to the windowing -- system for @display@ is closed. -- displayClosed :: DisplayClass self => Signal self (Bool -> IO ()) displayClosed = Signal (connect_BOOL__NONE "closed") #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/DisplayManager.chs0000644000000000000000000000574307346545000017503 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget DisplayManager -- -- Author : Andy Stewart -- -- Created: 29 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Maintains a list of all open GdkDisplays -- -- * Module available since Gdk version 2.2 -- module Graphics.UI.Gtk.Gdk.DisplayManager ( -- * Detail -- -- | The purpose of the 'DisplayManager' singleton object is to offer -- notification when displays appear or disappear or the default display -- changes. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----DisplayManager -- @ #if GTK_CHECK_VERSION(2,2,0) -- * Types DisplayManager, DisplayManagerClass, castToDisplayManager, toDisplayManager, -- * Methods displayManagerGet, displayManagerListDisplays, -- * Attributes displayManagerDefaultDisplay, -- * Signals displayManagerOpened, #endif ) where import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import System.Glib.GList {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gdk" prefix="gdk" #} #if GTK_CHECK_VERSION(2,2,0) -------------------- -- Methods -- | Returns the global 'DisplayManager' singleton; 'parsePargs', 'init', or -- 'initCheck' must have been called first. -- displayManagerGet :: IO DisplayManager -- ^ returns the singleton 'DisplayManager' object. displayManagerGet = constructNewGObject mkDisplayManager $ {# call gdk_display_manager_get #} -- | List all currently open displays. -- displayManagerListDisplays :: DisplayManagerClass self => self -> IO [Display] -- ^ returns a newly allocated list of 'Display' objects. displayManagerListDisplays self = {# call gdk_display_manager_list_displays #} (toDisplayManager self) >>= fromGSList >>= mapM (makeNewGObject mkDisplay . return) -------------------- -- Attributes -- | The default display. -- displayManagerDefaultDisplay :: DisplayManagerClass self => Attr self Display displayManagerDefaultDisplay = newAttrFromObjectProperty "default-display" {# call pure unsafe gdk_display_get_type #} -------------------- -- Signals -- | The 'displayManagerOpened' signal is emitted when a display is opened. -- displayManagerOpened :: DisplayManagerClass self => Signal self (Display -> IO ()) displayManagerOpened = Signal (connect_OBJECT__NONE "display_opened") #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/DrawWindow.chs0000644000000000000000000005740207346545000016667 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) DrawWindow -- -- Author : Axel Simon -- -- Created: 5 November 2002 -- -- Copyright (C) 2002-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A 'DrawWindow' is a rectangular region on the screen. -- module Graphics.UI.Gtk.Gdk.DrawWindow ( -- A 'DrawWindow' is used to implement high-level objects such as 'Widget' and -- 'Window' on the Gtk+ level. -- -- Most widgets draws its content into a 'DrawWindow', in particular -- 'DrawingArea' is nothing but a widget that contains a 'DrawWindow'. -- This object derives from 'Drawable' which defines the basic drawing -- primitives. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Drawable' -- | +----DrawWindow -- @ -- -- * Types DrawWindow, DrawWindowClass, castToDrawWindow, gTypeDrawWindow, WindowState(..), NativeWindowId, toNativeWindowId, fromNativeWindowId, -- * Methods drawWindowGetState, drawWindowScroll, #if GTK_MAJOR_VERSION < 3 drawWindowClear, drawWindowClearArea, drawWindowClearAreaExpose, #endif drawWindowRaise, drawWindowLower, drawWindowRegisterDnd, drawWindowBeginPaintRect, #if GTK_MAJOR_VERSION < 3 drawWindowBeginPaintRegion, #endif drawWindowEndPaint, drawWindowInvalidateRect, #if GTK_MAJOR_VERSION < 3 drawWindowInvalidateRegion, drawWindowGetUpdateArea, #endif drawWindowFreezeUpdates, drawWindowThawUpdates, drawWindowProcessUpdates, #if GTK_CHECK_VERSION(2,4,0) drawWindowSetAcceptFocus, #endif #if GTK_MAJOR_VERSION < 3 drawWindowShapeCombineMask, drawWindowShapeCombineRegion, #endif drawWindowSetChildShapes, drawWindowMergeChildShapes, drawWindowGetPointer, drawWindowGetPointerPos, drawWindowGetOrigin, drawWindowSetCursor, #if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) drawWindowForeignNew, #endif drawWindowGetDefaultRootWindow, #if GTK_CHECK_VERSION(2,24,0) drawWindowGetWidth, drawWindowGetHeight, #endif ) where import Control.Monad (liftM) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.Flags (toFlags) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Gdk.Enums#} #if GTK_MAJOR_VERSION < 3 {#import Graphics.UI.Gtk.Gdk.Region#} #endif {#import Graphics.UI.Gtk.Gdk.Cursor#} import Graphics.UI.Gtk.General.Structs {# context lib="gdk" prefix="gdk" #} -- | Gets the bitwise OR of the currently active drawWindow state flags, from -- the 'WindowState' enumeration. -- drawWindowGetState :: DrawWindowClass self => self -> IO [WindowState] -- ^ returns @DrawWindow@ flags drawWindowGetState self = liftM (toFlags . fromIntegral) $ {# call gdk_window_get_state #} (toDrawWindow self) -- | Scroll the contents of @DrawWindow@. -- -- * Scroll both, pixels and children, by the given amount. -- @DrawWindow@ itself does not move. Portions of the window that the -- scroll operation brings inm from offscreen areas are invalidated. The -- invalidated region may be bigger than what would strictly be necessary. (For -- X11, a minimum area will be invalidated if the window has no subwindows, or -- if the edges of the window's parent do not extend beyond the edges of the -- drawWindow. In other cases, a multi-step process is used to scroll the window -- which may produce temporary visual artifacts and unnecessary invalidations.) -- drawWindowScroll :: DrawWindowClass self => self -> Int -- ^ @dx@ - Amount to scroll in the X direction -> Int -- ^ @dy@ - Amount to scroll in the Y direction -> IO () drawWindowScroll self dx dy = {# call gdk_window_scroll #} (toDrawWindow self) (fromIntegral dx) (fromIntegral dy) #if GTK_MAJOR_VERSION < 3 -- | Clears an entire @DrawWindow@ to the background color or background pixmap. -- -- Removed in Gtk3. drawWindowClear :: DrawWindowClass self => self -> IO () drawWindowClear self = {# call gdk_window_clear #} (toDrawWindow self) -- | Clears an area of @DrawWindow@ to the background color or background pixmap. -- -- Removed in Gtk3. drawWindowClearArea :: DrawWindowClass self => self -> Int -- ^ @x@ - x coordinate of rectangle to clear -> Int -- ^ @y@ - y coordinate of rectangle to clear -> Int -- ^ @width@ - width of rectangle to clear -> Int -- ^ @height@ - height of rectangle to clear -> IO () drawWindowClearArea self x y width height = {# call gdk_window_clear_area #} (toDrawWindow self) (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) -- | Like 'drawWindowClearArea', but also generates an expose event for the -- cleared area. -- -- Removed in Gtk3. drawWindowClearAreaExpose :: DrawWindowClass self => self -> Int -- ^ @x@ - x coordinate of rectangle to clear -> Int -- ^ @y@ - y coordinate of rectangle to clear -> Int -- ^ @width@ - width of rectangle to clear -> Int -- ^ @height@ - height of rectangle to clear -> IO () drawWindowClearAreaExpose self x y width height = {# call gdk_window_clear_area_e #} (toDrawWindow self) (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) #endif -- | Raises @DrawWindow@ to the top of the Z-order (stacking order), so that other -- drawWindows with the same parent drawWindow appear below @DrawWindow@. This is true -- whether or not the drawWindows are visible. -- -- If @DrawWindow@ is a toplevel, the window manager may choose to deny the -- request to move the drawWindow in the Z-order, 'drawWindowRaise' only requests the -- restack, does not guarantee it. -- drawWindowRaise :: DrawWindowClass self => self -> IO () drawWindowRaise self = {# call gdk_window_raise #} (toDrawWindow self) -- | Lowers @DrawWindow@ to the bottom of the Z-order (stacking order), so that -- other windows with the same parent window appear above @DrawWindow@. This is -- true whether or not the other windows are visible. -- -- If @DrawWindow@ is a toplevel, the window manager may choose to deny the -- request to move the drawWindow in the Z-order, 'drawWindowLower' only -- requests the restack, does not guarantee it. -- -- Note that a widget is raised automatically when it is mapped, thus you -- need to call 'drawWindowLower' after -- 'Graphics.UI.Gtk.Abstract.Widget.widgetShow' if the window should -- not appear above other windows. -- drawWindowLower :: DrawWindowClass self => self -> IO () drawWindowLower self = {# call gdk_window_lower #} (toDrawWindow self) -- | Registers a drawWindow as a potential drop destination. -- drawWindowRegisterDnd :: DrawWindowClass self => self -> IO () drawWindowRegisterDnd self = {# call gdk_window_register_dnd #} (toDrawWindow self) -- | A convenience wrapper around 'drawWindowBeginPaintRegion' which creates a -- rectangular region for you. -- -- * See 'drawWindowBeginPaintRegion' for details. -- drawWindowBeginPaintRect :: DrawWindowClass self => self -> Rectangle -- ^ @rectangle@ - rectangle you intend to draw to -> IO () drawWindowBeginPaintRect self rectangle = with rectangle $ \rectPtr -> {#call gdk_window_begin_paint_rect#} (toDrawWindow self) (castPtr rectPtr) #if GTK_MAJOR_VERSION < 3 -- | Indicate that you are beginning the process of redrawing @region@. -- -- * A -- backing store (offscreen buffer) large enough to contain @region@ will be -- created. The backing store will be initialized with the background color or -- background pixmap for @DrawWindow@. Then, all drawing operations performed on -- @DrawWindow@ will be diverted to the backing store. When you call -- 'drawWindowEndPaint', the backing store will be copied to @DrawWindow@, making it -- visible onscreen. Only the part of @DrawWindow@ contained in @region@ will be -- modified; that is, drawing operations are clipped to @region@. -- -- The net result of all this is to remove flicker, because the user sees -- the finished product appear all at once when you call 'drawWindowEndPaint'. If -- you draw to @DrawWindow@ directly without calling 'drawWindowBeginPaintRegion', the -- user may see flicker as individual drawing operations are performed in -- sequence. The clipping and background-initializing features of -- 'drawWindowBeginPaintRegion' are conveniences for the programmer, so you can -- avoid doing that work yourself. -- -- When using GTK+, the widget system automatically places calls to -- 'drawWindowBeginPaintRegion' and 'drawWindowEndPaint' around emissions of the -- @expose_event@ signal. That is, if you\'re writing an expose event handler, -- you can assume that the exposed area in 'eventRegion' has already been -- cleared to the window background, is already set as the clip region, and -- already has a backing store. Therefore in most cases, application code need -- not call 'drawWindowBeginPaintRegion'. (You can disable the automatic calls -- around expose events on a widget-by-widget basis by calling -- 'widgetSetDoubleBuffered'.) -- -- If you call this function multiple times before calling the matching -- 'drawWindowEndPaint', the backing stores are pushed onto a stack. -- 'drawWindowEndPaint' copies the topmost backing store onscreen, subtracts the -- topmost region from all other regions in the stack, and pops the stack. All -- drawing operations affect only the topmost backing store in the stack. One -- matching call to 'drawWindowEndPaint' is required for each call to -- 'drawWindowBeginPaintRegion'. -- -- Removed in Gtk3. drawWindowBeginPaintRegion :: DrawWindowClass self => self -> Region -- ^ @region@ - region you intend to draw to -> IO () drawWindowBeginPaintRegion self region = {# call gdk_window_begin_paint_region #} (toDrawWindow self) region #endif -- | Signal that drawing has finished. -- -- * Indicates that the backing store created by the most recent call to -- 'drawWindowBeginPaintRegion' should be copied onscreen and deleted, leaving the -- next-most-recent backing store or no backing store at all as the active -- paint region. See 'drawWindowBeginPaintRegion' for full details. It is an error -- to call this function without a matching 'drawWindowBeginPaintRegion' first. -- drawWindowEndPaint :: DrawWindowClass self => self -> IO () drawWindowEndPaint self = {# call gdk_window_end_paint #} (toDrawWindow self) -- | A convenience wrapper around 'drawWindowInvalidateRegion' which invalidates a -- rectangular region. See 'drawWindowInvalidateRegion' for details. -- drawWindowInvalidateRect :: DrawWindowClass self => self -> Rectangle -- ^ @rect@ - rectangle to invalidate -> Bool -- ^ @invalidateChildren@ - whether to also invalidate -- child drawWindows -> IO () drawWindowInvalidateRect self rect invalidateChildren = with rect $ \rectPtr -> {# call gdk_window_invalidate_rect #} (toDrawWindow self) (castPtr rectPtr) (fromBool invalidateChildren) #if GTK_MAJOR_VERSION < 3 -- | Adds @region@ to the update area for @DrawWindow@. The update area is the -- region that needs to be redrawn, or \"dirty region.\". During the -- next idle period of the main look, an expose even for this region -- will be created. An application would normally redraw -- the contents of @DrawWindow@ in response to those expose events. -- -- The @invalidateChildren@ parameter controls whether the region of each -- child drawWindow that intersects @region@ will also be invalidated. If @False@, -- then the update area for child drawWindows will remain unaffected. -- drawWindowInvalidateRegion :: DrawWindowClass self => self -> Region -- ^ @region@ - a "Region" -> Bool -- ^ @invalidateChildren@ - @True@ to also invalidate child -- drawWindows -> IO () drawWindowInvalidateRegion self region invalidateChildren = {# call gdk_window_invalidate_region #} (toDrawWindow self) region (fromBool invalidateChildren) #endif #if GTK_MAJOR_VERSION < 3 -- | Ask for the dirty region of this window. -- -- * Transfers ownership of the update area from @DrawWindow@ to the caller of the -- function. That is, after calling this function, @DrawWindow@ will no longer have -- an invalid\/dirty region; the update area is removed from @DrawWindow@ and -- handed to you. If this window has no update area, 'drawWindowGetUpdateArea' returns 'Nothing'. -- -- Removed in Gtk3. drawWindowGetUpdateArea :: DrawWindowClass self => self -> IO (Maybe Region) -- ^ returns the update area for @DrawWindow@ drawWindowGetUpdateArea self = do reg <- {# call gdk_window_get_update_area #} (toDrawWindow self) if reg==nullPtr then return Nothing else liftM Just (makeNewRegion reg) #endif -- | Temporarily freezes a drawWindow such that it won\'t receive expose events. -- * The drawWindow will begin receiving expose events again when -- 'drawWindowThawUpdates' -- is called. If 'drawWindowFreezeUpdates' has been called more than once, -- 'drawWindowThawUpdates' must be called an equal number of times to begin -- processing exposes. -- drawWindowFreezeUpdates :: DrawWindowClass self => self -> IO () drawWindowFreezeUpdates self = {# call gdk_window_freeze_updates #} (toDrawWindow self) -- | Thaws a drawWindow frozen with 'drawWindowFreezeUpdates'. -- drawWindowThawUpdates :: DrawWindowClass self => self -> IO () drawWindowThawUpdates self = {# call gdk_window_thaw_updates #} (toDrawWindow self) -- | Sends one or more expose events to @DrawWindow@. -- -- * The areas in each expose -- event will cover the entire update area for the window (see -- 'drawWindowInvalidateRegion' for details). Normally Gtk calls -- 'drawWindowProcessUpdates' on your behalf, so there's no need to call this -- function unless you want to force expose events to be delivered immediately -- and synchronously (vs. the usual case, where Gtk delivers them in an idle -- handler). Occasionally this is useful to produce nicer scrolling behavior, -- for example. -- drawWindowProcessUpdates :: DrawWindowClass self => self -> Bool -- ^ @updateChildren@ - whether to also process updates for child -- drawWindows -> IO () drawWindowProcessUpdates self updateChildren = {# call gdk_window_process_updates #} (toDrawWindow self) (fromBool updateChildren) #if GTK_CHECK_VERSION(2,4,0) -- | Setting @acceptFocus@ to @False@ hints the desktop environment that the -- window doesn\'t want to receive input focus. -- -- On X, it is the responsibility of the drawWindow manager to interpret this -- hint. ICCCM-compliant drawWindow manager usually respect it. -- -- * Available since Gdk version 2.4 -- drawWindowSetAcceptFocus :: DrawWindowClass self => self -> Bool -- ^ @acceptFocus@ - @True@ if the drawWindow should receive input focus -> IO () drawWindowSetAcceptFocus self acceptFocus = {# call gdk_window_set_accept_focus #} (toDrawWindow self) (fromBool acceptFocus) #endif #if GTK_MAJOR_VERSION < 3 -- | Applies a shape mask to window. Pixels in window corresponding to set -- bits in the mask will be visible; pixels in window corresponding to -- unset bits in the mask will be transparent. This gives a non-rectangular -- window. -- -- * If @mask@ is @Nothing@, the shape mask will be unset, and the x\/y parameters -- are not used. The @mask@ must be a bitmap, that is, a 'Pixmap' of depth -- one. -- -- * On the X11 platform, this uses an X server extension which is widely -- available on most common platforms, but not available on very old -- X servers, and occasionally the implementation will be buggy. -- On servers without the shape extension, this function will do nothing. -- On the Win32 platform the functionality is always present. -- -- * This function works on both toplevel and child windows. -- drawWindowShapeCombineMask :: DrawWindowClass self => self -> Maybe Pixmap -- ^ @mask@ - region of drawWindow to be non-transparent -> Int -- ^ @offsetX@ - X position of @shapeRegion@ in @DrawWindow@ -- coordinates -> Int -- ^ @offsetY@ - Y position of @shapeRegion@ in @DrawWindow@ -- coordinates -> IO () drawWindowShapeCombineMask self (Just (Pixmap mask)) offsetX offsetY = withForeignPtr mask $ \maskPtr -> {# call gdk_window_shape_combine_mask #} (toDrawWindow self) (castPtr maskPtr) (fromIntegral offsetX) (fromIntegral offsetY) drawWindowShapeCombineMask self Nothing offsetX offsetY = {# call gdk_window_shape_combine_mask #} (toDrawWindow self) nullPtr (fromIntegral offsetX) (fromIntegral offsetY) #endif #if GTK_MAJOR_VERSION < 3 -- | Makes pixels in @DrawWindow@ outside @shapeRegion@ transparent. -- -- * Makes pixels in @DrawWindow@ outside @shapeRegion@ transparent, so that -- the window may be nonrectangular. -- -- If @shapeRegion@ is 'Nothing', the shape will be unset, so the whole -- 'DrawWindow' will be opaque again. The parameters @offsetX@ and @offsetY@ -- are ignored if @shapeRegion@ is 'Nothing'. -- -- On the X11 platform, this uses an X server extension which is widely -- available on most common platforms, but not available on very old X servers, -- and occasionally the implementation will be buggy. On servers without the -- shape extension, this function will do nothing. -- -- This function works on both toplevel and child drawWindows. -- drawWindowShapeCombineRegion :: DrawWindowClass self => self -> Maybe Region -- ^ @shapeRegion@ - region of drawWindow to be non-transparent -> Int -- ^ @offsetX@ - X position of @shapeRegion@ in @DrawWindow@ -- coordinates -> Int -- ^ @offsetY@ - Y position of @shapeRegion@ in @DrawWindow@ -- coordinates -> IO () drawWindowShapeCombineRegion self (Just reg) offsetX offsetY = {# call gdk_window_shape_combine_region #} (toDrawWindow self) reg (fromIntegral offsetX) (fromIntegral offsetY) drawWindowShapeCombineRegion self Nothing offsetX offsetY = {# call gdk_window_shape_combine_region #} (toDrawWindow self) (Region nullForeignPtr) (fromIntegral offsetX) (fromIntegral offsetY) #endif -- | Sets the shape mask of @DrawWindow@ to the union of shape masks for all -- children of @DrawWindow@, ignoring the shape mask of @DrawWindow@ itself. Contrast -- with 'drawWindowMergeChildShapes' which includes the shape mask of @DrawWindow@ in -- the masks to be merged. -- drawWindowSetChildShapes :: DrawWindowClass self => self -> IO () drawWindowSetChildShapes self = {# call gdk_window_set_child_shapes #} (toDrawWindow self) -- | Merges the shape masks for any child drawWindows into the shape mask for -- @DrawWindow@. i.e. the union of all masks for @DrawWindow@ and its children will -- become the new mask for @DrawWindow@. See 'drawWindowShapeCombineMask'. -- -- This function is distinct from 'drawWindowSetChildShapes' because it includes -- @DrawWindow@'s shape mask in the set of shapes to be merged. -- drawWindowMergeChildShapes :: DrawWindowClass self => self -> IO () drawWindowMergeChildShapes self = {# call gdk_window_merge_child_shapes #} (toDrawWindow self) -- Superseded by 'drawWindowGetPointerPos', won't be removed. -- Obtains the current pointer position and modifier state. -- -- * The position is -- given in coordinates relative to the given window. -- -- * The return value is @Just (same, x, y, mod)@ where @same@ is @True@ -- if the passed in window is the window over which the mouse currently -- resides. -- -- * The return value is @Nothing@ if the mouse cursor is over a different -- application. -- drawWindowGetPointer :: DrawWindowClass self => self -> IO (Maybe (Bool, Int, Int, [Modifier])) drawWindowGetPointer self = alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \mPtr -> do winPtr <- {# call gdk_window_get_pointer #} (toDrawWindow self) xPtr yPtr mPtr if winPtr==nullPtr then return Nothing else do same <- withForeignPtr (unDrawWindow (toDrawWindow self)) $ \dPtr -> return (winPtr==dPtr) x <- peek xPtr y <- peek yPtr m <- peek mPtr return (Just (same, fromIntegral x, fromIntegral y, toFlags (fromIntegral m))) -- | Obtains the current pointer position and modifier state. -- -- * The position is -- given in coordinates relative to the given window. -- -- * The return value is @(Just win, x, y, mod)@ where @win@ is the -- window over which the mouse currently resides and @mod@ denotes -- the keyboard modifiers currently being depressed. -- -- * The return value is @Nothing@ for the window if the mouse cursor is -- not over a known window. -- drawWindowGetPointerPos :: DrawWindowClass self => self -> IO (Maybe DrawWindow, Int, Int, [Modifier]) drawWindowGetPointerPos self = alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \mPtr -> do winPtr <- {# call gdk_window_get_pointer #} (toDrawWindow self) xPtr yPtr mPtr x <- peek xPtr y <- peek yPtr m <- peek mPtr mWin <- if winPtr==nullPtr then return Nothing else liftM Just $ makeNewGObject mkDrawWindow (return winPtr) return (mWin, fromIntegral x, fromIntegral y, toFlags (fromIntegral m)) -- | Obtains the position of a window in screen coordinates. -- -- You can use this to help convert a position between screen coordinates and -- local 'DrawWindow' relative coordinates. -- drawWindowGetOrigin :: DrawWindow -> IO (Int, Int) -- ^ @(x, y)@ drawWindowGetOrigin self = alloca $ \xPtr -> alloca $ \yPtr -> do {# call gdk_window_get_origin #} (toDrawWindow self) xPtr yPtr x <- peek xPtr y <- peek yPtr return (fromIntegral x, fromIntegral y) -- | Sets the mouse pointer for a 'DrawWindow'. -- -- Use 'cursorNewForDisplay' or 'cursorNewFromPixmap' to create the cursor. -- To make the cursor invisible, use 'BlankCursor'. Passing @Nothing@ means -- that the @DrawWindow@ will use the cursor of its parent @DrawWindow@. -- Most @DrawWindow@ should use this default. -- drawWindowSetCursor :: DrawWindow -> Maybe Cursor -> IO () drawWindowSetCursor self cursor = {# call gdk_window_set_cursor #} self (fromMaybe (Cursor nullForeignPtr) cursor) #if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) -- | Get the handle to an existing window of the windowing system. The -- passed-in handle is a reference to a native window, that is, an Xlib XID -- for X windows and a HWND for Win32. -- -- Removed in Gtk3. drawWindowForeignNew :: NativeWindowId -> IO (Maybe DrawWindow) drawWindowForeignNew anid = maybeNull (wrapNewGObject mkDrawWindow) $ liftM castPtr $ {#call gdk_window_foreign_new#} (fromNativeWindowId anid) #endif -- | Obtains the root window (parent all other windows are inside) for the default display and screen. drawWindowGetDefaultRootWindow :: IO DrawWindow -- ^ returns the default root window drawWindowGetDefaultRootWindow = makeNewGObject mkDrawWindow $ {#call gdk_get_default_root_window #} #if GTK_CHECK_VERSION(2,24,0) -- | Returns the width of the window. -- -- On the X11 platform the returned size is the size reported in the -- most-recently-processed configure event, rather than the current -- size on the X server. -- drawWindowGetWidth :: DrawWindow -> IO Int drawWindowGetWidth self = liftM fromIntegral $ {# call gdk_window_get_width #} (toDrawWindow self) -- | Returns the height of the window. -- -- On the X11 platform the returned size is the size reported in the -- most-recently-processed configure event, rather than the current -- size on the X server. -- drawWindowGetHeight :: DrawWindow -> IO Int drawWindowGetHeight self = liftM fromIntegral $ {# call gdk_window_get_height #} (toDrawWindow self) #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/Drawable.chs0000644000000000000000000003376207346545000016326 0ustar0000000000000000{-# LANGUAGE CPP, ScopedTypeVariables #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Drawable -- -- Author : Axel Simon -- -- Created: 22 September 2002 -- -- Copyright (C) 2002-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. -- -- TODO -- -- if gdk_visuals are implemented, do: get_visual -- -- if gdk_colormaps are implemented, do: set_colormap, get_colormap -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Drawing primitives. -- -- This module defines drawing primitives that can operate on 'DrawWindow's -- and 'Pixmap's. -- -- This module is empty when built with Gtk3 because GTKDrawable has been -- removed. module Graphics.UI.Gtk.Gdk.Drawable ( #if GTK_MAJOR_VERSION < 3 Drawable, DrawableClass, castToDrawable, gTypeDrawable, toDrawable, drawableGetDepth, drawableGetSize, drawableGetClipRegion, drawableGetVisibleRegion, drawableGetID, Point, drawPoint, drawPoints, drawLine, drawLines, #if GTK_CHECK_VERSION(2,2,0) Dither(..), drawPixbuf, #endif drawSegments, drawRectangle, drawArc, drawPolygon, drawGlyphs, drawLayoutLine, drawLayoutLineWithColors, drawLayout, drawLayoutWithColors, drawDrawable, #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.General.Structs (Point, drawableGetID) import Graphics.Rendering.Pango.Structs {#import Graphics.Rendering.Pango.Types#} {#import Graphics.Rendering.Pango.BasicTypes#} {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 {#import Graphics.UI.Gtk.Gdk.Region#} (Region, makeNewRegion) #endif import Graphics.UI.Gtk.Gdk.Enums (Dither(..)) {# context lib="gtk" prefix="gdk" #} -- methods -- | Get the size of pixels. -- -- * Returns the number of bits which are use to store information on each -- pixels in this 'Drawable'. -- drawableGetDepth :: DrawableClass d => d -> IO Int drawableGetDepth d = liftM fromIntegral $ {#call unsafe drawable_get_depth#} (toDrawable d) -- | Retrieve the size of the 'Drawable'. -- -- * The result might not be up-to-date if there are still resizing messages -- to be processed. -- drawableGetSize :: DrawableClass d => d -> IO (Int, Int) drawableGetSize d = alloca $ \wPtr -> alloca $ \hPtr -> do {#call unsafe drawable_get_size#} (toDrawable d) wPtr hPtr (w::{#type gint#}) <- peek wPtr (h::{#type gint#}) <- peek hPtr return (fromIntegral w, fromIntegral h) -- | Determine where not to draw. -- -- * Computes the region of a drawable that potentially can be written -- to by drawing primitives. This region will not take into account the -- clip region for the GC, and may also not take into account other -- factors such as if the window is obscured by other windows, but no -- area outside of this region will be affected by drawing primitives. -- drawableGetClipRegion :: DrawableClass d => d -> IO Region drawableGetClipRegion d = do rPtr <- {#call unsafe drawable_get_clip_region#} (toDrawable d) makeNewRegion rPtr -- | Determine what not to redraw. -- -- * Computes the region of a drawable that is potentially visible. -- This does not necessarily take into account if the window is obscured -- by other windows, but no area outside of this region is visible. -- drawableGetVisibleRegion :: DrawableClass d => d -> IO Region drawableGetVisibleRegion d = do rPtr <- {#call unsafe drawable_get_visible_region#} (toDrawable d) makeNewRegion rPtr -- | Draw a point into a 'Drawable'. -- drawPoint :: DrawableClass d => d -> GC -> Point -> IO () drawPoint d gc (x,y) = {#call unsafe draw_point#} (toDrawable d) (toGC gc) (fromIntegral x) (fromIntegral y) -- | Draw several points into a 'Drawable'. -- -- * This function is more efficient than calling 'drawPoint' on -- several points. -- drawPoints :: DrawableClass d => d -> GC -> [Point] -> IO () drawPoints d gc [] = return () drawPoints d gc points = withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $ \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_points#} (toDrawable d) (toGC gc) (castPtr aPtr) (fromIntegral (length points)) -- | Draw a line into a 'Drawable'. -- -- * The parameters are x1, y1, x2, y2. -- -- * Drawing several separate lines can be done more efficiently by -- 'drawSegments'. -- drawLine :: DrawableClass d => d -> GC -> Point -> Point -> IO () drawLine d gc (x1,y1) (x2,y2) = {#call unsafe draw_line#} (toDrawable d) (toGC gc) (fromIntegral x1) (fromIntegral y1) (fromIntegral x2) (fromIntegral y2) -- | Draw several lines. -- -- * The function uses the current line width, dashing and especially the -- joining specification in the graphics context (in contrast to -- 'drawSegments'. -- drawLines :: DrawableClass d => d -> GC -> [Point] -> IO () drawLines d gc [] = return () drawLines d gc points = withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $ \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_lines#} (toDrawable d) (toGC gc) (castPtr aPtr) (fromIntegral (length points)) #if GTK_CHECK_VERSION(2,2,0) -- | Render a 'Pixbuf'. -- -- * Usage: -- @drawPixbuf d gc pb srcX srcY destX destY srcWidth srcHeight dither xDither yDither@ -- Renders a rectangular portion of a 'Pixbuf' to a -- 'Drawable'. The @srcX@, @srcY@, -- @srcWidth@ and @srcHeight@ specify what part of the -- 'Pixbuf' should be rendered. The latter two values may be -- @-1@ in which case the width and height are taken from -- @pb@. The image is placed at @destX@, @destY@. -- If you render parts of an image at a time, set @ditherX@ and -- @ditherY@ to the origin of the image you are rendering. -- -- * Since 2.2. -- drawPixbuf :: DrawableClass d => d -> GC -> Pixbuf -> Int -> Int -> Int -> Int -> Int -> Int -> Dither -> Int -> Int -> IO () drawPixbuf d gc pb srcX srcY destX destY srcWidth srcHeight dither xDither yDither = {#call unsafe draw_pixbuf#} (toDrawable d) gc pb (fromIntegral srcX) (fromIntegral srcY) (fromIntegral destX) (fromIntegral destY) (fromIntegral srcWidth) (fromIntegral srcHeight) ((fromIntegral . fromEnum) dither) (fromIntegral xDither) (fromIntegral yDither) #endif -- | Draw several unconnected lines. -- -- * This method draws several unrelated lines. -- drawSegments :: DrawableClass d => d -> GC -> [(Point,Point)] -> IO () drawSegments d gc [] = return () drawSegments d gc pps = withArray (concatMap (\((x1,y1),(x2,y2)) -> [fromIntegral x1, fromIntegral y1, fromIntegral x2, fromIntegral y2]) pps) $ \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_segments#} (toDrawable d) (toGC gc) (castPtr aPtr) (fromIntegral (length pps)) -- | Draw a rectangular object. -- -- * Draws a rectangular outline or filled rectangle, using the -- foreground color and other attributes of the 'GC'. -- -- * A rectangle drawn filled is 1 pixel smaller in both dimensions -- than a rectangle outlined. Calling 'drawRectangle' w gc -- True 0 0 20 20 results in a filled rectangle 20 pixels wide and 20 -- pixels high. Calling 'drawRectangle' d gc False 0 0 20 20 -- results in an outlined rectangle with corners at (0, 0), (0, 20), (20, -- 20), and (20, 0), which makes it 21 pixels wide and 21 pixels high. -- drawRectangle :: DrawableClass d => d -- ^ drawable -> GC -- ^ graphics context -> Bool -- ^ filled -> Int -- ^ x -> Int -- ^ y -> Int -- ^ width -> Int -- ^ height -> IO () drawRectangle d gc filled x y width height = {#call unsafe draw_rectangle#} (toDrawable d) (toGC gc) (fromBool filled) (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) -- | Draws an arc or a filled 'pie slice'. -- -- * The arc is defined by the bounding rectangle of the entire -- ellipse, and the start and end angles of the part of the ellipse to be -- drawn. -- -- * The starting angle @aStart@ is relative to the 3 o'clock -- position, counter-clockwise, in 1\/64ths of a degree. @aEnd@ -- is measured similarly, but relative to @aStart@. -- drawArc :: DrawableClass d => d -> GC -> Bool -> Int -> Int -> Int -> Int -> Int -> Int -> IO () drawArc d gc filled x y width height aStart aEnd = {#call unsafe draw_arc#} (toDrawable d) (toGC gc) (fromBool filled) (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) (fromIntegral aStart) (fromIntegral aEnd) -- | Draws an outlined or filled polygon. -- -- * The polygon is closed automatically, connecting the last point to -- the first point if necessary. -- drawPolygon :: DrawableClass d => d -> GC -> Bool -> [Point] -> IO () drawPolygon _ _ _ [] = return () drawPolygon d gc filled points = withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $ \(aPtr::Ptr {#type gint#}) -> {#call unsafe draw_polygon#} (toDrawable d) (toGC gc) (fromBool filled) (castPtr aPtr) (fromIntegral (length points)) -- | Draw a segment of text. -- -- * This function draws a segment of text. These segments are the result -- of itemizing a string into segments with the same characteristics -- (font, text direction, etc.) using -- 'Graphics.Rendering.Pango.Rendering.itemize'. Each item is then turned -- into a shapes by calling 'Graphics.Rendering.Pango.Rendering.shape'. -- These shapes can then be drawn onto screen using this function. -- A simpler interface, that also takes care of breaking a paragraph -- into several lines is a 'Graphics.Rendering.Pango.Layout.LayoutLine'. -- drawGlyphs :: DrawableClass d => d -> GC -> Int -> Int -> GlyphItem -> IO () drawGlyphs d gc x y (GlyphItem pi gs) = do font <- pangoItemGetFont pi {#call unsafe draw_glyphs#} (toDrawable d) (toGC gc) font (fromIntegral x) (fromIntegral y) gs -- -- | Draw a single line of text. -- -- * The @x@ coordinate specifies the start of the string, -- the @y@ coordinate specifies the base line. -- drawLayoutLine :: DrawableClass d => d -> GC -> Int -> Int -> LayoutLine -> IO () drawLayoutLine d gc x y (LayoutLine _ ll) = {#call unsafe draw_layout_line#} (toDrawable d) (toGC gc) (fromIntegral x) (fromIntegral y) ll -- | Draw a single line of text. -- -- * The @x@ coordinate specifies the start of the string, -- the @y@ coordinate specifies the base line. -- -- * If both colors are @Nothing@ this function will behave like -- 'drawLayoutLine' in that it uses the default colors from -- the graphics context. -- drawLayoutLineWithColors :: DrawableClass d => d -> GC -> Int -> Int -> LayoutLine -> Maybe Color -> Maybe Color -> IO () drawLayoutLineWithColors d gc x y (LayoutLine _ ll) foreground background = let withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b withMB Nothing f = f nullPtr withMB (Just x) f = with x f in withMB foreground $ \fPtr -> withMB background $ \bPtr -> {#call unsafe draw_layout_line_with_colors#} (toDrawable d) (toGC gc) (fromIntegral x) (fromIntegral y) ll (castPtr fPtr) (castPtr bPtr) -- | Draw a paragraph of text. -- -- * The @x@ and @y@ values specify the upper left -- point of the layout. -- drawLayout :: DrawableClass d => d -> GC -> Int -> Int -> PangoLayout -> IO () drawLayout d gc x y (PangoLayout _ pl) = {#call unsafe draw_layout#} (toDrawable d) (toGC gc) (fromIntegral x) (fromIntegral y) pl -- | Draw a paragraph of text. -- -- * The @x@ and @y@ values specify the upper left -- point of the layout. -- -- * If both colors are @Nothing@ this function will behave like -- 'drawLayout' in that it uses the default colors from -- the graphics context. -- drawLayoutWithColors :: DrawableClass d => d -> GC -> Int -> Int -> PangoLayout -> Maybe Color -> Maybe Color -> IO () drawLayoutWithColors d gc x y (PangoLayout _ pl) foreground background = let withMB :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b withMB Nothing f = f nullPtr withMB (Just x) f = with x f in withMB foreground $ \fPtr -> withMB background $ \bPtr -> {#call unsafe draw_layout_with_colors#} (toDrawable d) (toGC gc) (fromIntegral x) (fromIntegral y) pl (castPtr fPtr) (castPtr bPtr) -- | Copies another 'Drawable'. -- -- * Copies the (width,height) region of the @src@ at coordinates -- (@xSrc@, @ySrc@) to coordinates (@xDest@, -- @yDest@) in the @dest@. The @width@ and\/or -- @height@ may be given as -1, in which case the entire source -- drawable will be copied. -- -- * Most fields in @gc@ are not used for this operation, but -- notably the clip mask or clip region will be honored. The source and -- destination drawables must have the same visual and colormap, or -- errors will result. (On X11, failure to match visual\/colormap results -- in a BadMatch error from the X server.) A common cause of this -- problem is an attempt to draw a bitmap to a color drawable. The way to -- draw a bitmap is to set the bitmap as a clip mask on your -- 'GC', then use 'drawRectangle' to draw a -- rectangle clipped to the bitmap. -- drawDrawable :: (DrawableClass src, DrawableClass dest) => dest -- ^ destination drawable -> GC -- ^ graphics context -> src -- ^ source drawable -> Int -- ^ @xSrc@ -> Int -- ^ @ySrc@ -> Int -- ^ @xDest@ -> Int -- ^ @yDest@ -> Int -- ^ @width@ -> Int -- ^ @height@ -> IO () drawDrawable dest gc src xSrc ySrc xDest yDest width height = {#call unsafe draw_drawable#} (toDrawable dest) (toGC gc) (toDrawable src) (fromIntegral xSrc) (fromIntegral ySrc) (fromIntegral xDest) (fromIntegral yDest) (fromIntegral width) (fromIntegral height) #endif /* GTK_MAJOR_VERSION < 3 */ gtk-0.15.9/Graphics/UI/Gtk/Gdk/Enums.chs0000644000000000000000000002360407346545000015666 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Enumerations -- -- Author : Manuel M. T. Chakravarty, Axel Simon -- -- Created: 13 January 1999 -- -- Copyright (C) 1999-2005 Manuel M. T. Chakravarty, 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) -- -- General enumeration types. -- module Graphics.UI.Gtk.Gdk.Enums ( CrossingMode(..), DragProtocol(..), DragAction(..), EventMask(..), Modifier(..), #if GTK_CHECK_VERSION(3,4,0) ModifierIntent(..), #endif NotifyType(..), ScrollDirection(..), VisibilityState(..), WindowState(..), WindowEdge(..), WindowTypeHint(..), Gravity(..), GrabStatus(..), #if GTK_CHECK_VERSION(2,6,0) OwnerChange(..), #endif #if GTK_MAJOR_VERSION < 3 ExtensionMode(..), CapStyle(..), Dither(..), Fill(..), Function(..), InputCondition(..), JoinStyle(..), LineStyle(..), SubwindowMode(..), #endif ) where import System.Glib.Flags (Flags) {#context lib="gdk" prefix ="gdk"#} #if GTK_MAJOR_VERSION < 3 -- | Specify the how the ends of a line is drawn. -- -- Removed in Gtk3. {#enum CapStyle {underscoreToCase} deriving(Eq,Show)#} #endif -- | How focus is crossing the widget. -- {#enum CrossingMode {underscoreToCase} deriving(Eq,Show) #} -- | Used in 'Graphics.UI.Gtk.Gdk.Drag.DragContext' to indicate the protocol according to which DND is done. -- {#enum DragProtocol {underscoreToCase} deriving(Eq,Bounded,Show)#} -- | Used in 'Graphics.UI.Gtk.Genearl.Drag.DragContext' to indicate what the -- destination should do with the dropped data. -- -- * 'ActionDefault': Initialisation value, should not be used. -- -- * 'ActionCopy': Copy the data. -- -- * 'ActionMove': Move the data, i.e. first copy it, then delete it from the source. -- -- * 'ActionLink': Add a link to the data. Note that this is only useful if source and -- destination agree on what it means. -- -- * 'ActionPrivate': Special action which tells the source that the destination will do -- something that the source doesn't understand. -- -- * 'ActionAsk': Ask the user what to do with the data. -- {#enum DragAction {underscoreToCase} deriving(Eq,Bounded,Show)#} instance Flags DragAction #if GTK_MAJOR_VERSION < 3 -- | Specify how to dither colors onto the screen. -- -- Removed in Gtk3. {#enum RgbDither as Dither {underscoreToCase} deriving(Eq,Show) #} #endif -- | Specify which events a widget will emit signals on. -- {#enum EventMask {underscoreToCase} deriving(Eq,Bounded,Show)#} instance Flags EventMask -- | Keyboard modifiers that are depressed when the user presses -- a key or a mouse button. -- -- * This data type is used to build lists of modifiers that were active -- during an event. -- -- * The "Apple" key on Macintoshs is mapped to 'Alt2' and the 'Meta' -- key (if available). -- -- * Since Gtk 2.10, there are also 'Super', 'Hyper' and 'Meta' modifiers -- which are simply generated from 'Alt' .. 'Compose' modifier keys, -- depending on the mapping used by the windowing system. Due to one -- key being mapped to e.g. 'Alt2' and 'Meta', you shouldn't pattern -- match directly against a certain key but check whether a key is -- in the list using the 'elem' function, say. -- #if GTK_CHECK_VERSION(2,10,0) {#enum ModifierType as Modifier {SHIFT_MASK as Shift, LOCK_MASK as Lock, CONTROL_MASK as Control, MOD1_MASK as Alt, MOD2_MASK as Alt2, MOD3_MASK as Alt3, MOD4_MASK as Alt4, MOD5_MASK as Alt5, BUTTON1_MASK as Button1, BUTTON2_MASK as Button2, BUTTON3_MASK as Button3, BUTTON4_MASK as Button4, BUTTON5_MASK as Button5, SUPER_MASK as Super, HYPER_MASK as Hyper, META_MASK as Meta, RELEASE_MASK as Release, MODIFIER_MASK as ModifierMask } deriving(Bounded,Show,Eq) #} #else {#enum ModifierType as Modifier {SHIFT_MASK as Shift, LOCK_MASK as Lock, CONTROL_MASK as Control, MOD1_MASK as Alt, MOD2_MASK as Alt2, MOD3_MASK as Alt3, MOD4_MASK as Alt4, MOD5_MASK as Alt5, BUTTON1_MASK as Button1, BUTTON2_MASK as Button2, BUTTON3_MASK as Button3, BUTTON4_MASK as Button4, BUTTON5_MASK as Button5, RELEASE_MASK as Release, MODIFIER_MASK as ModifierMask } deriving(Bounded,Show,Eq) #} #endif instance Flags Modifier #if GTK_CHECK_VERSION(3,4,0) {#enum ModifierIntent {underscoreToCase} deriving(Eq,Show) #} #endif #if GTK_MAJOR_VERSION < 3 -- | specify which input extension a widget desires -- {#enum ExtensionMode {underscoreToCase} deriving(Eq,Bounded,Show)#} instance Flags ExtensionMode -- | How objects are filled. -- -- Removed in Gtk3. {#enum Fill {underscoreToCase} deriving(Eq,Show) #} -- | Determine how bitmap operations are carried out. -- -- Removed in Gtk3. {#enum Function {underscoreToCase} deriving(Eq,Show) #} -- | Specify on what file condition a callback should be -- done. -- -- Removed in Gtk3. {#enum InputCondition {underscoreToCase} deriving(Eq,Bounded) #} instance Flags InputCondition -- | Determines how adjacent line ends are drawn. -- -- Removed in Gtk3. {#enum JoinStyle {underscoreToCase} deriving(Eq,Show)#} -- | Determines if a line is solid or dashed. -- -- Removed in Gtk3. {#enum LineStyle {underscoreToCase} deriving(Eq,Show)#} #endif -- | Information on from what level of the widget hierarchy the mouse -- cursor came. -- -- ['NotifyAncestor'] The window is entered from an ancestor or left towards -- an ancestor. -- -- ['NotifyVirtual'] The pointer moves between an ancestor and an inferior -- of the window. -- -- ['NotifyInferior'] The window is entered from an inferior or left -- towards an inferior. -- -- ['NotifyNonlinear'] The window is entered from or left towards a -- window which is neither an ancestor nor an inferior. -- -- ['NotifyNonlinearVirtual'] The pointer moves between two windows which -- are not ancestors of each other and the window is part of the ancestor -- chain between one of these windows and their least common ancestor. -- -- ['NotifyUnknown'] The level change does not fit into any of the other -- categories or could not be determined. -- {#enum NotifyType {underscoreToCase} deriving(Eq,Show) #} -- | in which direction was scrolled? -- {#enum ScrollDirection {underscoreToCase} deriving(Eq,Show) #} #if GTK_MAJOR_VERSION < 3 -- | Determine if child widget may be overdrawn. -- -- Removed in Gtk3. {#enum SubwindowMode {underscoreToCase} deriving(Eq,Show) #} #endif -- | visibility of a window -- {#enum VisibilityState {underscoreToCase, VISIBILITY_PARTIAL as VisibilityPartialObscured} deriving(Eq,Show) #} -- | The state a @DrawWindow@ is in. -- {#enum WindowState {underscoreToCase} deriving(Eq,Bounded,Show)#} instance Flags WindowState -- | Determines a window edge or corner. -- {#enum WindowEdge {underscoreToCase} deriving(Eq,Show) #} -- | These are hints for the window manager that indicate what type of function -- the window has. The window manager can use this when determining decoration -- and behaviour of the window. The hint must be set before mapping the window. -- -- See the extended window manager hints specification for more details about -- window types. -- {#enum WindowTypeHint {underscoreToCase} deriving(Eq,Show)#} -- | Defines the reference point of a window and the meaning of coordinates -- passed to 'Graphics.UI.Gtk.Windows.Window.windowMove'. See -- 'Graphics.UI.Gtk.Windows.Window.windowMove' and the "implementation notes" -- section of the extended window manager hints specification for more details. -- {#enum Gravity {underscoreToCase} deriving(Eq,Show) #} -- | Returned by 'pointerGrab' and 'keyboardGrab' to indicate success or the -- reason for the failure of the grab attempt. -- -- [@GrabSuccess@] the resource was successfully grabbed. -- -- [@GrabAlreadyGrabbed@] the resource is actively grabbed by another client. -- -- [@GrabInvalidTime@] the resource was grabbed more recently than the -- specified time. -- -- [@GrabNotViewable@] the grab window or the confine_to window are not -- viewable. -- -- [@GrabFrozen@] the resource is frozen by an active grab of another client. -- {#enum GrabStatus {underscoreToCase} deriving(Eq,Show) #} #if GTK_CHECK_VERSION(2,6,0) -- | Specifies why a selection ownership was changed. -- -- [@OwnerChangeNewOwner@] some other application claimed the ownership -- -- [@OwnerChangeDestroy@] the window was destroyed -- -- [@OwnerChangeClose@] the client was closed -- {#enum OwnerChange {underscoreToCase} deriving(Eq,Show) #} #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/EventM.hsc0000644000000000000000000006355307346545000016004 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE EmptyDataDecls #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE FlexibleContexts #-} #endif -- -*-haskell-*- #include #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) GDK Event information in a Monad -- -- Author : Axel Simon -- -- Created 12 October 2008 -- -- Copyright (C) 2008 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. -- -- #prune -- | -- Maintainer : gtk2hs-users\@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Types and accessors to examine information in events. -- module Graphics.UI.Gtk.Gdk.EventM ( -- * Detail -- -- | This modules provides a monad that encapsulates the information in an -- event. -- -- The events a widget can receive are defined in -- "Graphics.UI.Gtk.Abstract.Widget#7". Every event carries additional -- information which is accessible through functions in the 'EventM' monad. -- For instance, every event is associated with a -- 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' which is accessed using the -- 'eventWindow' accessor function. Other information is only available in -- one specific event. For example, the -- area that has to be redrawn, accessed by 'eventArea' is only available in -- the 'Graphics.UI.Gtk.Abstract.Widget.exposeEvent'. Indeed, you can only -- call 'eventArea' if the first type parameter of 'EventM' is the phantom -- type 'EExpose'. (A phantom type is a type for which no values exist and -- which is only used to enforce certain constraints on the usage of -- functions such as 'eventArea'.) Some information is available in several -- but not all events. In order to express these constraints the module -- defines type classes whose names start with @Has...@ but which are not -- exported, implying that no new instance can be created. (They could be -- called phantom type classes.) For instance, the mouse pointer coordinates -- can be retrieved using the function 'eventCoordinates' which requires -- that the first type parameter of 'EventM' is in the class -- 'HasCoordinates'. The module supplies instance of class 'HasCoordinates' -- for the types 'EButton', 'ECrossing', 'EMotion' and 'EScroll'. Thus for -- all events that require an 'EventM' action with one of the types above, -- the accessor function 'eventCoordinates' may be used. -- -- Note that an event handler must always returns @True@ if the event -- was handled or @False@ if the event should be dealt with by another -- event handler. For instance, a handler for a key press should return -- @False@ if the pressed key is not one of those that the widget reacts -- to. In this case the event is passed to the parent widgets. This -- ensures that pressing, say, @Alt-F@ opens the file menu even if the -- current input focus is in a text entry widget. In order to facilitate -- writing handlers that may abort handling an event, this module provides -- the function 'tryEvent'. This function catches pattern match exceptions -- and returns @False@. If the signal successfully runs to its end, it -- returns @True@. A typical use is as follows: -- -- > widget `on` keyPressEvent $ tryEvent $ do -- > [Control] <- eventModifier -- > "Return" <- eventKeyName -- > liftIO $ putStrLn "Ctrl-Return pressed" -- -- The rationale is that the action will throw an exception if the -- two event functions 'eventModifier' and 'eventKeyName' return something -- else than what is stated in -- the pattern. When no exception is thrown, execution continues to -- the last statement where the event is processed, here we merely -- print a message. Note that the return -- value of this statement must be @()@ since 'tryEvent' always -- assumes that the -- function handled the event if no exception is thrown. A handler -- wrapped by 'tryEvent' can also indicate that it cannot handle the -- given event by calling 'stopEvent'. -- -- Finally, not that the 'EventM' monad wraps the @IO@ monad. As such -- you can (and usually have to) use @liftIO@ to execute @IO@ functions. -- -- * Classes HasCoordinates, HasRootCoordinates, HasModifier, HasTime, -- * Event monad and type tags EventM, EAny, EKey, EButton, EScroll, EMotion, EExpose, EVisibility, ECrossing, EFocus, EConfigure, EProperty, EProximity, EWindowState, #if GTK_CHECK_VERSION(2,6,0) EOwnerChange, #endif #if GTK_CHECK_VERSION(2,8,0) EGrabBroken, #endif -- * Accessor functions for event information eventWindow, eventSent, eventCoordinates, eventRootCoordinates, eventModifier, eventModifierAll, eventModifierMouse, eventTime, eventKeyVal, eventKeyName, eventHardwareKeycode, eventKeyboardGroup, MouseButton(..), eventButton, Click(..), eventClick, ScrollDirection(..), eventScrollDirection, eventIsHint, #if GTK_CHECK_VERSION(2,12,0) eventRequestMotions, #endif eventArea, #if GTK_MAJOR_VERSION < 3 eventRegion, #endif VisibilityState(..), eventVisibilityState, CrossingMode(..), eventCrossingMode, NotifyType(..), eventNotifyType, eventCrossingFocus, eventFocusIn, eventPosition, eventSize, eventProperty, WindowState(..), eventWindowStateChanged, eventWindowState, #if GTK_CHECK_VERSION(2,6,0) OwnerChange(..), eventChangeReason, eventSelection, eventSelectionTime, #endif #if GTK_CHECK_VERSION(2,8,0) eventKeyboardGrab, eventImplicit, eventGrabWindow, #endif -- * Auxiliary Definitions Modifier(..), -- a mask of control keys TimeStamp, currentTime, tryEvent, stopEvent, ) where import Prelude hiding (catch) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import System.Glib.GObject ( makeNewGObject ) import Graphics.UI.Gtk.Gdk.Keys (KeyVal, KeyCode, keyName) #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Region (Region, makeNewRegion) #endif import Graphics.UI.Gtk.Gdk.Enums (Modifier(..), VisibilityState(..), CrossingMode(..), NotifyType(..), WindowState(..), ScrollDirection(..), #if GTK_CHECK_VERSION(2,6,0) OwnerChange(..) #endif ) import Graphics.UI.Gtk.General.Enums (MouseButton(..), Click(..)) import Graphics.UI.Gtk.General.Structs (Rectangle(..)) import Graphics.UI.Gtk.General.DNDTypes (Atom(..), SelectionTag) import Graphics.UI.Gtk.Types ( DrawWindow, mkDrawWindow ) import Data.List (isPrefixOf) import Control.Monad.Reader ( ReaderT, ask, runReaderT ) import Control.Monad.Trans ( liftIO ) import Control.Monad ( liftM ) #if __GLASGOW_HASKELL__ >= 610 import Control.Exception ( Handler(..) , PatternMatchFail(..) , catches, throw ) import System.IO.Error (isUserError, ioeGetErrorString) #else import Control.Exception (catch, throw, Exception(PatternMatchFail,IOException) ) #endif -- | A monad providing access to data in an event. -- type EventM t = ReaderT (Ptr t) IO -- | A tag for events that do not carry any event-specific information. data EAny -- | A tag for /key/ events. data EKey -- | A tag for /Button/ events. data EButton -- | A tag for /Scroll/ events. data EScroll -- | A tag for /Motion/ events. data EMotion -- | A tag for /Expose/ events. data EExpose -- | A tag for /Visibility/ events. data EVisibility -- | A tag for /Crossing/ events. data ECrossing -- | A tag for /Focus/ events. data EFocus -- | A tag for /Configure/ events. data EConfigure -- | A tag for /Property/ events. data EProperty -- | A tag for /Proximity/ events. data EProximity -- | A tag for /WindowState/ event. data EWindowState #if GTK_CHECK_VERSION(2,6,0) -- | A tag for /OwnerChange/ events. data EOwnerChange #endif #if GTK_CHECK_VERSION(2,8,0) -- | A tag for /GrabBroken/ events. data EGrabBroken #endif -- | Retrieve the 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' that this -- event relates to. eventWindow :: EventM any DrawWindow eventWindow = do ptr <- ask liftIO $ makeNewGObject mkDrawWindow (#{peek GdkEventAny, window} ptr) -- | Query if this event was sent sent explicitly by the application -- (rather than being generated by human interaction). eventSent :: EventM any Bool eventSent = do ptr <- ask liftIO $ #{peek GdkEventAny, send_event} ptr class HasCoordinates a instance HasCoordinates EButton instance HasCoordinates EScroll instance HasCoordinates EMotion instance HasCoordinates ECrossing -- | Retrieve the @(x,y)@ coordinates of the mouse. eventCoordinates :: HasCoordinates t => EventM t (Double, Double) eventCoordinates = do ptr <- ask liftIO $ do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr) if ty `elem` [ #{const GDK_BUTTON_PRESS}, #{const GDK_2BUTTON_PRESS}, #{const GDK_3BUTTON_PRESS}, #{const GDK_BUTTON_RELEASE}] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, y} ptr return (realToFrac x, realToFrac y) else if ty `elem` [ #{const GDK_SCROLL} ] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, y} ptr return (realToFrac x, realToFrac y) else if ty `elem` [ #{const GDK_MOTION_NOTIFY} ] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, y} ptr return (realToFrac x, realToFrac y) else if ty `elem` [ #{const GDK_ENTER_NOTIFY}, #{const GDK_LEAVE_NOTIFY}] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, y} ptr return (realToFrac x, realToFrac y) else error ("eventCoordinates: none for event type "++show ty) class HasRootCoordinates a instance HasRootCoordinates EButton instance HasRootCoordinates EScroll instance HasRootCoordinates EMotion instance HasRootCoordinates ECrossing -- | Retrieve the @(x,y)@ coordinates of the mouse relative to the -- root (origin) of the screen. eventRootCoordinates :: HasRootCoordinates t => EventM t (Double, Double) eventRootCoordinates = do ptr <- ask liftIO $ do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr) if ty `elem` [ #{const GDK_BUTTON_PRESS}, #{const GDK_2BUTTON_PRESS}, #{const GDK_3BUTTON_PRESS}, #{const GDK_BUTTON_RELEASE}] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, x_root} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, y_root} ptr return (realToFrac x, realToFrac y) else if ty `elem` [ #{const GDK_SCROLL} ] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, x_root} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, y_root} ptr return (realToFrac x, realToFrac y) else if ty `elem` [ #{const GDK_MOTION_NOTIFY} ] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, x_root} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, y_root} ptr return (realToFrac x, realToFrac y) else if ty `elem` [ #{const GDK_ENTER_NOTIFY}, #{const GDK_LEAVE_NOTIFY}] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, x_root} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, y_root} ptr return (realToFrac x, realToFrac y) else error ("eventRootCoordinates: none for event type "++show ty) class HasModifier a instance HasModifier EKey instance HasModifier EButton instance HasModifier EScroll instance HasModifier EMotion instance HasModifier ECrossing -- | Query the modifier keys that were depressed when the event happened. -- Sticky modifiers such as CapsLock are omitted in the return value. -- Use 'eventModifierAll' your application requires all modifiers. -- Use 'eventModifierMouse' if you just need the mouse buttons. -- eventModifier :: HasModifier t => EventM t [Modifier] eventModifier = eM defModMask -- | Query the modifier keys that were depressed when the event happened. -- The result includes sticky modifiers such as CapsLock. Normally, -- 'eventModifier' is more appropriate in applications. -- eventModifierAll :: HasModifier t => EventM t [Modifier] eventModifierAll = eM allModMask -- | Query the mouse buttons that were depressed when the event happened. -- eventModifierMouse :: HasModifier t => EventM t [Modifier] eventModifierMouse = eM mouseModMask allModMask = -1 foreign import ccall safe "gtk_accelerator_get_default_mod_mask" defModMask :: #gtk2hs_type guint mouseModMask = #{const GDK_BUTTON1_MASK} .|. #{const GDK_BUTTON2_MASK} .|. #{const GDK_BUTTON3_MASK} .|. #{const GDK_BUTTON4_MASK} .|. #{const GDK_BUTTON5_MASK} eM mask = do ptr <- ask liftIO $ do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr) if ty `elem` [ #{const GDK_KEY_PRESS}, #{const GDK_KEY_RELEASE}] then do (modif ::#gtk2hs_type guint) <- #{peek GdkEventKey, state} ptr return (toFlags (fromIntegral (modif .&. mask))) else if ty `elem` [ #{const GDK_BUTTON_PRESS}, #{const GDK_2BUTTON_PRESS}, #{const GDK_3BUTTON_PRESS}, #{const GDK_BUTTON_RELEASE}] then do (modif ::#gtk2hs_type guint) <- #{peek GdkEventButton, state} ptr return (toFlags (fromIntegral (modif .&. mask))) else if ty `elem` [ #{const GDK_SCROLL} ] then do (modif ::#gtk2hs_type guint) <- #{peek GdkEventScroll, state} ptr return (toFlags (fromIntegral (modif .&. mask))) else if ty `elem` [ #{const GDK_MOTION_NOTIFY} ] then do (modif ::#gtk2hs_type guint) <- #{peek GdkEventMotion, state} ptr return (toFlags (fromIntegral (modif .&. mask))) else if ty `elem` [ #{const GDK_ENTER_NOTIFY}, #{const GDK_LEAVE_NOTIFY}] then do (modif ::#gtk2hs_type guint) <- #{peek GdkEventCrossing, state} ptr return (toFlags (fromIntegral (modif .&. mask))) else error ("eventModifiers: none for event type "++show ty) class HasTime a instance HasTime EKey instance HasTime EButton instance HasTime EScroll instance HasTime EMotion instance HasTime ECrossing instance HasTime EProperty instance HasTime EProximity #if GTK_CHECK_VERSION(2,6,0) instance HasTime EOwnerChange #endif -- | The time (in milliseconds) when an event happened. This is used mostly -- for ordering events and responses to events. -- type TimeStamp = Word32 -- TODO: make this a newtype -- | Represents the current time, and can be used anywhere a time is expected. currentTime :: TimeStamp currentTime = #{const GDK_CURRENT_TIME} -- | Query the time when the event occurred. eventTime :: HasTime t => EventM t TimeStamp eventTime = do ptr <- ask liftIO $ do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr) if ty `elem` [ #{const GDK_KEY_PRESS}, #{const GDK_KEY_RELEASE}] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventKey, time} ptr return (fromIntegral time) else if ty `elem` [ #{const GDK_BUTTON_PRESS}, #{const GDK_2BUTTON_PRESS}, #{const GDK_3BUTTON_PRESS}, #{const GDK_BUTTON_RELEASE}] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventButton, time} ptr return (fromIntegral time) else if ty `elem` [ #{const GDK_SCROLL} ] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventScroll, time} ptr return (fromIntegral time) else if ty `elem` [ #{const GDK_MOTION_NOTIFY} ] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventMotion, time} ptr return (fromIntegral time) else if ty `elem` [ #{const GDK_ENTER_NOTIFY}, #{const GDK_LEAVE_NOTIFY}] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventCrossing, time} ptr return (fromIntegral time) else if ty `elem` [ #{const GDK_PROPERTY_NOTIFY} ] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventProperty, time} ptr return (fromIntegral time) else if ty `elem` [ #{const GDK_PROXIMITY_IN}, #{const GDK_PROXIMITY_OUT}] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventProximity, time} ptr return (fromIntegral time) #if GTK_CHECK_VERSION(2,6,0) else if ty `elem` [ #{const GDK_OWNER_CHANGE} ] then do (time :: #gtk2hs_type guint32) <- #{peek GdkEventOwnerChange, time} ptr return (fromIntegral time) #endif else error ("eventModifiers: none for event type "++show ty) -- | The key value. See 'Graphics.UI.Gtk.Gdk.Keys.KeyVal'. eventKeyVal :: EventM EKey KeyVal eventKeyVal = ask >>= \ptr -> liftIO $ liftM fromIntegral (#{peek GdkEventKey, keyval} ptr :: IO #{gtk2hs_type guint}) -- | The key value as a string. See 'Graphics.UI.Gtk.Gdk.Keys.KeyVal'. eventKeyName :: EventM EKey DefaultGlibString eventKeyName = liftM keyName $ eventKeyVal -- | The hardware key code. eventHardwareKeycode :: EventM EKey KeyCode eventHardwareKeycode = ask >>= \ptr -> liftIO $ liftM fromIntegral (#{peek GdkEventKey, hardware_keycode} ptr :: IO #{gtk2hs_type guint16}) -- | The keyboard group. eventKeyboardGroup :: EventM EKey Word8 eventKeyboardGroup = ask >>= \ptr -> liftIO $ liftM fromIntegral (#{peek GdkEventKey, group} ptr :: IO #{gtk2hs_type guint8}) -- | Query the mouse buttons. eventButton :: EventM EButton MouseButton eventButton = ask >>= \ptr -> liftIO $ liftM (toEnum . fromIntegral) (#{peek GdkEventButton, button} ptr :: IO #{gtk2hs_type guint}) --- | Query the mouse click. eventClick :: EventM EButton Click eventClick = do ptr <- ask liftIO $ do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr) case ty of #{const GDK_BUTTON_PRESS} -> return SingleClick #{const GDK_2BUTTON_PRESS} -> return DoubleClick #{const GDK_3BUTTON_PRESS} -> return TripleClick #{const GDK_BUTTON_RELEASE} -> return ReleaseClick _ -> error ("eventClick: non for event type "++show ty) -- | Query the direction of scrolling. eventScrollDirection :: EventM EScroll ScrollDirection eventScrollDirection = ask >>= \ptr -> liftIO $ liftM (toEnum . fromIntegral) (#{peek GdkEventScroll, direction} ptr :: IO #{gtk2hs_type GdkScrollDirection}) -- | Check if the motion event is only a hint rather than the full mouse -- movement information. eventIsHint :: EventM EMotion Bool eventIsHint = ask >>= \ptr -> liftIO $ liftM toBool (#{peek GdkEventMotion, is_hint} ptr :: IO #{gtk2hs_type gint16}) #if GTK_CHECK_VERSION(2,12,0) -- | Request more motion notifies if this event is a motion notify hint event. -- -- This action should be used instead of 'drawWindowGetPointer' to request -- further motion notifies, because it also works for extension events where -- motion notifies are provided for devices other than the core pointer. -- -- Coordinate extraction, processing and requesting more motion events from a -- 'motionNotifyEvent' usually works like this: -- -- > on widget motionNotifyEvent $ do -- > (x, y) <- eventCoordinates -- > -- handle the x,y motion: -- > ... -- > -- finally, notify that we are ready to get more motion events: -- > eventRequestMotions -- eventRequestMotions :: EventM EMotion () eventRequestMotions = ask >>= \ptr -> liftIO $ gdk_event_request_motions ptr foreign import ccall "gdk_event_request_motions" gdk_event_request_motions :: Ptr EMotion -> IO () #endif -- | Query a bounding box of the region that needs to be updated. eventArea :: EventM EExpose Rectangle eventArea = ask >>= \ptr -> liftIO $ (#{peek GdkEventExpose, area} ptr :: IO Rectangle) #if GTK_MAJOR_VERSION < 3 -- | Query the region that needs to be updated. -- Removed in Gtk3. eventRegion :: EventM EExpose Region eventRegion = ask >>= \ptr -> liftIO $ do (reg_ :: Ptr Region) <- #{peek GdkEventExpose, region} ptr reg_ <- gdk_region_copy reg_ makeNewRegion reg_ foreign import ccall "gdk_region_copy" gdk_region_copy :: Ptr Region -> IO (Ptr Region) #endif -- | Get the visibility status of a window. eventVisibilityState :: EventM EVisibility VisibilityState eventVisibilityState = ask >>= \ptr -> liftIO $ liftM (toEnum . fromIntegral) (#{peek GdkEventVisibility, state} ptr :: IO #{gtk2hs_type GdkVisibilityState}) -- | Get the mode of the mouse cursor crossing a window. eventCrossingMode :: EventM ECrossing CrossingMode eventCrossingMode = ask >>= \ptr -> liftIO $ liftM (toEnum . fromIntegral) (#{peek GdkEventCrossing, mode} ptr :: IO #{gtk2hs_type GdkCrossingMode}) -- | Get the notify type of the mouse cursor crossing a window. eventNotifyType :: EventM ECrossing NotifyType eventNotifyType = ask >>= \ptr -> liftIO $ liftM (toEnum . fromIntegral) (#{peek GdkEventCrossing, detail} ptr :: IO #{gtk2hs_type GdkNotifyType}) -- | Query if the window has the focus or is an inferior window. eventCrossingFocus :: EventM ECrossing Bool eventCrossingFocus = ask >>= \ptr -> liftIO $ liftM toBool (#{peek GdkEventCrossing, focus} ptr :: IO #{gtk2hs_type gboolean}) -- | Query if a window gained focus (@True@) or lost the focus (@False@). eventFocusIn :: EventM EFocus Bool eventFocusIn = ask >>= \ptr -> liftIO $ liftM toBool (#{peek GdkEventFocus, in} ptr :: IO #{gtk2hs_type gint16}) -- | Get the @(x,y)@ position of the window within the parent window. eventPosition :: EventM EConfigure (Int,Int) eventPosition = ask >>= \ptr -> liftIO $ do (x :: #{gtk2hs_type gint}) <- #{peek GdkEventConfigure, x} ptr (y :: #{gtk2hs_type gint}) <- #{peek GdkEventConfigure, y} ptr return (fromIntegral x, fromIntegral y) -- | Get the new size of the window as @(width,height)@. eventSize :: EventM EConfigure (Int,Int) eventSize = ask >>= \ptr -> liftIO $ do (x :: #{gtk2hs_type gint}) <- #{peek GdkEventConfigure, width} ptr (y :: #{gtk2hs_type gint}) <- #{peek GdkEventConfigure, height} ptr return (fromIntegral x, fromIntegral y) eventProperty :: EventM EProperty Atom eventProperty = ask >>= \ptr -> liftIO $ liftM Atom (#{peek GdkEventProperty, atom} ptr :: IO (Ptr ())) -- | Query which window state bits have changed. eventWindowStateChanged :: EventM EWindowState [WindowState] eventWindowStateChanged = ask >>= \ptr -> liftIO $ liftM (toFlags . fromIntegral) (#{peek GdkEventWindowState, changed_mask} ptr :: IO #{gtk2hs_type GdkWindowState}) -- | Query the new window state. eventWindowState :: EventM EWindowState [WindowState] eventWindowState = ask >>= \ptr -> liftIO $ liftM (toFlags . fromIntegral) (#{peek GdkEventWindowState, new_window_state} ptr :: IO #{gtk2hs_type GdkWindowState}) #if GTK_CHECK_VERSION(2,6,0) -- | Query why a seleciton changed its owner. eventChangeReason :: EventM EOwnerChange OwnerChange eventChangeReason = ask >>= \ptr -> liftIO $ liftM (toEnum . fromIntegral) (#{peek GdkEventOwnerChange, reason} ptr :: IO #{gtk2hs_type GdkOwnerChange}) -- | Query what selection changed its owner. eventSelection :: EventM EOwnerChange SelectionTag eventSelection = ask >>= \ptr -> liftIO $ liftM Atom (#{peek GdkEventOwnerChange, selection} ptr :: IO (Ptr ())) -- | Query the time when the selection was taken over. eventSelectionTime :: EventM EOwnerChange TimeStamp eventSelectionTime = ask >>= \ptr -> liftIO $ liftM fromIntegral (#{peek GdkEventOwnerChange, selection_time} ptr :: IO (#{gtk2hs_type guint32})) #endif #if GTK_CHECK_VERSION(2,8,0) -- | Check if a keyboard (@True@) or a mouse pointer grap (@False@) was -- broken. eventKeyboardGrab :: EventM EGrabBroken Bool eventKeyboardGrab = ask >>= \ptr -> liftIO $ liftM toBool (#{peek GdkEventGrabBroken, keyboard} ptr :: IO #{gtk2hs_type gboolean}) -- | Check if a grab was broken implicitly. eventImplicit :: EventM EGrabBroken Bool eventImplicit = ask >>= \ptr -> liftIO $ liftM toBool (#{peek GdkEventGrabBroken, implicit} ptr :: IO #{gtk2hs_type gboolean}) -- | Get the new window that owns the grab or @Nothing@ if the window -- is not part of this application. eventGrabWindow :: EventM EGrabBroken (Maybe DrawWindow) eventGrabWindow = do ptr <- ask liftIO $ maybeNull (makeNewGObject mkDrawWindow) (#{peek GdkEventAny, window} ptr) #endif -- | Execute an event handler and assume it handled the event unless it -- threw a pattern match exception or calls mzero (e.g. via guard). tryEvent :: EventM any () -> EventM any Bool tryEvent act = do ptr <- ask liftIO $ (runReaderT (act >> return True) ptr) #if __GLASGOW_HASKELL__ >= 610 `catches` [ Handler (\ (PatternMatchFail _) -> return False) , Handler (\ e -> if isUserError e && ("Pattern" `isPrefixOf` ioeGetErrorString e || "mzero" == ioeGetErrorString e) then return False else throw e) ] #else `catch` (\e -> case e of IOException e | "user error (Pattern" `isPrefixOf` show e -> return False | "user error (mzero" `isPrefixOf` show e -> return False PatternMatchFail _ -> return False _ -> throw e) #endif -- | Explicitly stop the handling of an event. This function should only be -- called inside a handler that is wrapped with 'tryEvent'. (It merely -- throws a bogus pattern matching error which 'tryEvent' interprets as if -- the handler does not handle the event.) stopEvent :: EventM any () stopEvent = liftIO $ throw (PatternMatchFail "EventM.stopEvent called explicitly") gtk-0.15.9/Graphics/UI/Gtk/Gdk/Events.hsc0000644000000000000000000006003507346545000016042 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- -*-haskell-*- #include #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) GDK Events -- -- Author : Axel Simon -- -- Created: 27 April 2001 -- -- Copyright (C) 2001-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. -- -- | -- Maintainer : gtk2hs-users\@lists.sourceforge.net -- Stability : deprecated -- Portability : portable (depends on GHC) -- -- Definition of a record that contains event information. Deprecated in -- favor of 'Graphics.UI.Gtk.Gdk.EventM' and not exported by Gtk.hs. -- module Graphics.UI.Gtk.Gdk.Events ( Modifier(..), -- a mask of control keys TimeStamp, currentTime, -- | Deprecated way of conveying event information. Event(..), -- information in event callbacks from Gdk EventButton, EventScroll, EventMotion, EventExpose, EventKey, EventConfigure, EventCrossing, EventFocus, EventProperty, EventProximity, EventVisibility, EventWindowState, EventGrabBroken, marshExposeRect, -- selector functions marshalEvent, -- convert a pointer to an event data structure -- used data structures VisibilityState(..), CrossingMode(..), NotifyType(..), WindowState(..), ScrollDirection(..), MouseButton(..), Click(..), Rectangle(..) ) where import System.IO.Unsafe (unsafeInterleaveIO) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import Graphics.UI.Gtk.Gdk.Keys (KeyVal, keyvalToChar, keyvalName) #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Region (Region, makeNewRegion) #endif import Graphics.UI.Gtk.Gdk.Enums (Modifier(..), VisibilityState(..), CrossingMode(..), NotifyType(..), WindowState(..), ScrollDirection(..)) import Graphics.UI.Gtk.General.Enums (MouseButton(..), Click(..)) import Graphics.UI.Gtk.General.Structs (Rectangle(..)) -- | The time (in milliseconds) when an event happened. This is used mostly -- for ordering events and responses to events. -- type TimeStamp = Word32 -- TODO: make this a newtype -- | Represents the current time, and can be used anywhere a time is expected. currentTime :: TimeStamp currentTime = #{const GDK_CURRENT_TIME} -- Note on Event: -- * 'Event' can communicate a small array of data to another widget. This -- functionality is not bound as it can be done easier in Haskell. -- -- * EventDND is not implemented as registering a DND source or sink -- should be easier and sufficient for everything. -- -- * EventProperty is not bound since it involves Atoms and its hard to see -- how a Haskell application should extract the data. It should be possible -- to connect directly to 'propertyChanged' signals. If there is a need -- to monitor a property for which there is no signal we could add -- a trigger for just that property. -- -- * EventSelection - I don\'t quite see how this works, so not bound. -- -- * NoExpose - seems pointless: you copy from a drawable and this signal -- tells you that it was up-to-date without redrawing. Maybe I'm missing -- something. -- -- * EventSetting informs about a change in setting that are shared among -- several applications. They are probably not relevant to user defined -- widgets. Anyway they don\'t make sense before GtkSettings isn\'t bound. -- -- * Property is a TODO. These come from RC files which are useful for -- custom widgets. -- | An event that contains information on a button press. type EventButton = Event -- | An event that contains information on scrolling. type EventScroll = Event -- | An event that contains information on the movement of the mouse pointer. type EventMotion = Event -- | An area of the 'DrawWindow' needs redrawing. type EventExpose = Event -- | An event that contains information about a key press. type EventKey = Event -- | An event that contains the new size of a window. type EventConfigure = Event -- | Generated when the pointer enters or leaves a window. type EventCrossing = Event -- | An event that informs about a change of the input focus. type EventFocus = Event -- | An event that indicates a property of the window changed. type EventProperty = Event -- | An event that indicates that the pen of a graphics table is touching or -- not touching the tablet. type EventProximity = Event -- | Parts of the window have been exposed or obscured. type EventVisibility = Event -- | The window state has changed. type EventWindowState = Event -- | A grab has been broken by unusual means. type EventGrabBroken = Event -- | Events that are delivered to a widget. -- -- * Any given signal only emits one of these variants as described -- in 'Graphics.UI.Gtk.Abstract.Widget.Widget'. -- Many events share common attributes: -- -- * The 'eventSent' attribute is @True@ if the event was not created by the -- user but by another application. -- -- * The 'eventTime' attribute contains a time in milliseconds when the event -- happened. -- -- * The 'eventX' and 'eventY' attributes contain the coordinates relative -- to the 'Graphics.UI.Gtk.Abstract.Gdk.DrawWindow' associated with this -- widget. The values can contain sub-pixel information if the input -- device is a graphics tablet or the like. -- -- * The 'eventModifier' attribute denotes what modifier key was pressed -- during the event. -- data Event = -- | An event that is not in one of the more specific categories below. This -- includes delete, destroy, map and unmap events. These events -- have no extra information associated with them. Event { eventSent :: Bool } -- | The expose event. -- -- * A region of widget that receives this event needs to be redrawn. -- This event is the result of revealing part or all of a window -- or by the application calling functions like -- 'Graphics.UI.Gtk.Abstract.Widget.widgetQueueDrawArea'. -- | Expose { eventSent :: Bool, -- | A bounding box denoting what needs to be updated. For a more -- detailed information on the area that needs redrawing, use the -- next field. eventArea :: Rectangle, #if GTK_MAJOR_VERSION < 3 -- | A set of horizontal stripes that denote the invalid area. eventRegion :: Region, #endif -- | The number of contiguous 'Expose' events following this -- one. The only use for this is \"exposure compression\", i.e. -- handling all contiguous 'Expose' events in one go, though Gdk -- performs some exposure compression so this is not normally needed. eventCount :: Int } -- | Mouse motion. -- -- * Captures the movement of the mouse cursor while it is within the area -- of the widget. -- | Motion { eventSent :: Bool, eventTime :: TimeStamp, eventX,eventY :: Double, eventModifier :: [Modifier], -- | Indicate if this event is only a hint of the motion. -- -- * If the 'Graphics.UI.Gtk.Abstract.Widget.PointerMotionHintMask' -- is set with 'Data.Array.MArray.widgetAddEvents' then -- mouse positions are only generated each time -- 'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowGetPointer' -- is called. In this case 'eventIsHint' is set to @True@. -- eventIsHint :: Bool, eventXRoot, eventYRoot :: Double } -- | A mouse button was pressed or released. -- -- * This event is triggered if the mouse button was pressed or released -- while the mouse cursor was within the region of the widget. -- | Button { eventSent :: Bool, -- | The kind of button press, see 'Click'. Note that double clicks will -- trigger this event with 'eventClick' set to 'SingleClick', -- 'ReleaseClick', -- 'SingleClick', 'DoubleClick', 'ReleaseClick'. Triple clicks will -- produce this sequence followed by 'SingleClick', 'DoubleClick', -- 'TripleClick', 'ReleaseClick'. eventClick :: Click, -- | The time of the event in milliseconds. eventTime :: TimeStamp, eventX,eventY :: Double, eventModifier :: [Modifier], -- | The button that was pressed. eventButton :: MouseButton, -- | The coordinates of the click relative to the screen origin. eventXRoot, eventYRoot :: Double } -- | A key was pressed while the widget had the input focus. -- -- * If the widget has the current input focus (see -- 'Graphics.UI.Gtk.Abstract.Widget.widgetSetCanFocus') -- it will receive key pressed events. Certain key combinations are of -- no interest to a normal widget like Alt-F to access the file menu. -- For all these keys, the handler must return @False@ to indicate that -- the key stroke should be propagated to the parent widget. At the -- top-level widget, keyboard shortcuts like Alt-F are turned into the -- corresponding signals. -- | Key { -- | This flag is set if the key was released. This flag makes it possible -- to connect the same handler to -- 'Graphics.UI.Gtk.Abstract.Widget.onKeyPress' and -- 'Graphics.UI.Gtk.Abstract.Widget.onKeyRelease'. eventRelease :: Bool, eventSent :: Bool, eventTime :: TimeStamp, eventModifier :: [Modifier], -- | This flag is @True@ if Caps Lock is on while this key was pressed. eventWithCapsLock :: Bool, -- | This flag is @True@ if Number Lock is on while this key was pressed. eventWithNumLock :: Bool, -- | This flag is @True@ if Scroll Lock is on while this key was pressed. eventWithScrollLock :: Bool, -- | A number representing the key that was pressed or released. A more convenient -- interface is provided by the next two fields. eventKeyVal :: KeyVal, -- | A string representing the key that was pressed or released. -- -- * This string contains a description of the key rather than what -- should appear on screen. For example, pressing "1" on the keypad -- results in "KP_1". Of particular interest are "F1" till "F12", -- for a complete list refer to \"\" where all -- possible values are defined. The corresponding strings are the -- constants without the GDK_ prefix. eventKeyName :: DefaultGlibString, -- | A character matching the key that was pressed. -- -- * This entry can be used to build up a whole input string. -- The character is @Nothing@ if the key does not correspond to a simple -- unicode character. -- eventKeyChar :: Maybe Char } -- | Mouse cursor crossing event. -- -- * This event indicates that the mouse cursor is hovering over this -- widget. It is used to set a widget into the pre-focus state where -- some GUI elements like buttons on a toolbar change their appearance. -- | Crossing { eventSent :: Bool, eventTime :: TimeStamp, eventX,eventY :: Double, eventXRoot, eventYRoot :: Double, -- | This flag is false if the widget was entered, it is true when the -- widget the mouse cursor left the widget. eventLeaves :: Bool, -- | Kind of enter\/leave event. -- -- * The mouse cursor might enter this widget because it grabs the mouse -- cursor for e.g. a modal dialog box. -- eventCrossingMode :: CrossingMode, -- | Information on from what level of the widget hierarchy the mouse -- cursor came. -- -- * See 'NotifyType'. -- eventNotifyType :: NotifyType, eventModifier :: [Modifier]} -- | Gaining or losing input focus. -- | Focus { eventSent :: Bool, -- | This flag is @True@ if the widget receives the focus and @False@ if -- it just lost the input focus. eventInFocus :: Bool} -- | The widget\'s size has changed. -- -- * In response to this event the application can allocate resources that -- are specific to the size of the widget. It is emitted when the widget -- is shown the first time and on every resize. -- | Configure { eventSent :: Bool, -- | Position within the parent window. eventXParent :: Int, -- | Position within the parent window. eventYParent :: Int, eventWidth :: Int, eventHeight :: Int} -- | Change of visibility of a widget. | Visibility { eventSent :: Bool, -- | Denote what portions of the widget is visible. eventVisible :: VisibilityState } -- | Wheel movement of the mouse. -- -- * This action denotes that the content of the widget should be scrolled. -- The event is triggered by the movement of the mouse wheel. Surrounding -- scroll bars are independent of this signal. Most mice do not have -- buttons for horizontal scrolling, hence 'eventDirection' will usually not -- contain 'ScrollLeft' and 'ScrollRight'. Mice with additional -- buttons may not work on X since only five buttons are supported -- (the three main buttons and two for the wheel). -- -- * The handler of this signal should update the scroll bars that -- surround this widget which in turn tell this widget to update. -- | Scroll { eventSent :: Bool, eventTime :: TimeStamp, eventX,eventY :: Double, eventDirection :: ScrollDirection, eventXRoot, eventYRoot :: Double} -- | Indicate how the appearance of this window has changed. | WindowState { eventSent :: Bool, -- | The mask indicates which flags have changed. eventWindowMask :: [WindowState], -- | The state indicates the current state of the window. eventWindowState :: [WindowState]} -- | The state of the pen of a graphics tablet pen or touchscreen device. | Proximity { eventSent :: Bool, eventTime :: TimeStamp, -- | Whether the stylus has moved in or out of contact with the tablet. eventInContact :: Bool } deriving Show marshalEvent :: Ptr Event -> IO Event marshalEvent ptr = do (eType::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr (case eType of #{const GDK_DELETE} -> marshAny #{const GDK_DESTROY} -> marshAny #{const GDK_EXPOSE} -> marshExpose #{const GDK_MOTION_NOTIFY} -> marshMotion #{const GDK_BUTTON_PRESS} -> marshButton SingleClick #{const GDK_2BUTTON_PRESS} -> marshButton DoubleClick #{const GDK_3BUTTON_PRESS} -> marshButton TripleClick #{const GDK_BUTTON_RELEASE} -> marshButton ReleaseClick #{const GDK_KEY_PRESS} -> marshKey False #{const GDK_KEY_RELEASE} -> marshKey True #{const GDK_ENTER_NOTIFY} -> marshCrossing False #{const GDK_LEAVE_NOTIFY} -> marshCrossing True #{const GDK_FOCUS_CHANGE} -> marshFocus #{const GDK_CONFIGURE} -> marshConfigure #{const GDK_MAP} -> marshAny #{const GDK_UNMAP} -> marshAny -- #{const GDK_PROPERTY_NOTIFY}-> marshProperty #{const GDK_PROXIMITY_IN} -> marshProximity True #{const GDK_PROXIMITY_OUT} -> marshProximity False #{const GDK_VISIBILITY_NOTIFY}-> marshVisibility #{const GDK_SCROLL} -> marshScroll #{const GDK_WINDOW_STATE} -> marshWindowState code -> \_ -> fail $ "marshalEvent: unhandled event type " ++ show code ++ "\nplease report this as a bug to gtk2hs-devel@lists.sourceforge.net" ) ptr marshAny ptr = do (sent ::#gtk2hs_type gint8) <- #{peek GdkEventAny, send_event} ptr return Event { eventSent = toBool sent } marshExpose ptr = do (#{const GDK_EXPOSE}::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventExpose, send_event} ptr (area_ ::Rectangle) <- #{peek GdkEventExpose, area} ptr #if GTK_MAJOR_VERSION < 3 (reg_ :: Ptr Region) <- #{peek GdkEventExpose, region} ptr reg_ <- gdk_region_copy reg_ region_ <- makeNewRegion reg_ #endif (count_ ::#gtk2hs_type gint) <- #{peek GdkEventExpose, count} ptr return $ Expose { eventSent = toBool sent_, eventArea = area_, #if GTK_MAJOR_VERSION < 3 eventRegion = region_, #endif eventCount = fromIntegral count_} #if GTK_MAJOR_VERSION < 3 foreign import ccall "gdk_region_copy" gdk_region_copy :: Ptr Region -> IO (Ptr Region) #endif marshExposeRect :: Ptr Event -> IO Rectangle marshExposeRect ptr = do (#{const GDK_EXPOSE}::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr (area_ ::Rectangle) <- #{peek GdkEventExpose, area} ptr return area_ marshMotion ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventMotion, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventMotion, time} ptr (x_ ::#gtk2hs_type gdouble) <- #{peek GdkEventMotion, x} ptr (y_ ::#gtk2hs_type gdouble) <- #{peek GdkEventMotion, y} ptr (modif_ ::#gtk2hs_type guint) <- #{peek GdkEventMotion, state} ptr (isHint_ ::#gtk2hs_type gint16) <- #{peek GdkEventMotion, is_hint} ptr (xRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventMotion, x_root} ptr (yRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventMotion, y_root} ptr return $ Motion { eventSent = toBool sent_, eventTime = fromIntegral time_, eventX = realToFrac x_, eventY = realToFrac y_, eventModifier = (toFlags . fromIntegral) modif_, eventIsHint = toBool isHint_, eventXRoot = realToFrac xRoot_, eventYRoot = realToFrac yRoot_} marshButton but ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventButton, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventButton, time} ptr (x_ ::#gtk2hs_type gdouble) <- #{peek GdkEventButton, x} ptr (y_ ::#gtk2hs_type gdouble) <- #{peek GdkEventButton, y} ptr (modif_ ::#gtk2hs_type guint) <- #{peek GdkEventButton, state} ptr (button_ ::#gtk2hs_type guint) <- #{peek GdkEventButton, button} ptr (xRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventButton, x_root} ptr (yRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventButton, y_root} ptr return $ Button { eventClick = but, eventSent = toBool sent_, eventTime = fromIntegral time_, eventX = realToFrac x_, eventY = realToFrac y_, eventModifier = (toFlags . fromIntegral) modif_, eventButton = (toEnum.fromIntegral) button_, eventXRoot = realToFrac xRoot_, eventYRoot = realToFrac yRoot_} marshKey up ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventKey, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventKey, time} ptr (modif_ ::#gtk2hs_type guint) <- #{peek GdkEventKey, state} ptr (keyval_ ::#gtk2hs_type guint) <- #{peek GdkEventKey, keyval} ptr (length_ ::#gtk2hs_type gint) <- #{peek GdkEventKey, length} ptr keyChar <- keyvalToChar keyval_ keyName <- unsafeInterleaveIO $ keyvalName keyval_ return $ Key { eventRelease = up, eventSent = toBool sent_, eventTime = fromIntegral time_, eventModifier = (toFlags . fromIntegral) modif_, eventWithCapsLock = (modif_ .&. #{const GDK_LOCK_MASK})/=0, eventWithNumLock = (modif_ .&. #{const GDK_MOD2_MASK})/=0, eventWithScrollLock = (modif_ .&. #{const GDK_MOD3_MASK})/=0, eventKeyVal = keyval_, eventKeyName = keyName, eventKeyChar = keyChar } marshCrossing leave ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventCrossing, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventCrossing, time} ptr (x_ ::#gtk2hs_type gdouble) <- #{peek GdkEventCrossing, x} ptr (y_ ::#gtk2hs_type gdouble) <- #{peek GdkEventCrossing, y} ptr (modif_ ::#gtk2hs_type guint) <- #{peek GdkEventCrossing, state} ptr (xRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventCrossing, x_root} ptr (yRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventCrossing, y_root} ptr (cMode_ ::#gtk2hs_type GdkCrossingMode) <- #{peek GdkEventCrossing, mode} ptr (nType_ ::#gtk2hs_type GdkNotifyType) <- #{peek GdkEventCrossing, detail} ptr (modif_ ::#gtk2hs_type guint) <- #{peek GdkEventCrossing, state} ptr return $ Crossing { eventSent = toBool sent_, eventTime = fromIntegral time_, eventX = realToFrac x_, eventY = realToFrac y_, eventXRoot = realToFrac xRoot_, eventYRoot = realToFrac yRoot_, eventLeaves = leave, eventCrossingMode = (toEnum.fromIntegral) cMode_, eventNotifyType = (toEnum.fromIntegral) nType_, eventModifier = (toFlags . fromIntegral) modif_} marshFocus ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventFocus, send_event} ptr (inFocus_::#gtk2hs_type gint16) <- #{peek GdkEventFocus, in} ptr return $ Focus { eventSent = toBool sent_, eventInFocus= toBool inFocus_} marshConfigure ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventConfigure, send_event} ptr (xPar_ ::#gtk2hs_type gint) <- #{peek GdkEventConfigure, x} ptr (yPar_ ::#gtk2hs_type gint) <- #{peek GdkEventConfigure, y} ptr (width_ ::#gtk2hs_type gint) <- #{peek GdkEventConfigure, width} ptr (height_ ::#gtk2hs_type gint) <- #{peek GdkEventConfigure, height} ptr return $ Configure { eventSent = toBool sent_, eventXParent = fromIntegral xPar_, eventYParent = fromIntegral yPar_, eventWidth = fromIntegral width_, eventHeight = fromIntegral height_} {- marshProperty ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventProperty, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventProperty, time} ptr return $ Property { eventSent = toBool sent_, eventTime = fromIntegral time_} -} marshProximity contact ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventProximity, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventProximity, time} ptr return $ Proximity { eventSent = toBool sent_, eventTime = fromIntegral time_, eventInContact = contact} marshVisibility ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventVisibility, send_event} ptr (state_ ::#gtk2hs_type GdkVisibilityState) <- #{peek GdkEventVisibility, state} ptr return $ Visibility { eventSent = toBool sent_, eventVisible= (toEnum.fromIntegral) state_} marshScroll ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventScroll, send_event} ptr (time_ ::#gtk2hs_type guint32) <- #{peek GdkEventScroll, time} ptr (x_ ::#gtk2hs_type gdouble) <- #{peek GdkEventScroll, x} ptr (y_ ::#gtk2hs_type gdouble) <- #{peek GdkEventScroll, y} ptr (direc_ ::#gtk2hs_type GdkScrollDirection) <- #{peek GdkEventScroll, direction} ptr (xRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventScroll, x_root} ptr (yRoot_ ::#gtk2hs_type gdouble) <- #{peek GdkEventScroll, y_root} ptr return $ Scroll { eventSent = toBool sent_, eventTime = fromIntegral time_, eventX = realToFrac x_, eventY = realToFrac y_, eventDirection = (toEnum.fromIntegral) direc_, eventXRoot = realToFrac xRoot_, eventYRoot = realToFrac yRoot_} marshWindowState ptr = do (sent_ ::#gtk2hs_type gint8) <- #{peek GdkEventWindowState, send_event} ptr (wMask_ ::#gtk2hs_type GdkWindowState) <- #{peek GdkEventWindowState, changed_mask} ptr (wState_ ::#gtk2hs_type GdkWindowState) <- #{peek GdkEventWindowState, new_window_state} ptr return $ WindowState { eventSent = toBool sent_, eventWindowMask = (toFlags.fromIntegral) wMask_, eventWindowState = (toFlags.fromIntegral) wState_} gtk-0.15.9/Graphics/UI/Gtk/Gdk/GC.chs0000644000000000000000000001325507346545000015071 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) GC -- -- Author : Axel Simon -- -- Created: 28 September 2002 -- -- Copyright (C) 2002-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Graphics contexts - objects to encapsulate drawing properties -- module Graphics.UI.Gtk.Gdk.GC ( -- * Detail -- -- | All drawing operations in Gdk take a graphics context (GC) argument. A -- graphics context encapsulates information about the way things are drawn, -- such as the foreground color or line width. By using graphics contexts, the -- number of arguments to each drawing call is greatly reduced, and -- communication overhead is minimized, since identical arguments do not need -- to be passed repeatedly. -- -- Most values of a graphics context can be set at creation time by using -- 'gcNewWithValues'. A few of the values in the GC, such as the dash -- pattern, can only be set by the latter method. -- -- Graphics Contexts are removed in Gtk3, so this module is empty. #if GTK_MAJOR_VERSION < 3 GC, GCClass, castToGC, gTypeGC, gcNew, GCValues(GCValues), newGCValues, Color(..), foreground, background, Function(..), function, Fill(..), fill, tile, stipple, clipMask, SubwindowMode(..), subwindowMode, tsXOrigin, tsYOrigin, clipXOrigin, clipYOrigin, graphicsExposure, lineWidth, LineStyle(..), lineStyle, CapStyle(..), capStyle, JoinStyle(..), joinStyle, gcNewWithValues, gcSetValues, gcGetValues, gcSetClipRectangle, gcSetClipRegion, gcSetDashes #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (when) import Data.Maybe (fromJust, isJust) import Control.Exception (handle, ErrorCall(..)) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Structs import Graphics.UI.Gtk.General.Enums (Function(..), Fill(..), SubwindowMode(..), LineStyle(..), CapStyle(..), JoinStyle(..)) #if GTK_MAJOR_VERSION < 3 {#import Graphics.UI.Gtk.Gdk.Region#} (Region(Region)) #endif {# context lib="gtk" prefix="gdk" #} -- | Create an empty graphics context. -- gcNew :: DrawableClass d => d -> IO GC gcNew d = do gcPtr <- {#call unsafe gc_new#} (toDrawable d) if (gcPtr==nullPtr) then return (error "gcNew: null graphics context.") else wrapNewGObject mkGC (return gcPtr) -- | Creates a graphics context with specific values. -- gcNewWithValues :: DrawableClass d => d -> GCValues -> IO GC gcNewWithValues d gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do mask <- pokeGCValues vPtr gcv gc <- wrapNewGObject mkGC $ {#call unsafe gc_new_with_values#} (toDrawable d) (castPtr vPtr) mask handle (\(ErrorCall _) -> return ()) $ when (isJust (tile gcv)) $ touchForeignPtr ((unPixmap.fromJust.tile) gcv) handle (\(ErrorCall _) -> return ()) $ when (isJust (stipple gcv)) $ touchForeignPtr ((unPixmap.fromJust.stipple) gcv) handle (\(ErrorCall _) -> return ()) $ when (isJust (clipMask gcv)) $ touchForeignPtr ((unPixmap.fromJust.clipMask) gcv) return gc -- | Change some of the values of a graphics context. -- gcSetValues :: GC -> GCValues -> IO () gcSetValues gc gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do mask <- pokeGCValues vPtr gcv gc <- {#call unsafe gc_set_values#} gc (castPtr vPtr) mask handle (\(ErrorCall _) -> return ()) $ when (isJust (tile gcv)) $ touchForeignPtr ((unPixmap.fromJust.tile) gcv) handle (\(ErrorCall _) -> return ()) $ when (isJust (stipple gcv)) $ touchForeignPtr ((unPixmap.fromJust.stipple) gcv) handle (\(ErrorCall _) -> return ()) $ when (isJust (clipMask gcv)) $ touchForeignPtr ((unPixmap.fromJust.clipMask) gcv) return gc -- | Retrieve the values in a graphics context. -- gcGetValues :: GC -> IO GCValues gcGetValues gc = alloca $ \vPtr -> do {#call unsafe gc_get_values#} gc (castPtr vPtr) peek vPtr -- | Set a clipping rectangle. -- -- * All drawing operations are restricted to this rectangle. This rectangle -- is interpreted relative to the clip origin. -- gcSetClipRectangle :: GC -> Rectangle -> IO () gcSetClipRectangle gc r = with r $ \rPtr -> {#call unsafe gc_set_clip_rectangle#} gc (castPtr rPtr) -- | Set a clipping region. -- -- * All drawing operations are restricted to this region. This region -- is interpreted relative to the clip origin. -- gcSetClipRegion :: GC -> Region -> IO () gcSetClipRegion = {#call unsafe gc_set_clip_region#} -- | Specify the pattern with which lines are drawn. -- -- * Every tuple in the list contains an even and an odd segment. Even -- segments are drawn normally, whereby the 'lineStyle' -- member of the graphics context defines if odd segments are drawn -- or not. A @phase@ argument greater than 0 will drop -- @phase@ pixels before starting to draw. -- gcSetDashes :: GC -> Int -> [(Int,Int)] -> IO () gcSetDashes gc phase onOffList = do let onOff :: [{#type gint8#}] onOff = concatMap (\(on,off) -> [fromIntegral on, fromIntegral off]) onOffList withArray onOff $ \aPtr -> {#call unsafe gc_set_dashes#} gc (fromIntegral phase) aPtr (fromIntegral (length onOff)) #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/Gdk.chs0000644000000000000000000002005107346545000015275 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Gdk -- -- Author : Jens Petersen -- -- Created: 6 June 2003 -- -- Copyright (C) 2003-2005 Jens-Ulrik Holger Petersen -- -- 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) -- -- Gdk general functions. -- module Graphics.UI.Gtk.Gdk.Gdk ( flush, screenWidth, screenHeight, screenWidthMM, screenHeightMM, GrabStatus(..), pointerGrab, pointerUngrab, pointerIsGrabbed, keyboardGrab, keyboardUngrab, beep #if GTK_MAJOR_VERSION >= 3 ,RGBA(..) #endif ) where import Control.Monad (liftM) import System.Glib.Flags (fromFlags) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Gdk.Cursor#} (Cursor(..)) import Graphics.UI.Gtk.Gdk.Events import Graphics.UI.Gtk.Gdk.Enums (EventMask, GrabStatus(..)) #if GTK_MAJOR_VERSION >= 3 import Graphics.UI.Gtk.General.Structs (RGBA(..)) #endif {#context lib="gdk" prefix ="gdk"#} -- | Emits a short beep. -- beep :: IO () beep = {#call beep#} -- | Flushes the X output buffer and waits until all requests have been -- processed by the server. This is rarely needed by applications. -- flush :: IO () flush = {#call flush#} -- | Returns the width of the default screen in pixels. -- screenWidth :: IO Int screenWidth = liftM fromIntegral $ {#call screen_width#} -- | Returns the height of the default screen in pixels. -- screenHeight :: IO Int screenHeight = liftM fromIntegral $ {#call screen_height#} -- | Returns the width of the default screen in millimeters. Note that on many -- X servers this value will not be correct. -- screenWidthMM :: IO Int screenWidthMM = liftM fromIntegral $ {#call screen_width_mm#} -- | Returns the height of the default screen in millimeters. Note that on many -- X servers this value will not be correct. -- screenHeightMM :: IO Int screenHeightMM = liftM fromIntegral $ {#call screen_height_mm#} -- | Grabs the pointer (usually a mouse) so that all events are passed to this -- application until the pointer is ungrabbed with 'pointerUngrab', or the grab -- window becomes unviewable. This overrides any previous pointer grab by this -- client. -- -- Pointer grabs are used for operations which need complete control over mouse -- events, even if the mouse leaves the application. For example in GTK+ it is -- used for Drag and Drop, for dragging the handle in the GtkHPaned and -- GtkVPaned widgets, and for resizing columns in GtkCList widgets. -- -- Note that if the event mask of an X window has selected both button press -- and button release events, then a button press event will cause an automatic -- pointer grab until the button is released. X does this automatically since -- most applications expect to receive button press and release events in -- pairs. It is equivalent to a pointer grab on the window with @owner_events@ -- set to @True@. -- -- If you set up anything at the time you take the grab that needs to be -- cleaned up when the grab ends, you should handle the GdkEventGrabBroken -- events that are emitted when the grab ends unvoluntarily. -- pointerGrab :: (DrawWindowClass window, DrawWindowClass confine_to) => window -- ^ @window@ - the 'DrawWindow' which will own the grab (the grab -- window). -> Bool -- ^ @owner_events@ - if @False@ then all pointer events are -- reported with respect to @window@ and are only reported if -- selected by @event_mask@. If @True@ then pointer events for this -- application are reported as normal, but pointer events outside -- this application are reported with respect to @window@ and only -- if selected by @event_mask@. In either mode, unreported events -- are discarded. -> [EventMask] -- ^ @event_mask@ - specifies the event mask, which is used in -- accordance with @owner_events@. Note that only pointer -- events (i.e. button and motion events) may be selected. -> Maybe confine_to -- ^ @confine_to@ If supplied, the pointer will be -- confined to this window during the grab. If the -- pointer is outside @confine_to@, it will automatically -- be moved to the closest edge of @confine_to@ and enter -- and leave events will be generated as necessary. -> Maybe Cursor -- ^ @cursor@ - the cursor to display while the grab is -- active. If this is @Nothing@ then the normal cursors are -- used for @window@ and its descendants, and the cursor for -- @window@ is used for all other windows. -> TimeStamp -- ^ @time@ - the timestamp of the event which led to this -- pointer grab. This usually comes from an 'Event', though -- 'currentTime' can be used if the time isn't known. -> IO GrabStatus -- ^ @Returns@ - 'GrabSuccess' if the grab was successful. pointerGrab window owner_events event_mask mbConfine_to mbCursor time = liftM (toEnum . fromIntegral) $ {#call pointer_grab#} (toDrawWindow window) (fromBool owner_events) (fromIntegral $ fromFlags event_mask) (maybe (DrawWindow nullForeignPtr) toDrawWindow mbConfine_to) (maybe (Cursor nullForeignPtr) id mbCursor) (fromIntegral time) -- | Ungrabs the pointer on the default display, if it is grabbed by this -- application. -- pointerUngrab :: TimeStamp -- ^ @time@ - a timestamp from an 'Event', or 'currentTime' if no -- timestamp is available. -> IO () pointerUngrab time = {#call pointer_ungrab#} (fromIntegral time) -- | Returns @True@ if the pointer on the default display is currently grabbed -- by this application. -- -- Note that this does not take the inmplicit pointer grab on button presses -- into account. -- pointerIsGrabbed :: IO Bool pointerIsGrabbed = liftM toBool $ {#call pointer_is_grabbed#} -- | Grabs the keyboard so that all events are passed to this application until -- the keyboard is ungrabbed with 'keyboardUngrab'. This overrides any previous -- keyboard grab by this client. -- -- If you set up anything at the time you take the grab that needs to be -- cleaned up when the grab ends, you should handle the GdkEventGrabBroken -- events that are emitted when the grab ends unvoluntarily. keyboardGrab :: (DrawWindowClass window) => window -- ^ @window@ - the 'DrawWindow' which will own the grab (the grab -- window). -> Bool -- ^ @owner_events@ - if @False@ then all keyboard events are -- reported with respect to @window@. If @True@ then keyboard events -- for this application are reported as normal, but keyboard events -- outside this application are reported with respect to @window@. -- Both key press and key release events are always reported, -- independent of the event mask set by the application. -> TimeStamp -- ^ @time@ - a timestamp from an 'Event', or 'currentTime' if -- no timestamp is available. -> IO GrabStatus -- ^ @Returns@ - 'GrabSuccess' if the grab was successful. keyboardGrab window owner_events time = liftM (toEnum . fromIntegral) $ {#call keyboard_grab#} (toDrawWindow window) (fromBool owner_events) (fromIntegral time) -- | Ungrabs the keyboard on the default display, if it is grabbed by this -- application. keyboardUngrab :: TimeStamp -- ^ @time@ - a timestamp from an 'Event', or 'currentTime' if no -- timestamp is available. -> IO () keyboardUngrab time = {#call keyboard_ungrab#} (fromIntegral time) gtk-0.15.9/Graphics/UI/Gtk/Gdk/Keymap.chs0000644000000000000000000003353707346545000016033 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Keymap -- -- Author : Andy Stewart -- -- Created: 30 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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 manipulating keyboard codes -- module Graphics.UI.Gtk.Gdk.Keymap ( -- * Details -- -- | Key values are the codes which are sent whenever a key is pressed or released. They appear in the -- keyval field of the 'EventKey' structure, which is passed to signal handlers for the -- 'keyPressEvent' and 'keyReleaseEvent' signals. -- -- Key values are regularly updated from the upstream X.org X11 implementation, so new values are added -- regularly. They will be prefixed with GDK_ rather than XF86XK_ or ' (for older symbols)'. -- -- Key values can be converted into a string representation using 'keyvalName'. The reverse -- function, converting a string to a key value, is provided by 'keyvalFromName'. -- -- The case of key values can be determined using 'keyvalIsUpper'. Key -- values can be converted to upper or lower case using 'keyvalToUpper' and -- 'keyvalToLower'. -- -- When it makes sense, key values can be converted to and from Unicode characters with -- 'keyvalToUnicode'. -- -- One 'Keymap' object exists for each user display. 'keymapGetDefault' returns the 'Keymap' -- for the default display; to obtain keymaps for other displays, use 'keymapGetForDisplay'. A -- keymap is a mapping from 'KeymapKey' to key values. You can think of a 'KeymapKey' as a -- representation of a symbol printed on a physical keyboard key. That is, it contains three pieces of -- information. First, it contains the hardware keycode; this is an identifying number for a physical -- key. Second, it contains the level of the key. The level indicates which symbol on the key will be -- used, in a vertical direction. So on a standard US keyboard, the key with the number \"1\" on it also -- has the exclamation point \"!\" character on it. The level indicates whether to use the \"1\" or the -- \"!\" symbol. The letter keys are considered to have a lowercase letter at level 0, and an uppercase -- letter at level 1, though only the uppercase letter is printed. Third, the 'KeymapKey' contains a -- group; groups are not used on standard US keyboards, but are used in many other countries. On a -- keyboard with groups, there can be 3 or 4 symbols printed on a single key. The group indicates -- movement in a horizontal direction. Usually groups are used for two different languages. In group 0, -- a key might have two English characters, and in group 1 it might have two Hebrew characters. The -- Hebrew characters will be printed on the key next to the English characters. -- -- In order to use a keymap to interpret a key event, it's necessary to first convert the keyboard -- state into an effective group and level. This is done via a set of rules that varies widely -- according to type of keyboard and user configuration. The function -- 'keymapTranslateKeyboardState' accepts a keyboard state -- consisting of hardware keycode -- pressed, active modifiers, and active group -- applies the appropriate rules, and returns the -- group/level to be used to index the keymap, along with the modifiers which did not affect the group -- and level. i.e. it returns "unconsumed modifiers." The keyboard group may differ from the effective -- group used for keymap lookups because some keys don't have multiple groups - e.g. the Enter key is -- always in group 0 regardless of keyboard state. -- -- Note that 'keymapTranslateKeyboardState' also returns the keyval, i.e. it goes ahead and -- performs the keymap lookup in addition to telling you which effective group/level values were used -- for the lookup. 'EventKey' already contains this keyval, however, so you don't normally need to -- call 'keymapTranslateKeyboardState' just to get the keyval. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----Keymap -- @ -- * Types Keymap, KeymapClass, castToKeymap, toKeymap, KeymapKey, -- * Methods keymapGetDefault, #if GTK_CHECK_VERSION(2,2,0) keymapGetForDisplay, #endif keymapLookupKey, keymapTranslateKeyboardState, keymapGetEntriesForKeyval, keymapGetEntriesForKeycode, keymapGetDirection, #if GTK_CHECK_VERSION(2,12,0) keymapHaveBidiLayouts, #endif #if GTK_CHECK_VERSION(2,16,0) keymapGetCapsLockState, #endif -- * Signals #if GTK_CHECK_VERSION(2,0,0) keymapDirectionChanged, #if GTK_CHECK_VERSION(2,2,0) keymapKeysChanged, #if GTK_CHECK_VERSION(2,16,0) keymapStateChanged, #endif #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Gdk.Enums (Modifier(..)) import Graphics.UI.Gtk.Gdk.Keys (KeyVal (..)) {#import Graphics.Rendering.Pango.Enums#} {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Structs (KeymapKey (..)) {# context lib="gdk" prefix="gdk" #} -------------------- -- Methods -- | Returns the 'Keymap' attached to the default display. -- keymapGetDefault :: IO Keymap -- ^ returns the 'Keymap' attached to the default display. keymapGetDefault = makeNewGObject mkKeymap $ {# call gdk_keymap_get_default #} #if GTK_CHECK_VERSION(2,2,0) -- | Returns the 'Keymap' attached to @display@. -- -- * Available since Gdk version 2.2 -- keymapGetForDisplay :: Display -- ^ @display@ - the 'Display'. -> IO Keymap -- ^ returns the 'Keymap' attached to @display@. keymapGetForDisplay display = makeNewGObject mkKeymap $ {# call gdk_keymap_get_for_display #} display #endif -- | Looks up the keyval mapped to a keycode\/group\/level triplet. If no -- keyval is bound to @key@, returns 0. For normal user input, you want to use -- 'keymapTranslateKeyboardState' instead of this function, since the effective -- group\/level may not be the same as the current keyboard state. -- keymapLookupKey :: KeymapClass self => (Maybe self) -- ^ @keymap@ a 'Keymap' or 'Nothing' to use the default keymap -> KeymapKey -- ^ @key@ - a 'KeymapKey' -- with keycode, group, and level initialized -> IO Int -- ^ returns a keyval, or 0 if none was mapped to -- the given @key@ keymapLookupKey Nothing key = liftM fromIntegral $ allocaBytes {# sizeof GdkKeymapKey #} $ \ keyPtr -> do poke keyPtr key {# call gdk_keymap_lookup_key #} (Keymap nullForeignPtr) (castPtr keyPtr) keymapLookupKey (Just self) key = liftM fromIntegral $ allocaBytes {# sizeof GdkKeymapKey #} $ \ keyPtr -> do poke keyPtr key {# call gdk_keymap_lookup_key #} (toKeymap self) (castPtr keyPtr) -- | Translates the contents of a 'EventKey' into a -- keyval, effective group, and level. Modifiers that affected the translation -- and are thus unavailable for application use are returned in -- @consumedModifiers@. See 'keyvalGetKeys' for an explanation of groups and -- levels. The @effectiveGroup@ is the group that was actually used for the -- translation; some keys such as Enter are not affected by the active keyboard -- group. The @level@ is derived from @state@. For convenience, 'EventKey' -- already contains the translated keyval, so this function -- isn't as useful as you might think. -- keymapTranslateKeyboardState :: KeymapClass self => self -> Int -- ^ @hardwareKeycode@ - a keycode -> Modifier -- ^ @state@ - a modifier state -> Int -- ^ @group@ - active keyboard group -> IO (Maybe (Int, Int, Int, Modifier)) keymapTranslateKeyboardState self hardwareKeycode state group = alloca $ \keyvalPtr -> alloca $ \effectiveGroupPtr -> alloca $ \levelPtr -> alloca $ \modifierPtr -> do success <- liftM toBool $ {# call gdk_keymap_translate_keyboard_state #} (toKeymap self) (fromIntegral hardwareKeycode) ((fromIntegral . fromEnum) state) (fromIntegral group) keyvalPtr effectiveGroupPtr levelPtr modifierPtr if success then do keyval <- peek keyvalPtr effectiveGroup <- peek effectiveGroupPtr level <- peek levelPtr modifier <- peek modifierPtr return (Just (fromIntegral keyval ,fromIntegral effectiveGroup ,fromIntegral level ,toEnum $ fromIntegral modifier)) else return Nothing -- | Obtains a list of keycode\/group\/level combinations that will generate -- @keyval@. Groups and levels are two kinds of keyboard mode; in general, the -- level determines whether the top or bottom symbol on a key is used, and the -- group determines whether the left or right symbol is used. On US keyboards, -- the shift key changes the keyboard level, and there are no groups. A group -- switch key might convert a keyboard between Hebrew to English modes, for -- example. 'EventKey' contains a @group@ field that -- indicates the active keyboard group. The level is computed from the modifier -- mask. -- keymapGetEntriesForKeyval :: KeymapClass self => self -> KeyVal -- ^ @keyval@ - a keyval, such as @GDK_a@, @GDK_Up@, -- @GDK_Return@, etc. -> IO (Maybe [KeymapKey]) keymapGetEntriesForKeyval self keyval = alloca $ \nKeysPtr -> allocaArray 0 $ \ keysPtr -> do success <- liftM toBool $ {# call gdk_keymap_get_entries_for_keyval #} (toKeymap self) (fromIntegral keyval) (castPtr keysPtr) nKeysPtr if success then do nKeys <- liftM fromIntegral $ peek nKeysPtr keys <- peekArray nKeys keysPtr keyList <- mapM peek keys {#call unsafe g_free#} (castPtr keysPtr) return (Just keyList) else return Nothing -- | Returns the keyvals bound to @hardwareKeycode@. The Nth 'KeymapKey' -- in @keys@ is bound to the Nth keyval in @keyvals@. -- When a keycode is pressed by the user, the -- keyval from this list of entries is selected by considering the effective -- keyboard group and level. See 'keymapTranslateKeyboardState'. -- keymapGetEntriesForKeycode :: KeymapClass self => self -> Int -- ^ @hardwareKeycode@ - a keycode -> IO (Maybe ([KeymapKey], [KeyVal])) keymapGetEntriesForKeycode self hardwareKeycode = alloca $ \nEntriesPtr -> allocaArray 0 $ \ keysPtr -> allocaArray 0 $ \ keyvalsPtr -> do success <- liftM toBool $ {# call gdk_keymap_get_entries_for_keycode #} (toKeymap self) (fromIntegral hardwareKeycode) (castPtr keysPtr) keyvalsPtr nEntriesPtr if success then do nEntries <- liftM fromIntegral $ peek nEntriesPtr keys <- peekArray nEntries keysPtr keyvals <- peekArray nEntries keyvalsPtr keyvalsList <- mapM (\x -> liftM fromIntegral $ peek x) keyvals keysList <- mapM peek keys {#call unsafe g_free#} (castPtr keysPtr) {#call unsafe g_free#} (castPtr keyvalsPtr) return (Just (keysList, keyvalsList)) else return Nothing -- | Returns the direction of effective layout of the keymap. -- -- Returns the direction of the keymap. -- keymapGetDirection :: KeymapClass self => self -> IO PangoDirection -- ^ returns 'DirectionLtr' or 'DirectionRtl' if it can -- determine the direction. 'DirectionNeutral' otherwise. keymapGetDirection self = liftM (toEnum . fromIntegral) $ {# call gdk_keymap_get_direction #} (toKeymap self) #if GTK_CHECK_VERSION(2,12,0) -- | Determines if keyboard layouts for both right-to-left and left-to-right -- languages are in use. -- -- * Available since Gdk version 2.12 -- keymapHaveBidiLayouts :: KeymapClass self => self -> IO Bool -- ^ returns @True@ if there are layouts in both directions, -- @False@ otherwise keymapHaveBidiLayouts self = liftM toBool $ {# call gdk_keymap_have_bidi_layouts #} (toKeymap self) #endif #if GTK_CHECK_VERSION(2,16,0) -- | Returns whether the Caps Lock modifier is locked. -- -- * Available since Gdk version 2.16 -- keymapGetCapsLockState :: KeymapClass self => self -> IO Bool -- ^ returns @True@ if Caps Lock is on keymapGetCapsLockState self = liftM toBool $ {# call gdk_keymap_get_caps_lock_state #} (toKeymap self) #endif -------------------- -- Signals #if GTK_CHECK_VERSION(2,0,0) -- | The 'keymapDirectionChanged' signal gets emitted when the direction of the -- keymap changes. -- -- * Available since Gdk version 2.0 -- keymapDirectionChanged :: KeymapClass self => Signal self (IO ()) keymapDirectionChanged = Signal (connect_NONE__NONE "direction_changed") #if GTK_CHECK_VERSION(2,2,0) -- | The 'keymapKeysChanged' signal is emitted when the mapping represented by -- @keymap@ changes. -- -- * Available since Gdk version 2.2 -- keymapKeysChanged :: KeymapClass self => Signal self (IO ()) keymapKeysChanged = Signal (connect_NONE__NONE "keys_changed") #if GTK_CHECK_VERSION(2,16,0) -- | The 'keymapStateChanged' signal is emitted when the state of the keyboard -- changes, e.g when Caps Lock is turned on or off. See -- 'keymapGetCapsLockState'. -- -- * Available since Gdk version 2.16 -- keymapStateChanged :: KeymapClass self => Signal self (IO ()) keymapStateChanged = Signal (connect_NONE__NONE "state_changed") #endif #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/Keys.chs0000644000000000000000000001164507346545000015514 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Keys -- -- Author : Jens Petersen -- -- Created: 24 May 2002 -- -- Copyright (C) 2002-2005 Jens Petersen -- -- 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 -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A 'KeyVal' is a numeric value identifying a keyboard key. The defined -- values can be found at . -- The names of the keys are the names of the macros without the prefix. -- module Graphics.UI.Gtk.Gdk.Keys ( KeyVal, KeyCode, keyName, keyFromName, keyToChar, keyvalName, keyvalFromName, keyvalToChar, keyvalConvertCase, keyvalToUpper, keyvalToLower, keyvalIsUpper, keyvalIsLower, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString {#context lib="gdk" prefix ="gdk"#} -- | Key values are the codes which are sent whenever a key is pressed or -- released. -- type KeyVal = Word32 type KeyCode = Word16 -- | Converts a key value into a symbolic name. -- keyName :: KeyVal -> DefaultGlibString keyName k = unsafePerformIO $ keyvalName k -- | Converts a key name to a key value. -- keyFromName :: DefaultGlibString -> KeyVal keyFromName k = unsafePerformIO $ keyvalFromName k -- | Convert from a Gdk key symbol to the corresponding Unicode character. -- keyToChar :: KeyVal -- ^ @keyval@ - a Gdk key symbol -> Maybe Char -- ^ returns the corresponding unicode character, or -- Nothing if there is no corresponding character. keyToChar k = unsafePerformIO $ keyvalToChar k keyvalName :: KeyVal -> IO DefaultGlibString keyvalName keyval = do strPtr <- {# call gdk_keyval_name #} (fromIntegral keyval) if strPtr==nullPtr then return "" else peekUTFString strPtr keyvalFromName :: DefaultGlibString -> IO KeyVal keyvalFromName keyvalName = liftM fromIntegral $ withUTFString keyvalName $ \keyvalNamePtr -> {# call gdk_keyval_from_name #} keyvalNamePtr keyvalToChar :: KeyVal -> IO (Maybe Char) keyvalToChar keyval = {# call gdk_keyval_to_unicode #} (fromIntegral keyval) >>= \code -> if code == 0 then return Nothing else return $ Just $ toEnum $ fromIntegral code -- | Obtains the upper- and lower-case versions of the keyval symbol. Examples of keyvals are GDK_a, -- 'Enter', 'F1', etc. keyvalConvertCase :: KeyVal -- ^ @symbol@ a keyval -> (KeyVal, KeyVal) -- ^ @(lower, upper)@ -- ^ lower is the lowercase version of symbol. -- ^ upper is uppercase version of symbol. keyvalConvertCase keyval = unsafePerformIO $ alloca $ \ lowerPtr -> alloca $ \ upperPtr -> do {#call gdk_keyval_convert_case #} (fromIntegral keyval) lowerPtr upperPtr lower <- peek lowerPtr upper <- peek upperPtr return (fromIntegral lower, fromIntegral upper) -- | Converts a key value to upper case, if applicable. keyvalToUpper :: KeyVal -- ^ @keyval@ a key value. -> KeyVal -- ^ returns the upper case form of keyval, -- or keyval itself if it is already in upper case or it is not subject to case keyvalToUpper keyval = unsafePerformIO $ liftM fromIntegral $ {#call gdk_keyval_to_upper #} (fromIntegral keyval) -- | Converts a key value to lower case, if applicable. keyvalToLower :: KeyVal -- ^ @keyval@ a key value. -> KeyVal -- ^ returns the lower case form of keyval, -- or keyval itself if it is already in lower case or it is not subject to case keyvalToLower keyval = unsafePerformIO $ liftM fromIntegral $ {#call gdk_keyval_to_lower #} (fromIntegral keyval) -- | Returns 'True' if the given key value is in upper case. keyvalIsLower :: KeyVal -> Bool -- ^ returns 'True' if keyval is in upper case, or if keyval is not subject to case conversion. keyvalIsLower keyval = unsafePerformIO $ liftM toBool $ {#call gdk_keyval_is_lower #} (fromIntegral keyval) -- | Returns 'True' if the given key value is in upper case. keyvalIsUpper :: KeyVal -> Bool -- ^ returns 'True' if keyval is in upper case, or if keyval is not subject to case conversion. keyvalIsUpper keyval = unsafePerformIO $ liftM toBool $ {#call gdk_keyval_is_upper #} (fromIntegral keyval) gtk-0.15.9/Graphics/UI/Gtk/Gdk/Pixbuf.chs0000644000000000000000000007706507346545000016046 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Pixbuf -- -- Author : Vincenzo Ciancia, Axel Simon -- -- Created: 26 March 2002 -- -- Copyright (C) 2002-2005 Axel Simon, Vincenzo Ciancia -- -- 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 -- -- if anybody writes an image manipulation program, do the checker board -- functions: gdk_pixbuf_composite_color_simple and -- gdk_pixbuf_composite_color. Moreover, do: pixbuf_saturate_and_pixelate -- -- -- pixbuf loader -- -- module interface -- -- rendering function for Bitmaps and Pixmaps when the latter are added -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- 'Pixbuf's are bitmap images in memory. -- -- * A Pixbuf is used to represent images. It contains information -- about the image's pixel data, its color space, bits per sample, width -- and height, and the rowstride or number of bytes between rows. -- -- * This module contains functions to scale and crop -- 'Pixbuf's and to scale and crop a 'Pixbuf' and -- compose the result with an existing image. -- -- * 'Pixbuf's can be displayed on screen by either creating an 'Image' that -- from the 'Pixbuf' or by rendering (part of) the 'Pixbuf' into a -- vanilla widget like 'DrawWindow' using -- 'Graphics.UI.Gtk.Gdk.Drawable.drawPixbuf'. -- module Graphics.UI.Gtk.Gdk.Pixbuf ( -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----Pixbuf -- @ -- * Types Pixbuf, PixbufClass, castToPixbuf, gTypePixbuf, toPixbuf, PixbufError(..), Colorspace(..), -- * Constructors pixbufNew, pixbufNewFromData, pixbufNewFromFile, #if GTK_CHECK_VERSION(2,4,0) pixbufNewFromFileAtSize, #endif #if GTK_CHECK_VERSION(2,6,0) pixbufNewFromFileAtScale, #endif #if GTK_CHECK_VERSION(3,0,0) pixbufNewFromSurface, pixbufNewFromWindow, #endif pixbufNewFromInline, InlineImage, pixbufNewSubpixbuf, pixbufNewFromXPMData, -- * Methods pixbufGetColorSpace, pixbufGetNChannels, pixbufGetHasAlpha, pixbufGetBitsPerSample, PixbufData, pixbufGetPixels, pixbufGetWidth, pixbufGetHeight, pixbufGetRowstride, pixbufGetOption, ImageFormat, pixbufGetFormats, pixbufSave, pixbufCopy, InterpType(..), pixbufScaleSimple, pixbufScale, pixbufComposite, #if GTK_CHECK_VERSION(2,6,0) pixbufFlipHorizontally, pixbufFlipHorazontally, pixbufFlipVertically, pixbufRotateSimple, PixbufRotation(..), #endif pixbufAddAlpha, pixbufCopyArea, pixbufFill, #if GTK_MAJOR_VERSION < 3 pixbufGetFromDrawable, pixbufRenderThresholdAlpha, pixbufRenderPixmapAndMaskForColormap #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GObject {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Structs (Rectangle(..)) #endif import System.Glib.GError (GError(..), GErrorClass(..), GErrorDomain, propagateGError) import Graphics.UI.Gtk.Gdk.PixbufData ( PixbufData, mkPixbufData ) #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Pixmap (Bitmap) #else import Graphics.Rendering.Cairo import Graphics.Rendering.Cairo.Types #endif {# context prefix="gdk" #} -- | Error codes for loading image files. -- {#enum PixbufError {underscoreToCase} #} -- | Enumerate all supported color spaces. -- -- * Only RGB is supported right now. -- {#enum Colorspace {underscoreToCase} #} -- | Queries the color space of a pixbuf. -- pixbufGetColorSpace :: Pixbuf -> IO Colorspace pixbufGetColorSpace pb = liftM (toEnum . fromIntegral) $ {#call unsafe pixbuf_get_colorspace#} pb -- | Queries the number of colors for each pixel. -- -- * This function returns 3 for an RGB image without alpha (transparency) -- channel, 4 for an RGB image with alpha channel. -- pixbufGetNChannels :: Pixbuf -> IO Int pixbufGetNChannels pb = liftM fromIntegral $ {#call unsafe pixbuf_get_n_channels#} pb -- | Query if the image has an alpha channel. -- -- * The alpha channel determines the opaqueness of the pixel. -- pixbufGetHasAlpha :: Pixbuf -> IO Bool pixbufGetHasAlpha pb = liftM toBool $ {#call unsafe pixbuf_get_has_alpha#} pb -- | Queries the number of bits for each color. -- -- * Each pixel is has a number of cannels for each pixel, each channel -- has this many bits. -- pixbufGetBitsPerSample :: Pixbuf -> IO Int pixbufGetBitsPerSample pb = liftM fromIntegral $ {#call unsafe pixbuf_get_bits_per_sample#} pb -- | Retrieve the internal array of raw image data. -- -- * Image data in a pixbuf is stored in memory in uncompressed, -- packed format. Rows in the image are stored top to bottom, and in each -- row pixels are stored from left to right. There may be padding at the -- end of a row. The "rowstride" value of a pixbuf, as returned by -- 'pixbufGetRowstride', indicates the number of bytes between rows. -- -- * The returned array is a flat representation of a three dimensional -- array: x-coordinate, y-coordinate and several channels for each color. -- The number of channels is usually 3 for plain RGB data or 4 for -- RGB data with an alpha channel. To read or write a specific pixel -- use the formula: @p = y * rowstride + x * nChannels@ for the pixel. -- If the array contains bytes (or 'Word8's), @p+0@ is the red value, -- @p+1@ green, @p+2@ blue and @p+3@ the alpha (transparency) channel -- if present. If the alpha channel is present, the array can accessed -- as an array over 'Word32' to modify a whole pixel at a time. See also -- 'pixbufGetBitsPerSample' and 'pixbufGetNChannels'. -- -- * Calling this function without explicitly giving it a type will often -- lead to a compiler error since the type parameter @e@ is underspecified. -- If this happens the function can be explicitly typed: -- @pbData <- (pixbufGetPixels pb :: IO (PixbufData Int Word8))@ -- -- * If modifying an image through Haskell\'s array interface is not -- fast enough, it is possible to use 'unsafeRead' and -- 'unsafeWrite' which have the same type signatures -- as 'readArray' and 'writeArray'. -- Note that these are internal -- functions that might change with GHC. -- pixbufGetPixels :: Storable e => Pixbuf -> IO (PixbufData Int e) pixbufGetPixels pb = do pixPtr_ <- {#call unsafe pixbuf_get_pixels#} pb chan <- pixbufGetNChannels pb bits <- pixbufGetBitsPerSample pb w <- pixbufGetWidth pb h <- pixbufGetHeight pb r <- pixbufGetRowstride pb let pixPtr = castPtr pixPtr_ let bytes = (h-1)*r+w*((chan*bits+7) `div` 8) return (mkPixbufData pb pixPtr bytes) -- | Queries the width of this image. -- pixbufGetWidth :: Pixbuf -> IO Int pixbufGetWidth pb = liftM fromIntegral $ {#call unsafe pixbuf_get_width#} pb -- | Queries the height of this image. -- pixbufGetHeight :: Pixbuf -> IO Int pixbufGetHeight pb = liftM fromIntegral $ {#call unsafe pixbuf_get_height#} pb -- | Queries the rowstride of this image. -- -- * Queries the rowstride of a pixbuf, which is the number of bytes between -- rows. Use this value to calculate the offset to a certain row. -- pixbufGetRowstride :: Pixbuf -> IO Int pixbufGetRowstride pb = liftM fromIntegral $ {#call unsafe pixbuf_get_rowstride#} pb -- | Returns an attribute of an image. -- -- * Looks up if some information was stored under the @key@ when -- this image was saved. -- pixbufGetOption :: (GlibString string) => Pixbuf -> string -> IO (Maybe string) pixbufGetOption pb key = withUTFString key $ \strPtr -> do resPtr <- {#call unsafe pixbuf_get_option#} pb strPtr if (resPtr==nullPtr) then return Nothing else liftM Just $ peekUTFString resPtr -- helper functions pixbufErrorDomain :: GErrorDomain pixbufErrorDomain = {#call pure unsafe pixbuf_error_quark#} instance GErrorClass PixbufError where gerrorDomain _ = pixbufErrorDomain -- | Load an image synchonously. -- -- * Use this function to load only small images as this call will block. -- -- * If an error occurs, the function will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'PixbufError'. -- pixbufNewFromFile :: GlibFilePath fp => fp -> IO Pixbuf pixbufNewFromFile fname = wrapNewGObject mkPixbuf $ propagateGError $ \errPtrPtr -> withUTFFilePath fname $ \strPtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) {#call unsafe pixbuf_new_from_file_utf8#} #else {#call unsafe pixbuf_new_from_file#} #endif strPtr errPtrPtr #if GTK_CHECK_VERSION(2,4,0) -- | Creates a new pixbuf by loading an image from a file. The file format is -- detected automatically. The image will be scaled to fit in the requested -- size, preserving the image's aspect ratio. -- -- * If an error occurs, the function will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'PixbufError'. -- -- * Available since Gtk+ version 2.4 -- pixbufNewFromFileAtSize :: GlibString string => string -> Int -> Int -> IO Pixbuf pixbufNewFromFileAtSize filename width height = wrapNewGObject mkPixbuf $ propagateGError $ \errPtrPtr -> withUTFString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) {# call gdk_pixbuf_new_from_file_at_size_utf8 #} #else {# call gdk_pixbuf_new_from_file_at_size #} #endif filenamePtr (fromIntegral width) (fromIntegral height) errPtrPtr #endif #if GTK_CHECK_VERSION(2,6,0) -- | Creates a new pixbuf by loading an image from a file. The file format is -- detected automatically. The image will be scaled to fit in the requested -- size, optionally preserving the image's aspect ratio. -- -- When preserving the aspect ratio, a width of -1 will cause the image to be -- scaled to the exact given height, and a height of -1 will cause the image to -- be scaled to the exact given width. When not preserving aspect ratio, a width -- or height of -1 means to not scale the image at all in that dimension. -- Negative values for width and height are allowed since Gtk+ 2.8. -- -- * If an error occurs, the function will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'PixbufError'. -- -- * Available since Gtk+ version 2.6 -- pixbufNewFromFileAtScale :: GlibString string => string -- ^ the name of the file -> Int -- ^ target width -> Int -- ^ target height -> Bool -- ^ whether to preserve the aspect ratio -> IO Pixbuf pixbufNewFromFileAtScale filename width height preserveAspectRatio = wrapNewGObject mkPixbuf $ propagateGError $ \errPtrPtr -> withUTFString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) {# call gdk_pixbuf_new_from_file_at_scale_utf8 #} #else {# call gdk_pixbuf_new_from_file_at_scale #} #endif filenamePtr (fromIntegral width) (fromIntegral height) (fromBool preserveAspectRatio) errPtrPtr #endif #if GTK_CHECK_VERSION(3,0,0) -- | Creates a new pixbuf from a cairo Surface. -- -- Transfers image data from a cairo Surface and converts it to an RGB(A) representation inside a Pixbuf. This allows you to efficiently read individual pixels from cairo surfaces. For GdkWindows, use gdk_pixbuf_get_from_window() instead. -- -- This function will create an RGB pixbuf with 8 bits per channel. The pixbuf will contain an alpha channel if the surface contains one. pixbufNewFromSurface :: Surface -> Int -> Int -> Int -> Int -> IO Pixbuf pixbufNewFromSurface surface srcX srcY width height = withSurface surface $ \ss -> wrapNewGObject mkPixbuf $ {# call gdk_pixbuf_get_from_surface #} (castPtr ss) (fromIntegral srcX) (fromIntegral srcY) (fromIntegral width) (fromIntegral height) -- | Creates a new pixbuf from a GDK window. -- -- Transfers image data from a GdkWindow and converts it to an RGB(A) representation inside a GdkPixbuf. In other words, copies image data from a server-side drawable to a client-side RGB(A) buffer. This allows you to efficiently read individual pixels on the client side. -- -- This function will create an RGB pixbuf with 8 bits per channel with the size specified by the width and height arguments scaled by the scale factor of window. The pixbuf will contain an alpha channel if the window contains one. pixbufNewFromWindow :: DrawWindowClass self => self -- ^ @window@ - The source window. -> Int -- ^ @srcX@ - Source X coordinate within window. -> Int -- ^ @srcY@ - Source Y coordinate within window. -> Int -- ^ @width@ - Width in pixels of region to get. -> Int -- ^ @height@ - Height in pixels of region to get. -> IO Pixbuf pixbufNewFromWindow window srcX srcY width height = wrapNewGObject mkPixbuf $ {# call gdk_pixbuf_get_from_window #} (toDrawWindow window) (fromIntegral srcX) (fromIntegral srcY) (fromIntegral width) (fromIntegral height) #endif -- | A string representing an image file format. -- type ImageFormat = DefaultGlibString -- constant pixbufGetFormats A list of valid image file formats. -- pixbufGetFormats :: [ImageFormat] pixbufGetFormats = ["png","bmp","wbmp", "gif","ico","ani","jpeg","pnm", "ras","tiff","xpm","xbm","tga"] -- | Save an image to disk. -- -- * The function takes a list of key - value pairs to specify -- either how an image is saved or to actually save this additional -- data with the image. JPEG images can be saved with a \"quality\" -- parameter; its value should be in the range [0,100]. Text chunks -- can be attached to PNG images by specifying parameters of the form -- \"tEXt::key\", where key is an ASCII string of length 1-79. -- The values are Unicode strings. -- -- * If an error occurs, the function will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'PixbufError'. -- pixbufSave :: (GlibString string, GlibFilePath fp) => Pixbuf -> fp -> ImageFormat -> [(string, string)] -> IO () pixbufSave pb fname iType options = let (keys, values) = unzip options in propagateGError $ \errPtrPtr -> withUTFFilePath fname $ \fnPtr -> withUTFString iType $ \tyPtr -> withUTFStringArray0 keys $ \keysPtr -> withUTFStringArray values $ \valuesPtr -> do #if defined (WIN32) && GTK_CHECK_VERSION(2,6,5) {# call unsafe pixbuf_savev_utf8 #} #else {# call unsafe pixbuf_savev #} #endif pb fnPtr tyPtr keysPtr valuesPtr errPtrPtr return () -- | Create a new image in memory. -- -- * Creates a new pixbuf structure and allocates a buffer for -- it. Note that the buffer is not cleared initially. -- -- * The boolean flag is true if the pixbuf should have an alpha -- (transparency) channel. The next integer denotes the bits per -- color sample, e.g. 8 bits per color for 2^24 colors. The last -- two integers denote the width and height, respectively. -- pixbufNew :: Colorspace -> Bool -> Int -> Int -> Int -> IO Pixbuf pixbufNew colorspace hasAlpha bitsPerSample width height = wrapNewGObject mkPixbuf $ {#call pixbuf_new#} ((fromIntegral . fromEnum) colorspace) (fromBool hasAlpha) (fromIntegral bitsPerSample) (fromIntegral width) (fromIntegral height) pixbufNewFromData :: Ptr CUChar -> Colorspace -> Bool -> Int -> Int -> Int -> Int -> IO Pixbuf pixbufNewFromData imData cSpace hasAlpha bitsPerSample width height rowStride = wrapNewGObject mkPixbuf $ {#call pixbuf_new_from_data #} imData (fromIntegral . fromEnum $ cSpace) (fromBool hasAlpha) (fromIntegral bitsPerSample) (fromIntegral width) (fromIntegral height) (fromIntegral rowStride) nullFunPtr nullPtr -- | Create a new image from a string. -- -- * Creates a new pixbuf from a string description. -- pixbufNewFromXPMData :: GlibString string => [string] -> IO Pixbuf pixbufNewFromXPMData s = withUTFStringArray0 s $ \strsPtr -> wrapNewGObject mkPixbuf $ {#call pixbuf_new_from_xpm_data#} strsPtr -- | A dymmy type for inline picture data. -- -- * This dummy type is used to declare pointers to image data -- that is embedded in the executable. See -- 'pixbufNewFromInline' for an example. -- data InlineImage -- | Create a new image from a static pointer. -- -- * Like 'pixbufNewFromXPMData', this function allows to -- include images in the final binary program. The method used by this -- function uses a binary representation and therefore needs less space -- in the final executable. Save the image you want to include as -- @png@ and run: -- -- > @echo #include "my_image.h" > my_image.c -- > gdk-pixbuf-csource --raw --extern --name=my_image myimage.png >> my_image.c -- -- on it. Write a header file @my_image.h@ containing: -- -- > #include -- > extern guint8 my_image[]; -- -- and save it in the current directory. -- The created file can be compiled with: -- -- > cc -c my_image.c `pkg-config --cflags gdk-2.0` -- -- into an object file which must be linked into your Haskell program by -- specifying @my_image.o@ and @\"-#include my_image.h\"@ on -- the command line of GHC. -- Within you application you declare a pointer to this image: -- -- > foreign label "my_image" myImage :: Ptr InlineImage -- -- Calling 'pixbufNewFromInline' with this pointer will -- return the image in the object file. Creating the C file with -- the @--raw@ flag will result in a non-compressed image in the -- object file. The advantage is that the picture will not be -- copied when this function is called. -- -- pixbufNewFromInline :: Ptr InlineImage -> IO Pixbuf pixbufNewFromInline iPtr = alloca $ \errPtrPtr -> do pbPtr <- {#call unsafe pixbuf_new_from_inline#} (-1) (castPtr iPtr) (fromBool False) (castPtr errPtrPtr) if pbPtr/=nullPtr then wrapNewGObject mkPixbuf (return pbPtr) else do errPtr <- peek errPtrPtr (GError dom code msg) <- peek errPtr error $ glibToString msg -- | Create a restricted view of an image. -- -- * This function returns a 'Pixbuf' object which shares -- the image of the original one but only shows a part of it. -- Modifying either buffer will affect the other. -- -- * This function throw an exception if the requested bounds are invalid. -- pixbufNewSubpixbuf :: Pixbuf -> Int -> Int -> Int -> Int -> IO Pixbuf pixbufNewSubpixbuf pb srcX srcY height width = wrapNewGObject mkPixbuf $ do pbPtr <- {#call unsafe pixbuf_new_subpixbuf#} pb (fromIntegral srcX) (fromIntegral srcY) (fromIntegral height) (fromIntegral width) if pbPtr==nullPtr then error "pixbufNewSubpixbuf: invalid bounds" else return pbPtr -- | Create a deep copy of an image. -- pixbufCopy :: Pixbuf -> IO Pixbuf pixbufCopy pb = wrapNewGObject mkPixbuf $ {#call unsafe pixbuf_copy#} pb -- | How an image is scaled. -- -- [@InterpNearest@] Nearest neighbor sampling; this is the -- fastest and lowest quality mode. Quality is normally unacceptable when -- scaling down, but may be OK when scaling up. -- -- [@InterpTiles@] This is an accurate simulation of the -- PostScript image operator without any interpolation enabled. Each -- pixel is rendered as a tiny parallelogram of solid color, the edges of -- which are implemented with antialiasing. It resembles nearest neighbor -- for enlargement, and bilinear for reduction. -- -- [@InterpBilinear@] Best quality\/speed balance; use this -- mode by default. Bilinear interpolation. For enlargement, it is -- equivalent to point-sampling the ideal bilinear-interpolated -- image. For reduction, it is equivalent to laying down small tiles and -- integrating over the coverage area. -- -- [@InterpHyper@] This is the slowest and highest quality -- reconstruction function. It is derived from the hyperbolic filters in -- Wolberg's \"Digital Image Warping\", and is formally defined as the -- hyperbolic-filter sampling the ideal hyperbolic-filter interpolated -- image (the filter is designed to be idempotent for 1:1 pixel mapping). -- {#enum InterpType {underscoreToCase} #} -- | Scale an image. -- -- * Creates a new 'Pixbuf' containing a copy of -- @src@ scaled to the given measures. Leaves @src@ -- unaffected. -- -- * @interp@ affects the quality and speed of the scaling function. -- 'InterpNearest' is the fastest option but yields very poor quality -- when scaling down. 'InterpBilinear' is a good trade-off between -- speed and quality and should thus be used as a default. -- pixbufScaleSimple :: Pixbuf -- ^ @src@ - the source image -> Int -- ^ @width@ - the target width -> Int -- ^ @height@ the target height -> InterpType -- ^ interpolation type -> IO Pixbuf pixbufScaleSimple pb width height interp = wrapNewGObject mkPixbuf $ liftM castPtr $ {#call pixbuf_scale_simple#} (toPixbuf pb) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromEnum interp) -- | Copy a scaled image part to another image. -- -- * This function is the generic version of 'pixbufScaleSimple'. It scales -- @src@ by @scaleX@ and @scaleY@ and translate the image by @offsetX@ and -- @offsetY@. Whatever is in the intersection with the rectangle @destX@, -- @destY@, @destWidth@, @destHeight@ will be rendered into @dest@. -- -- * The rectangle in the destination is simply overwritten. Use -- 'pixbufComposite' if you need to blend the source image onto the -- destination. -- pixbufScale :: Pixbuf -- ^ @src@ - the source pixbuf -> Pixbuf -- ^ @dest@ - the pixbuf into which to render the results -> Int -- ^ @destX@ - the left coordinate for region to render -> Int -- ^ @destY@ - the top coordinate for region to render -> Int -- ^ @destWidth@ - the width of the region to render -> Int -- ^ @destHeight@ - the height of the region to render -> Double -- ^ @offsetX@ - the offset in the X direction (currently -- rounded to an integer) -> Double -- ^ @offsetY@ - the offset in the Y direction -- (currently rounded to an integer) -> Double -- ^ @scaleX@ - the scale factor in the X direction -> Double -- ^ @scaleY@ - the scale factor in the Y direction -> InterpType -- ^ the interpolation type for the transformation. -> IO () pixbufScale src dest destX destY destWidth destHeight offsetX offsetY scaleX scaleY interp = {#call unsafe pixbuf_scale#} src dest (fromIntegral destX) (fromIntegral destY) (fromIntegral destWidth) (fromIntegral destHeight) (realToFrac offsetX) (realToFrac offsetY) (realToFrac scaleX) (realToFrac scaleY) ((fromIntegral . fromEnum) interp) -- | Blend a scaled image part onto another image. -- -- * This function is similar to 'pixbufScale' but allows the -- original image to \"shine through\". The @alpha@ value determines -- how opaque the source image is. Passing @0@ is -- equivalent to not calling this function at all, passing -- @255@ has the -- same effect as calling 'pixbufScale'. -- pixbufComposite :: Pixbuf -- ^ @src@ - the source pixbuf -> Pixbuf -- ^ @dest@ - the pixbuf into which to render the results -> Int -- ^ @destX@ - the left coordinate for region to render -> Int -- ^ @destY@ - the top coordinate for region to render -> Int -- ^ @destWidth@ - the width of the region to render -> Int -- ^ @destHeight@ - the height of the region to render -> Double -- ^ @offsetX@ - the offset in the X direction (currently -- rounded to an integer) -> Double -- ^ @offsetY@ - the offset in the Y direction -- (currently rounded to an integer) -> Double -- ^ @scaleX@ - the scale factor in the X direction -> Double -- ^ @scaleY@ - the scale factor in the Y direction -> InterpType -- ^ the interpolation type for the transformation. -> Word8 -- ^ @alpha@ - the transparency -> IO () pixbufComposite src dest destX destY destWidth destHeight offsetX offsetY scaleX scaleY interp alpha = {#call unsafe pixbuf_composite#} src dest (fromIntegral destX) (fromIntegral destY) (fromIntegral destWidth) (fromIntegral destHeight) (realToFrac offsetX) (realToFrac offsetY) (realToFrac scaleX) (realToFrac scaleY) ((fromIntegral . fromEnum) interp) (fromIntegral alpha) #if GTK_CHECK_VERSION(2,6,0) -- | Flips a pixbuf horizontally and returns the result in a new pixbuf. -- pixbufFlipHorizontally :: Pixbuf -> IO Pixbuf pixbufFlipHorizontally self = wrapNewGObject mkPixbuf $ {# call pixbuf_flip #} self (fromBool True) pixbufFlipHorazontally = pixbufFlipHorizontally -- | Flips a pixbuf vertically and returns the result in a new pixbuf. -- pixbufFlipVertically :: Pixbuf -> IO Pixbuf pixbufFlipVertically self = wrapNewGObject mkPixbuf $ {# call pixbuf_flip #} self (fromBool False) -- | Rotates a pixbuf by a multiple of 90 degrees, and returns the result in a -- new pixbuf. -- pixbufRotateSimple :: Pixbuf -> PixbufRotation -> IO Pixbuf pixbufRotateSimple self angle = wrapNewGObject mkPixbuf $ {# call pixbuf_rotate_simple #} self ((fromIntegral . fromEnum) angle) -- | The possible rotations which can be passed to 'pixbufRotateSimple'. -- -- To make them easier to use, their numerical values are the actual degrees. -- {#enum PixbufRotation {underscoreToCase} #} #endif -- | Add an opacity layer to the 'Pixbuf'. -- -- * This function returns a copy of the given @src@ -- 'Pixbuf', leaving @src@ unmodified. -- The new 'Pixbuf' has an alpha (opacity) -- channel which defaults to @255@ (fully opaque pixels) -- unless @src@ already had an alpha channel in which case -- the original values are kept. -- Passing in a color triple @(r,g,b)@ makes all -- pixels that have this color fully transparent -- (opacity of @0@). The pixel color itself remains unchanged -- during this substitution. -- pixbufAddAlpha :: Pixbuf -> Maybe (Word8, Word8, Word8) -> IO Pixbuf pixbufAddAlpha pb Nothing = wrapNewGObject mkPixbuf $ {#call unsafe pixbuf_add_alpha#} pb (fromBool False) 0 0 0 pixbufAddAlpha pb (Just (r,g,b)) = wrapNewGObject mkPixbuf $ {#call unsafe pixbuf_add_alpha#} pb (fromBool True) (fromIntegral r) (fromIntegral g) (fromIntegral b) -- | Copy a rectangular portion into another 'Pixbuf'. -- -- The source 'Pixbuf' remains unchanged. Conversion between -- different formats is done automatically. -- pixbufCopyArea :: Pixbuf -- ^ Source pixbuf -> Int -- ^ Source X coordinate within the source pixbuf -> Int -- ^ Source Y coordinate within the source pixbuf -> Int -- ^ Width of the area to copy -> Int -- ^ Height of the area to copy -> Pixbuf -- ^ Destination pixbuf -> Int -- ^ X coordinate within the destination pixbuf -> Int -- ^ Y coordinate within the destination pixbuf -> IO () pixbufCopyArea src srcX srcY srcWidth srcHeight dest destX destY = {#call unsafe pixbuf_copy_area#} src (fromIntegral srcX) (fromIntegral srcY) (fromIntegral srcWidth) (fromIntegral srcHeight) dest (fromIntegral destX) (fromIntegral destY) -- | Fills a 'Pixbuf' with a color. -- -- * The passed-in color is a quadruple consisting of the red, green, blue -- and alpha component of the pixel. If the 'Pixbuf' does not -- have an alpha channel, the alpha value is ignored. -- pixbufFill :: Pixbuf -> Word8 -> Word8 -> Word8 -> Word8 -> IO () pixbufFill pb red green blue alpha = {#call unsafe pixbuf_fill#} pb ((fromIntegral red) `shiftL` 24 .|. (fromIntegral green) `shiftL` 16 .|. (fromIntegral blue) `shiftL` 8 .|. (fromIntegral alpha)) #if GTK_MAJOR_VERSION < 3 -- | Take a screenshot of a 'Drawable'. -- -- * This function creates a 'Pixbuf' and fills it with the image -- currently in the 'Drawable' (which might be invalid if the -- window is obscured or minimized). Note that this transfers data from -- the server to the client on X Windows. -- -- * This function will return a 'Pixbuf' with no alpha channel -- containing the part of the 'Drawable' specified by the -- rectangle. The function will return @Nothing@ if the window -- is not currently visible. -- -- Removed in Gtk3. pixbufGetFromDrawable :: DrawableClass d => d -> Rectangle -> IO (Maybe Pixbuf) pixbufGetFromDrawable d (Rectangle x y width height) = maybeNull (wrapNewGObject mkPixbuf) $ {#call unsafe pixbuf_get_from_drawable#} (Pixbuf nullForeignPtr) (toDrawable d) (Colormap nullForeignPtr) (fromIntegral x) (fromIntegral y) 0 0 (fromIntegral width) (fromIntegral height) -- | Takes the opacity values in a rectangular portion of a pixbuf and -- thresholds them to produce a bi-level alpha mask that can be used -- as a clipping mask for a drawable. -- -- Removed in Gtk3. pixbufRenderThresholdAlpha :: Pixbuf -- ^ A pixbuf. -> Bitmap -- ^ Bitmap where the bilevel mask will be painted to. -> Int -- ^ Source X coordinate. -> Int -- ^ source Y coordinate. -> Int -- ^ Destination X coordinate. -> Int -- ^ Destination Y coordinate. -> Int -- ^ Width of region to threshold, or -1 to use pixbuf width -> Int -- ^ Height of region to threshold, or -1 to use pixbuf height -> Int -- ^ Opacity values below this will be painted as zero; all other values will be painted as one. -> IO () pixbufRenderThresholdAlpha src dest srcX srcY destX destY w h at = withForeignPtr (unPixmap dest) $ \destPtr -> {#call unsafe pixbuf_render_threshold_alpha#} src (castPtr destPtr) (fromIntegral srcX) (fromIntegral srcY) (fromIntegral destX) (fromIntegral destY) (fromIntegral w) (fromIntegral h) (fromIntegral at) -- | Creates a pixmap and a mask bitmap which are returned and renders -- a pixbuf and its corresponding thresholded alpha mask to them. This -- is merely a convenience function; applications that need to render -- pixbufs with dither offsets or to given drawables should use -- 'Graphics.UI.Gtk.Gdk.Drawable.drawPixbuf', and -- 'pixbufRenderThresholdAlpha'. -- -- The pixmap that is created uses the 'Colormap' specified by -- colormap. This colormap must match the colormap of the window where -- the pixmap will eventually be used or an error will result. -- -- If the pixbuf does not have an alpha channel, then the returned -- mask will be @Nothing@. -- -- Removed in Gtk3. pixbufRenderPixmapAndMaskForColormap :: Pixbuf -- ^ A pixbuf. -> Colormap -- ^ A Colormap -> Int -- ^ Threshold value for opacity values -> IO (Pixmap, Maybe Bitmap) -- ^ (Created pixmap, created mask) pixbufRenderPixmapAndMaskForColormap pixbuf colormap threshold = alloca $ \pmRetPtr -> alloca $ \bmRetPtr -> do {#call unsafe pixbuf_render_pixmap_and_mask_for_colormap#} pixbuf colormap (castPtr pmRetPtr) -- seems to reject Pixmap**, so cast (castPtr bmRetPtr) (fromIntegral threshold) pm <- wrapNewGObject mkPixmap (peek pmRetPtr :: IO (Ptr Pixmap)) bm <- maybeNull (wrapNewGObject mkPixmap) (peek bmRetPtr :: IO (Ptr Bitmap)) return (pm, bm) #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs0000644000000000000000000003140107346545000017666 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Pixbuf Animation -- -- Author : Matthew Arsenault -- -- Created: 14 November 2009 -- -- Copyright (C) 2009 Matthew Arsenault -- -- 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 Graphics.UI.Gtk.Gdk.PixbufAnimation ( -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'PixbufAnimation' -- | +----'PixbufSimpleAnim' -- @ -- * Types PixbufAnimation, PixbufAnimationClass, castToPixbufAnimation, gTypePixbufAnimation, toPixbufAnimation, PixbufAnimationIter, PixbufAnimationIterClass, castToPixbufAnimationIter, gTypePixbufAnimationIter, toPixbufAnimationIter, PixbufSimpleAnim, PixbufSimpleAnimClass, castToPixbufSimpleAnim, gTypePixbufSimpleAnim, toPixbufSimpleAnim, -- * Constructors pixbufAnimationNewFromFile, #if GTK_CHECK_VERSION(2,8,0) pixbufSimpleAnimNew, #endif -- * Methods pixbufAnimationGetWidth, pixbufAnimationGetHeight, pixbufAnimationGetIter, pixbufAnimationIsStaticImage, pixbufAnimationGetStaticImage, pixbufAnimationIterAdvance, pixbufAnimationIterGetDelayTime, pixbufAnimationIterOnCurrentlyLoadingFrame, pixbufAnimationIterGetPixbuf, #if GTK_CHECK_VERSION(2,8,0) pixbufSimpleAnimAddFrame, #endif #if GTK_CHECK_VERSION(2,18,0) pixbufSimpleAnimSetLoop, pixbufSimpleAnimGetLoop #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GDateTime import System.Glib.GObject {#import Graphics.UI.Gtk.Types#} import System.Glib.GError (propagateGError) {# context prefix="gdk" #} --CHECKME: Domain error doc, GFileError ??? -- | Creates a new animation by loading it from a file. The file -- format is detected automatically. If the file's format does not -- support multi-frame images, then an animation with a single frame -- will be created. Possible errors are in the 'PixbufError' and -- 'GFileError' domains. -- -- Any of several error conditions may occur: the file could not be -- opened, there was no loader for the file's format, there was not -- enough memory to allocate the image buffer, or the image file -- contained invalid data. -- -- * If an error occurs, the function will throw an exception that can -- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the -- error codes in 'PixbufError' or 'GFileError' -- pixbufAnimationNewFromFile :: GlibFilePath fp => fp -- ^ Name of file to load, in the GLib file name encoding -> IO PixbufAnimation -- ^ A newly-created animation pixbufAnimationNewFromFile fname = wrapNewGObject mkPixbufAnimation $ propagateGError $ \errPtrPtr -> withUTFFilePath fname $ \strPtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,5) {#call unsafe pixbuf_animation_new_from_file_utf8#} strPtr errPtrPtr #else {#call unsafe pixbuf_animation_new_from_file#} strPtr errPtrPtr #endif -- | Queries the width of the bounding box of a pixbuf animation. pixbufAnimationGetWidth :: PixbufAnimation -- ^ An animation. -> IO Int -- ^ Width of the bounding box of the animation. pixbufAnimationGetWidth self = liftM fromIntegral $ {#call unsafe pixbuf_animation_get_width#} self -- | Queries the height of the bounding box of a pixbuf animation. pixbufAnimationGetHeight :: PixbufAnimation -- ^ An animation. -> IO Int -- ^ Height of the bounding box of the animation. pixbufAnimationGetHeight self = liftM fromIntegral $ {#call unsafe pixbuf_animation_get_height#} self -- | Get an iterator for displaying an animation. The iterator -- provides the frames that should be displayed at a given time. The -- start time would normally come from 'gGetCurrentTime', and marks -- the beginning of animation playback. After creating an iterator, -- you should immediately display the pixbuf returned by -- 'pixbufAnimationIterGetPixbuf'. Then, you should install a -- timeout (with 'timeoutAdd') or by some other mechanism ensure -- that you'll update the image after -- 'pixbufAnimationIterGetDelayTime' milliseconds. Each time the -- image is updated, you should reinstall the timeout with the new, -- possibly-changed delay time. -- -- As a shortcut, if start_time is @Nothing@, the result of -- 'gGetCurrentTime' will be used automatically. -- -- To update the image (i.e. possibly change the result of -- 'pixbufAnimationIterGetPixbuf' to a new frame of the animation), -- call 'pixbufAnimationIterAdvance'. -- -- If you're using 'PixbufLoader', in addition to updating the image -- after the delay time, you should also update it whenever you -- receive the area_updated signal and -- 'pixbufAnimationIterOnCurrentlyLoadingFrame' returns @True@. In -- this case, the frame currently being fed into the loader has -- received new data, so needs to be refreshed. The delay time for a -- frame may also be modified after an area_updated signal, for -- example if the delay time for a frame is encoded in the data after -- the frame itself. So your timeout should be reinstalled after any -- area_updated signal. -- -- A delay time of -1 is possible, indicating "infinite." -- pixbufAnimationGetIter :: PixbufAnimation -- ^ a 'PixbufAnimation' -> Maybe GTimeVal -- ^ time when the animation starts playing -> IO PixbufAnimationIter -- ^ an iterator to move over the animation pixbufAnimationGetIter self tv = maybeWith with tv $ \stPtr -> wrapNewGObject mkPixbufAnimationIter $ {#call unsafe pixbuf_animation_get_iter#} self (castPtr stPtr) -- | If you load a file with 'pixbufAnimationNewFromFile' and it turns -- out to be a plain, unanimated image, then this function will -- return @True@. Use 'pixbufAnimationGetStaticImage' to retrieve -- the image. -- pixbufAnimationIsStaticImage :: PixbufAnimation -> IO Bool -- ^ TRUE if the "animation" was really just an image pixbufAnimationIsStaticImage self = liftM toBool $ {#call unsafe pixbuf_animation_is_static_image#} self -- | If an animation is really just a plain image (has only one -- frame), this function returns that image. If the animation is an -- animation, this function returns a reasonable thing to display as -- a static unanimated image, which might be the first frame, or -- something more sophisticated. If an animation hasn't loaded any -- frames yet, this function will return @Nothing@. -- pixbufAnimationGetStaticImage :: PixbufAnimation -> IO (Maybe Pixbuf) -- ^ unanimated image representing the animation pixbufAnimationGetStaticImage self = maybeNull (makeNewGObject mkPixbuf) $ {#call unsafe pixbuf_animation_get_static_image#} self -- | Possibly advances an animation to a new frame. Chooses the frame -- based on the start time passed to 'pixbufAnimationGetIter'. -- -- current_time would normally come from 'gGetCurrentTime', and must -- be greater than or equal to the time passed to -- 'pixbufAnimationGetIter', and must increase or remain unchanged -- each time 'pixbufAnimationIterGetPixbuf' is called. That is, you -- can't go backward in time; animations only play forward. -- -- As a shortcut, pass @Nothing@ for the current time and -- 'gGetCurrentTime' will be invoked on your behalf. So you only need -- to explicitly pass current_time if you're doing something odd like -- playing the animation at double speed. -- -- If this function returns @False@, there's no need to update the -- animation display, assuming the display had been rendered prior to -- advancing; if @True@, you need to call 'animationIterGetPixbuf' and -- update the display with the new pixbuf. -- pixbufAnimationIterAdvance :: PixbufAnimationIter -- ^ A 'PixbufAnimationIter' -> Maybe GTimeVal -- ^ current time -> IO Bool -- ^ @True@ if the image may need updating pixbufAnimationIterAdvance iter currentTime = liftM toBool $ maybeWith with currentTime $ \tvPtr -> {# call unsafe pixbuf_animation_iter_advance #} iter (castPtr tvPtr) -- | Gets the number of milliseconds the current pixbuf should be -- displayed, or -1 if the current pixbuf should be displayed -- forever. 'timeoutAdd' conveniently takes a timeout in -- milliseconds, so you can use a timeout to schedule the next -- update. -- pixbufAnimationIterGetDelayTime :: PixbufAnimationIter -- ^ an animation iterator -> IO Int -- ^ delay time in milliseconds (thousandths of a second) pixbufAnimationIterGetDelayTime self = liftM fromIntegral $ {#call unsafe pixbuf_animation_iter_get_delay_time#} self -- | Used to determine how to respond to the area_updated signal on -- 'PixbufLoader' when loading an animation. area_updated is emitted -- for an area of the frame currently streaming in to the loader. So -- if you're on the currently loading frame, you need to redraw the -- screen for the updated area. -- pixbufAnimationIterOnCurrentlyLoadingFrame :: PixbufAnimationIter -> IO Bool -- ^ @True@ if the frame we're on is partially loaded, or the last frame pixbufAnimationIterOnCurrentlyLoadingFrame iter = liftM toBool $ {# call unsafe pixbuf_animation_iter_on_currently_loading_frame #} iter --CHECKME: referencing, usage of constructNewGObject -- | Gets the current pixbuf which should be displayed; the pixbuf will -- be the same size as the animation itself -- ('pixbufAnimationGetWidth', 'pixbufAnimationGetHeight'). This -- pixbuf should be displayed for 'pixbufAnimationIterGetDelayTime' -- milliseconds. The caller of this function does not own a reference -- to the returned pixbuf; the returned pixbuf will become invalid -- when the iterator advances to the next frame, which may happen -- anytime you call 'pixbufAnimationIterAdvance'. Copy the pixbuf to -- keep it (don't just add a reference), as it may get recycled as you -- advance the iterator. -- pixbufAnimationIterGetPixbuf :: PixbufAnimationIter -- ^ an animation iterator -> IO Pixbuf -- ^ the pixbuf to be displayed pixbufAnimationIterGetPixbuf iter = makeNewGObject mkPixbuf $ {# call unsafe pixbuf_animation_iter_get_pixbuf #} iter #if GTK_CHECK_VERSION(2,8,0) -- | Creates a new, empty animation. -- -- * Available since Gtk+ version 2.8 -- pixbufSimpleAnimNew :: Int -- ^ the width of the animation -> Int -- ^ the height of the animation -> Float -- ^ the speed of the animation, in frames per second -> IO PixbufSimpleAnim -- ^ a newly allocated 'PixbufSimpleAnim' pixbufSimpleAnimNew width height rate = wrapNewGObject mkPixbufSimpleAnim $ {#call unsafe pixbuf_simple_anim_new#} (fromIntegral width) (fromIntegral height) (realToFrac rate) -- | Adds a new frame to animation. The pixbuf must have the -- dimensions specified when the animation was constructed. -- -- * Available since Gtk+ version 2.8 -- pixbufSimpleAnimAddFrame :: PixbufSimpleAnim -- ^ a 'PixbufSimpleAnim' -> Pixbuf -- ^ the pixbuf to add -> IO () pixbufSimpleAnimAddFrame psa pb = {#call unsafe pixbuf_simple_anim_add_frame#} psa pb #endif #if GTK_CHECK_VERSION(2,18,0) -- | Sets whether animation should loop indefinitely when it reaches -- the end. -- -- * Available since Gtk+ version 2.18 -- pixbufSimpleAnimSetLoop :: PixbufSimpleAnim -- ^ a 'PixbufSimpleAnim' -> Bool -- ^ whether to loop the animation -> IO () pixbufSimpleAnimSetLoop animation loop = {#call unsafe pixbuf_simple_anim_set_loop#} animation (fromBool loop) -- | Gets whether animation should loop indefinitely when it reaches -- the end. -- -- * Available since Gtk+ version 2.18 -- pixbufSimpleAnimGetLoop :: PixbufSimpleAnim -- ^ a 'PixbufSimpleAnim' -> IO Bool -- ^ @True@ if the animation loops forever, @False@ otherwise pixbufSimpleAnimGetLoop animation = liftM toBool $ {#call unsafe pixbuf_simple_anim_get_loop#} animation #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/PixbufData.hs0000644000000000000000000000471407346545000016464 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses #-} {-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Pixbuf as Array -- -- Author : Ciancia, Axel Simon -- -- Created: 26 March 2002 -- -- Copyright (C) 2002-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : no (uses MTC, depends on internal GHC module) -- -- 'PixbufData' exposes 'Pixbuf's as mutable array. -- -- #hide module Graphics.UI.Gtk.Gdk.PixbufData ( PixbufData, mkPixbufData ) where import System.Glib.FFI import Graphics.UI.Gtk.Types -- internal module of GHC import Data.Array.Base ( MArray(..), newArray_, unsafeRead, unsafeWrite, getBounds, getNumElements ) -- | An array that stored the raw pixel data of a 'Pixbuf'. -- -- * See 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetPixels'. -- data PixbufData i e = PixbufData !Pixbuf {-# UNPACK #-} !(Ptr e) !(i,i) {-# UNPACK #-} !Int mkPixbufData :: Storable e => Pixbuf -> Ptr e -> Int -> PixbufData Int e mkPixbufData pb (ptr :: Ptr e) size = PixbufData pb ptr (0, count) count where count = fromIntegral (size `div` sizeOf (undefined :: e)) -- | 'PixbufData' is a mutable array. instance Storable e => MArray PixbufData e IO where newArray (l,u) e = error "Gtk.Gdk.Pixbuf.newArray: not implemented" newArray_ (l,u) = error "Gtk.Gdk.Pixbuf.newArray_: not implemented" {-# INLINE unsafeRead #-} unsafeRead (PixbufData (Pixbuf pb) pixPtr _ _) idx = do e <- peekElemOff pixPtr idx touchForeignPtr pb return e {-# INLINE unsafeWrite #-} unsafeWrite (PixbufData (Pixbuf pb) pixPtr _ _) idx elem = do pokeElemOff pixPtr idx elem touchForeignPtr pb {-# INLINE getBounds #-} getBounds (PixbufData _ _ bd _) = return bd {-# INLINE getNumElements #-} getNumElements (PixbufData _ _ _ count) = return count gtk-0.15.9/Graphics/UI/Gtk/Gdk/Pixmap.chs0000644000000000000000000000655407346545000016042 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Pixmap -- -- Author : Armin Groesslinger -- -- Created: 05 July 2005 -- -- Copyright (C) 2005 Armin Groesslinger -- -- 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 -- -- add methods -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Pixmaps -- Offscreen drawables -- -- This module is empty when built with Gtk3 because Pixmap has been -- removed. module Graphics.UI.Gtk.Gdk.Pixmap ( -- * Detail -- Pixmaps are offscreen drawables. They can be drawn upon with the -- standard drawing primitives, then copied to another drawable -- with 'drawDrawable'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Drawable' -- | +----Pixmap -- @ #if GTK_MAJOR_VERSION < 3 -- * Types Pixmap, PixmapClass, Bitmap, -- * Constructors pixmapNew #endif ) where #if GTK_MAJOR_VERSION < 3 import Data.Maybe import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} {# context lib="gdk" prefix="gdk" #} -- | A 'Bitmap' is a special 'Pixmap' in that the number of bits per pixel -- is one, that is, a pixel is either set or unset. Whenever a function -- expects a 'Bitmap', a 'Pixmap' of depth one must be supplied. type Bitmap = Pixmap -- | Create a new pixmap. -- -- If @drawable@ is @Nothing@, the depth of the pixmap is taken from the -- @depth@ parameter, otherwise the pixmap has the same depth as the -- 'Drawable' specified by @drawable@. Therefore, at least one of @drawable@ -- and @depth@ must not be @Nothing@. -- -- * Note that in Gtk+ 2.0 the @drawable@ can only be a 'DrawWindow', not an -- arbitrary 'Drawable'. -- #if GTK_CHECK_VERSION(2,2,0) pixmapNew :: DrawableClass drawable => Maybe drawable -- ^ @drawable@ - drawable supplying default values for the --pixmap -> Int -- ^ @width@ - width of the pixmap -> Int -- ^ @height@ - height of the pixmap -> Maybe Int -- ^ @depth@ - depth of the pixmap -> IO Pixmap pixmapNew mbDrawable width height depth = wrapNewGObject mkPixmap $ {# call unsafe pixmap_new #} (maybe (Drawable nullForeignPtr) toDrawable mbDrawable) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromMaybe (negate 1) depth) #else pixmapNew :: Maybe DrawWindow -- ^ @drawable@ - drawable supplying default values for -- the pixmap -> Int -- ^ @width@ - width of the pixmap -> Int -- ^ @height@ - height of the pixmap -> Maybe Int -- ^ @depth@ - depth of the pixmap -> IO Pixmap pixmapNew mbDrawWindow width height depth = wrapNewGObject mkPixmap $ {# call unsafe pixmap_new #} (maybe (DrawWindow nullForeignPtr) toDrawWindow mbDrawWindow) (fromIntegral width) (fromIntegral height) (fromIntegral $ fromMaybe (negate 1) depth) #endif #endif /* GTK_MAJOR_VERSION < 3 */ gtk-0.15.9/Graphics/UI/Gtk/Gdk/Region.chs0000644000000000000000000001470207346545000016021 0ustar0000000000000000{-# LANGUAGE CPP, ScopedTypeVariables #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Region -- -- Author : Axel Simon -- -- Created: 22 September 2002 -- -- Copyright (C) 2002-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. -- -- TODO -- -- The Span functions and callbacks are not implemented since retrieving -- a set of rectangles and working on them within Haskell seems to be easier. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A set of rectangles describing areas to be redrawn. -- -- * Regions consist of a set of non-overlapping rectangles. They are used to -- specify the area of a window which needs updating. -- -- This module is empty when built with Gtk3 because Pixmap has been -- removed. module Graphics.UI.Gtk.Gdk.Region ( #if GTK_MAJOR_VERSION < 3 makeNewRegion, Region(Region), regionNew, FillRule(..), regionPolygon, regionCopy, regionRectangle, regionGetClipbox, regionGetRectangles, regionEmpty, regionEqual, regionPointIn, OverlapType(..), regionRectIn, regionOffset, regionShrink, regionUnionWithRect, regionIntersect, regionUnion, regionSubtract, regionXor #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.General.Structs (Point, Rectangle(..)) {# context lib="gdk" prefix="gdk" #} {#pointer *GdkRegion as Region foreign newtype #} instance Show Region where show r = show (unsafePerformIO (regionGetRectangles r)) -- Construct a region from a pointer. -- makeNewRegion :: Ptr Region -> IO Region makeNewRegion rPtr = do region <- newForeignPtr rPtr region_destroy return (Region region) foreign import ccall unsafe "&gdk_region_destroy" region_destroy :: FinalizerPtr Region -- | Specify how to interpret a polygon. -- -- * The flag determines what happens if a polygon has overlapping areas. -- {#enum FillRule {underscoreToCase}#} -- | How a rectangle is contained in a 'Region'. -- {#enum OverlapType {underscoreToCase}#} -- | Create an empty region. -- regionNew :: IO Region regionNew = do rPtr <- {#call unsafe region_new#} makeNewRegion rPtr -- | Convert a polygon into a 'Region'. -- regionPolygon :: [Point] -> FillRule -> IO Region regionPolygon points rule = withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $ \(aPtr :: Ptr {#type gint#}) -> do rPtr <- {#call unsafe region_polygon#} (castPtr aPtr) (fromIntegral (length points)) ((fromIntegral.fromEnum) rule) makeNewRegion rPtr -- | Copy a 'Region'. -- regionCopy :: Region -> IO Region regionCopy r = do rPtr <- {#call unsafe region_copy#} r makeNewRegion rPtr -- | Convert a rectangle to a 'Region'. -- regionRectangle :: Rectangle -> IO Region regionRectangle rect = with rect $ \rectPtr -> do regPtr <- {#call unsafe region_rectangle#} (castPtr rectPtr) makeNewRegion regPtr -- | Smallest rectangle including the -- 'Region'. -- regionGetClipbox :: Region -> IO Rectangle regionGetClipbox r = alloca $ \rPtr -> do {#call unsafe region_get_clipbox#} r (castPtr rPtr) peek rPtr -- | Turn the 'Region' into its rectangles. -- -- A 'Region' is a set of horizontal bands. Each band consists of one or more -- rectangles of the same height. No rectangles in a band touch. -- regionGetRectangles :: Region -> IO [Rectangle] regionGetRectangles region = alloca $ \(rectPtrPtr :: Ptr (Ptr Rectangle)) -> alloca $ \(iPtr :: Ptr {#type gint#}) -> do {#call unsafe region_get_rectangles#} region (castPtr rectPtrPtr) iPtr size <- peek iPtr rectPtr <- peek rectPtrPtr rects <- peekArray (fromIntegral size) rectPtr {#call unsafe g_free#} (castPtr rectPtr) return rects -- | Test if a 'Region' is empty. -- regionEmpty :: Region -> IO Bool regionEmpty r = liftM toBool $ {#call unsafe region_empty#} r -- | Compares two 'Region's for equality. -- regionEqual :: Region -> Region -> IO Bool regionEqual r1 r2 = liftM toBool $ {#call unsafe region_equal#} r1 r2 -- | Checks if a point it is within a region. -- regionPointIn :: Region -> Point -> IO Bool regionPointIn r (x,y) = liftM toBool $ {#call unsafe region_point_in#} r (fromIntegral x) (fromIntegral y) -- | Check if a rectangle is within a region. -- regionRectIn :: Region -> Rectangle -> IO OverlapType regionRectIn reg rect = liftM (toEnum.fromIntegral) $ with rect $ \rPtr -> {#call unsafe region_rect_in#} reg (castPtr rPtr) -- | Move a region. -- regionOffset :: Region -> Int -> Int -> IO () regionOffset r dx dy = {#call unsafe region_offset#} r (fromIntegral dx) (fromIntegral dy) -- | Move a region. -- -- * Positive values shrink the region, negative values expand it. -- regionShrink :: Region -> Int -> Int -> IO () regionShrink r dx dy = {#call unsafe region_shrink#} r (fromIntegral dx) (fromIntegral dy) -- | Updates the region to include the rectangle. -- regionUnionWithRect :: Region -> Rectangle -> IO () regionUnionWithRect reg rect = with rect $ \rPtr -> {#call unsafe region_union_with_rect#} reg (castPtr rPtr) -- | Intersects one region with another. -- -- * Changes @reg1@ to include the common areas of @reg1@ -- and @reg2@. -- regionIntersect :: Region -> Region -> IO () regionIntersect reg1 reg2 = {#call unsafe region_intersect#} reg1 reg2 -- | Unions one region with another. -- -- * Changes @reg1@ to include @reg1@ and @reg2@. -- regionUnion :: Region -> Region -> IO () regionUnion reg1 reg2 = {#call unsafe region_union#} reg1 reg2 -- | Removes pars of a 'Region'. -- -- * Reduces the region @reg1@ so that is does not include any areas -- of @reg2@. -- regionSubtract :: Region -> Region -> IO () regionSubtract reg1 reg2 = {#call unsafe region_subtract#} reg1 reg2 -- | XORs two 'Region's. -- -- * The exclusive or of two regions contains all areas which were not -- overlapping. In other words, it is the union of the regions minus -- their intersections. -- regionXor :: Region -> Region -> IO () regionXor reg1 reg2 = {#call unsafe region_xor#} reg1 reg2 #endif gtk-0.15.9/Graphics/UI/Gtk/Gdk/Screen.chs0000644000000000000000000004246007346545000016017 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Screen -- -- Author : Duncan Coutts -- -- Created: 29 October 2007 -- -- Copyright (C) 2007 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) -- -- Object representing a physical screen -- -- * Module available since Gdk version 2.2 -- module Graphics.UI.Gtk.Gdk.Screen ( -- * Detail -- -- | 'Screen' objects are the GDK representation of a physical screen. It is -- used throughout GDK and Gtk+ to specify which screen the top level windows -- are to be displayed on. It is also used to query the screen specification -- and default settings such as the default colormap -- ('screenGetDefaultColormap'), the screen width ('screenGetWidth'), etc. -- -- Note that a screen may consist of multiple monitors which are merged to -- form a large screen area. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----Screen -- @ #if GTK_CHECK_VERSION(2,2,0) -- * Types Screen, ScreenClass, castToScreen, gTypeScreen, toScreen, -- * Methods screenGetDefault, #if GTK_MAJOR_VERSION <3 screenGetSystemColormap, #if GTK_CHECK_VERSION(2,8,0) screenGetRGBAColormap, #endif #ifndef DISABLE_DEPRECATED screenGetDefaultColormap, screenSetDefaultColormap, #endif #endif screenGetSystemVisual, #if GTK_CHECK_VERSION(2,10,0) screenIsComposited, #endif screenGetRootWindow, screenGetDisplay, screenGetNumber, screenGetWidth, screenGetHeight, screenGetWidthMm, screenGetHeightMm, screenGetWidthMM, screenGetHeightMM, screenListVisuals, screenGetToplevelWindows, screenMakeDisplayName, screenGetNMonitors, screenGetMonitorGeometry, screenGetMonitorAtPoint, screenGetMonitorAtWindow, #if GTK_CHECK_VERSION(2,14,0) screenGetMonitorHeightMm, screenGetMonitorWidthMm, screenGetMonitorPlugName, #endif -- screenGetSetting, #if GTK_CHECK_VERSION(2,10,0) screenGetActiveWindow, screenGetWindowStack, #endif -- * Attributes screenFontOptions, screenResolution, #if GTK_MAJOR_VERSION < 3 screenDefaultColormap, #endif -- * Signals screenSizeChanged, #if GTK_CHECK_VERSION(2,10,0) screenCompositedChanged, #if GTK_CHECK_VERSION(2,14,0) screenMonitorsChanged, #endif #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Signals import System.Glib.Attributes import System.Glib.Properties import System.Glib.GList {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Signals import Graphics.Rendering.Cairo.Types ( FontOptions(..), mkFontOptions, withFontOptions) import Graphics.UI.Gtk.General.Structs ( Rectangle(..) ) {# context lib="gdk" prefix="gdk" #} #if GTK_CHECK_VERSION(2,2,0) -------------------- -- Methods -- | Gets the default screen for the default display. (See -- 'displayGetDefault'). -- screenGetDefault :: IO (Maybe Screen) -- ^ returns a 'Screen', or @Nothing@ if there is no -- default display. screenGetDefault = maybeNull (makeNewGObject mkScreen) $ {# call gdk_screen_get_default #} #if GTK_MAJOR_VERSION < 3 screenGetDefaultColormap :: Screen -> IO Colormap -- ^ returns the default 'Colormap'. screenGetDefaultColormap self = makeNewGObject mkColormap $ {# call gdk_screen_get_default_colormap #} self {-# DEPRECATED screenGetDefaultColormap "instead of 'screenGetDefaultColormap obj' use 'get obj screenDefaultColormap'" #-} screenSetDefaultColormap :: Screen -> Colormap -- ^ @colormap@ - a 'Colormap' -> IO () screenSetDefaultColormap self colormap = {# call gdk_screen_set_default_colormap #} self colormap {-# DEPRECATED screenSetDefaultColormap "instead of 'screenSetDefaultColormap obj value' use 'set obj [ screenDefaultColormap := value ]'" #-} -- | Gets the system default colormap for @screen@ -- -- Removed in Gtk3. screenGetSystemColormap :: Screen -> IO Colormap -- ^ returns the default colormap for @screen@. screenGetSystemColormap self = makeNewGObject mkColormap $ {# call gdk_screen_get_system_colormap #} self #if GTK_CHECK_VERSION(2,8,0) -- | Gets a colormap to use for creating windows or pixmaps with an alpha -- channel. The windowing system on which Gtk+ is running may not support this -- capability, in which case @Nothing@ will be returned. Even if a -- non-@Nothing@ value is returned, its possible that the window's alpha -- channel won't be honored when displaying the window on the screen: in -- particular, for X an appropriate windowing manager and compositing manager -- must be running to provide appropriate display. -- -- * Available since Gdk version 2.8 -- -- Removed in Gtk3. screenGetRGBAColormap :: Screen -> IO (Maybe Colormap) -- ^ returns a colormap to use for windows with an -- alpha channel or @Nothing@ if the capability is not -- available. screenGetRGBAColormap self = maybeNull (makeNewGObject mkColormap) $ {# call gdk_screen_get_rgba_colormap #} self #endif #endif -- | Get the system's default visual for @screen@. This is the visual for the -- root window of the display. -- screenGetSystemVisual :: Screen -> IO Visual -- ^ returns the system visual screenGetSystemVisual self = makeNewGObject mkVisual $ {# call gdk_screen_get_system_visual #} self #if GTK_CHECK_VERSION(2,10,0) -- | Returns whether windows with an RGBA visual can reasonably be expected to -- have their alpha channel drawn correctly on the screen. -- -- On X11 this function returns whether a compositing manager is compositing -- @screen@. -- -- * Available since Gdk version 2.10 -- screenIsComposited :: Screen -> IO Bool -- ^ returns Whether windows with RGBA visuals can reasonably be -- expected to have their alpha channels drawn correctly on the -- screen. screenIsComposited self = liftM toBool $ {# call gdk_screen_is_composited #} self #endif -- | Gets the root window of @screen@. -- screenGetRootWindow :: Screen -> IO DrawWindow -- ^ returns the root window screenGetRootWindow self = makeNewGObject mkDrawWindow $ {# call gdk_screen_get_root_window #} self -- | Gets the display to which the @screen@ belongs. -- screenGetDisplay :: Screen -> IO Display -- ^ returns the display to which @screen@ belongs screenGetDisplay self = makeNewGObject mkDisplay $ {# call gdk_screen_get_display #} self -- | Gets the index of @screen@ among the screens in the display to which it -- belongs. (See 'screenGetDisplay') -- screenGetNumber :: Screen -> IO Int -- ^ returns the index screenGetNumber self = liftM fromIntegral $ {# call gdk_screen_get_number #} self -- | Gets the width of @screen@ in pixels -- screenGetWidth :: Screen -> IO Int -- ^ returns the width of @screen@ in pixels. screenGetWidth self = liftM fromIntegral $ {# call gdk_screen_get_width #} self -- | Gets the height of @screen@ in pixels -- screenGetHeight :: Screen -> IO Int -- ^ returns the height of @screen@ in pixels. screenGetHeight self = liftM fromIntegral $ {# call gdk_screen_get_height #} self -- | Gets the width of @screen@ in millimeters. Note that on some X servers -- this value will not be correct. -- screenGetWidthMM :: Screen -> IO Int -- ^ returns the width of @screen@ in millimeters. screenGetWidthMM self = liftM fromIntegral $ {# call gdk_screen_get_width_mm #} self screenGetWidthMm = screenGetWidthMM -- | Returns the height of @screen@ in millimeters. Note that on some X -- servers this value will not be correct. -- screenGetHeightMM :: Screen -> IO Int -- ^ returns the height of @screen@ in millimeters. screenGetHeightMM self = liftM fromIntegral $ {# call gdk_screen_get_height_mm #} self screenGetHeightMm = screenGetHeightMM -- | Lists the available visuals for the specified @screen@. A visual -- describes a hardware image data format. For example, a visual might support -- 24-bit color, or 8-bit color, and might expect pixels to be in a certain -- format. -- screenListVisuals :: Screen -> IO [Visual] -- ^ returns a list of visuals screenListVisuals self = {# call gdk_screen_list_visuals #} self >>= fromGList >>= mapM (makeNewGObject mkVisual . return) -- | Obtains a list of all toplevel windows known to GDK on the screen -- @screen@. A toplevel window is a child of the root window (see -- 'getDefaultRootWindow'). -- screenGetToplevelWindows :: Screen -> IO [DrawWindow] -- ^ returns list of toplevel windows screenGetToplevelWindows self = {# call gdk_screen_get_toplevel_windows #} self >>= fromGList >>= mapM (makeNewGObject mkDrawWindow . return) -- | Determines the name to pass to 'displayOpen' to get a 'Display' with this -- screen as the default screen. -- screenMakeDisplayName :: GlibString string => Screen -> IO string -- ^ returns a newly allocated string screenMakeDisplayName self = {# call gdk_screen_make_display_name #} self >>= readUTFString -- | Returns the number of monitors which @screen@ consists of. -- screenGetNMonitors :: Screen -> IO Int -- ^ returns number of monitors which @screen@ consists of. screenGetNMonitors self = liftM fromIntegral $ {# call gdk_screen_get_n_monitors #} self -- | Retrieves the 'Rectangle' representing the size and -- position of the individual monitor within the entire screen area. -- -- Note that the size of the entire screen area can be retrieved via -- 'screenGetWidth' and 'screenGetHeight'. -- screenGetMonitorGeometry :: Screen -> Int -- ^ @monitorNum@ - the monitor number. -> IO Rectangle screenGetMonitorGeometry self monitorNum = alloca $ \rPtr -> do {# call gdk_screen_get_monitor_geometry #} self (fromIntegral monitorNum) (castPtr rPtr) peek rPtr -- | Returns the monitor number in which the point (@x@,@y@) is located. -- screenGetMonitorAtPoint :: Screen -> Int -- ^ @x@ - the x coordinate in the virtual screen. -> Int -- ^ @y@ - the y coordinate in the virtual screen. -> IO Int -- ^ returns the monitor number in which the point (@x@,@y@) lies, -- or a monitor close to (@x@,@y@) if the point is not in any -- monitor. screenGetMonitorAtPoint self x y = liftM fromIntegral $ {# call gdk_screen_get_monitor_at_point #} self (fromIntegral x) (fromIntegral y) -- | Returns the number of the monitor in which the largest area of the -- bounding rectangle of @window@ resides. -- screenGetMonitorAtWindow :: Screen -> DrawWindow -- ^ @window@ - a 'DrawWindow' -> IO Int -- ^ returns the monitor number in which most of @window@ is -- located, or if @window@ does not intersect any monitors, a -- monitor, close to @window@. screenGetMonitorAtWindow self window = liftM fromIntegral $ {# call gdk_screen_get_monitor_at_window #} self window #if GTK_CHECK_VERSION(2,14,0) -- | Gets the height in millimeters of the specified monitor. -- -- * Available since Gdk version 2.14 -- screenGetMonitorHeightMm :: Screen -> Int -- ^ @monitorNum@ - number of the monitor -> IO Int -- ^ returns the height of the monitor, or -1 if not available screenGetMonitorHeightMm self monitorNum = liftM fromIntegral $ {# call gdk_screen_get_monitor_height_mm #} self (fromIntegral monitorNum) -- | Gets the width in millimeters of the specified monitor, if available. -- -- * Available since Gdk version 2.14 -- screenGetMonitorWidthMm :: Screen -> Int -- ^ @monitorNum@ - number of the monitor -> IO Int -- ^ returns the width of the monitor, or -1 if not available screenGetMonitorWidthMm self monitorNum = liftM fromIntegral $ {# call gdk_screen_get_monitor_width_mm #} self (fromIntegral monitorNum) -- | Returns the output name of the specified monitor. Usually something like -- VGA, DVI, or TV, not the actual product name of the display device. -- -- * Available since Gdk version 2.14 -- screenGetMonitorPlugName :: GlibString string => Screen -> Int -- ^ @monitorNum@ - number of the monitor -> IO (Maybe string) -- ^ returns a newly-allocated string containing the name of the -- monitor, or @Nothing@ if the name cannot be determined screenGetMonitorPlugName self monitorNum = do sPtr <- {# call gdk_screen_get_monitor_plug_name #} self (fromIntegral monitorNum) if sPtr==nullPtr then return Nothing else liftM Just $ readUTFString sPtr #endif {- -- | Retrieves a desktop-wide setting such as double-click time for the -- 'Screen'@screen@. -- -- FIXME needs a list of valid settings here, or a link to more information. -- screenGetSetting :: GlibString string => Screen -> string -- ^ @name@ - the name of the setting -> {-GValue*-} -- ^ @value@ - location to store the value of the setting -> IO Bool -- ^ returns @True@ if the setting existed and a value was -- stored in @value@, @False@ otherwise. screenGetSetting self name value = liftM toBool $ withUTFString name $ \namePtr -> {# call gdk_screen_get_setting #} self namePtr {-value-} -} -- these are only used for the attributes screenGetFontOptions :: Screen -> IO (Maybe FontOptions) screenGetFontOptions self = do fPtr <- {# call gdk_screen_get_font_options #} self if fPtr==nullPtr then return Nothing else liftM Just $ mkFontOptions (castPtr fPtr) screenSetFontOptions :: Screen -> Maybe FontOptions -> IO () screenSetFontOptions self Nothing = {# call gdk_screen_set_font_options #} self nullPtr screenSetFontOptions self (Just options) = withFontOptions options $ \fPtr -> {# call gdk_screen_set_font_options #} self (castPtr fPtr) #if GTK_CHECK_VERSION(2,10,0) -- | Returns the currently active window of this screen. -- -- On X11, this is done by inspecting the _NET_ACTIVE_WINDOW property on the -- root window, as described in the Extended Window Manager Hints. If there is -- no currently currently active window, or the window manager does not support -- the _NET_ACTIVE_WINDOW hint, this function returns @Nothing@. -- -- On other platforms, this function may return @Nothing@, depending on whether -- it is implementable on that platform. -- -- * Available since Gdk version 2.10 -- screenGetActiveWindow :: Screen -> IO (Maybe DrawWindow) -- ^ returns the currently active window, or -- @Nothing@. screenGetActiveWindow self = maybeNull (wrapNewGObject mkDrawWindow) $ {# call gdk_screen_get_active_window #} self #endif -- | Returns a list of 'DrawWindow's representing the -- current window stack. -- -- On X11, this is done by inspecting the _NET_CLIENT_LIST_STACKING property -- on the root window, as described in the Extended Window Manager Hints. If -- the window manager does not support the _NET_CLIENT_LIST_STACKING hint, this -- function returns @Nothing@. -- -- On other platforms, this function may return @Nothing@, depending on whether it is -- implementable on that platform. -- -- * Available since Gdk version 2.10 -- screenGetWindowStack :: Screen -> IO (Maybe [DrawWindow]) -- ^ returns a list of 'DrawWindow's for the -- current window stack, or @Nothing@. screenGetWindowStack self = do lPtr <- {# call gdk_screen_get_window_stack #} self if lPtr==nullPtr then return Nothing else liftM Just $ do fromGList lPtr >>= mapM (wrapNewGObject mkDrawWindow . return) #endif -------------------- -- Attributes -- | The default font options for the screen. -- screenFontOptions :: Attr Screen (Maybe FontOptions) screenFontOptions = newAttr screenGetFontOptions screenSetFontOptions -- | The resolution for fonts on the screen. -- -- Default value: -1 -- screenResolution :: Attr Screen Double screenResolution = newAttrFromDoubleProperty "resolution" #if GTK_MAJOR_VERSION < 3 -- | Sets the default @colormap@ for @screen@. -- -- Gets the default colormap for @screen@. -- -- Removed in Gtk3. screenDefaultColormap :: Attr Screen Colormap screenDefaultColormap = newAttr screenGetDefaultColormap screenSetDefaultColormap #endif -------------------- -- Signals -- | The ::size_changed signal is emitted when the pixel width or height of a -- screen changes. -- screenSizeChanged :: ScreenClass self => Signal self (IO ()) screenSizeChanged = Signal (connect_NONE__NONE "size-changed") #if GTK_CHECK_VERSION(2,10,0) -- | The 'screenCompositedChanged' signal is emitted when the composited status of -- the screen changes -- -- * Available since Gdk version 2.10 -- screenCompositedChanged :: ScreenClass self => Signal self (IO ()) screenCompositedChanged = Signal (connect_NONE__NONE "composited-changed") #if GTK_CHECK_VERSION(2,14,0) -- | The 'screenMonitorsChanged' signal is emitted when the number, size or -- position of the monitors attached to the screen change. -- -- Only for X for now. Future implementations for Win32 and OS X may be a -- possibility. -- -- * Available since Gdk version 2.14 -- screenMonitorsChanged :: ScreenClass self => Signal self (IO ()) screenMonitorsChanged = Signal (connect_NONE__NONE "monitors-changed") #endif #endif gtk-0.15.9/Graphics/UI/Gtk/General/0000755000000000000000000000000007346545000014743 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/General/Clipboard.chs0000644000000000000000000006021207346545000017342 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Clipboard -- -- Author : Axel Simon -- -- Created: 26 March 2007 -- -- Copyright (C) 2007 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. -- -- I removed all definitions for the clipboard by Juergen Nicklisch since -- the way the clipboards were selected didn't tie in with the Selection -- module. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Storing data on clipboards -- module Graphics.UI.Gtk.General.Clipboard ( -- * Detail -- -- | The 'Clipboard' object represents a clipboard of data shared between -- different processes or between different widgets in the same process. Each -- clipboard is identified by a 'SelectionTag' which itself is an 'Atom'. The -- default clipboard corresponds to the 'selectionClipboard' tag; another -- commonly used clipboard is the 'selectionPrimary' tag, which, in X, -- traditionally contains the currently selected text. -- -- To support having a number of different formats on the clipboard at the -- same time, the clipboard mechanism allows providing callbacks instead of -- the actual data. When you set the contents of the clipboard, you can either -- supply the data directly (via functions like 'clipboardSetText'), or you -- can supply a callback to be called at a later time when the data is needed -- (via 'clipboardSetWithData'). Providing a callback also avoids having to -- make copies of the data when it is not needed. -- -- Setting clipboard data is done using 'clipboardSetWithData' and -- 'clipboardSetWithOwner'. Both functions are quite similar; the choice -- between the two depends mostly on which is more convenient in a particular -- situation. The former is most useful when you want to have a blob of data -- with callbacks to convert it into the various data types that you -- advertise. When the @clearFunc@ you provided is called, you simply free the -- data blob. The latter is more useful when the contents of clipboard reflect -- the internal state of a 'GObject' (As an example, for the -- 'selectionPrimary' clipboard, when an entry widget provides the clipboard's -- contents the contents are simply the text within the selected region.) If -- the contents change, the entry widget can call 'clipboardSetWithOwner' to -- update the timestamp for clipboard ownership, without having to worry about -- @clearFunc@ being called. -- -- Requesting the data from the clipboard is essentially asynchronous. If the -- contents of the clipboard are provided within the same process, then a -- direct function call will be made to retrieve the data, but if they are -- provided by another process, then the data needs to be retrieved from the -- other process, which may take some time. To avoid blocking the user -- interface, the call to request the selection, 'clipboardRequestContents' -- takes a callback that will be called when the contents are received (or -- when the request fails.) If you don't want to deal with providing a -- separate callback, you can also use 'clipboardWaitForContents'. What this -- does is run the GLib main loop recursively waiting for the contents. This -- can simplify the code flow, but you still have to be aware that other -- callbacks in your program can be called while this recursive mainloop is -- running. -- -- Along with the functions to get the clipboard contents as an arbitrary data -- chunk, there are also functions to retrieve it as text, -- 'clipboardRequestText' and 'clipboardWaitForText'. These functions take -- care of determining which formats are advertised by the clipboard provider, -- asking for the clipboard in the best available format and converting the -- its content. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----Clipboard -- @ -- * Types Clipboard, ClipboardClass, castToClipboard, gTypeClipboard, toClipboard, -- * Constants selectionPrimary, selectionSecondary, selectionClipboard, -- * Methods clipboardGet, #if GTK_CHECK_VERSION(2,2,0) clipboardGetForDisplay, clipboardGetDisplay, #endif clipboardSetWithData, {- clipboardSetWithOwner, clipboardGetOwner, clipboardClear, -} clipboardSetText, #if GTK_CHECK_VERSION(2,6,0) clipboardSetImage, #endif clipboardRequestContents, clipboardRequestText, #if GTK_CHECK_VERSION(2,6,0) clipboardRequestImage, #endif #if GTK_CHECK_VERSION(2,4,0) clipboardRequestTargets, #if GTK_CHECK_VERSION(2,10,0) clipboardRequestRichText, #endif #endif #if GTK_CHECK_VERSION(2,6,0) clipboardSetCanStore, clipboardStore, #endif ) where import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.DNDTypes#} (SelectionTag, TargetTag, Atom(..)) {#import Graphics.UI.Gtk.General.Selection#} (InfoId, SelectionDataM) import Graphics.UI.Gtk.General.Structs ( selectionPrimary, selectionSecondary, selectionClipboard, withTargetEntries) import Control.Monad ( liftM ) import Control.Monad.Reader (runReaderT) import Data.IORef ( newIORef, readIORef, writeIORef ) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- %hash c:d8d1 d:febf -- | Returns the clipboard object for the given selection. See -- 'clipboardGetForDisplay' for complete details. -- clipboardGet :: SelectionTag -- ^ @selection@ - a 'SelectionTag' which -- identifies the clipboard to use. -> IO Clipboard -- ^ returns the appropriate clipboard object. If no -- clipboard already exists, a new one will be created. Once a -- clipboard object has been created, it is persistent. clipboardGet (Atom selection) = makeNewGObject mkClipboard $ {# call gtk_clipboard_get #} selection #if GTK_CHECK_VERSION(2,2,0) -- %hash c:251 d:39fa -- | Returns the clipboard object for the given selection. Cut\/copy\/paste -- menu items and keyboard shortcuts should use the default clipboard, -- returned by passing 'selectionClipboard' for @selection@. The -- currently-selected object or text should be provided on the clipboard -- identified by 'selectionPrimary'. Cut\/copy\/paste menu items conceptually -- copy the contents of the 'selectionPrimary' clipboard to the default -- clipboard, i.e. they copy the selection to what the user sees as the -- clipboard. -- -- See -- for a detailed -- discussion of the 'selectionClipboard' vs. 'selectionPrimary' selections -- under the X window system. On Win32 the 'selectionPrimary' clipboard is -- essentially ignored. -- -- It's possible to have arbitrary named clipboards; if you do invent new -- clipboards, you should prefix the selection name with an underscore -- (because the ICCCM requires that nonstandard atoms are -- underscore-prefixed), and namespace it as well. For example, if your -- application called \"Foo\" has a special-purpose clipboard, you could -- create it using 'Graphics.UI.Gtk.General.Selection.atomNew' -- \"_FOO_SPECIAL_CLIPBOARD\". -- -- * Available since Gtk+ version 2.2 -- clipboardGetForDisplay :: Display -- ^ @display@ - the display for which the clipboard is to be -- retrieved or created -> SelectionTag -- ^ @selection@ - a 'SelectionTag' which -- identifies the clipboard to use. -> IO Clipboard -- ^ returns the appropriate clipboard object. If no -- clipboard already exists, a new one will be created. Once a -- clipboard object has been created, it is persistent. clipboardGetForDisplay display (Atom selection) = makeNewGObject mkClipboard $ {# call gtk_clipboard_get_for_display #} display selection -- %hash c:3931 d:93f1 -- | Gets the 'Display' associated with @clipboard@ -- -- * Available since Gtk+ version 2.2 -- clipboardGetDisplay :: ClipboardClass self => self -> IO Display -- ^ returns the 'Display' associated with @clipboard@ clipboardGetDisplay self = makeNewGObject mkDisplay $ {# call gtk_clipboard_get_display #} (toClipboard self) #endif -- The memory management of the ClipboardGetFunc and ClipboardClearFunc sucks badly -- in that there is no consistent way in which the latter could free the function -- closure of the former, since it is *not* called when the data of the same -- object is changed. What we do is that we store the function pointers as attributes -- of the Clipboard. Overwriting or finalizing these attributes will call their -- destructors and thereby free them. Thus, by setting these attributes each time we -- install new data functions, we cuningly finalized the previous closures. Hooray. {-# NOINLINE getFuncQuark #-} getFuncQuark :: Quark getFuncQuark = unsafePerformIO $ quarkFromString ("hsClipboardGetFuncClosure"::DefaultGlibString) {-# NOINLINE clearFuncQuark #-} clearFuncQuark :: Quark clearFuncQuark = unsafePerformIO $ quarkFromString ("hsClipboardClearFuncClosure"::DefaultGlibString) -- %hash c:c65a d:b402 -- | Virtually sets the contents of the specified clipboard by providing a -- list of supported formats for the clipboard data and a function to call to -- get the actual data when it is requested. -- clipboardSetWithData :: ClipboardClass self => self -> [(TargetTag, InfoId)] -- ^ @targets@ - a list containing information -- about the available forms for the clipboard -- data -> (InfoId -> SelectionDataM ()) -- ^ @getFunc@ - function to call to get the -- actual clipboard data, should call -- 'selectionDataSet'. -> IO () -- ^ @clearFunc@ - when the clipboard contents -- are set again, this function will be called, -- and @getFunc@ will not be subsequently called. -> IO Bool -- ^ returns @True@ if setting the clipboard -- data succeeded. clipboardSetWithData self targets getFunc clearFunc = do gFunPtr <- mkClipboardGetFunc (\_ sPtr info _ -> runReaderT (getFunc info) sPtr >> return ()) cFunPtr <- mkClipboardClearFunc (\_ _ -> clearFunc) res <- withTargetEntries targets $ \nTargets targets -> liftM toBool $ {# call gtk_clipboard_set_with_data #} (toClipboard self) targets (fromIntegral nTargets) gFunPtr cFunPtr nullPtr {#call unsafe g_object_set_qdata_full#} (toGObject self) getFuncQuark (castFunPtrToPtr gFunPtr) destroyFunPtr {#call unsafe g_object_set_qdata_full#} (toGObject self) clearFuncQuark (castFunPtrToPtr cFunPtr) destroyFunPtr return res {#pointer ClipboardGetFunc#} {#pointer ClipboardClearFunc#} foreign import ccall "wrapper" mkClipboardGetFunc :: (Ptr Clipboard -> Ptr () -> {#type guint#} -> Ptr () -> IO ()) -> IO ClipboardGetFunc foreign import ccall "wrapper" mkClipboardClearFunc :: (Ptr Clipboard -> Ptr () -> IO ()) -> IO ClipboardClearFunc -- %hash c:e778 d:7b3f -- | Virtually sets the contents of the specified clipboard by providing a -- list of supported formats for the clipboard data and a function to call to -- get the actual data when it is requested. -- -- The difference between this function and 'clipboardSetWithData' is that -- a 'GObject' is passed in. -- _clipboardSetWithOwner :: (ClipboardClass self, GObjectClass owner) => self -> [(TargetTag, InfoId)] -- ^ @targets@ - a list containing information -- about the available forms for the clipboard -- data -> (InfoId -> SelectionDataM ()) -- ^ @getFunc@ - function to call to get the -- actual clipboard data, should call -- 'selectionDataSet'. -> IO () -- ^ @clearFunc@ - when the clipboard contents -- are set again, this function will be called, -- and @getFunc@ will not be subsequently called. -> owner -- ^ @owner@ - an object that \"owns\" the data. -> IO Bool -- ^ returns @True@ if setting the clipboard -- data succeeded. If setting the clipboard data -- failed the provided callback functions will be -- ignored. _clipboardSetWithOwner self targets getFunc clearFunc owner = do gFunPtr <- mkClipboardGetFunc (\_ sPtr info _ -> runReaderT (getFunc info) sPtr >> return ()) cFunPtr <- mkClipboardClearFunc (\_ _ -> clearFunc) res <- withTargetEntries targets $ \nTargets targets -> liftM toBool $ {# call gtk_clipboard_set_with_owner #} (toClipboard self) targets (fromIntegral nTargets) gFunPtr cFunPtr (toGObject owner) {#call unsafe g_object_set_qdata_full#} (toGObject self) getFuncQuark (castFunPtrToPtr gFunPtr) destroyFunPtr {#call unsafe g_object_set_qdata_full#} (toGObject self) clearFuncQuark (castFunPtrToPtr cFunPtr) destroyFunPtr return res -- %hash c:dba2 d:efc2 -- | If the clipboard contents callbacks were set with -- 'clipboardSetWithOwner', and the 'clipboardSetWithData' or 'clipboardClear' -- has not subsequently called, returns the owner set by -- 'clipboardSetWithOwner'. -- _clipboardGetOwner :: ClipboardClass self => self -> IO (Maybe GObject) -- ^ returns the owner of the clipboard, if any; otherwise -- @Nothing@. _clipboardGetOwner self = maybeNull (makeNewGObject mkGObject) $ {# call gtk_clipboard_get_owner #} (toClipboard self) -- %hash c:d6f8 d:486 -- | Clears the contents of the clipboard. Generally this should only be -- called between the time you call 'clipboardSetWithOwner' or -- 'clipboardSetWithData', and when the @clearFunc@ you supplied is called. -- Otherwise, the clipboard may be owned by someone else. -- _clipboardClear :: ClipboardClass self => self -> IO () _clipboardClear self = {# call gtk_clipboard_clear #} (toClipboard self) -- %hash c:5211 d:14c6 -- | Sets the contents of the clipboard to the given UTF-8 string. Gtk+ will -- make a copy of the text and take responsibility for responding for requests -- for the text, and for converting the text into the requested format. -- clipboardSetText :: (ClipboardClass self, GlibString string) => self -> string -- ^ @text@ - the text to be set as clipboard content -> IO () clipboardSetText self text = withUTFStringLen text $ \(textPtr,len) -> {# call gtk_clipboard_set_text #} (toClipboard self) textPtr (fromIntegral len) #if GTK_CHECK_VERSION(2,6,0) -- %hash c:5172 d:e4dd -- | Sets the contents of the clipboard to the given 'Pixbuf'. Gtk+ will take -- responsibility for responding for requests for the image, and for converting -- the image into the requested format. -- -- * Available since Gtk+ version 2.6 -- clipboardSetImage :: ClipboardClass self => self -> Pixbuf -- ^ @pixbuf@ - a 'Pixbuf' -> IO () clipboardSetImage self pixbuf = {# call gtk_clipboard_set_image #} (toClipboard self) pixbuf #endif -- %hash c:22cd d:f72d -- | Requests the contents of clipboard as the given target. When the results -- of the result are later received the supplied callback will be called. -- clipboardRequestContents :: ClipboardClass self => self -> TargetTag -- ^ @target@ - an atom representing the form -- into which the clipboard owner should -- convert the selection. -> SelectionDataM () -- ^ @callback@ - A function to call when the -- results are received (or the retrieval -- fails). If the retrieval fails, -- 'selectionDataIsValid' returns @False@. -> IO () clipboardRequestContents self (Atom target) callback = do cbRef <- newIORef nullFunPtr cbPtr <- mkClipboardReceivedFunc (\_ sPtr _ -> do freeHaskellFunPtr =<< readIORef cbRef runReaderT callback sPtr return ()) writeIORef cbRef cbPtr {# call gtk_clipboard_request_contents #} (toClipboard self) target cbPtr nullPtr {#pointer ClipboardReceivedFunc#} foreign import ccall "wrapper" mkClipboardReceivedFunc :: (Ptr Clipboard -> Ptr () -> Ptr () -> IO ()) -> IO ClipboardReceivedFunc -- %hash c:7bb1 d:4ef1 -- | Requests the contents of the clipboard as text. When the text is later -- received, it will be converted if it is stored in a different character set -- if necessary, and @callback@ will be called. -- -- The @text@ parameter to @callback@ will contain the resulting text if the -- request succeeded, or @Nothing@ if it failed. This could happen for various reasons, in -- particular if the clipboard was empty or if the contents of the clipboard -- could not be converted into text form. -- clipboardRequestText :: (ClipboardClass self, GlibString string) => self -> (Maybe string -> IO ()) -- ^ @callback@ - a function to call when -- the text is received, or the retrieval -- fails. (It will always be called one -- way or the other.) -> IO () clipboardRequestText self callback = do cbRef <- newIORef nullFunPtr cbPtr <- mkClipboardTextReceivedFunc (\_ sPtr _ -> do freeHaskellFunPtr =<< readIORef cbRef mStr <- if sPtr==nullPtr then return Nothing else liftM Just $ peekUTFString sPtr callback mStr) writeIORef cbRef cbPtr {# call gtk_clipboard_request_text #} (toClipboard self) cbPtr nullPtr {#pointer ClipboardTextReceivedFunc#} foreign import ccall "wrapper" mkClipboardTextReceivedFunc :: (Ptr Clipboard -> CString -> Ptr () -> IO ()) -> IO ClipboardTextReceivedFunc #if GTK_CHECK_VERSION(2,6,0) -- %hash c:3207 d:e3c1 -- | Requests the contents of the clipboard as image. When the image is later -- received, it will be converted to a 'Pixbuf', and @callback@ will be called. -- -- The @pixbuf@ parameter to @callback@ will contain the resulting 'Pixbuf' -- if the request succeeded, or @Nothing@ if it failed. This could happen for various -- reasons, in particular if the clipboard was empty or if the contents of the -- clipboard could not be converted into an image. -- -- * Available since Gtk+ version 2.6 -- clipboardRequestImage :: ClipboardClass self => self -> (Maybe Pixbuf -> IO ()) -- ^ @callback@ - a function to call -- when the image is received, or the -- retrieval fails. (It will always be -- called one way or the other.) -> IO () clipboardRequestImage self callback = do cbRef <- newIORef nullFunPtr cbPtr <- mkClipboardImageReceivedFunc (\_ sPtr _ -> do freeHaskellFunPtr =<< readIORef cbRef mPixbuf <- maybeNull (makeNewGObject mkPixbuf) (return sPtr) callback mPixbuf) writeIORef cbRef cbPtr {# call gtk_clipboard_request_image #} (toClipboard self) cbPtr nullPtr {#pointer ClipboardImageReceivedFunc#} foreign import ccall "wrapper" mkClipboardImageReceivedFunc :: (Ptr Clipboard -> Ptr Pixbuf -> Ptr () -> IO ()) -> IO ClipboardImageReceivedFunc #endif #if GTK_CHECK_VERSION(2,4,0) -- %hash c:63f6 d:c0e1 -- | Requests the contents of the clipboard as list of supported targets. When -- the list is later received, @callback@ will be called. -- -- The @targets@ parameter to @callback@ will contain the resulting targets -- if the request succeeded, or @Nothing@ if it failed. -- -- * Available since Gtk+ version 2.4 -- clipboardRequestTargets :: ClipboardClass self => self -> (Maybe [TargetTag] -> IO ()) -- ^ @callback@ - a function to call -- when the targets are received, or -- the retrieval fails. (It will always -- be called one way or the other.) -> IO () clipboardRequestTargets self callback = do cbRef <- newIORef nullFunPtr cbPtr <- mkClipboardTargetsReceivedFunc (\_ tPtr len _ -> do -- We must free Haskell pointer *in* the callback to avoid segfault. freeHaskellFunPtr =<< readIORef cbRef mTargets <- if tPtr==nullPtr then return Nothing else liftM (Just . map Atom) $ peekArray (fromIntegral len) tPtr callback mTargets) writeIORef cbRef cbPtr {# call gtk_clipboard_request_targets #} (toClipboard self) cbPtr nullPtr {#pointer ClipboardTargetsReceivedFunc#} foreign import ccall "wrapper" mkClipboardTargetsReceivedFunc :: (Ptr Clipboard -> Ptr (Ptr ()) -> {#type gint#} -> Ptr () -> IO ()) -> IO ClipboardTargetsReceivedFunc #if GTK_CHECK_VERSION(2,10,0) -- %hash c:5601 d:d6a6 -- | Requests the contents of the clipboard as rich text. When the rich text -- is later received, @callback@ will be called. -- -- The @text@ parameter to @callback@ will contain the resulting rich text if -- the request succeeded, or @Nothing@ if it failed. This function can fail -- for various reasons, in particular if the clipboard was empty or if the -- contents of the clipboard could not be converted into rich text form. -- -- * Available since Gtk+ version 2.10 -- clipboardRequestRichText :: (ClipboardClass self, TextBufferClass buffer, GlibString string) => self -> buffer -- ^ @buffer@ - a 'TextBuffer' that determines the supported rich text formats -> (Maybe (TargetTag,string) -> IO ()) -- ^ @callback@ - a function to call -- when the text is received, or the -- retrieval fails. (It will always be -- called one way or the other.) -> IO () clipboardRequestRichText self buffer callback = do cbRef <- newIORef nullFunPtr cbPtr <- mkClipboardRichTextReceivedFunc (\_ tPtr sPtr len _ -> do freeHaskellFunPtr =<< readIORef cbRef mRes <- if sPtr==nullPtr then return Nothing else liftM Just $ do str <- peekUTFStringLen (castPtr sPtr,fromIntegral len) return (Atom tPtr, str) callback mRes) writeIORef cbRef cbPtr {# call gtk_clipboard_request_rich_text #} (toClipboard self) (toTextBuffer buffer) cbPtr nullPtr {#pointer ClipboardRichTextReceivedFunc#} foreign import ccall "wrapper" mkClipboardRichTextReceivedFunc :: (Ptr Clipboard -> Ptr () -> Ptr CUChar -> {#type gsize#} -> Ptr () -> IO ()) -> IO ClipboardRichTextReceivedFunc #endif #endif #if GTK_CHECK_VERSION(2,6,0) -- %hash c:6e6a d:f98a -- | Hints that the clipboard data should be stored somewhere when the -- application exits or when 'clipboardStore' is called. -- -- This value is reset when the clipboard owner changes. Where the clipboard -- data is stored is platform dependent, see 'displayStoreClipboard' for more -- information. -- -- * Available since Gtk+ version 2.6 -- clipboardSetCanStore :: ClipboardClass self => self -> Maybe [(TargetTag, InfoId)] -- ^ @targets@ - list containing information -- about which forms should be stored or -- @Nothing@ to indicate that all forms -- should be stored. -> IO () clipboardSetCanStore self Nothing = {# call gtk_clipboard_set_can_store #} (toClipboard self) nullPtr 0 clipboardSetCanStore self (Just targets) = withTargetEntries targets $ \nTargets targets -> {# call gtk_clipboard_set_can_store #} (toClipboard self) targets (fromIntegral nTargets) -- %hash c:f98a d:ded8 -- | Stores the current clipboard data somewhere so that it will stay around -- after the application has quit. -- -- * Available since Gtk+ version 2.6 -- clipboardStore :: ClipboardClass self => self -> IO () clipboardStore self = {# call gtk_clipboard_store #} (toClipboard self) #endif gtk-0.15.9/Graphics/UI/Gtk/General/DNDTypes.chs0000644000000000000000000001130607346545000017075 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Type declarations for DND and Selections -- -- Author : Axel Simon -- -- Created: 11 April 2007 -- -- Copyright (C) 2007 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. -- -- functions that seem to be internal: gtk_selection_convert -- functions that relate to target tables are not bound since they seem -- superfluous -- -- Type declarations for Selections that are used for DND and Clipboards. -- #hide module Graphics.UI.Gtk.General.DNDTypes ( -- * Types InfoId, TargetTag, SelectionTag, SelectionTypeTag, PropertyTag, Atom(Atom), TargetList(TargetList), SelectionData, SelectionDataM, -- * Constructors atomNew, targetListNew, mkTargetList ) where import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} () import Control.Monad ( liftM ) import Control.Monad.Reader ( ReaderT ) {# context lib="gtk" prefix="gtk" #} -- | A number that the application can use to differentiate between different -- data types or application states. type InfoId = {#type guint#} -- | A tag that uniquely identifies a selection. A selection denotes the -- exchange mechanism that is being used, for instance, the clipboard is the -- most common exchange mechanism. For drag and drop applications, a new -- selection tag is usually created for each different kind of data that is -- being exchanged. type SelectionTag = Atom -- | A tag that uniquely identifies a target. A target describes the format of -- the underlying data source, for instance, it might be a string. A single -- selection may support multiple targets: suppose a new target is created for -- the Haskell data type 'Double'. In this case, the value of the floating -- point number could also be offered as a string. type TargetTag = Atom -- | A tag that defines the encoding of the binary data. For instance, a -- string might be encoded as UTF-8 or in a different locale. Each encoding -- would use the same 'TargetTag' but a different 'SelectionTypeTag'. type SelectionTypeTag = Atom -- | A tag -- that uniquely identifies a property of a -- 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow'. -- type PropertyTag = Atom -- | An atom is an index into a global string table. It is possible to -- associate binary data with each entry. This facility is used for -- inter-application data exchange such as properties of -- 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' (using 'PropertyTag'), -- 'Graphics.UI.Gtk.Clipboard.Clipboard' or 'Graphics.UI.Gtk.General.Drag' -- ('SelectionId' and 'TargetId'). newtype Atom = Atom (Ptr ()) deriving Eq instance Show Atom where show (Atom ptr) = show (atomToString ptr :: DefaultGlibString) atomToString ptr = unsafePerformIO $ do strPtr <- {#call unsafe gdk_atom_name#} ptr readUTFString strPtr -- | A 'TargetList' contains information about all possible formats -- (represented as 'TargetTag') that a widget can create or receive in form of -- a selection. -- {#pointer *GtkTargetList as TargetList foreign newtype#} -------------------- -- Constructors -- | Create a new 'TargetTag', 'SelectionTag', 'SelectionTypeTag' or -- 'PropertyTag'. Note that creating two target tags with the same name will -- create the same tag, in particular, the tag will be the same across -- different applications. Note that the name of an 'Atom' can be printed -- by 'show' though comparing the atom is merely an integer comparison. -- atomNew :: GlibString string => string -> IO Atom atomNew name = withUTFString name $ \strPtr -> liftM Atom $ {#call unsafe gdk_atom_intern#} strPtr 0 -- | Create a new, empty 'TargetList'. -- targetListNew :: IO TargetList targetListNew = do tlPtr <- {#call unsafe target_list_new#} nullPtr 0 liftM TargetList $ newForeignPtr tlPtr target_list_unref foreign import ccall unsafe ">k_target_list_unref" target_list_unref :: FinalizerPtr TargetList -- Wrap a 'TargetList' pointer. mkTargetList :: Ptr TargetList -> IO TargetList mkTargetList tlPtr = do tl <- liftM TargetList $ newForeignPtr tlPtr target_list_unref {#call unsafe target_list_ref#} tl return tl -- | A pointer to selection data. {#pointer *SelectionData #} -- | A monad providing access to selection data. -- type SelectionDataM a = ReaderT (Ptr ()) IO a gtk-0.15.9/Graphics/UI/Gtk/General/Drag.chs0000644000000000000000000006643207346545000016332 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Drag-and-Drop functionality -- -- Author : Axel Simon -- -- Created: 26 March 2007 -- -- Copyright (C) 2007 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. -- -- -- functions not bound: -- dragBegin : necessary to implement custom widgets that may be the source of -- drags. Would need to pass an event and an array of targets. The event needs -- to have the following information: Motion { -- eventTime :: TimeStamp, -- eventModifier :: [Modifier], -- eventIsHint (this needs to be True in order to avoid gdk_event_get_screen to be called (which causes havoc)) -- eventXRoot, -- eventYRoot :: Double } -- Button { -- eventClick :: Click, -- eventTime :: TimeStamp, -- eventModifier :: [Modifier], -- Key { -- eventTime :: TimeStamp, -- eventModifier :: [Modifier], -- Crossing { -- eventTime :: TimeStamp, -- eventModifier :: [Modifier]} -- -- drag_set_icon_pixmap : colormaps are a pain, they might be useful here -- drag_set_default_icon : obsolete drag_source_set_icon : colormap problem -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net Stability : provisional -- Portability : portable (depends on GHC) -- -- Drag-and-Drop functionality. -- -- GTK+ has a rich set of functions for doing inter-process communication via -- the drag-and-drop metaphor. GTK+ can do drag-and-drop (DND) via multiple -- protocols. The currently supported protocols are the Xdnd and Motif -- protocols. As well as the functions listed here, applications may need to -- use some facilities provided for 'Selection's. Also, the Drag and Drop API -- makes use of signals in the 'Widget' class. -- module Graphics.UI.Gtk.General.Drag ( -- * Types DragContext, DragContextClass, DragAction(..), DestDefaults(..), DragProtocol(..), #if GTK_CHECK_VERSION(2,12,0) DragResult(..), #endif castToDragContext, gTypeDragContext, toDragContext, -- * Methods #if GTK_MAJOR_VERSION < 3 dragContextActions, dragContextSuggestedAction, dragContextAction, #endif dragDestSet, dragDestSetProxy, dragDestUnset, dragDestFindTarget, dragDestGetTargetList, dragDestSetTargetList, #if GTK_CHECK_VERSION(2,6,0) dragDestAddTextTargets, dragDestAddImageTargets, dragDestAddURITargets, #endif dragStatus, dragFinish, dragGetData, dragGetSourceWidget, dragHighlight, dragUnhighlight, dragSetIconWidget, dragSetIconPixbuf, dragSetIconStock, #if GTK_CHECK_VERSION(2,8,0) dragSetIconName, #endif dragSetIconDefault, dragCheckThreshold, dragSourceSet, dragSourceSetIconPixbuf, dragSourceSetIconStock, #if GTK_CHECK_VERSION(2,8,0) dragSourceSetIconName, #endif dragSourceUnset, #if GTK_CHECK_VERSION(2,8,0) dragSourceSetTargetList, dragSourceGetTargetList, #endif #if GTK_CHECK_VERSION(2,6,0) dragSourceAddTextTargets, dragSourceAddImageTargets, dragSourceAddURITargets, #endif -- * Signals dragBegin, dragDataDelete, dragDataGet, dragDataReceived, dragDrop, dragEnd, #if GTK_CHECK_VERSION(2,12,0) dragFailed, #endif dragLeave, dragMotion ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import Graphics.UI.Gtk.General.StockItems ( StockId ) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.DNDTypes#} import Graphics.UI.Gtk.Gdk.Enums ( DragAction(..) ) import Graphics.UI.Gtk.General.Enums ( DestDefaults(..), DragProtocol(..) #if GTK_CHECK_VERSION(2,12,0) , DragResult(..) #endif ) import Graphics.UI.Gtk.Gdk.Events ( TimeStamp, Modifier ) import Graphics.UI.Gtk.General.Structs ( Point, #if GTK_MAJOR_VERSION < 3 dragContextGetActions, dragContextSetActions, dragContextGetSuggestedAction, dragContextSetSuggestedAction, dragContextGetAction, dragContextSetAction #endif ) import Graphics.UI.Gtk.Signals import Control.Monad.Reader (runReaderT) #if GTK_MAJOR_VERSION < 3 import System.Glib.Attributes ( Attr, newAttr ) #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods #if GTK_MAJOR_VERSION < 3 -- | A set of actions that the source recommends to be taken. Only valid if -- 'dragContextSuggestedAction' is set to 'ActionAsk'. -- -- Removed in Gtk3. dragContextActions :: Attr DragContext [DragAction] dragContextActions = newAttr (liftM toFlags . dragContextGetActions) (\o -> dragContextSetActions o . fromFlags) -- | The action suggested by the source. dragContextSuggestedAction :: Attr DragContext DragAction dragContextSuggestedAction = newAttr (liftM toEnum . dragContextGetSuggestedAction) (\o -> dragContextSetSuggestedAction o . fromEnum) -- | The action chosen by the destination. dragContextAction :: Attr DragContext DragAction dragContextAction = newAttr (liftM toEnum . dragContextGetAction) (\o -> dragContextSetAction o . fromEnum) #endif -- %hash c:4ff5 d:af3f -- | Sets a widget as a potential drop destination. -- -- * The 'DestDefaults' flags specify what actions Gtk should take on behalf -- of a widget for drops onto that widget. The given actions and any targets -- set through 'dragDestSetTargetList' only are used if 'DestDefaultMotion' -- or 'DestDefaultDrop' are given. -- -- * Things become more complicated when you try to preview the dragged data, -- as described in the documentation for 'dragMotion'. The default -- behaviors described by flags make some assumptions, that can conflict -- with your own signal handlers. For instance 'DestDefaultDrop' causes -- invocations of 'dragStatus' in the handler of 'dragMotion', and -- invocations of 'dragFinish' in 'dragDataReceived'. Especially the -- latter is dramatic, when your own 'dragMotion' handler calls -- 'dragGetData' to inspect the dragged data. -- dragDestSet :: WidgetClass widget => widget -> [DestDefaults] -> [DragAction] -> IO () dragDestSet widget flags actions = {# call gtk_drag_dest_set #} (toWidget widget) ((fromIntegral . fromFlags) flags) nullPtr 0 ((fromIntegral . fromFlags) actions) -- %hash c:89d2 d:af3f -- | Sets this widget as a proxy for drops to another window. -- dragDestSetProxy :: WidgetClass widget => widget -> DrawWindow -- ^ The window to which to forward drag events. -> DragProtocol -- ^ The drag protocol which the 'DrawWindow' accepts. -> Bool -- ^ If @True@, send the same coordinates to the destination, -- because it is an embedded subwindow. -> IO () dragDestSetProxy widget proxyWindow protocol useCoordinates = {# call gtk_drag_dest_set_proxy #} (toWidget widget) proxyWindow ((fromIntegral . fromEnum) protocol) (fromBool useCoordinates) -- %hash c:f319 d:af3f -- | Clears information about a drop destination set with 'dragDestSet'. The -- widget will no longer receive notification of drags. -- dragDestUnset :: WidgetClass widget => widget -> IO () dragDestUnset widget = {# call gtk_drag_dest_unset #} (toWidget widget) -- %hash c:db53 d:af3f -- | Looks for a match between the targets mentioned in the context and the -- 'TargetList', returning the first matching target, otherwise returning -- @Nothing@. If @Nothing@ is given as target list, use the value from -- 'destGetTargetList'. Some widgets may have different valid targets for -- different parts of the widget; in that case, they will have to implement a -- 'dragMotion' handler that passes the correct target list to this -- function. -- dragDestFindTarget :: (WidgetClass widget, DragContextClass context) => widget -> context -> Maybe TargetList -> IO (Maybe TargetTag) dragDestFindTarget widget context (Just targetList) = do ttPtr <- {# call gtk_drag_dest_find_target #} (toWidget widget) (toDragContext context) targetList if ttPtr==nullPtr then return Nothing else return (Just (Atom ttPtr)) dragDestFindTarget widget context Nothing = do ttPtr <- {# call gtk_drag_dest_find_target #} (toWidget widget) (toDragContext context) (TargetList nullForeignPtr) if ttPtr==nullPtr then return Nothing else return (Just (Atom ttPtr)) -- %hash c:41c7 d:af3f -- | Returns the list of targets this widget can accept for drag-and-drop. -- dragDestGetTargetList :: WidgetClass widget => widget -> IO (Maybe TargetList) dragDestGetTargetList widget = do tlPtr <- {# call gtk_drag_dest_get_target_list #} (toWidget widget) if tlPtr==nullPtr then return Nothing else liftM Just (mkTargetList tlPtr) -- %hash c:5c89 d:af3f -- | Sets the target types that this widget can accept from drag-and-drop. The -- widget must first be made into a drag destination with 'dragDestSet'. -- dragDestSetTargetList :: WidgetClass widget => widget -> TargetList -> IO () dragDestSetTargetList widget targetList = {# call gtk_drag_dest_set_target_list #} (toWidget widget) targetList #if GTK_CHECK_VERSION(2,6,0) -- %hash c:36c2 d:af3f -- | Add the text targets supported by the selection mechanism to the target -- list of the drag source. The targets are added with an 'InfoId' of 0. If -- you need another value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and -- 'dragSourceSetTargetList'. -- dragDestAddTextTargets :: WidgetClass widget => widget -> IO () dragDestAddTextTargets widget = {# call gtk_drag_dest_add_text_targets #} (toWidget widget) -- %hash c:691c d:af3f -- | Add image targets supported by the selection mechanism to the target list -- of the drag source. The targets are added with an 'InfoId' of 0. If you -- need another value, use -- 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and -- 'dragSourceSetTargetList'. -- dragDestAddImageTargets :: WidgetClass widget => widget -> IO () dragDestAddImageTargets widget = {# call gtk_drag_dest_add_image_targets #} (toWidget widget) -- %hash c:6f83 d:af3f -- | Add URI targets supported by the selection mechanism to the target list -- of the drag source. The targets are added with an 'InfoId' of 0. If you -- need another value, use -- 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and -- 'dragSourceSetTargetList'. -- dragDestAddURITargets :: WidgetClass widget => widget -> IO () dragDestAddURITargets widget = {# call gtk_drag_dest_add_uri_targets #} (toWidget widget) #endif -- %hash c:a91 d:af3f -- | Informs the drag source that the drop is finished, and that the data of -- the drag will no longer be required. -- dragFinish :: DragContextClass context => context -> Bool -- ^ a flag indicating whether the drop was successful -> Bool -- ^ a flag indicating whether the source should delete the original data. -- (This should be @True@ for a move) -> TimeStamp -- ^ the timestamp from the 'dragDrop' signal. -> IO () dragFinish context success del time = {# call gtk_drag_finish #} (toDragContext context) (fromBool success) (fromBool del) (fromIntegral time) -- %hash c:a37d d:af3f -- | Gets the data associated with a drag. When the data is received or the -- retrieval fails, GTK+ will emit a 'dragDataReceived' signal. Failure of -- the retrieval is indicated by passing @Nothing@ in the 'selectionData' signal. -- However, when 'dragGetData' is called -- implicitly because the 'DestDefaultDrop' was set, then the widget will -- not receive notification of failed drops. -- dragGetData :: (WidgetClass widget, DragContextClass context) => widget -- ^ The widget that will receive the 'dragDataReceived' signal. -> context -> TargetTag -- ^ The target (form of the data) to retrieve. -> TimeStamp -- ^ A timestamp for retrieving the data. This will generally be -- the time received in a 'dragMotion' or 'dragDrop' signal. -> IO () dragGetData widget context (Atom target) time = {# call gtk_drag_get_data #} (toWidget widget) (toDragContext context) target (fromIntegral time) -- %hash c:8c18 d:af3f -- | Queries he source widget for a drag. -- -- * If the drag is occurring within a single application, a pointer to the -- source widget is returned. Otherwise the return value is @Nothing@. -- dragGetSourceWidget :: DragContextClass context => context -> IO (Maybe Widget) dragGetSourceWidget context = maybeNull (makeNewGObject mkWidget) $ {# call gtk_drag_get_source_widget #} (toDragContext context) -- %hash c:1765 d:af3f -- | Draws a highlight around a widget. This will attach handlers to -- the expose handlers, so the highlight will continue to be displayed -- until 'dragUnhighlight' is called. -- dragHighlight :: WidgetClass widget => widget -> IO () dragHighlight widget = {# call gtk_drag_highlight #} (toWidget widget) -- %hash c:f00e d:af3f -- | Removes a highlight set by 'dragHighlight' from a widget. -- dragUnhighlight :: WidgetClass widget => widget -> IO () dragUnhighlight widget = {# call gtk_drag_unhighlight #} (toWidget widget) -- %hash c:f20 d:af3f -- | Changes the icon for a drag to a given widget. GTK+ will not destroy -- the widget, so if you don't want it to persist, you should connect to the -- 'dragEnd' signal and destroy it yourself. -- -- * The function must be called with the context of the source side. -- dragSetIconWidget :: (DragContextClass context, WidgetClass widget) => context -> widget -> Int -- ^ x hot-spot -> Int -- ^ y hot-spot -> IO () dragSetIconWidget context widget hotX hotY = {# call gtk_drag_set_icon_widget #} (toDragContext context) (toWidget widget) (fromIntegral hotX) (fromIntegral hotY) -- %hash c:69 d:af3f -- | Set the given 'Pixbuf' as the icon for the given drag. -- dragSetIconPixbuf :: DragContextClass context => context -> Pixbuf -> Int -- ^ x hot-spot -> Int -- ^ y hot-spot -> IO () dragSetIconPixbuf context pixbuf hotX hotY = {# call gtk_drag_set_icon_pixbuf #} (toDragContext context) pixbuf (fromIntegral hotX) (fromIntegral hotY) -- %hash c:f73f d:af3f -- | Sets the icon for a given drag from a stock ID. -- dragSetIconStock :: DragContextClass context => context -> StockId -> Int -- ^ x hot-spot -> Int -- ^ y hot-spot -> IO () dragSetIconStock context stockId hotX hotY = withUTFString stockId $ \stockIdPtr -> {# call gtk_drag_set_icon_stock #} (toDragContext context) stockIdPtr (fromIntegral hotX) (fromIntegral hotY) #if GTK_CHECK_VERSION(2,8,0) -- %hash c:1eba d:af3f -- | Sets the icon for a given drag from a named themed icon. See the docs for -- 'IconTheme' for more details. Note that the size of the icon depends on the -- icon theme (the icon is loaded at the DND size), thus x and y hot-spots -- have to be used with care. Since Gtk 2.8. -- dragSetIconName :: (DragContextClass context, GlibString string) => context -> string -> Int -- ^ x hot-spot -> Int -- ^ y hot-spot -> IO () dragSetIconName context iconName hotX hotY = withUTFString iconName $ \iconNamePtr -> {# call gtk_drag_set_icon_name #} (toDragContext context) iconNamePtr (fromIntegral hotX) (fromIntegral hotY) #endif -- %hash c:2beb d:af3f -- | Sets the icon for a particular drag to the default icon. This function -- must be called with a context for the source side of a drag -- dragSetIconDefault :: DragContextClass context => context -> IO () dragSetIconDefault context = {# call gtk_drag_set_icon_default #} (toDragContext context) -- %hash c:5785 d:af3f -- | Checks to see if a mouse drag starting at @(startX, startY)@ and ending -- at @(currentX, currentY)@ has passed the GTK+ drag threshold, and thus -- should trigger the beginning of a drag-and-drop operation. -- dragCheckThreshold :: WidgetClass widget => widget -> Int -- ^ @startX@ -> Int -- ^ @startY@ -> Int -- ^ @currentX@ -> Int -- ^ @currentY@ -> IO Bool dragCheckThreshold widget startX startY currentX currentY = liftM toBool $ {# call gtk_drag_check_threshold #} (toWidget widget) (fromIntegral startX) (fromIntegral startY) (fromIntegral currentX) (fromIntegral currentY) -- %hash c:ce13 d:af3f -- | Sets up a widget so that GTK+ will start a drag operation when the user -- clicks and drags on the widget. The widget must have a window. Note that a -- set of possible targets have to be set for a drag to be successful. -- dragSourceSet :: WidgetClass widget => widget -> [Modifier] -> [DragAction] -> IO () dragSourceSet widget startButtonMask actions = {# call gtk_drag_source_set #} (toWidget widget) ((fromIntegral . fromFlags) startButtonMask) nullPtr 0 ((fromIntegral . fromFlags) actions) -- %hash c:63f5 d:af3f -- | Sets the icon that will be used for drags from a particular widget from a -- 'Pixbuf'. -- dragSourceSetIconPixbuf :: WidgetClass widget => widget -> Pixbuf -> IO () dragSourceSetIconPixbuf widget pixbuf = {# call gtk_drag_source_set_icon_pixbuf #} (toWidget widget) pixbuf -- %hash c:b38b d:af3f -- | Sets the icon that will be used for drags from a particular source to a -- stock icon. -- dragSourceSetIconStock :: WidgetClass widget => widget -> StockId -> IO () dragSourceSetIconStock widget stockId = withUTFString stockId $ \stockIdPtr -> {# call gtk_drag_source_set_icon_stock #} (toWidget widget) stockIdPtr #if GTK_CHECK_VERSION(2,8,0) -- %hash c:1786 d:af3f -- | Sets the icon that will be used for drags from a particular source to a -- themed icon. See the docs for 'IconTheme' for more details. -- dragSourceSetIconName :: (WidgetClass widget, GlibString string) => widget -> string -> IO () dragSourceSetIconName widget iconName = withUTFString iconName $ \iconNamePtr -> {# call gtk_drag_source_set_icon_name #} (toWidget widget) iconNamePtr #endif -- %hash c:653c d:af3f -- | Undoes the effects of 'dragSourceSet'. -- dragSourceUnset :: WidgetClass widget => widget -> IO () dragSourceUnset widget = {# call gtk_drag_source_unset #} (toWidget widget) #if GTK_CHECK_VERSION(2,8,0) -- %hash c:facc d:af3f -- | Changes the target types that this widget offers for drag-and-drop. The -- widget must first be made into a drag source with 'dragSourceSet'. -- -- * Since Gtk 2.4. -- dragSourceSetTargetList :: WidgetClass widget => widget -> TargetList -> IO () dragSourceSetTargetList widget targetList = {# call gtk_drag_source_set_target_list #} (toWidget widget) targetList -- %hash c:e9aa d:af3f -- | Gets the list of targets this widget can provide for drag-and-drop. -- -- * Since Gtk 2.4. -- dragSourceGetTargetList :: WidgetClass widget => widget -> IO (Maybe TargetList) dragSourceGetTargetList widget = do tlPtr <- {# call gtk_drag_source_get_target_list #} (toWidget widget) if tlPtr==nullPtr then return Nothing else liftM Just (mkTargetList tlPtr) #endif #if GTK_CHECK_VERSION(2,6,0) -- %hash c:1f25 d:af3f -- | Add the text targets supported by -- 'Graphics.UI.Gtk.General.Selection.Selection' to the target list of -- the drag source. The targets are added with @info = 0@. If you need -- another value, use -- 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and -- 'dragSourceSetTargetList'. -- -- * Since Gtk 2.6. -- dragSourceAddTextTargets :: WidgetClass widget => widget -> IO () dragSourceAddTextTargets widget = {# call gtk_drag_source_add_text_targets #} (toWidget widget) -- %hash c:44bf d:af3f -- | Add the image targets supported by 'Selection' to the target list of the -- drag source. The targets are added with @info = 0@. If you need another -- value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and 'dragSourceSetTargetList'. -- -- * Since Gtk 2.6. -- dragSourceAddImageTargets :: WidgetClass widget => widget -> IO () dragSourceAddImageTargets widget = {# call gtk_drag_source_add_image_targets #} (toWidget widget) -- %hash c:4766 d:af3f -- | Add the URI targets supported by 'Selection' to the target list of the -- drag source. The targets are added with @info = 0@. If you need another -- value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and 'dragSourceSetTargetList'. -- -- * Since Gtk 2.6. -- dragSourceAddURITargets :: WidgetClass widget => widget -> IO () dragSourceAddURITargets widget = {# call gtk_drag_source_add_uri_targets #} (toWidget widget) #endif -- | Visualises the actions offered by the drag source. -- -- * This function is called by the drag destination in response to -- 'dragMotion' called by the drag source. The passed-in action -- is indicated where @Nothing@ will show that the drop is not -- allowed. -- dragStatus :: DragContext -> Maybe DragAction -> TimeStamp -> IO () dragStatus ctxt mAction ts = {# call gdk_drag_status #} ctxt (maybe 0 (fromIntegral . fromEnum) mAction) (fromIntegral ts) -- %hash c:fcf8 d:b945 -- | The 'dragBegin' signal is emitted on the drag source when a drag is -- started. A typical reason to connect to this signal is to set up a custom -- drag icon with 'dragSourceSetIcon'. -- dragBegin :: WidgetClass self => Signal self (DragContext -> IO ()) dragBegin = Signal (connect_OBJECT__NONE "drag-begin") -- %hash c:bfef d:a2ff -- | The 'dragDataDelete' signal is emitted on the drag source when a drag -- with the action 'ActionMove' is successfully completed. The signal handler -- is responsible for deleting the data that has been dropped. What \"delete\" -- means, depends on the context of the drag operation. -- dragDataDelete :: WidgetClass self => Signal self (DragContext -> IO ()) dragDataDelete = Signal (connect_OBJECT__NONE "drag-data-delete") -- %hash c:eb9c d:844c -- | The 'dragDataGet' signal is emitted on the drag source when the -- drop site requests the data which is dragged. It is the -- responsibility of the signal handler to set the selection data in -- the format which is indicated by 'InfoId'. See -- 'Graphics.UI.Gtk.General.Selection.selectionDataSet' and -- 'Graphics.UI.Gtk.General.Selection.selectionDataSetText'. -- dragDataGet :: WidgetClass self => Signal self (DragContext -> InfoId -> TimeStamp -> SelectionDataM ()) dragDataGet = Signal (\after object handler -> do connect_OBJECT_PTR_WORD_WORD__NONE "drag-data-get" after object $ \ctxt dataPtr info time -> do runReaderT (handler ctxt (fromIntegral info) (fromIntegral time)) dataPtr >> return ()) -- %hash c:9251 d:a6d8 -- | The 'dragDataReceived' signal is emitted on the drop site when the -- dragged data has been received. If the data was received in order to -- determine whether the drop will be accepted, the handler is expected to call -- 'dragStatus' and /not/ finish the drag. If the data was received in response -- to a 'dragDrop' signal (and this is the last target to be received), the -- handler for this signal is expected to process the received data and then -- call 'dragFinish', setting the @success@ parameter depending on whether the -- data was processed successfully. -- -- The handler may inspect and modify 'dragContextAction' before calling -- 'dragFinish', e.g. to implement 'ActionAsk' as shown in the following -- example: -- dragDataReceived :: WidgetClass self => Signal self (DragContext -> Point -> InfoId -> TimeStamp -> SelectionDataM ()) dragDataReceived = Signal (\after object handler -> do connect_OBJECT_INT_INT_PTR_WORD_WORD__NONE "drag-data-received" after object $ \ctxt x y dataPtr info time -> do runReaderT (handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral info) (fromIntegral time)) dataPtr >> return ()) -- %hash c:4ef4 d:f4b8 -- | The 'dragDrop' signal is emitted on the drop site when the user drops -- the data onto the widget. The signal handler must determine whether the -- cursor position is in a drop zone or not. If it is not in a drop zone, it -- returns @False@ and no further processing is necessary. Otherwise, the -- handler returns @True@. In this case, the handler must ensure that -- 'dragFinish' is called to let the source know that the drop is done. The -- call to 'dragFinish' can be done either directly or in a -- 'dragDataReceived' handler which gets triggered by calling 'dropGetData' -- to receive the data for one or more of the supported targets. -- dragDrop :: WidgetClass self => Signal self (DragContext -> Point -> TimeStamp -> IO Bool) dragDrop = Signal (\after object handler -> connect_OBJECT_INT_INT_WORD__BOOL "drag-drop" after object $ \ctxt x y time -> handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral time)) -- %hash c:9d4e d:a5ac -- | The 'dragEnd' signal is emitted on the drag source when a drag is -- finished. A typical reason to connect to this signal is to undo things done -- in 'dragBegin'. -- dragEnd :: WidgetClass self => Signal self (DragContext -> IO ()) dragEnd = Signal (connect_OBJECT__NONE "drag-end") #if GTK_CHECK_VERSION(2,12,0) -- | The 'dragFailed' signal is emitted on the drag source when a drag has -- failed. The signal handler may hook custom code to handle a failed DND -- operation based on the type of error, it returns @True@ is the failure has -- been already handled (not showing the default \"drag operation failed\" -- animation), otherwise it returns @False@. -- -- * Available since Gtk+ 2.12.0. -- dragFailed :: WidgetClass self => Signal self (DragContext -> DragResult -> IO Bool) dragFailed = Signal (connect_OBJECT_ENUM__BOOL "drag-failed") #endif -- %hash c:4a85 d:6122 -- | The 'dragLeave' signal is emitted on the drop site when the cursor -- leaves the widget. A typical reason to connect to this signal is to undo -- things done in 'dragMotion', e.g. undo highlighting with 'dragUnhighlight' -- dragLeave :: WidgetClass self => Signal self (DragContext -> TimeStamp -> IO ()) dragLeave = Signal (\after object handler -> connect_OBJECT_WORD__NONE "drag-leave" after object $ \ctxt time -> handler ctxt (fromIntegral time)) -- %hash c:53f7 d:176d -- | The 'dragMotion' signal is emitted on the drop site when the user moves -- the cursor over the widget during a drag. The signal handler must determine -- whether the cursor position is in a drop zone or not. If it is not in a drop -- zone, it returns @False@ and no further processing is necessary. Otherwise, -- the handler returns @True@. In this case, the handler is responsible for -- providing the necessary information for displaying feedback to the user, by -- calling 'dragStatus'. If the decision whether the drop will be accepted or -- rejected can't be made based solely on the cursor position and the type of -- the data, the handler may inspect the dragged data by calling 'dragGetData' -- and defer the 'dragStatus' call to the 'dragDataReceived' handler. -- -- Note that there is no 'dragEnter' signal. The drag receiver has to keep -- track of whether he has received any 'dragMotion' signals since the last -- 'dragLeave' and if not, treat the 'dragMotion' signal as an \"enter\" -- signal. Upon an \"enter\", the handler will typically highlight the drop -- site with 'dragHighlight'. -- dragMotion :: WidgetClass self => Signal self (DragContext -> Point -> TimeStamp -> IO Bool) dragMotion = Signal (\after object handler -> do connect_OBJECT_INT_INT_WORD__BOOL "drag-motion" after object $ \ctxt x y time -> handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral time)) gtk-0.15.9/Graphics/UI/Gtk/General/Enums.chs0000644000000000000000000003501507346545000016535 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Enumerations -- -- Author : Axel Simon, Manuel Chakravarty -- -- Created: 13 January 1999 -- -- Copyright (C) 1999..2005 Axel Simon, Manuel Chakravarty -- -- 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) -- -- General enumeration types. -- module Graphics.UI.Gtk.General.Enums ( AccelFlags(..), #if GTK_CHECK_VERSION(3,0,0) Align(..), #endif ArrowType(..), AttachOptions(..), #if GTK_CHECK_VERSION(3,10,0) BaselinePosition(..), #endif MouseButton(..), ButtonBoxStyle(..), CalendarDisplayOptions(..), Click(..), CornerType(..), DeleteType(..), DestDefaults(..), #if GTK_CHECK_VERSION(2,12,0) DragResult(..), #endif DirectionType(..), Justification(..), #if GTK_CHECK_VERSION(3,6,0) LevelBarMode(..), #endif #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED MatchType(..), #endif #endif MenuDirectionType(..), #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,8,0) MetricType(..), #endif #endif MovementStep(..), Orientation(..), Packing(..), toPacking, fromPacking, PackType(..), PathPriorityType(..), PathType(..), PolicyType(..), PositionType(..), #if GTK_MAJOR_VERSION < 3 ProgressBarOrientation(..), #endif ReliefStyle(..), ResizeMode(..), ScrollType(..), ScrollStep (..), SelectionMode(..), ShadowType(..), #if GTK_CHECK_VERSION(3,0,0) StateFlags(..), #endif SortType(..), StateType(..), #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED SubmenuDirection(..), SubmenuPlacement(..), #endif #endif SpinButtonUpdatePolicy(..), SpinType(..), TargetFlags(..), TextDirection(..), TextSearchFlags(..), TextWindowType(..), ToolbarStyle(..), TreeViewColumnSizing(..), --TroughType(..), #if GTK_MAJOR_VERSION < 3 UpdateType(..), Visibility(..), #endif WindowPosition(..), WindowType(..), WrapMode(..), #if GTK_CHECK_VERSION(2,16,0) EntryIconPosition(..), #endif #if GTK_MAJOR_VERSION < 3 AnchorType (..), #endif #if GTK_CHECK_VERSION(3,10,0) StackTransitionType (..), #endif module Graphics.UI.Gtk.Gdk.Enums ) where import System.Glib.Flags (Flags) import Graphics.UI.Gtk.Gdk.Enums {#context lib="gtk" prefix ="gtk"#} -- | State of an accelerator -- {#enum AccelFlags {underscoreToCase} deriving(Bounded,Eq,Show)#} instance Flags AccelFlags #if GTK_CHECK_VERSION(3,0,0) -- | State of an accelerator -- {#enum Align {underscoreToCase} deriving(Bounded,Eq,Show)#} #endif -- | Arrow directions for the arrow widget -- {#enum ArrowType {underscoreToCase} deriving (Eq,Show)#} -- | Child widget attach options for table containers -- {#enum AttachOptions {underscoreToCase} deriving(Bounded,Eq,Show)#} instance Flags AttachOptions #if GTK_CHECK_VERSION(3,10,0) -- | Whenever a container has some form of natural row it may align children in -- that row along a common typographical baseline. If the amount of vertical space -- in the row is taller than the total requested height of the baseline-aligned -- children then it can use a BaselinePosition to select where to put the -- baseline inside the extra available space. -- {#enum BaselinePosition {underscoreToCase} deriving (Eq,Show)#} #endif -- | Mouse buttons. -- data MouseButton = LeftButton | MiddleButton | RightButton | OtherButton Int deriving (Eq,Show) instance Enum MouseButton where toEnum 1 = LeftButton toEnum 2 = MiddleButton toEnum 3 = RightButton toEnum n = OtherButton (fromIntegral n) fromEnum LeftButton = 1 fromEnum MiddleButton = 2 fromEnum RightButton = 3 fromEnum (OtherButton n) = fromIntegral n -- | Dictate the style that a ButtonBox uses to align it contents -- {#enum ButtonBoxStyle {underscoreToCase} deriving (Eq,Show)#} -- | Specify which items of a calendar should be displayed. -- {#enum CalendarDisplayOptions {underscoreToCase} deriving(Bounded,Eq,Show)#} instance Flags CalendarDisplayOptions -- | Type of mouse click -- data Click = SingleClick | DoubleClick | TripleClick | ReleaseClick deriving (Eq,Show,Enum) -- | Specifies in which corner a child widget should be placed -- {#enum CornerType {underscoreToCase} deriving (Eq,Show)#} -- | Editing option -- {#enum DeleteType {underscoreToCase} deriving (Eq,Show)#} -- | The 'DestDefaults' enumeration specifies the various types of action that -- will be taken on behalf of the user for a drag destination site. -- -- * 'DestDefaultMotion': If set for a widget, GTK+, during a drag over this -- widget will check if the drag matches this widget's list of possible -- targets and actions. GTK+ will then call -- 'Graphics.UI.Gtk.Gdk.Drag.dragStatus' as appropriate. -- -- * 'DestDefaultHighlight': If set for a widget, GTK+ will draw a -- highlight on this widget as long as a drag is over this widget and the -- widget drag format and action are acceptable. -- -- * 'DestDefaultDrop': If set for a widget, when a drop occurs, GTK+ will -- will check if the drag matches this widget's list of possible targets and -- actions. If so, GTK+ will call 'Graphics.UI.Gtk.Gdk.Drag.dragGetData' on -- behalf of the widget. Whether or not the drop is successful, GTK+ will -- call 'Graphics.UI.Gtk.Gdk.Drag.dragFinish'. If the action was a move, -- then if the drag was successful, then @True@ will be passed for the -- delete parameter to 'Graphics.UI.Gtk.Gdk.Drag.dragFinish' -- -- * 'DestDefaultAll': If set, specifies that all default actions should be -- taken. -- {#enum DestDefaults {underscoreToCase} deriving (Bounded,Eq,Show)#} instance Flags DestDefaults #if GTK_CHECK_VERSION(2,12,0) -- | Gives an indication why a drag operation failed. The value can by -- obtained by connecting to the 'dragFailed' signal. -- -- * 'DragResultSuccess': The drag operation was successful -- -- * 'DragResultNoTarget': No suitable drag target -- -- * 'DragResultUserCancelled': The user cancelled the drag operation -- -- * 'DragResultTimeoutExpired': The drag operation timed out -- -- * 'DragResultGrabBroken': The pointer or keyboard grab used for the drag -- operation was broken -- -- * 'DragResultError': The drag operation failed due to some unspecified error -- {#enum DragResult {underscoreToCase} deriving (Bounded,Eq,Show)#} #endif -- | Editing direction -- {#enum DirectionType {underscoreToCase} deriving (Eq,Show)#} -- | Justification for label and maybe other widgets (text?) -- {#enum Justification {underscoreToCase} deriving (Eq,Show)#} #if GTK_CHECK_VERSION(3,6,0) {#enum LevelBarMode {underscoreToCase} deriving (Eq,Show)#} #endif #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Some kind of string search options -- -- Removed in Gtk3. {#enum MatchType {underscoreToCase} deriving (Eq,Show)#} #endif #endif -- | From where was a menu item entered? -- {#enum MenuDirectionType {underscoreToCase} deriving (Eq,Show)#} #if GTK_MAJOR_VERSION < 3 -- | Units of measure -- -- Removed in Gtk3. {#enum MetricType {underscoreToCase} deriving (Eq,Show)#} #endif -- | Movement in text widget -- {#enum MovementStep {underscoreToCase} deriving (Eq,Show)#} -- | Orientation is good -- {#enum Orientation {underscoreToCase} deriving (Eq,Show)#} -- | Packing parameters of a widget -- -- * The 'Packing' parameter determines how the child behaves in the horizontal -- or vertical way in an 'Graphics.UI.Gtk.Layout.HBox' or -- 'Graphics.UI.Gtk.Layout.VBox', respectively. 'PackNatural' -- means the child is as big as it requests. It will stay at the start or -- end of a 'Graphics.UI.Gtk.Layout.Box' if there is more space available. -- All children packed with 'PackRepel' will be padded on both sides with -- additional space. 'PackGrow' will increase the size of a widget so that it -- covers the available space. A menu bar, for instance, should always -- stay at the top of a window and should only occupy as little space -- as possible. Hence it should be packed at the start of a -- 'Graphics.UI.Gtk.Layout.VBox' with -- the packing option 'PackNatural'. The working area of a window -- (e.g. the text area in an editor) should expand when the window is -- resized. Here the packing option 'PackGrow' is the right choice and -- it is irrelevant whether the main area is inserted at the start or -- the end of a box. Finally 'PackRepel' is most useful in a window -- where no widget can make use of excess space. Examples include a -- dialog box without list boxes or text fields. -- data Packing = PackRepel | PackGrow | PackNatural deriving (Enum,Eq,Show) -- The conversions between our Packing type and Gtk's expand and fill -- properties. -- toPacking :: Bool -> Bool -> Packing toPacking expand True = PackGrow toPacking True fill = PackRepel toPacking False fill = PackNatural fromPacking :: Packing -> (Bool, Bool) fromPacking PackGrow = (True,True) fromPacking PackRepel = (True,False) fromPacking PackNatural = (False,False) -- | Packing of widgets at start or end in a box -- {#enum PackType {underscoreToCase} deriving (Eq,Show)#} -- | Priorities -- {#enum PathPriorityType {underscoreToCase} deriving (Eq,Show)#} -- | Widget identification path -- {#enum PathType {underscoreToCase} deriving (Eq,Show)#} -- | Scrollbar policy types (for scrolled windows) -- {#enum PolicyType {underscoreToCase} deriving (Eq,Show)#} -- | Position a scale's value is drawn relative to the -- through -- {#enum PositionType {underscoreToCase} deriving (Eq,Show)#} #if GTK_MAJOR_VERSION < 3 -- | Is the ProgressBar horizontally or vertically -- directed? -- -- Removed in Gtk3. {#enum ProgressBarOrientation {underscoreToCase} deriving (Eq,Show)#} #endif -- | I don't have a clue. -- {#enum ReliefStyle {underscoreToCase} deriving (Eq,Show)#} -- | Resize mode, for containers -- -- * 'ResizeParent' Pass resize request to the parent -- -- * 'ResizeQueue' Queue resizes on this widget -- -- * 'ResizeImmediate' Perform the resizes now -- {#enum ResizeMode {underscoreToCase} deriving (Eq,Show)#} -- | Scrolling type -- {#enum ScrollType {underscoreToCase} deriving (Eq,Show)#} -- | Scrolling step -- {#enum ScrollStep {underscoreToCase} deriving (Eq,Show)#} -- | Mode in which selections can be performed -- -- * There is a deprecated entry SelectionExtended which should have the same -- value as SelectionMultiple. C2HS chokes on that construct. -- data SelectionMode = SelectionNone | SelectionSingle | SelectionBrowse | SelectionMultiple deriving (Enum,Eq,Show) -- {#enum SelectionMode {underscoreToCase} deriving (Eq,Show)#} -- | Shadow types -- {#enum ShadowType {underscoreToCase} deriving (Eq,Show)#} #if GTK_CHECK_VERSION(3,0,0) -- | Describes a widget state. Widget states are used to match the widget against -- CSS pseudo-classes. Note that GTK extends the regular CSS classes and -- sometimes uses different names. -- {#enum StateFlags {underscoreToCase} deriving (Bounded,Eq,Show)#} instance Flags StateFlags #endif -- Sort a 'Graphics.UI.Gtk.ModelView.TreeViewColumn' in ascending or descending -- order. -- {#enum SortType {underscoreToCase} deriving (Eq,Show)#} -- | Widget states -- {#enum StateType {underscoreToCase} deriving (Eq,Show)#} #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Submenu direction policies -- -- Removed in Gtk3. {#enum SubmenuDirection {underscoreToCase} deriving (Eq,Show)#} -- | Submenu placement policies -- -- Removed in Gtk3. {#enum SubmenuPlacement {underscoreToCase} deriving (Eq,Show)#} #endif #endif -- | Whether to clamp or ignore illegal values. -- {#enum SpinButtonUpdatePolicy {underscoreToCase} deriving (Eq,Show)#} -- | Spin a SpinButton with the following method. -- {#enum SpinType {underscoreToCase} deriving (Eq,Show)#} -- | The 'TargetFlags' enumeration is used to specify constraints on an entry -- in a 'Graphics.UI.Gtk.Gdk.Selection.TargetList'. These flags are only -- used for drag and drop. -- -- * If the 'TargetSameApp' flag is set, the target will only be selected for -- drags within a single application. -- -- * If the 'TargetSameWidget' flag is set, the target will only be selected -- for drags within a single widget. -- {#enum TargetFlags {underscoreToCase} deriving(Bounded,Eq,Show) #} instance Flags TargetFlags -- | Is the text written from left to right or the exotic way? -- {#enum TextDirection {underscoreToCase} deriving (Eq,Show)#} -- | Specify the way the search function for -- 'Graphics.UI.Gtk.Multiline.TextBuffer' works. -- {#enum TextSearchFlags {underscoreToCase} deriving(Bounded,Eq,Show)#} instance Flags TextSearchFlags -- | The window type for coordinate translation. -- {#enum TextWindowType {underscoreToCase} deriving (Eq,Show)#} -- | Where to place the toolbar? -- {#enum ToolbarStyle {underscoreToCase} deriving (Eq,Show)#} -- | Whether columns of a tree or list widget can be resized. -- {#enum TreeViewColumnSizing {underscoreToCase} deriving (Eq,Show)#} -- hm... text editing? --{#enum TroughType {underscoreToCase} deriving (Eq,Show)#} #if GTK_MAJOR_VERSION < 3 -- | Updating types for range widgets (determines when the -- @\"connectToValueChanged\"@ signal is emitted by the widget) -- -- Removed in Gtk3. {#enum UpdateType {underscoreToCase} deriving (Eq,Show)#} -- | Visibility -- -- Removed in Gtk3. {#enum Visibility {underscoreToCase} deriving (Eq,Show)#} #endif -- | Window position types -- {#enum WindowPosition {underscoreToCase} deriving (Eq,Show)#} -- | Interaction of a window with window manager -- {#enum WindowType {underscoreToCase} deriving (Eq,Show)#} -- | Determine how lines are wrapped in a 'Graphics.UI.Gtk.Multiline.TextView'. -- {#enum WrapMode {underscoreToCase} deriving (Eq,Show)#} #if GTK_CHECK_VERSION(2,16,0) -- | Specifies the side of the entry at which an icon is placed. -- {#enum EntryIconPosition {underscoreToCase} deriving (Eq,Show)#} #endif #if GTK_MAJOR_VERSION < 3 -- | -- -- Removed in Gtk3. {#enum AnchorType {underscoreToCase} deriving (Eq,Show)#} #endif #if GTK_CHECK_VERSION(3,10,0) {#enum StackTransitionType {underscoreToCase} deriving (Eq,Show)#} #endif gtk-0.15.9/Graphics/UI/Gtk/General/General.chs0000644000000000000000000003722307346545000017026 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) General -- -- Author : Axel Simon, Manuel M. T. Chakravarty -- -- Created: 8 December 1998 -- -- Copyright (C) 2000..2005 Axel Simon, Manuel M. T. Chakravarty -- -- 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) -- -- library initialization, main event loop, and events -- module Graphics.UI.Gtk.General.General ( -- getDefaultLanguage, -- * Initialisation initGUI, -- ** Support for OS threads unsafeInitGUIForThreadedRTS, postGUISync, postGUIAsync, threadsEnter, threadsLeave, -- * Main event loop mainGUI, mainQuit, -- ** Less commonly used event loop functions eventsPending, mainLevel, mainIteration, mainIterationDo, mainDoEvent, -- ** Call when mainloop is left #if GTK_MAJOR_VERSION < 3 quitAddDestroy, quitAdd, quitRemove, #endif -- * Grab widgets grabAdd, grabGetCurrent, grabRemove, -- * Timeout and idle callbacks Priority, priorityLow, priorityDefaultIdle, priorityHighIdle, priorityDefault, priorityHigh, timeoutAdd, timeoutAddFull, timeoutRemove, idleAdd, idleRemove, inputAdd, inputRemove, IOCondition(..), HandlerId, FD ) where import Control.Applicative import Prelude import System.Environment (getProgName, getArgs) import Control.Monad (liftM, when) import Control.Concurrent (rtsSupportsBoundThreads, newEmptyMVar, putMVar, takeMVar) import System.Glib.FFI import System.Glib.UTFString import qualified System.Glib.MainLoop as ML import System.Glib.MainLoop ( Priority, priorityLow, priorityDefaultIdle, priorityHighIdle, priorityDefault, priorityHigh, timeoutRemove, idleRemove, inputRemove, IOCondition(..), HandlerId ) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Gdk.EventM (EventM) import Control.Monad.Reader (ask) import Control.Monad.Trans (liftIO) {#import Graphics.UI.Gtk.Types#} {#context lib="gtk" prefix ="gtk"#} {- -- | Retrieve the current language. -- * This function returns a String which's pointer can be used later on for -- comarisions. -- --getDefaultLanguage :: GlibString string => IO string --getDefaultLanguage = do -- strPtr <- {#call unsafe get_default_language#} -- str <- peekUTFString strPtr -- destruct strPtr -- return str -} unsafeInitGUIForThreadedRTS = initGUI -- We compile this module using -#include"gtk/wingtk.h" to bypass the win32 abi -- check however we do not compile users programs with this header so if -- initGUI was ever inlined in a users program, then that program would not -- bypass the abi check and would fail on startup. So to stop that we must -- prevent initGUI from being inlined. {-# NOINLINE initGUI #-} -- | Initialize the GUI. -- -- This must be called before any other function in the Gtk2Hs library. -- -- This function initializes the GUI toolkit and parses all Gtk -- specific arguments. The remaining arguments are returned. If the -- initialization of the toolkit fails for whatever reason, an exception -- is thrown. -- -- * Throws: @error \"Cannot initialize GUI.\"@ -- -- -- * If you want to use Gtk2Hs and in a multi-threaded application then it is your obligation -- to ensure that all calls to Gtk+ happen in a single OS thread. -- If you want to make calls to Gtk2Hs functions from a Haskell thread other -- than the one that calls this functions and 'mainGUI' then you will have to -- \'post\' your GUI actions to the main GUI thread. You can do this using -- 'postGUISync' or 'postGUIAsync'. See also 'threadsEnter'. -- initGUI :: IO [String] initGUI = do initialise when rtsSupportsBoundThreads initialiseGThreads -- note: initizliseGThreads calls 'threadsEnter' prog <- getProgName args <- getArgs let allArgs = (prog:args) withMany withUTFString (map stringToGlib allArgs) $ \addrs -> withArrayLen addrs $ \argc argv -> with argv $ \argvp -> with argc $ \argcp -> do res <- {#call unsafe init_check#} (castPtr argcp) (castPtr argvp) if (toBool res) then do argc' <- peek argcp argv' <- peek argvp _:addrs' <- peekArray argc' argv' -- drop the program name mapM ((glibToString <$>) . peekUTFString) addrs' else error "Cannot initialize GUI." -- g_thread_init aborts the whole program if it's called more than once so -- we've got to keep track of whether or not we've called it already. Sigh. -- foreign import ccall "hsgthread.h gtk2hs_threads_initialise" initialiseGThreads :: IO () foreign import ccall "hsgthread.h gtk2hs_initialise" initialise :: IO () -- | Post an action to be run in the main GUI thread. -- -- The current thread blocks until the action completes and the result is -- returned. -- postGUISync :: IO a -> IO a postGUISync action = do resultVar <- newEmptyMVar idleAdd (action >>= putMVar resultVar >> return False) priorityDefault takeMVar resultVar -- | Post an action to be run in the main GUI thread. -- -- The current thread continues and does not wait for the result of the -- action. -- postGUIAsync :: IO () -> IO () postGUIAsync action = do idleAdd (action >> return False) priorityDefault return () -- | Acquire the global Gtk lock. -- -- * During normal operation, this lock is held by the thread from which all -- interaction with Gtk is performed. When calling 'mainGUI', the thread will -- release this global lock before it waits for user interaction. During this -- time it is, in principle, possible to use a different OS thread (any other -- Haskell thread that is bound to the Gtk OS thread will be blocked anyway) -- to interact with Gtk by explicitly acquiring the lock, calling Gtk functions -- and releasing the lock. However, the Gtk functions that are called from this -- different thread may not trigger any calls to the OS since this will -- lead to a crash on Windows (the Win32 API can only be used from a single -- thread). Since it is very hard to tell which function only interacts on -- Gtk data structures and which function call actual OS functions, it -- is best not to use this feature at all. A better way to perform updates -- in the background is to spawn a Haskell thread and to perform the update -- to Gtk widgets using 'postGUIAsync' or 'postGUISync'. These will execute -- their arguments from the main loop, that is, from the OS thread of Gtk, -- thereby ensuring that any Gtk and OS function can be called. -- {#fun gdk_threads_enter as threadsEnter {} -> `()' #} -- | Release the global Gtk lock. -- -- * The use of this function is not recommended. See 'threadsEnter'. -- {#fun unsafe gdk_threads_leave as threadsLeave {} -> `()' #} -- | Inquire the number of events pending on the event queue -- eventsPending :: IO Int eventsPending = liftM fromIntegral {#call events_pending#} -- | Run the Gtk+ main event loop. -- mainGUI :: IO () mainGUI = {#call main#} -- | Inquire the main loop level. -- -- * Callbacks that take more time to process can call 'mainIteration' to keep -- the GUI responsive. Each time the main loop is restarted this way, the main -- loop counter is increased. This function returns this counter. -- mainLevel :: IO Int mainLevel = liftM (toEnum.fromEnum) {#call unsafe main_level#} -- | Exit the main event loop. -- mainQuit :: IO () mainQuit = {#call main_quit#} -- | Process an event, block if necessary. -- -- * Returns @True@ if 'mainQuit' was called while processing the event. -- mainIteration :: IO Bool mainIteration = liftM toBool {#call main_iteration#} -- | Process a single event. -- -- * Called with @True@, this function behaves as 'mainIteration' in that it -- waits until an event is available for processing. It will return -- immediately, if passed @False@. -- -- * Returns @True@ if the 'mainQuit' was called while processing the event. -- mainIterationDo :: Bool -> IO Bool mainIterationDo blocking = liftM toBool $ {#call main_iteration_do#} (fromBool blocking) -- | Processes a single GDK event. This is public only to allow filtering of events between GDK and -- GTK+. You will not usually need to call this function directly. -- -- While you should not call this function directly, you might want to know how exactly events are -- handled. So here is what this function does with the event: -- -- 1. Compress enter\/leave notify events. If the event passed build an enter\/leave pair together with -- the next event (peeked from GDK) both events are thrown away. This is to avoid a backlog of -- (de-)highlighting widgets crossed by the pointer. -- -- 2. Find the widget which got the event. If the widget can't be determined the event is thrown away -- unless it belongs to a INCR transaction. In that case it is passed to -- 'selectionIncrEvent'. -- -- 3. Then the event is passed on a stack so you can query the currently handled event with -- 'getCurrentEvent'. -- -- 4. The event is sent to a widget. If a grab is active all events for widgets that are not in the -- contained in the grab widget are sent to the latter with a few exceptions: -- -- * Deletion and destruction events are still sent to the event widget for obvious reasons. -- -- * Events which directly relate to the visual representation of the event widget. -- -- * Leave events are delivered to the event widget if there was an enter event delivered to it -- before without the paired leave event. -- -- * Drag events are not redirected because it is unclear what the semantics of that would be. -- -- Another point of interest might be that all key events are first passed through the key snooper -- functions if there are any. Read the description of 'keySnooperInstall' if you need this -- feature. -- -- 5. After finishing the delivery the event is popped from the event stack. mainDoEvent :: EventM t () mainDoEvent = do ptr <- ask liftIO $ {#call main_do_event #} (castPtr ptr) #if GTK_MAJOR_VERSION < 3 -- | Trigger destruction of object in case the mainloop at level @mainLevel@ is quit. -- -- Removed in Gtk3. quitAddDestroy :: ObjectClass obj => Int -- ^ @mainLevel@ Level of the mainloop which shall trigger the destruction. -> obj -- ^ @object@ Object to be destroyed. -> IO () quitAddDestroy mainLevel obj = {#call quit_add_destroy #} (fromIntegral mainLevel) (toObject obj) -- | Registers a function to be called when an instance of the mainloop is left. -- -- Removed in Gtk3. quitAdd :: Int -- ^ @mainLevel@ Level at which termination the function shall be called. You can pass 0 here to have the function run at the current mainloop. -> (IO Bool) -- ^ @function@ The function to call. This should return 'False' to be removed from the list of quit handlers. Otherwise the function might be called again. -> IO Int -- ^ returns A handle for this quit handler (you need this for 'quitRemove') quitAdd mainLevel func = do funcPtr <- mkGtkFunction $ \ _ -> liftM fromBool func liftM fromIntegral $ {#call quit_add #} (fromIntegral mainLevel) funcPtr nullPtr {#pointer GtkFunction#} foreign import ccall "wrapper" mkGtkFunction :: (Ptr () -> IO {#type gboolean#}) -> IO GtkFunction -- | Removes a quit handler by its identifier. -- -- Removed in Gtk3. quitRemove :: Int -- ^ @quitHandlerId@ Identifier for the handler returned when installing it. -> IO () quitRemove quitHandlerId = {#call quit_remove #} (fromIntegral quitHandlerId) #endif -- | add a grab widget -- grabAdd :: WidgetClass wd => wd -> IO () grabAdd = {#call grab_add#} . toWidget -- | inquire current grab widget -- grabGetCurrent :: IO (Maybe Widget) grabGetCurrent = do wPtr <- {#call grab_get_current#} if (wPtr==nullPtr) then return Nothing else liftM Just $ makeNewObject mkWidget (return wPtr) -- | remove a grab widget -- grabRemove :: WidgetClass w => w -> IO () grabRemove = {#call grab_remove#} . toWidget -- | 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). -- -- This function differs from 'ML.timeoutAdd' in that the action will -- be executed within the global Gtk+ lock. It is therefore possible to -- call Gtk+ functions from the action. -- 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). -- -- This function differs from 'ML.timeoutAddFull' in that the action will -- be executed within the global Gtk+ lock. It is therefore possible to -- call Gtk+ functions from the action. -- timeoutAddFull :: IO Bool -> Priority -> Int -> IO HandlerId timeoutAddFull fun pri msec = ML.timeoutAddFull (threadsEnter >> fun >>= \r -> threadsLeave >> return r) pri msec -- | 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. -- -- This function differs from 'ML.idleAdd' in that the action will -- be executed within the global Gtk+ lock. It is therefore possible to -- call Gtk+ functions from the action. -- idleAdd :: IO Bool -> Priority -> IO HandlerId idleAdd fun pri = ML.idleAdd (threadsEnter >> fun >>= \r -> threadsLeave >> return r) pri type FD = Int -- | Adds the file descriptor into the main event loop with the given priority. -- -- This function differs from 'ML.inputAdd' in that the action will -- be executed within the global Gtk+ lock. It is therefore possible to -- call Gtk+ functions from the action. -- 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 = ML.inputAdd fd conds pri (threadsEnter >> fun >>= \r -> threadsLeave >> return r) gtk-0.15.9/Graphics/UI/Gtk/General/IconFactory.chs0000644000000000000000000003555107346545000017673 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) IconFactory -- -- Author : Axel Simon -- -- Created: 24 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Manipulating stock icons -- module Graphics.UI.Gtk.General.IconFactory ( -- * Detail -- -- | Browse the available stock icons in the list of stock IDs found here. You -- can also use the gtk-demo application for this purpose. -- -- An icon factory manages a collection of 'IconSet'; a 'IconSet' manages a -- set of variants of a particular icon (i.e. a 'IconSet' contains variants for -- different sizes and widget states). Icons in an icon factory are named by a -- stock ID, which is a simple string identifying the icon. Each 'Style' has a -- list of 'IconFactory' derived from the current theme; those icon factories -- are consulted first when searching for an icon. If the theme doesn't set a -- particular icon, Gtk+ looks for the icon in a list of default icon -- factories, maintained by 'iconFactoryAddDefault' and -- 'iconFactoryRemoveDefault'. Applications with icons should add a default -- icon factory with their icons, which will allow themes to override the icons -- for the application. -- -- To display an icon, always use -- 'Graphics.UI.Gtk.General.Style.styleLookupIconSet' on the widget that -- will display the icon, or the convenience function -- 'Graphics.UI.Gtk.Abstract.Widget.widgetRenderIcon'. These -- functions take the theme into account when looking up the icon to use for a -- given stock ID. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----IconFactory -- @ -- * Types IconFactory, IconFactoryClass, castToIconFactory, gTypeIconFactory, toIconFactory, -- * Constructors iconFactoryNew, -- * Methods iconFactoryAdd, iconFactoryAddDefault, iconFactoryLookup, iconFactoryLookupDefault, iconFactoryRemoveDefault, IconSet, iconSetNew, iconSetNewFromPixbuf, iconSetAddSource, iconSetRenderIcon, iconSetGetSizes, IconSource, iconSourceNew, TextDirection(..), iconSourceGetDirection, iconSourceSetDirection, iconSourceResetDirection, iconSourceGetFilename, iconSourceSetFilename, iconSourceGetPixbuf, iconSourceSetPixbuf, iconSourceGetSize, iconSourceSetSize, iconSourceResetSize, StateType(..), iconSourceGetState, iconSourceSetState, iconSourceResetState, IconSize(..), iconSizeCheck, iconSizeRegister, iconSizeRegisterAlias, iconSizeFromName, iconSizeGetName ) where import Control.Applicative import Prelude import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (TextDirection(..), StateType(..)) import Graphics.UI.Gtk.General.StockItems import Graphics.UI.Gtk.General.Structs (IconSize(..)) {# context lib="gtk" prefix="gtk" #} {#pointer *IconSource foreign newtype#} {#pointer *IconSet foreign newtype#} -- The Show instance for IconSize is here since we need c2hs. instance Show IconSize where show i = unsafePerformIO (lookupSizeString (fromEnum i)) where lookupSizeString n = do ptr <- {#call unsafe icon_size_get_name#} (fromIntegral n) if ptr==nullPtr then return "" else glibToString <$> peekUTFString ptr -------------------- -- Constructors -- | Create a new IconFactory. -- -- * An application should create a new 'IconFactory' and add all -- needed icons. -- By calling 'iconFactoryAddDefault' these icons become -- available as stock objects and can easily be displayed by -- 'Image'. Furthermore, a theme can override the icons defined by -- the application. -- iconFactoryNew :: IO IconFactory iconFactoryNew = wrapNewGObject mkIconFactory {#call unsafe icon_factory_new#} -------------------- -- Methods -- | Add an IconSet to an IconFactory. -- -- In order to use the new stock object, the factory as to be added to the -- default factories by 'iconFactoryAddDefault'. -- iconFactoryAdd :: IconFactory -> StockId -> IconSet -> IO () iconFactoryAdd i stockId iconSet = withUTFString stockId $ \strPtr -> {#call unsafe icon_factory_add#} i strPtr iconSet -- | Add all entries of the IconFactory to the -- applications stock object database. -- iconFactoryAddDefault :: IconFactory -> IO () iconFactoryAddDefault = {#call unsafe icon_factory_add_default#} -- | Looks up the stock id in the icon factory, returning an icon set if found, -- otherwise Nothing. -- -- For display to the user, you should use -- 'Graphics.UI.Gtk.General.Style.styleLookupIconSet' on the -- 'Graphics.UI.Gtk.General.Style.Style' -- for the widget that will display the icon, instead of using this function -- directly, so that themes are taken into account. -- iconFactoryLookup :: IconFactory -> StockId -> IO (Maybe IconSet) iconFactoryLookup i stockId = withUTFString stockId $ \strPtr -> do iconSetPtr <- {#call unsafe icon_factory_lookup#} i strPtr if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $ newForeignPtr iconSetPtr icon_set_unref -- | Looks for an icon in the list of default icon factories. -- -- For display to the user, you should use -- 'Graphics.UI.Gtk.General.Style.styleLookupIconSet' on the -- 'Graphics.UI.Gtk.General.Style.Style' -- for the widget that will display the icon, instead of using this function -- directly, so that themes are taken into account. -- iconFactoryLookupDefault :: StockId -> IO (Maybe IconSet) iconFactoryLookupDefault stockId = withUTFString stockId $ \strPtr -> do iconSetPtr <- {#call unsafe icon_factory_lookup_default#} strPtr if iconSetPtr == nullPtr then return Nothing else liftM (Just . IconSet) $ newForeignPtr iconSetPtr icon_set_unref -- | Remove an IconFactory from the -- application's stock database. -- iconFactoryRemoveDefault :: IconFactory -> IO () iconFactoryRemoveDefault = {#call unsafe icon_factory_remove_default#} -- | Add an 'IconSource' (an Icon with -- attributes) to an 'IconSet'. -- -- * If an icon is looked up in the IconSet @set@ the best matching -- IconSource will be taken. It is therefore advisable to add a default -- (wildcarded) icon, than can be used if no exact match is found. -- iconSetAddSource :: IconSet -> IconSource -> IO () iconSetAddSource set source = {#call unsafe icon_set_add_source#} set source iconSetRenderIcon :: WidgetClass widget => IconSet -> TextDirection -> StateType -> IconSize -> widget -> IO Pixbuf iconSetRenderIcon set dir state size widget = wrapNewGObject mkPixbuf $ {#call icon_set_render_icon#} set (Style nullForeignPtr) ((fromIntegral.fromEnum) dir) ((fromIntegral.fromEnum) state) ((fromIntegral.fromEnum) size) (toWidget widget) nullPtr -- | Create a new IconSet. -- -- * Each icon in an application is contained in an 'IconSet'. The -- 'IconSet' contains several variants ('IconSource's) to -- accommodate for different sizes and states. -- iconSetNew :: IO IconSet iconSetNew = do isPtr <- {#call unsafe icon_set_new#} liftM IconSet $ newForeignPtr isPtr icon_set_unref -- | Creates a new 'IconSet' with the given pixbuf as the default\/fallback -- source image. If you don't add any additional "IconSource" to the icon set, -- all variants of the icon will be created from the pixbuf, using scaling, -- pixelation, etc. as required to adjust the icon size or make the icon look -- insensitive\/prelighted. -- iconSetNewFromPixbuf :: Pixbuf -> IO IconSet iconSetNewFromPixbuf pixbuf = do isPtr <- {#call unsafe icon_set_new_from_pixbuf#} pixbuf liftM IconSet $ newForeignPtr isPtr icon_set_unref -- | Obtains a list of icon sizes this icon set can render. -- iconSetGetSizes :: IconSet -> IO [IconSize] iconSetGetSizes set = alloca $ \sizesArrPtr -> alloca $ \lenPtr -> do {#call unsafe icon_set_get_sizes#} set sizesArrPtr lenPtr len <- peek lenPtr sizesArr <- peek sizesArrPtr list <- peekArray (fromIntegral len) sizesArr {#call unsafe g_free#} (castPtr sizesArr) return $ map (toEnum.fromIntegral) list foreign import ccall unsafe ">k_icon_set_unref" icon_set_unref :: FinalizerPtr IconSet -- | Check if a given IconSize is registered. -- -- * Useful if your application expects a theme to install a set with a -- specific size. You can test if this actually happens and use another size -- if not. -- iconSizeCheck :: IconSize -> IO Bool iconSizeCheck size = liftM toBool $ {#call icon_size_lookup#} ((fromIntegral . fromEnum) size) nullPtr nullPtr -- | Register a new IconSize. -- iconSizeRegister :: GlibString string => string -- ^ the new name of the size -> Int -- ^ the width of the icon -> Int -- ^ the height of the icon -> IO IconSize -- ^ the new icon size iconSizeRegister name width height = liftM (toEnum . fromIntegral) $ withUTFString name $ \strPtr -> {#call unsafe icon_size_register#} strPtr (fromIntegral width) (fromIntegral height) -- | Register an additional alias for a name. -- iconSizeRegisterAlias :: GlibString string => IconSize -> string -> IO () iconSizeRegisterAlias target alias = withUTFString alias $ \strPtr -> {#call unsafe icon_size_register_alias#} strPtr ((fromIntegral . fromEnum) target) -- | Lookup an IconSize by name. -- -- * This fixed value 'iconSizeInvalid' is returned if the name was -- not found. -- iconSizeFromName :: GlibString string => string -> IO IconSize iconSizeFromName name = liftM (toEnum . fromIntegral) $ withUTFString name {#call unsafe icon_size_from_name#} -- | Lookup the name of an IconSize. -- -- * Returns @Nothing@ if the name was not found. -- iconSizeGetName :: GlibString string => IconSize -> IO (Maybe string) iconSizeGetName size = do strPtr <- {#call unsafe icon_size_get_name#} ((fromIntegral . fromEnum) size) if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr -- | Retrieve the 'TextDirection' of -- this IconSource. -- -- * @Nothing@ is returned if no explicit direction was set. -- iconSourceGetDirection :: IconSource -> IO (Maybe TextDirection) iconSourceGetDirection is = do res <- {#call icon_source_get_direction_wildcarded#} is if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $ {#call unsafe icon_source_get_direction#} is -- | Retrieve the filename this IconSource was -- based on. -- -- * Returns @Nothing@ if the IconSource was generated by a Pixbuf. -- iconSourceGetFilename :: GlibString string => IconSource -> IO (Maybe string) iconSourceGetFilename is = do #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 strPtr <- {#call unsafe icon_source_get_filename_utf8#} is #else strPtr <- {#call unsafe icon_source_get_filename#} is #endif if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr -- | Retrieve the 'IconSize' of this -- IconSource. -- -- * @Nothing@ is returned if no explicit size was set (i.e. this -- 'IconSource' matches all sizes). -- iconSourceGetSize :: IconSource -> IO (Maybe IconSize) iconSourceGetSize is = do res <- {#call unsafe icon_source_get_size_wildcarded#} is if (toBool res) then return Nothing else liftM (Just . toEnum . fromIntegral) $ {#call unsafe icon_source_get_size#} is -- | Retrieve the 'StateType' of this -- 'IconSource'. -- -- * @Nothing@ is returned if the 'IconSource' matches all -- states. -- iconSourceGetState :: IconSource -> IO (Maybe StateType) iconSourceGetState is = do res <- {#call unsafe icon_source_get_state_wildcarded#} is if (toBool res) then return Nothing else liftM (Just .toEnum.fromIntegral) $ {#call unsafe icon_source_get_state#} is -- | Create a new IconSource. -- -- * An IconSource is a single image that is usually added to an IconSet. Next -- to the image it contains information about which state, text direction -- and size it should apply. -- iconSourceNew :: IO IconSource iconSourceNew = do isPtr <- {#call unsafe icon_source_new#} liftM IconSource $ newForeignPtr isPtr icon_source_free foreign import ccall unsafe ">k_icon_source_free" icon_source_free :: FinalizerPtr IconSource -- | Mark this 'IconSource' that it -- should only apply to the specified 'TextDirection'. -- iconSourceSetDirection :: IconSource -> TextDirection -> IO () iconSourceSetDirection is td = do {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool False) {#call unsafe icon_source_set_direction#} is ((fromIntegral.fromEnum) td) -- | Reset the specific -- 'TextDirection' set with 'iconSourceSetDirection'. -- iconSourceResetDirection :: IconSource -> IO () iconSourceResetDirection is = {#call unsafe icon_source_set_direction_wildcarded#} is (fromBool True) -- | Load an icon picture from this filename. -- iconSourceSetFilename :: GlibFilePath fp => IconSource -> fp -> IO () iconSourceSetFilename is name = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 withUTFFilePath name $ {# call unsafe icon_source_set_filename_utf8 #} is #else withUTFFilePath name $ {# call unsafe icon_source_set_filename #} is #endif -- | Retrieves the source pixbuf, or Nothing if none is set. -- iconSourceGetPixbuf :: IconSource -> IO (Maybe Pixbuf) iconSourceGetPixbuf is = maybeNull (makeNewGObject mkPixbuf) $ {#call unsafe icon_source_get_pixbuf#} is -- | Sets a pixbuf to use as a base image when creating icon variants for -- 'IconSet'. -- iconSourceSetPixbuf :: IconSource -> Pixbuf -> IO () iconSourceSetPixbuf is pb = do {#call icon_source_set_pixbuf#} is pb -- | Set this 'IconSource' to a specific -- size. -- iconSourceSetSize :: IconSource -> IconSize -> IO () iconSourceSetSize is size = do {#call unsafe icon_source_set_size_wildcarded#} is (fromBool False) {#call unsafe icon_source_set_size#} is ((fromIntegral . fromEnum) size) -- | Reset the 'IconSize' of this -- 'IconSource' so that is matches anything. -- iconSourceResetSize :: IconSource -> IO () iconSourceResetSize is = {#call unsafe icon_source_set_size_wildcarded#} is (fromBool True) -- | Mark this icon to be used only with this -- specific state. -- iconSourceSetState :: IconSource -> StateType -> IO () iconSourceSetState is state = do {#call unsafe icon_source_set_state_wildcarded#} is (fromBool False) {#call unsafe icon_source_set_state#} is ((fromIntegral.fromEnum) state) -- | Reset the 'StateType' of this -- 'IconSource' so that is matches anything. -- iconSourceResetState :: IconSource -> IO () iconSourceResetState is = {#call unsafe icon_source_set_state_wildcarded#} is (fromBool True) gtk-0.15.9/Graphics/UI/Gtk/General/IconTheme.chs0000644000000000000000000006556607346545000017337 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget IconTheme -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Looking up icons by name -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.General.IconTheme ( -- * Detail -- -- | 'IconTheme' provides a facility for looking up icons by name and size. The main reason for using a -- name rather than simply providing a filename is to allow different icons to be used depending on -- what icon theme is selected by the user. The operation of icon themes on Linux and Unix follows the -- Icon Theme Specification. There is a default icon theme, named hicolor where applications should -- install their icons, but more additional application themes can be installed as operating system -- vendors and users choose. -- -- Named icons are similar to the Themeable Stock Images facility, and the distinction between the -- two may be a bit confusing. A few things to keep in mind: -- -- * Stock images usually are used in conjunction with Stock Items, such as ''StockOk'' or -- ''StockOpen''. Named icons are easier to set up and therefore are more useful for new icons -- that an application wants to add, such as application icons or window icons. -- -- * Stock images can only be loaded at the symbolic sizes defined by the 'IconSize' enumeration, or -- by custom sizes defined by 'iconSizeRegister', while named icons are more flexible and any -- pixel size can be specified. -- -- * Because stock images are closely tied to stock items, and thus to actions in the user interface, -- stock images may come in multiple variants for different widget states or writing directions. -- -- A good rule of thumb is that if there is a stock image for what you want to use, use it, otherwise -- use a named icon. It turns out that internally stock images are generally defined in terms of one or -- more named icons. (An example of the more than one case is icons that depend on writing direction; -- ''StockGoForward'' uses the two themed icons 'gtkStockGoForwardLtr' and -- 'gtkStockGoForwardRtl'.) -- -- In many cases, named themes are used indirectly, via 'Image' or stock items, rather than directly, -- but looking up icons directly is also simple. The 'IconTheme' object acts as a database of all the -- icons in the current theme. You can create new 'IconTheme' objects, but its much more efficient to -- use the standard icon theme for the 'Screen' so that the icon information is shared with other -- people looking up icons. In the case where the default screen is being used, looking up an icon can -- be as simple as: -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----IconTheme -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types IconTheme, IconThemeClass, castToIconTheme, toIconTheme, IconInfo, -- * Enums IconLookupFlags(..), IconThemeError(..), -- * Constructors iconThemeNew, #if GTK_CHECK_VERSION(2,14,0) iconInfoNewForPixbuf, #endif -- * Methods iconThemeGetDefault, iconThemeGetForScreen, iconThemeSetScreen, iconThemeSetSearchPath, iconThemeGetSearchPath, iconThemeAppendSearchPath, iconThemePrependSearchPath, iconThemeSetCustomTheme, iconThemeHasIcon, iconThemeLookupIcon, #if GTK_CHECK_VERSION(2,12,0) iconThemeChooseIcon, #ifdef HAVE_GIO #if GTK_CHECK_VERSION(2,14,0) iconThemeLookupByGIcon, #endif #endif #endif iconThemeLoadIcon, #if GTK_CHECK_VERSION(2,12,0) iconThemeListContexts, #endif iconThemeListIcons, #if GTK_CHECK_VERSION(2,6,0) iconThemeGetIconSizes, #endif iconThemeGetExampleIconName, iconThemeRescanIfNeeded, iconThemeAddBuiltinIcon, iconThemeErrorQuark, iconInfoCopy, iconInfoGetAttachPoints, iconInfoGetBaseSize, iconInfoGetBuiltinPixbuf, iconInfoGetDisplayName, iconInfoGetEmbeddedRect, iconInfoGetFilename, iconInfoLoadIcon, iconInfoSetRawCoordinates, -- * Signals iconThemeChanged, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError (propagateGError) import Graphics.UI.Gtk.General.Structs (Rectangle, Point) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} #ifdef HAVE_GIO {#import System.GIO.Types#} #endif {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Enums {#enum IconLookupFlags {underscoreToCase} deriving (Bounded,Eq,Show)#} {#enum IconThemeError {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Constructors -- | Creates a new icon theme object. Icon theme objects are used to lookup up -- an icon by name in a particular icon theme. Usually, you'll want to use -- 'iconThemeGetDefault' or 'iconThemeGetForScreen' rather than creating a new -- icon theme object for scratch. -- iconThemeNew :: IO IconTheme iconThemeNew = wrapNewGObject mkIconTheme $ {# call gtk_icon_theme_new #} -------------------- -- Methods -- | Gets the icon theme for the default screen. See 'iconThemeGetForScreen'. -- iconThemeGetDefault :: IO IconTheme -- ^ returns A unique 'IconTheme' associated with the default -- screen. This icon theme is associated with the screen and -- can be used as long as the screen is open. iconThemeGetDefault = makeNewGObject mkIconTheme $ {# call gtk_icon_theme_get_default #} -- | Gets the icon theme object associated with @screen@; if this function has -- not previously been called for the given screen, a new icon theme object -- will be created and associated with the screen. Icon theme objects are -- fairly expensive to create, so using this function is usually a better -- choice than calling than 'iconThemeNew' and setting the screen yourself; by -- using this function a single icon theme object will be shared between users. -- iconThemeGetForScreen :: Screen -- ^ @screen@ - a 'Screen' -> IO IconTheme -- ^ returns A unique 'IconTheme' associated with the given -- screen. iconThemeGetForScreen screen = makeNewGObject mkIconTheme $ {# call gtk_icon_theme_get_for_screen #} screen -- | Sets the screen for an icon theme; the screen is used to track the user's -- currently configured icon theme, which might be different for different -- screens. -- iconThemeSetScreen :: IconThemeClass self => self -> Screen -- ^ @screen@ - a 'Screen' -> IO () iconThemeSetScreen self screen = {# call gtk_icon_theme_set_screen #} (toIconTheme self) screen -- | Sets the search path for the icon theme object. When looking for an icon -- theme, Gtk+ will search for a subdirectory of one or more of the directories -- in @path@ with the same name as the icon theme. (Themes from multiple of the -- path elements are combined to allow themes to be extended by adding icons in -- the user's home directory.) -- -- In addition if an icon found isn't found either in the current icon theme -- or the default icon theme, and an image file with the right name is found -- directly in one of the elements of @path@, then that image will be used for -- the icon name. (This is legacy feature, and new icons should be put into the -- default icon theme, which is called DEFAULT_THEME_NAME, rather than directly -- on the icon path.) -- iconThemeSetSearchPath :: (IconThemeClass self, GlibFilePath fp) => self -> [fp] -- ^ @path@ - list of directories that are searched for icon -- themes -> Int -- ^ @nElements@ - number of elements in @path@. -> IO () iconThemeSetSearchPath self path nElements = withUTFFilePathArray path $ \pathPtr -> {# call gtk_icon_theme_set_search_path #} (toIconTheme self) pathPtr (fromIntegral nElements) -- | Gets the current search path. See 'iconThemeSetSearchPath'. -- iconThemeGetSearchPath :: (IconThemeClass self, GlibFilePath fp) => self -> IO ([fp], Int) -- ^ @(path, nElements)@ -- @path@ - location to store a list of icon theme path -- directories. iconThemeGetSearchPath self = alloca $ \nElementsPtr -> allocaArray 0 $ \pathPtr -> do {# call gtk_icon_theme_get_search_path #} (toIconTheme self) (castPtr pathPtr) nElementsPtr pathStr <- readUTFFilePathArray0 pathPtr nElements <- peek nElementsPtr return (pathStr, fromIntegral nElements) -- | Appends a directory to the search path. See 'iconThemeSetSearchPath'. -- iconThemeAppendSearchPath :: (IconThemeClass self, GlibFilePath fp) => self -> fp -- ^ @path@ - directory name to append to the icon path -> IO () iconThemeAppendSearchPath self path = withUTFFilePath path $ \pathPtr -> {# call gtk_icon_theme_append_search_path #} (toIconTheme self) pathPtr -- | Prepends a directory to the search path. See 'iconThemeSetSearchPath'. -- iconThemePrependSearchPath :: (IconThemeClass self, GlibFilePath fp) => self -> fp -- ^ @path@ - directory name to prepend to the icon path -> IO () iconThemePrependSearchPath self path = withUTFFilePath path $ \pathPtr -> {# call gtk_icon_theme_prepend_search_path #} (toIconTheme self) pathPtr -- | Sets the name of the icon theme that the 'IconTheme' object uses -- overriding system configuration. This function cannot be called on the icon -- theme objects returned from 'iconThemeGetDefault' and -- 'iconThemeGetForScreen'. -- iconThemeSetCustomTheme :: (IconThemeClass self, GlibString string) => self -> (Maybe string) -- ^ @themeName@ name of icon theme to use instead of configured theme, or 'Nothing' to unset a previously set custom theme -> IO () iconThemeSetCustomTheme self themeName = maybeWith withUTFString themeName $ \themeNamePtr -> {# call gtk_icon_theme_set_custom_theme #} (toIconTheme self) themeNamePtr -- | Checks whether an icon theme includes an icon for a particular name. -- iconThemeHasIcon :: (IconThemeClass self, GlibString string) => self -> string -- ^ @iconName@ - the name of an icon -> IO Bool -- ^ returns @True@ if @iconTheme@ includes an icon for -- @iconName@. iconThemeHasIcon self iconName = liftM toBool $ withUTFString iconName $ \iconNamePtr -> {# call gtk_icon_theme_has_icon #} (toIconTheme self) iconNamePtr -- | Looks up a named icon and returns a structure containing information such -- as the filename of the icon. The icon can then be rendered into a pixbuf -- using 'iconInfoLoadIcon'. ('iconThemeLoadIcon' combines these two steps if -- all you need is the pixbuf.) -- iconThemeLookupIcon :: (IconThemeClass self, GlibString string) => self -> string -- ^ @iconName@ - the name of the icon to lookup -> Int -- ^ @size@ - desired icon size -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the -- icon lookup -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo' -- structure containing information about the icon, or -- 'Nothing' if the icon wasn't found. iconThemeLookupIcon self iconName size flags = withUTFString iconName $ \iconNamePtr -> do iiPtr <- {# call gtk_icon_theme_lookup_icon #} (toIconTheme self) iconNamePtr (fromIntegral size) ((fromIntegral . fromEnum) flags) if iiPtr == nullPtr then return Nothing else liftM Just (mkIconInfo (castPtr iiPtr)) #if GTK_CHECK_VERSION(2,12,0) -- | Looks up a named icon and returns a structure containing information such -- as the filename of the icon. The icon can then be rendered into a pixbuf -- using 'iconInfoLoadIcon'. ('iconThemeLoadIcon' combines these two steps if -- all you need is the pixbuf.) -- -- If @iconNames@ contains more than one name, this function tries them all -- in the given order before falling back to inherited icon themes. -- -- * Available since Gtk+ version 2.12 -- iconThemeChooseIcon :: (IconThemeClass self, GlibString string) => self -> [string] -- ^ @iconNames@ terminated list of icon names to lookup -> Int -- ^ @size@ - desired icon size -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the -- icon lookup -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo' -- structure containing information about the icon, or -- 'Nothing' if the icon wasn't found. iconThemeChooseIcon self iconNames size flags = withUTFStringArray0 iconNames $ \iconNamesPtr -> do iiPtr <- {# call gtk_icon_theme_choose_icon #} (toIconTheme self) iconNamesPtr (fromIntegral size) ((fromIntegral . fromEnum) flags) if iiPtr == nullPtr then return Nothing else liftM Just (mkIconInfo (castPtr iiPtr)) #ifdef HAVE_GIO #if GTK_CHECK_VERSION(2,14,0) -- | Looks up an icon and returns a structure containing information such as -- the filename of the icon. The icon can then be rendered into a pixbuf using -- 'iconInfoLoadIcon'. -- -- * Available since Gtk+ version 2.14 -- iconThemeLookupByGIcon :: (IconThemeClass self, IconClass icon) => self -> icon -- ^ @icon@ - the 'Icon' to look up -> Int -- ^ @size@ - desired icon size -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the -- icon lookup -> IO (Maybe IconInfo) -- ^ returns a 'IconInfo' -- structure containing information about the icon, or -- 'Nothing' if the icon wasn't found. iconThemeLookupByGIcon self icon size flags = do iiPtr <- {# call gtk_icon_theme_lookup_by_gicon #} (toIconTheme self) (toIcon icon) (fromIntegral size) ((fromIntegral . fromEnum) flags) if iiPtr == nullPtr then return Nothing else liftM Just (mkIconInfo (castPtr iiPtr)) #endif #endif #endif -- | Looks up an icon in an icon theme, scales it to the given size and -- renders it into a pixbuf. This is a convenience function; if more details -- about the icon are needed, use 'iconThemeLookupIcon' followed by -- 'iconInfoLoadIcon'. -- -- Note that you probably want to listen for icon theme changes and update -- the icon. This is usually done by connecting to the 'Widget'::style-set -- signal. If for some reason you do not want to update the icon when the icon -- theme changes, you should consider using 'pixbufCopy' to make a private copy -- of the pixbuf returned by this function. Otherwise Gtk+ may need to keep the -- old icon theme loaded, which would be a waste of memory. -- iconThemeLoadIcon :: (IconThemeClass self, GlibString string) => self -> string -- ^ @iconName@ - the name of the icon to lookup -> Int -- ^ @size@ - the desired icon size. The resulting icon -- may not be exactly this size; see 'iconInfoLoadIcon'. -> IconLookupFlags -- ^ @flags@ - flags modifying the behavior of the icon -- lookup -> IO (Maybe Pixbuf) -- ^ returns the rendered icon; this may be a newly -- created icon or a new reference to an internal icon, -- so you must not modify the icon. -- `Nothing` if the icon isn't found. iconThemeLoadIcon self iconName size flags = maybeNull (wrapNewGObject mkPixbuf) $ propagateGError $ \errorPtr -> withUTFString iconName $ \iconNamePtr -> {# call gtk_icon_theme_load_icon #} (toIconTheme self) iconNamePtr (fromIntegral size) ((fromIntegral . fromEnum) flags) errorPtr #if GTK_CHECK_VERSION(2,12,0) -- | Gets the list of contexts available within the current hierarchy of icon -- themes -- -- * Available since Gtk+ version 2.12 -- iconThemeListContexts :: (IconThemeClass self, GlibString string) => self -> IO [string] -- ^ returns a String list -- holding the names of all the contexts in the -- theme. iconThemeListContexts self = do glistPtr <- {# call gtk_icon_theme_list_contexts #} (toIconTheme self) list <- fromGList glistPtr result <- mapM readUTFString list {#call unsafe g_list_free #} (castPtr glistPtr) return result #endif -- | Lists the icons in the current icon theme. Only a subset of the icons can -- be listed by providing a context string. The set of values for the context -- string is system dependent, but will typically include such values as -- \"Applications\" and \"MimeTypes\". -- iconThemeListIcons :: (IconThemeClass self, GlibString string) => self -> (Maybe string) -- ^ @context@ a string identifying a particular type of icon, or 'Nothing' to list all icons. -> IO [string] -- ^ returns a String list -- holding the names of all the icons in the theme. iconThemeListIcons self context = maybeWith withUTFString context $ \contextPtr -> do glistPtr <- {# call gtk_icon_theme_list_icons #} (toIconTheme self) contextPtr list <- fromGList glistPtr result <- mapM readUTFString list {#call unsafe g_list_free#} (castPtr glistPtr) return result #if GTK_CHECK_VERSION(2,6,0) -- | Returns an list of integers describing the sizes at which the icon is -- available without scaling. A size of -1 means that the icon is available in -- a scalable format. The list is zero-terminated. -- -- * Available since Gtk+ version 2.6 -- iconThemeGetIconSizes :: (IconThemeClass self, GlibString string) => self -> string -- ^ @iconName@ - the name of an icon -> IO [Int] -- ^ returns An newly allocated list describing the sizes at -- which the icon is available. iconThemeGetIconSizes self iconName = withUTFString iconName $ \iconNamePtr -> do listPtr <- {# call gtk_icon_theme_get_icon_sizes #} (toIconTheme self) iconNamePtr list <- peekArray 0 listPtr {#call unsafe g_free #} (castPtr listPtr) return (map fromIntegral list) #endif -- | Gets the name of an icon that is representative of the current theme (for -- instance, to use when presenting a list of themes to the user.) -- iconThemeGetExampleIconName :: (IconThemeClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the name of an example icon or `Nothing' iconThemeGetExampleIconName self = do namePtr <- {# call gtk_icon_theme_get_example_icon_name #} (toIconTheme self) if namePtr == nullPtr then return Nothing else liftM Just $ readUTFString namePtr -- | Checks to see if the icon theme has changed; if it has, any currently -- cached information is discarded and will be reloaded next time @iconTheme@ -- is accessed. -- iconThemeRescanIfNeeded :: IconThemeClass self => self -> IO Bool -- ^ returns @True@ if the icon theme has changed and needed to be -- reloaded. iconThemeRescanIfNeeded self = liftM toBool $ {# call gtk_icon_theme_rescan_if_needed #} (toIconTheme self) -- | Registers a built-in icon for icon theme lookups. The idea of built-in -- icons is to allow an application or library that uses themed icons to -- function requiring files to be present in the file system. For instance, the -- default images for all of Gtk+'s stock icons are registered as built-icons. -- -- In general, if you use 'iconThemeAddBuiltinIcon' you should also install -- the icon in the icon theme, so that the icon is generally available. -- -- This function will generally be used with pixbufs loaded via -- 'pixbufNewFromInline'. -- iconThemeAddBuiltinIcon :: GlibString string => string -- ^ @iconName@ - the name of the icon to register -> Int -- ^ @size@ - the size at which to register the icon (different -- images can be registered for the same icon name at different -- sizes.) -> Pixbuf -- ^ @pixbuf@ - 'Pixbuf' that contains the image to use for -- @iconName@. -> IO () iconThemeAddBuiltinIcon iconName size pixbuf = withUTFString iconName $ \iconNamePtr -> {# call gtk_icon_theme_add_builtin_icon #} iconNamePtr (fromIntegral size) pixbuf -- | -- iconThemeErrorQuark :: IO Quark iconThemeErrorQuark = {# call gtk_icon_theme_error_quark #} -------------------- -- Types {#pointer *IconInfo foreign newtype#} foreign import ccall unsafe ">k_icon_info_free" icon_info_free :: FinalizerPtr IconInfo -- | Helper function for build 'IconInfo' mkIconInfo :: Ptr IconInfo -> IO IconInfo mkIconInfo infoPtr = liftM IconInfo $ newForeignPtr infoPtr icon_info_free -------------------- -- Constructors #if GTK_CHECK_VERSION(2,14,0) -- | -- iconInfoNewForPixbuf :: IconThemeClass iconTheme => iconTheme -> Pixbuf -> IO IconInfo iconInfoNewForPixbuf iconTheme pixbuf = {# call gtk_icon_info_new_for_pixbuf #} (toIconTheme iconTheme) pixbuf >>= mkIconInfo #endif -------------------- -- Methods -- | -- iconInfoCopy :: IconInfo -> IO IconInfo iconInfoCopy self = {# call gtk_icon_info_copy #} self >>= mkIconInfo -- | Fetches the set of attach points for an icon. An attach point is a location in the icon that can be -- used as anchor points for attaching emblems or overlays to the icon. iconInfoGetAttachPoints :: IconInfo -> IO (Maybe [Point]) iconInfoGetAttachPoints self = alloca $ \arrPtrPtr -> alloca $ \nPointsPtr -> do success <- liftM toBool $ {# call gtk_icon_info_get_attach_points #} self (castPtr arrPtrPtr) nPointsPtr if success then do arrPtr <- peek arrPtrPtr nPoints <- peek nPointsPtr pointList <- peekArray (fromIntegral nPoints) arrPtr {#call unsafe g_free#} (castPtr arrPtr) return $ Just pointList else return Nothing -- | Gets the base size for the icon. The base size is a size for the icon that was specified by the icon -- theme creator. This may be different than the actual size of image; an example of this is small -- emblem icons that can be attached to a larger icon. These icons will be given the same base size as -- the larger icons to which they are attached. -- iconInfoGetBaseSize :: IconInfo -> IO Int iconInfoGetBaseSize self = liftM fromIntegral $ {# call gtk_icon_info_get_base_size #} self -- | Gets the built-in image for this icon, if any. To allow GTK+ to use built in icon images, you must -- pass the ''IconLookupUseBuiltin'' to 'iconThemeLookupIcon'. iconInfoGetBuiltinPixbuf :: IconInfo -> IO (Maybe Pixbuf) -- ^ returns the built-in image pixbuf, or 'Nothing'. iconInfoGetBuiltinPixbuf self = do pixbufPtr <- {# call gtk_icon_info_get_builtin_pixbuf #} self if pixbufPtr == nullPtr then return Nothing else liftM Just $ makeNewGObject mkPixbuf (return pixbufPtr) -- | Gets the display name for an icon. A display name is a string to be used in place of the icon name -- in a user visible context like a list of icons. iconInfoGetDisplayName :: GlibString string => IconInfo -> IO (Maybe string) -- ^ returns the display name for the icon or 'Nothing', if the icon doesn't have a specified display name. iconInfoGetDisplayName self = do strPtr <- {# call gtk_icon_info_get_display_name #} self if strPtr == nullPtr then return Nothing else liftM Just $ peekUTFString strPtr -- | Gets the coordinates of a rectangle within the icon that can be used for display of information such -- as a preview of the contents of a text file. See 'iconInfoSetRawCoordinates' for further -- information about the coordinate system. iconInfoGetEmbeddedRect :: IconInfo -> IO (Maybe Rectangle) -- ^ @rectangle@ 'Rectangle' in which to store embedded -- rectangle coordinates. iconInfoGetEmbeddedRect self = alloca $ \rectPtr -> do success <- liftM toBool $ {# call gtk_icon_info_get_embedded_rect #} self (castPtr rectPtr) if success then liftM Just $ peek rectPtr else return Nothing -- | Gets the filename for the icon. If the ''IconLookupUseBuiltin'' flag was passed to -- 'iconThemeLookupIcon', there may be no filename if a builtin icon is returned; in this case, -- you should use 'iconInfoGetBuiltinPixbuf'. iconInfoGetFilename :: GlibString string => IconInfo -> IO (Maybe string) -- ^ returns the filename for the icon, -- or 'Nothing' if 'iconInfoGetBuiltinPixbuf' should be used instead. iconInfoGetFilename self = do namePtr <- {# call gtk_icon_info_get_filename #} self if namePtr == nullPtr then return Nothing else liftM Just $ peekUTFString namePtr -- | Looks up an icon in an icon theme, scales it to the given size and renders it into a pixbuf. This is -- a convenience function; if more details about the icon are needed, use 'iconThemeLookupIcon' -- followed by 'iconInfoLoadIcon'. -- -- Note that you probably want to listen for icon theme changes and update the icon. This is usually -- done by connecting to the 'styleSet' signal. If for some reason you do not want to update -- the icon when the icon theme changes, you should consider using 'pixbufCopy' to make a private -- copy of the pixbuf returned by this function. Otherwise GTK+ may need to keep the old icon theme -- loaded, which would be a waste of memory. iconInfoLoadIcon :: IconInfo -> IO Pixbuf iconInfoLoadIcon self = wrapNewGObject mkPixbuf $ propagateGError $ \errorPtr -> {# call gtk_icon_info_load_icon #} self errorPtr -- | Sets whether the coordinates returned by 'iconInfoGetEmbeddedRect' and -- 'iconInfoGetAttachPoints' should be returned in their original form as specified in the icon -- theme, instead of scaled appropriately for the pixbuf returned by 'iconInfoLoadIcon'. -- -- Raw coordinates are somewhat strange; they are specified to be with respect to the unscaled pixmap -- for PNG and XPM icons, but for SVG icons, they are in a 1000x1000 coordinate space that is scaled to -- the final size of the icon. You can determine if the icon is an SVG icon by using -- 'iconInfoGetFilename', and seeing if it is non-'Nothing' and ends in '.svg'. -- -- This function is provided primarily to allow compatibility wrappers for older API's, and is not -- expected to be useful for applications. iconInfoSetRawCoordinates :: IconInfo -> Bool -- ^ @rawCoordinates@ whether the coordinates of -- embedded rectangles and attached points should be returned in their original -> IO () iconInfoSetRawCoordinates self rawCoordinates = {# call gtk_icon_info_set_raw_coordinates #} self (fromBool rawCoordinates) -------------------- -- Signals -- | Emitted when the current icon theme is switched or Gtk+ detects that a -- change has occurred in the contents of the current icon theme. -- iconThemeChanged :: IconThemeClass self => Signal self (IO ()) iconThemeChanged = Signal (connect_NONE__NONE "changed") #endif gtk-0.15.9/Graphics/UI/Gtk/General/RcStyle.chs0000644000000000000000000005755107346545000017044 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) RcStyle -- -- Author : Axel Simon -- -- Created: 22 October 2009 -- -- Copyright (C) 2009 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) -- -- Routines for handling resource files -- module Graphics.UI.Gtk.General.RcStyle ( -- * Detail -- -- | Gtk+ provides resource file mechanism for configuring various aspects of -- the operation of a Gtk+ program at runtime. -- ** Default files -- -- | An application can cause Gtk+ to parse a specific RC file by calling -- 'rcParse'. In addition to this, certain files will be read at the end of -- 'initGUI'. Unless modified, the files looked for will be -- @\\/gtk-2.0\/gtkrc@ and @.gtkrc-2.0@ in the users home directory. -- @(\@ defaults to @\/usr\/local\/etc@. It can be changed with the -- --prefix or --sysconfdir options when configuring Gtk+.) Note that although -- the filenames contain the version number 2.0, all 2.x versions of Gtk+ look -- for these files. -- -- The set of these default files can be retrieved with 'rcGetDefaultFiles' -- and modified with 'rcAddDefaultFile' and 'rcSetDefaultFiles'. Additionally, -- the @GTK2_RC_FILES@ environment variable can be set to a -- @G_SEARCHPATH_SEPARATOR_S@-separated list of -- files in order to overwrite the set of default files at runtime. -- -- For each RC file, in addition to the file itself, Gtk+ will look for a -- locale-specific file that will be parsed after the main file. For instance, -- if @LANG@ is set to @ja_JP.ujis@, when loading the default file @~\/.gtkrc@ then -- Gtk+ looks for @~\/.gtkrc.ja_JP@ and @~\/.gtkrc.ja@, and parses the first of -- those that exists. -- ** Pathnames and patterns -- -- | A resource file defines a number of styles and key bindings and attaches -- them to particular widgets. The attachment is done by the @widget@, -- @widget_class@, and @class@ declarations. As an example of such a statement: -- attaches the style @\"my-entry-class\"@ to all widgets whose widget path -- matches the pattern @\"mywindow.*.GtkEntry\"@. That is, all 'Entry' widgets -- which are part of a 'Window' named @\"mywindow\"@. -- -- > widget "mywindow.*.GtkEntry" style "my-entry-class" -- -- The patterns here are given in the standard shell glob syntax. The -- @\"?\"@ wildcard matches any character, while @\"*\"@ matches zero or more -- of any character. The three types of matching are against the widget path, -- the class path and the class hierarchy. Both the widget path and the class -- path consist of a @\".\"@ separated list of all the parents of the widget -- and the widget itself from outermost to innermost. The difference is that in -- the widget path, the name assigned by 'widgetSetName' is used if present, -- otherwise the class name of the widget, while for the class path, the class -- name is always used. -- -- Since Gtk+ 2.10, @widget_class@ paths can also contain @\@ -- substrings, which are matching the class with the given name and any derived -- classes. For instance, will match 'Label' widgets which are contained in any -- kind of menu item. -- -- > widget_class "*GtkMenuItem.GtkLabel" style "my-style" -- -- So, if you have a 'Entry' named @\"myentry\"@, inside of a horizontal box -- in a window named @\"mywindow\"@, then the widget path is: -- @\"mywindow.GtkHBox.myentry\"@ while the class path is: -- @\"GtkWindow.GtkHBox.GtkEntry\"@. -- -- Matching against class is a little different. The pattern match is done -- against all class names in the widgets class hierarchy (not the layout -- hierarchy) in sequence, so the pattern: will match not just 'Button' -- widgets, but also 'ToggleButton' and 'CheckButton' widgets, since those -- classes derive from 'Button'. -- -- > class "GtkButton" style "my-style" -- -- Additionally, a priority can be specified for each pattern, and styles -- override other styles first by priority, then by pattern type and then by -- order of specification (later overrides earlier). The priorities that can be -- specified are (highest to lowest): -- -- * @highest@ -- -- * @rc@ -- -- * @theme@ -- -- * @application@ -- -- * @gtk@ -- -- * @lowest@ -- -- @rc@ is the default for styles read from an RC file, @theme@ is the -- default for styles read from theme RC files, @application@ should be used -- for styles an application sets up, and @gtk@ is used for styles that Gtk+ -- creates internally. -- ** Optimizing RC Style Matches -- -- | Every time a widget is created and added to the layout hierarchy of a -- 'Window' (\"anchored\" to be exact), a list of matching RC styles out of all -- RC styles read in so far is composed. For this, every RC style is matched -- against the widgets class path, the widgets name path and widgets -- inheritance hierarchy. As a consequence, significant slowdown can be caused -- by utilization of many RC styles and by using RC style patterns that are -- slow or complicated to match against a given widget. The following ordered -- list provides a number of advices (prioritized by effectiveness) to reduce -- the performance overhead associated with RC style matches: -- -- Move RC styles for specific applications into RC files dedicated to those -- applications and parse application specific RC files only from applications -- that are affected by them. This reduces the overall amount of RC styles that -- have to be considered for a match across a group of applications. -- -- Merge multiple styles which use the same matching rule, for instance: is -- faster to match as: -- -- > style "Foo" { foo_content } -- > class "X" style "Foo" -- > style "Bar" { bar_content } -- > class "X" style "Bar" -- -- > style "FooBar" { foo_content bar_content } -- > class "X" style "FooBar" -- -- Use of wildcards should be avoided, this can reduce the individual RC -- style match to a single integer comparison in most cases. -- -- To avoid complex recursive matching, specification of full class names -- (for @class@ matches) or full path names (for @widget@ and @widget_class@ -- matches) is to be preferred over shortened names containing @\"*\"@ or -- @\"?\"@. -- -- If at all necessary, wildcards should only be used at the tail or head of -- a pattern. This reduces the match complexity to a string comparison per RC -- style. -- -- When using wildcards, use of @\"?\"@ should be preferred over @\"*\"@. -- This can reduce the matching complexity from O(n^2) to O(n). For example -- @\"Gtk*Box\"@ can be turned into @\"Gtk?Box\"@ and will still match 'HBox' -- and 'VBox'. -- -- The use of @\"*\"@ wildcards should be restricted as much as possible, -- because matching @\"A*B*C*RestString\"@ can result in matching complexities -- of O(n^2) worst case. -- ** Toplevel declarations -- -- | An RC file is a text file which is composed of a sequence of -- declarations. @\'#\'@ characters delimit comments and the portion of a line -- after a @\'#\'@ is ignored when parsing an RC file. -- -- The possible toplevel declarations are: -- -- [@binding name { ... }@] Declares a binding set. -- -- [@class pattern [ style | binding \][ : priority \] name@] -- Specifies a style or binding set for a particular branch of the inheritance -- hierarchy. -- -- [@include filename@] Parses another file at this point. If filename is -- not an absolute filename, it is searched in the directories of the currently -- open RC files. Gtk+ also tries to load a locale-specific variant of the -- included file. -- -- [@module_path path@] Sets a path (a list of directories separated by -- colons) that will be searched for theme engines referenced in RC files. -- -- [@pixmap_path path@] Sets a path (a list of directories separated by -- colons) that will be searched for pixmaps referenced in RC files. -- -- [@im_module_file pathname@] Sets the pathname for the IM modules file. -- Setting this from RC files is deprecated; you should use the environment -- variable GTK_IM_MODULE_FILE instead. -- -- [@style name [ = parent \] { ... }@] Declares a style. -- -- [@widget pattern [ style | binding \][ : priority \] name@] -- Specifies a style or binding set for a particular group of widgets by -- matching on the widget pathname. -- -- [@widget_class pattern [ style | binding \][ : priority \] name@] -- Specifies a style or binding set for a particular group of widgets by -- matching on the class pathname. -- -- [setting = value] Specifies a value for a setting. Note that settings in -- RC files are overwritten by system-wide settings (which are managed by an -- XSettings manager on X11). -- ** Styles -- -- | A RC style is specified by a @style@ declaration in a RC file, and then -- bound to widgets with a @widget@, @widget_class@, or @class@ declaration. -- All styles applying to a particular widget are composited together with -- @widget@ declarations overriding @widget_class@ declarations which, in turn, -- override @class@ declarations. Within each type of declaration, later -- declarations override earlier ones. -- -- Within a @style@ declaration, the possible elements are: -- -- [@bg[state\] = color@] Sets the color used for the background of -- most widgets. -- -- [@fg[state\] = color@] Sets the color used for the foreground of -- most widgets. -- -- [@base[state\] = color@] Sets the color used for the background of -- widgets displaying editable text. This color is used for the background of, -- among others, {GtkText, FIXME: unknown type\/value}, 'Entry', 'List', and -- 'CList'. -- -- [@text[state\] = color@] Sets the color used for foreground of -- widgets using @base@ for the background color. -- -- [@xthickness = number@] Sets the xthickness, which is used for -- various horizontal padding values in Gtk+. -- -- [@ythickness = number@] Sets the ythickness, which is used for -- various vertical padding values in Gtk+. -- -- [@bg_pixmap[state\] = pixmap@] Sets a background pixmap to be used -- in place of the @bg@ color (or for {GtkText, FIXME: unknown type\/value}, in -- place of the @base@ color. The special value @\"\\"@ may be used to -- indicate that the widget should use the same background pixmap as its -- parent. The special value @\"\\"@ may be used to indicate no -- background pixmap. -- -- [@font = font@] Starting with Gtk+ 2.0, the \"font\" and \"fontset\" -- declarations are ignored; use \"font_name\" declarations instead. -- -- [@fontset = font@] Starting with Gtk+ 2.0, the \"font\" and \"fontset\" -- declarations are ignored; use \"font_name\" declarations instead. -- -- [@font_name = font@] Sets the font for a widget. font must be a Pango -- font name, e.g. @\"Sans Italic 10\"@. For details about Pango font names, -- see 'fontDescriptionFromString'. -- -- [@stock[\"stock-id\"\] = { icon source specifications }@] Defines the -- icon for a stock item. -- -- [@color[\"color-name\"\] = color specification@] Since 2.10, this element -- can be used to defines symbolic colors. See below for the syntax of color -- specifications. -- -- [@engine \"engine\" { engine-specific settings }@] Defines the engine to -- be used when drawing with this style. -- -- [@class::property = value@] Sets a style property for a widget class. -- -- The colors and background pixmaps are specified as a function of the -- state of the widget. The states are: -- -- [@NORMAL@] A color used for a widget in its normal state. -- -- [@ACTIVE@] A variant of the @NORMAL@ color used when the widget is in the -- 'StateActive' state, and also for the through of a ScrollBar, tabs of a -- NoteBook other than the current tab and similar areas. Frequently, this -- should be a darker variant of the @NORMAL@ color. -- -- [@PRELIGHT@] A color used for widgets in the 'StatePrelight' state. This -- state is the used for Buttons and MenuItems that have the mouse cursor over -- them, and for their children. -- -- [@SELECTED@] A color used to highlight data selected by the user. for -- instance, the selected items in a list widget, and the selection in an -- editable widget. -- -- [@INSENSITIVE@] A color used for the background of widgets that have been -- set insensitive with 'widgetSetSensitive'. -- -- Colors can be specified as a string containing a color name (GTK+ knows -- all names from the X color database \/usr\/lib\/X11\/rgb.txt), in one of the -- hexadecimal forms @#rrrrggggbbbb@, @#rrrgggbbb@, @#rrggbb@, or @#rgb@, where -- @r@, @g@ and @b@ are hex digits, or they can be specified as a triplet @{ r, -- g, b}@, where @r@, @g@ and @b@ are either integers in the range 0-65535 or -- floats in the range 0.0-1.0. -- -- Since 2.10, colors can also be specified by referring to a symbolic color, -- as follows: @\@color-name@, or by using expressions to combine colors. The -- following expressions are currently supported: -- -- [mix (factor, color1, color2)] Computes a new color by mixing color1 and -- color2. The factor determines how close the new color is to color1. A factor -- of 1.0 gives pure color1, a factor of 0.0 gives pure color2. -- -- [shade (factor, color)] Computes a lighter or darker variant of color. A -- factor of 1.0 leaves the color unchanged, smaller factors yield darker -- colors, larger factors yield lighter colors. -- -- [lighter (color)] This is an abbreviation for @shade (1.3, color)@. -- -- [darker (color)] This is an abbreviation for @shade (0.7, color)@. -- -- Here are some examples of color expressions: -- -- > mix (0.5, "red", "blue") -- > shade (1.5, mix (0.3, "#0abbc0", { 0.3, 0.5, 0.9 })) -- > lighter (@foreground) -- -- In a @stock@ definition, icon sources are specified as a 4-tuple of image -- filename or icon name, text direction, widget state, and size, in that -- order. Each icon source specifies an image filename or icon name to use with -- a given direction, state, and size. Filenames are specified as a string such -- as @\"itemltr.png\"@, while icon names (looked up in the current icon -- theme), are specified with a leading @\@@, such as @\@\"item-ltr\"@. The @*@ -- character can be used as a wildcard, and if direction\/state\/size are -- omitted they default to @*@. So for example, the following specifies -- different icons to use for left-to-right and right-to-left languages: This -- could be abbreviated as follows: -- -- > stock["my-stock-item"] = -- > { -- > { "itemltr.png", LTR, *, * }, -- > { "itemrtl.png", RTL, *, * } -- > } -- -- > stock["my-stock-item"] = -- > { -- > { "itemltr.png", LTR }, -- > { "itemrtl.png", RTL } -- > } -- -- You can specify custom icons for specific sizes, as follows: The sizes -- that come with Gtk+ itself are @\"gtk-menu\"@, @\"gtk-small-toolbar\"@, -- @\"gtk-large-toolbar\"@, @\"gtk-button\"@, @\"gtk-dialog\"@. Applications -- can define other sizes. -- -- > stock["my-stock-item"] = -- > { -- > { "itemmenusize.png", *, *, "gtk-menu" }, -- > { "itemtoolbarsize.png", *, *, "gtk-large-toolbar" } -- > { "itemgeneric.png" } /* implicit *, *, * as a fallback */ -- > } -- -- It's also possible to use custom icons for a given state, for example: -- -- > stock["my-stock-item"] = -- > { -- > { "itemprelight.png", *, PRELIGHT }, -- > { "iteminsensitive.png", *, INSENSITIVE }, -- > { "itemgeneric.png" } /* implicit *, *, * as a fallback */ -- > } -- -- When selecting an icon source to use, Gtk+ will consider text direction -- most important, state second, and size third. It will select the best match -- based on those criteria. If an attribute matches exactly (e.g. you specified -- @PRELIGHT@ or specified the size), Gtk+ won't modify the image; if the -- attribute matches with a wildcard, Gtk+ will scale or modify the image to -- match the state and size the user requested. -- ** Key bindings -- -- | Key bindings allow the user to specify actions to be taken on particular -- key presses. The form of a binding set declaration is: -- -- key is a string consisting of a series of modifiers followed by the name -- of a key. The modifiers can be: -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- * @\@ -- -- @\@ is an alias for @\@, @\@ is an alias for -- @\@, and @\@ is an alias for @\@. -- -- The action that is bound to the key is a sequence of signal names -- (strings) followed by parameters for each signal. The signals must be action -- signals. (See 'gSignalNew'). Each parameter can be a float, integer, string, -- or unquoted string representing an enumeration value. The types of the -- parameters specified must match the types of the parameters of the signal. -- -- Binding sets are connected to widgets in the same manner as styles, with -- one difference: Binding sets override other binding sets first by pattern -- type, then by priority and then by order of specification. The priorities -- that can be specified and their default values are the same as for styles. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----RcStyle -- @ -- * Types RcStyle, RcStyleClass, castToRcStyle, gTypeRcStyle, toRcStyle, -- * Constructors rcStyleNew, -- * Methods rcStyleCopy, rcAddDefaultFile, rcGetDefaultFiles, rcGetImModuleFile, rcGetModuleDir, rcGetStyle, rcGetStyleByPaths, rcGetThemeDir, rcParse, rcParseString, rcReparseAll, rcReparseAllForSettings, rcResetStyles, rcSetDefaultFiles, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GType (GType) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'RcStyle' with no fields set. The 'RcStyle' structure is -- used to represent a set of information about the appearance of a widget. -- This can later be composited together with other 'RcStyle' structures to -- form a 'Style'. -- rcStyleNew :: IO RcStyle rcStyleNew = wrapNewGObject mkRcStyle $ {# call gtk_rc_style_new #} -------------------- -- Methods -- | Makes a copy of the specified 'RcStyle'. This function will correctly -- copy an RC style that is a member of a class derived from 'RcStyle'. -- rcStyleCopy :: RcStyleClass self => self -> IO RcStyle -- ^ returns the resulting 'RcStyle' rcStyleCopy self = wrapNewGObject mkRcStyle $ {# call gtk_rc_style_copy #} (toRcStyle self) -- | Adds a file to the list of files to be parsed at the end of 'initGUI'. -- rcAddDefaultFile :: GlibString string => string -> IO () rcAddDefaultFile filename = withUTFString filename $ \filenamePtr -> {# call gtk_rc_add_default_file #} filenamePtr -- | etrieves the current list of RC files that will be parsed at the end of -- 'initGUI'. -- rcGetDefaultFiles :: GlibString string => IO [string] rcGetDefaultFiles = do aPtr <- {# call gtk_rc_get_default_files #} sPtrs <- peekArray0 nullPtr (castPtr aPtr) mapM peekUTFString sPtrs -- | Obtains the path to the IM modules file. See the documentation of the -- @GTK_IM_MODULE_FILE@ environment variable for more details. -- rcGetImModuleFile :: GlibString string => IO string rcGetImModuleFile = {# call gtk_rc_get_im_module_file #} >>= readUTFString -- | Returns a directory in which GTK+ looks for theme engines. -- rcGetModuleDir :: GlibString string => IO string rcGetModuleDir = {# call gtk_rc_get_module_dir #} >>= readUTFString -- | Finds all matching RC styles for a given widget, composites them -- together, and then creates a GtkStyle representing the composite -- appearance. (GTK+ actually keeps a cache of previously created styles, so a -- new style may not be created.) -- rcGetStyle :: WidgetClass widget => widget -> IO Style rcGetStyle widget = makeNewGObject mkStyle $ {# call gtk_rc_get_style #} (toWidget widget) -- | Creates up a 'Style' from styles defined in a RC file by providing the -- raw components used in matching. This function may be useful when creating -- pseudo-widgets that should be themed like widgets but don't actually have -- corresponding GTK+ widgets. -- rcGetStyleByPaths :: GlibString string => Settings -> Maybe string -- ^ @widgetPath@ : the widget path to use when looking up the style, or -- @Nothing@ if no matching against the widget path should be done -> Maybe string -- ^ @classPath@ : the class path to use when looking up the style, or -- @Nothing@ if no matching against the class path should be done. -> GType -- ^ @type@ : a type that will be used along with parent types of this type when -- matching against class styles, or 'none' -> IO Style rcGetStyleByPaths settings mWidgetPath mClassPath type_ = makeNewGObject mkStyle $ (case mClassPath of Just classPath -> withUTFString classPath Nothing -> (\act -> act nullPtr)) $ \classPathPtr -> (case mWidgetPath of Just widgetPath -> withUTFString widgetPath Nothing -> (\act -> act nullPtr)) $ \widgetPathPtr -> {# call gtk_rc_get_style_by_paths #} settings widgetPathPtr classPathPtr type_ -- | Returns the standard directory in which themes should be installed. (GTK+ -- does not actually use this directory itself.) -- rcGetThemeDir :: GlibString string => IO string rcGetThemeDir = {# call gtk_rc_get_theme_dir #} >>= readUTFString -- | Parses a given resource file. -- rcParse :: GlibString string => string -- ^ @filename@ : the @filename@ of a file to parse. If @filename@ is not -- absolute, it is searched in the current directory. -> IO () rcParse filename = withUTFString filename $ \filenamePtr -> {# call gtk_rc_parse #} filenamePtr -- | Parses resource information directly from a string. -- rcParseString :: GlibString string => string -> IO () rcParseString rcString = withUTFString rcString $ \rcStringPtr -> {# call gtk_rc_parse_string #} rcStringPtr -- | If the modification time on any previously read file for the default -- 'Settings' has changed, discard all style information and then reread all -- previously read RC files. -- rcReparseAll :: IO Bool -- ^ @True@ if the files were reread. rcReparseAll = liftM toBool $ {# call gtk_rc_reparse_all #} -- | f the modification time on any previously read file for the given -- 'Settings' has changed, discard all style information and then reread all -- previously read RC files. -- rcReparseAllForSettings :: Settings -> Bool -- ^ @forceLoad@ : load whether or not anything changed -> IO Bool -- ^ @True@ if the files were reread. rcReparseAllForSettings settings forceLoad = liftM toBool $ {# call gtk_rc_reparse_all_for_settings #} (toSettings settings) (fromBool forceLoad) -- | This function recomputes the styles for all widgets that use a particular -- 'Settings' object. (There is one 'Settings' object per 'Screen', see -- 'settingsGetForScreen'.) It is useful when some global parameter has -- changed that affects the appearance of all widgets, because when a widget -- gets a new style, it will both redraw and recompute any cached information -- about its appearance. As an example, it is used when the default font size -- set by the operating system changes. Note that this function doesn't affect -- widgets that have a style set explicitly on them with 'widgetSetStyle'. -- rcResetStyles :: Settings -> IO () rcResetStyles settings = {# call gtk_rc_reset_styles #} (toSettings settings) -- | Sets the list of files that GTK+ will read at the end of 'initGUI'. -- rcSetDefaultFiles :: GlibString string => [string] -> IO () rcSetDefaultFiles files = withUTFStringArray0 files $ \ssPtr -> {# call gtk_rc_set_default_files #} ssPtr gtk-0.15.9/Graphics/UI/Gtk/General/Selection.chs0000644000000000000000000004171707346545000017401 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Selection support -- -- Author : Axel Simon -- -- Created: 26 March 2007 -- -- Copyright (C) 2007 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. -- -- functions that seem to be internal: gtk_selection_convert -- functions that relate to target tables are not bound since they seem -- superfluous: targets_*, selection_data_copy, selection_data_free -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Functions for handling inter-process communication via selections. -- module Graphics.UI.Gtk.General.Selection ( -- * Types InfoId, Atom, TargetTag, SelectionTag, SelectionTypeTag, TargetList, SelectionDataM, TargetFlags(..), -- * Constants targetString, selectionTypeAtom, selectionTypeInteger, selectionTypeString, -- * Constructors atomNew, targetListNew, -- * Methods targetListAdd, #if GTK_CHECK_VERSION(2,6,0) targetListAddTextTargets, targetListAddImageTargets, targetListAddUriTargets, #endif #if GTK_CHECK_VERSION(2,10,0) targetListAddRichTextTargets, #endif targetListRemove, selectionAddTarget, selectionClearTargets, selectionOwnerSet, selectionOwnerSetForDisplay, selectionRemoveAll, selectionDataSet, #if GTK_MAJOR_VERSION < 3 selectionDataGet, #endif selectionDataIsValid, selectionDataSetText, selectionDataGetText, #if GTK_CHECK_VERSION(2,6,0) selectionDataSetPixbuf, selectionDataGetPixbuf, selectionDataSetURIs, selectionDataGetURIs, selectionDataTargetsIncludeImage, #endif selectionDataGetTarget, #if GTK_MAJOR_VERSION < 3 selectionDataSetTarget, #endif selectionDataGetTargets, selectionDataTargetsIncludeText, #if GTK_CHECK_VERSION(2,10,0) selectionDataTargetsIncludeUri, selectionDataTargetsIncludeRichText, #endif -- * Signals selectionGet, selectionReceived ) where import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags (fromFlags) import System.Glib.Signals import System.Glib.GObject {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.DNDTypes#} import Graphics.UI.Gtk.Gdk.Events (TimeStamp) import Graphics.UI.Gtk.General.Enums (TargetFlags(..)) import Graphics.UI.Gtk.General.Structs ( targetString, selectionTypeAtom, selectionTypeInteger, selectionTypeString, #if GTK_MAJOR_VERSION < 3 selectionDataGetType #endif ) import Graphics.UI.Gtk.Signals import Control.Monad ( liftM ) import Control.Monad.Trans ( liftIO ) import Control.Monad.Reader (runReaderT, ask) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Append another target to the given 'TargetList'. -- -- * Note that the 'TargetFlags' are only used for drag and drop, not in normal -- selection handling. -- targetListAdd :: TargetList -> TargetTag -> [TargetFlags] -> InfoId -> IO () targetListAdd tl (Atom tagPtr) flags info = do {#call unsafe target_list_add#} tl tagPtr (fromIntegral (fromFlags flags)) info #if GTK_CHECK_VERSION(2,6,0) -- | Append all text targets supported by the selection mechanism to the -- target list. All targets are added with the same 'InfoId'. -- -- * Since Gtk 2.6. -- targetListAddTextTargets :: TargetList -> InfoId -> IO () targetListAddTextTargets = {#call unsafe target_list_add_text_targets#} -- | Append all image targets supported by the selection mechanism to the -- target list. All targets are added with the same 'InfoId'. If the boolean -- flag is set, only targets will be added which Gtk+ knows how to convert -- into a 'Graphics.UI.Gtk.Pixbuf.Pixbuf'. -- -- * Since Gtk 2.6. -- targetListAddImageTargets :: TargetList -> InfoId -> Bool -> IO () targetListAddImageTargets tl info writable = {#call unsafe target_list_add_image_targets#} tl info (fromBool writable) -- | Append all URI (universal resource indicator, fomerly URL) targets -- supported by the selection mechanism to the target list. All targets are -- added with the same 'InfoId'. -- -- * Since Gtk 2.6. -- targetListAddUriTargets :: TargetList -> InfoId -> IO () targetListAddUriTargets = {#call unsafe target_list_add_uri_targets#} #endif #if GTK_CHECK_VERSION(2,10,0) -- | Append all rich text targets registered with -- 'Graphics.UI.Gtk.TextBuffer.textBufferRegisterSerializeFormat' to the -- target list. All targets are added with the same 'InfoId'. If the boolean -- flag is @True@ then deserializable rich text formats will be added, -- serializable formats otherwise. -- -- * Since Gtk 2.10. -- targetListAddRichTextTargets :: TextBufferClass tb => TargetList -> InfoId -> Bool -> tb -> IO () targetListAddRichTextTargets tl info deser tb = {#call unsafe target_list_add_rich_text_targets#} tl info (fromBool deser) (toTextBuffer tb) #endif -- | Remove a target from a target list. -- targetListRemove :: TargetList -> TargetTag -> IO () targetListRemove tl (Atom t)= {#call unsafe target_list_remove#} tl t -- %hash c:9971 d:af3f -- | Appends a specified target to the list of supported targets for a given -- widget and selection. -- selectionAddTarget :: WidgetClass widget => widget -> SelectionTag -> TargetTag -> InfoId -> IO () selectionAddTarget widget (Atom selection) (Atom target) info = {#call unsafe gtk_selection_add_target #} (toWidget widget) selection target (fromIntegral info) -- %hash c:d523 d:af3f -- | Remove all targets registered for the given selection for the widget. -- selectionClearTargets :: WidgetClass widget => widget -> SelectionTag -> IO () selectionClearTargets widget (Atom selection) = {#call unsafe gtk_selection_clear_targets #} (toWidget widget) selection -- %hash c:85a8 d:af3f -- | Claims ownership of a given selection for a particular widget, or, if -- widget is 'Nothing', release ownership of the selection. -- selectionOwnerSet :: WidgetClass widget => Maybe widget -> SelectionTag -> TimeStamp -> IO Bool selectionOwnerSet widget (Atom selection) time = liftM toBool $ {#call unsafe gtk_selection_owner_set #} (maybe (Widget nullForeignPtr) toWidget widget) selection (fromIntegral time) -- %hash c:174 d:af3f -- | Set the ownership of a given selection and display. -- selectionOwnerSetForDisplay :: WidgetClass widget => Display -> Maybe widget -> SelectionTag -> TimeStamp -> IO Bool selectionOwnerSetForDisplay display widget (Atom selection) time = liftM toBool $ {#call unsafe gtk_selection_owner_set_for_display #} display (maybe (Widget nullForeignPtr) toWidget widget) selection (fromIntegral time) -- %hash c:c29 d:af3f -- | Removes all handlers and unsets ownership of all selections for a widget. -- Called when widget is being destroyed. This function will not generally be -- called by applications. -- selectionRemoveAll :: WidgetClass widget => widget -> IO () selectionRemoveAll widget = {#call unsafe gtk_selection_remove_all #} (toWidget widget) -- %hash c:7662 d:af3f -- | Stores new data in the 'SelectionDataM' monad. The stored data may only -- be an array of integer types that are no larger than 32 bits. -- selectionDataSet :: (Integral a, Storable a) => SelectionTypeTag -> [a] -> SelectionDataM () selectionDataSet (Atom tagPtr) values@(~(v:_)) = ask >>= \selPtr -> liftIO $ withArrayLen values $ \arrayLen arrayPtr -> {#call unsafe gtk_selection_data_set #} selPtr tagPtr (fromIntegral (8*sizeOf v)) (castPtr arrayPtr) (fromIntegral (arrayLen*sizeOf v)) -- The GtkSelectionData struct was made opaque in Gtk3, but the accessor routines -- where introduced in 2.14. #if GTK_CHECK_VERSION(2,14,0) #if GTK_MAJOR_VERSION < 3 selectionDataGet_format selPtr = {#call gtk_selection_data_get_format#} selPtr #endif selectionDataGet_length selPtr = {#call gtk_selection_data_get_length#} selPtr #if GTK_MAJOR_VERSION < 3 selectionDataGet_data selPtr = {#call gtk_selection_data_get_data#} selPtr #endif selectionDataGet_target selPtr = {#call gtk_selection_data_get_target#} selPtr #else selectionDataGet_format selPtr = {#get SelectionData -> format#} selPtr selectionDataGet_length selPtr = {#get SelectionData -> length#} selPtr selectionDataGet_data selPtr = {#get SelectionData -> data#} selPtr selectionDataGet_target selPtr = {#get SelectionData -> target#} selPtr #endif #if GTK_MAJOR_VERSION < 3 -- | Retrieves the data in the 'SelectionDataM' monad. The returned array -- must have elements of the size that were used to set this data. If -- the size or the type tag does not match, @Nothing@ is returned. -- -- Removed in Gtk3. selectionDataGet :: (Integral a, Storable a) => SelectionTypeTag -> SelectionDataM (Maybe [a]) selectionDataGet tagPtr = do selPtr <- ask liftIO $ do typeTag <- selectionDataGetType selPtr if typeTag/=tagPtr then return Nothing else do bitSize <- liftM fromIntegral $ selectionDataGet_format selPtr lenBytes <- liftM fromIntegral $ selectionDataGet_length selPtr dataPtr <- liftM castPtr $ selectionDataGet_data selPtr if lenBytes<=0 || bitSize/=sizeOf (unsafePerformIO (peek dataPtr))*8 then return Nothing else liftM Just $ do peekArray (fromIntegral (lenBytes `quot` (bitSize `quot` 8))) dataPtr #endif selectionDataGetLength :: SelectionDataM Int selectionDataGetLength = do selPtr <- ask liftIO $ liftM fromIntegral $ selectionDataGet_length selPtr -- | Check if the currently stored data is valid. -- -- * If this function returns @False@, no data is set in this selection -- and 'selectionDataGet' will return @Nothing@ no matter what type -- is requested. -- selectionDataIsValid :: SelectionDataM Bool selectionDataIsValid = do len <- selectionDataGetLength return (len>=0) -- %hash c:9bdf d:af3f -- | Sets the contents of the selection from a string. The -- string is converted to the form determined by the allowed targets of the -- selection. -- -- * Returns @True@ if setting the text was successful. -- selectionDataSetText :: GlibString string => string -> SelectionDataM Bool selectionDataSetText str = do selPtr <- ask liftM toBool $ liftIO $ withUTFStringLen str $ \(strPtr,len) -> {#call unsafe gtk_selection_data_set_text #} selPtr strPtr (fromIntegral len) -- %hash c:90e0 d:af3f -- | Gets the contents of the selection data as a string. -- selectionDataGetText :: GlibString string => SelectionDataM (Maybe string) selectionDataGetText = do selPtr <- ask liftIO $ do strPtr <- {#call unsafe gtk_selection_data_get_text #} selPtr if strPtr==nullPtr then return Nothing else do str <- peekUTFString (castPtr strPtr) {#call unsafe g_free#} (castPtr strPtr) return (Just str) #if GTK_CHECK_VERSION(2,6,0) -- %hash c:ed8d d:af3f -- | Sets the contents of the selection from a 'Pixbuf'. The pixbuf is -- converted to the form determined by the allowed targets of the selection. -- -- * Returns @True@ if setting the 'Pixbuf' was successful. Since Gtk 2.6. -- selectionDataSetPixbuf :: Pixbuf -> SelectionDataM Bool selectionDataSetPixbuf pixbuf = do selPtr <- ask liftM toBool $ liftIO $ {#call unsafe gtk_selection_data_set_pixbuf #} selPtr pixbuf -- %hash c:52cd d:af3f -- | Gets the contents of the selection data as a 'Pixbuf'. -- -- * Since Gtk 2.6. -- selectionDataGetPixbuf :: SelectionDataM (Maybe Pixbuf) selectionDataGetPixbuf = do selPtr <- ask liftIO $ maybeNull (wrapNewGObject mkPixbuf) $ {#call unsafe gtk_selection_data_get_pixbuf #} selPtr -- %hash c:d222 d:af3f -- | Sets the contents of the selection from a list of URIs. The string is -- converted to the form determined by the possible targets of the selection. -- -- * Returns @True@ if setting the URIs was successful. Since Gtk 2.6. -- selectionDataSetURIs :: GlibString string => [string] -> SelectionDataM Bool selectionDataSetURIs uris = do selPtr <- ask liftIO $ liftM toBool $ withUTFStringArray0 uris $ \strPtrPtr -> {#call unsafe gtk_selection_data_set_uris #} selPtr strPtrPtr -- %hash c:472f d:af3f -- | Gets the contents of the selection data as list of URIs. Returns -- @Nothing@ if the selection did not contain any URIs. -- -- * Since Gtk 2.6. -- selectionDataGetURIs :: GlibString string => SelectionDataM (Maybe [string]) selectionDataGetURIs = do selPtr <- ask liftIO $ do strPtrPtr <- {#call unsafe gtk_selection_data_get_uris #} selPtr if strPtrPtr==nullPtr then return Nothing else do uris <- peekUTFStringArray0 strPtrPtr {#call unsafe g_strfreev#} strPtrPtr return (Just uris) #endif -- | Retrieve the currently set 'TargetTag' in the selection. selectionDataGetTarget :: SelectionDataM TargetTag selectionDataGetTarget = do selPtr <- ask liftM Atom $ liftIO $ selectionDataGet_target selPtr #if GTK_MAJOR_VERSION < 3 -- | Set the selection to the given 'TargetTag'. -- -- Removed in Gtk3. selectionDataSetTarget :: TargetTag -> SelectionDataM () selectionDataSetTarget (Atom targetTag) = do selPtr <- ask liftIO $ {#set SelectionData -> target#} selPtr targetTag #endif -- %hash c:e659 d:af3f -- | Queries the content type of the selection data as a list of targets. -- Whenever the application is asked whether certain targets are acceptable, -- it is handed a selection that contains a list of 'TargetTag's as payload. -- A similar result could be achieved using 'selectionDataGet -- selectionTypeAtom'. -- selectionDataGetTargets :: SelectionDataM [TargetTag] selectionDataGetTargets = do selPtr <- ask liftIO $ alloca $ \nAtomsPtr -> alloca $ \targetPtrPtr -> do valid <- liftM toBool $ {#call unsafe gtk_selection_data_get_targets #} selPtr targetPtrPtr nAtomsPtr if not valid then return [] else do len <- peek nAtomsPtr targetPtr <- peek targetPtrPtr targetPtrs <- peekArray (fromIntegral len) targetPtr {#call unsafe g_free#} (castPtr targetPtr) return (map Atom targetPtrs) #if GTK_CHECK_VERSION(2,6,0) -- %hash c:5a8 d:af3f -- | Given a 'SelectionDataM' holding a list of targets, determines if any of -- the targets in targets can be used to provide a 'Pixbuf'. -- -- * Since Gtk 2.6 -- selectionDataTargetsIncludeImage :: Bool -- ^ whether to accept only targets for which GTK+ knows how to convert a -- pixbuf into the format -> SelectionDataM Bool selectionDataTargetsIncludeImage writable = do selPtr <- ask liftM toBool $ liftIO $ {#call unsafe gtk_selection_data_targets_include_image #} selPtr (fromBool writable) #endif -- %hash c:abe8 d:af3f -- | Given a 'SelectionDataM' holding a list of targets, determines if any of -- the targets in targets can be used to provide text. -- selectionDataTargetsIncludeText :: SelectionDataM Bool selectionDataTargetsIncludeText = do selPtr <- ask liftM toBool $ liftIO $ {#call unsafe gtk_selection_data_targets_include_text #} selPtr #if GTK_CHECK_VERSION(2,10,0) -- | Given a 'SelectionDataM' holding a list of targets, determines if any of -- the targets in targets can be used to provide URIs. -- -- * Since Gtk 2.10 -- selectionDataTargetsIncludeUri :: SelectionDataM Bool selectionDataTargetsIncludeUri = do selPtr <- ask liftM toBool $ liftIO $ {#call unsafe gtk_selection_data_targets_include_uri #} selPtr -- | Given a 'SelectionDataM' holding a list of targets, check if, -- well, dunno really. FIXME: what does the 'TextBuffer' do? -- -- * Since Gtk 2.10 -- selectionDataTargetsIncludeRichText :: TextBufferClass tb => tb -> SelectionDataM Bool selectionDataTargetsIncludeRichText tb = do selPtr <- ask liftM toBool $ liftIO $ {#call unsafe gtk_selection_data_targets_include_rich_text #} selPtr (toTextBuffer tb) #endif -------------------- -- Signals -- %hash c:f7c3 d:af3f -- | Pass the supplied selection data to the application. The application is -- expected to read the data using 'selectionDataGet' or one of its -- derivatives. -- selectionReceived :: WidgetClass self => Signal self (TimeStamp -> SelectionDataM ()) selectionReceived = Signal (\after object handler -> do connect_PTR_WORD__NONE "selection-received" after object $ \dataPtr time -> do runReaderT (handler (fromIntegral time)) dataPtr >> return ()) -- %hash c:c3 d:af3f -- | Emitted in order to ask the application for selection data. Within the -- handler the function 'selectionDataSet' or one of its derivatives should be -- called. -- selectionGet :: WidgetClass self => Signal self (InfoId -> TimeStamp -> SelectionDataM ()) selectionGet = Signal (\after object handler -> do connect_PTR_WORD_WORD__NONE "selection-get" after object $ \dataPtr info time -> do runReaderT (handler (fromIntegral info) (fromIntegral time)) dataPtr >> return ()) gtk-0.15.9/Graphics/UI/Gtk/General/Settings.chs0000644000000000000000000000571107346545000017246 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Clipboard -- -- Author : Axel Simon -- -- Created: 26 March 2007 -- -- Copyright (C) 2007 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. -- -- I removed all definitions for the clipboard by Juergen Nicklisch since -- the way the clipboards were selected didn't tie in with the Selection -- module. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Storing data on clipboards -- module Graphics.UI.Gtk.General.Settings ( -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----Settings -- @ -- * Types Settings, SettingsClass, castToSettings, gTypeSettings, toSettings, -- * Methods settingsGetDefault, #if GTK_CHECK_VERSION(2,2,0) settingsGetForScreen, #endif settingsSetLongProperty, settingsSetStringProperty ) where import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Gets the Settings object for the default GDK screen, creating -- it if necessary. See 'settingsGetForScreen'. -- settingsGetDefault :: IO (Maybe Settings) -- ^ returns a Settings. If there is no default -- screen, then returns Nothing. settingsGetDefault = maybeNull (makeNewGObject mkSettings) {# call gtk_settings_get_default #} #if GTK_CHECK_VERSION(2,2,0) -- | Gets the Settings object for screen, creating it if necessary. -- settingsGetForScreen :: ScreenClass screen => screen -> IO Settings settingsGetForScreen screen = makeNewGObject mkSettings $ {# call gtk_settings_get_for_screen #} (toScreen screen) #endif settingsSetLongProperty :: (SettingsClass settings, GlibString string) => settings -> string -> Int -> string -> IO () settingsSetLongProperty settings name value origin = withUTFString name $ \namePtr -> withUTFString origin $ \originPtr -> {# call gtk_settings_set_long_property #} (toSettings settings) namePtr (fromIntegral value) originPtr settingsSetStringProperty :: (SettingsClass settings, GlibString string) => settings -> string -> string -> string -> IO () settingsSetStringProperty settings name value origin = withUTFString name $ \namePtr -> withUTFString value $ \valuePtr -> withUTFString origin $ \originPtr -> {# call gtk_settings_set_string_property #} (toSettings settings) namePtr valuePtr originPtr gtk-0.15.9/Graphics/UI/Gtk/General/StockItems.hsc0000644000000000000000000006756307346545000017550 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- #include #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) StockItems -- -- Author : Axel Simon -- -- Created: 24 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A StockItem is a resource that is know throughout Gtk. -- -- * Defining you own 'Graphics.UI.Gtk.General.IconFactory.IconSet's -- as 'StockItem's will make it possible for Gtk to choose the most -- appropriate sizes and enables themes to override your built in -- icons. A couple of constants are defined here as well. They are -- useful in accessing Gtk's predefined items. -- module Graphics.UI.Gtk.General.StockItems ( StockItem(StockItem), StockId, siStockId, siLabel, siModifier, siKeyval, siTransDom, stockAddItem, stockLookupItem, stockListIds, stockAbout, stockAdd, stockApply, stockBold, stockCancel, #if GTK_CHECK_VERSION(2,16,0) stockCapsLockWarning, #endif stockCDROM, stockClear, stockClose, stockColorPicker, stockConvert, stockConnect, stockCopy, stockCut, stockDelete, stockDialogAuthentication, stockDialogError, stockDialogInfo, stockDialogQuestion, stockDialogWarning, stockDirectory, #if GTK_CHECK_VERSION(2,12,0) stockDiscard, #endif stockDisconnect, stockDnd, stockDndMultiple, stockEdit, stockExecute, stockFile, stockFind, stockFindAndRelpace, stockFloppy, stockFullscreen, stockGotoBottom, stockGotoFirst, stockGotoLast, stockGotoTop, stockGoBack, stockGoDown, stockGoForward, stockGoUp, stockHarddisk, stockHelp, stockHome, stockIndent, stockIndex, stockInfo, stockItalic, stockJumpTo, stockJustifyCenter, stockJustifyFill, stockJustifyLeft, stockJustifyRight, stockLeaveFullscreen, stockMediaForward, stockMediaNext, stockMediaPause, stockMediaPlay, stockMediaPrevious, stockMediaRecord, stockMediaRewind, stockMediaStop, stockMissingImage, stockNetwork, stockNew, stockNo, stockOk, stockOpen, #if GTK_CHECK_VERSION(2,10,0) stockOrientationLandscape, stockOrientationReverseLandscape, stockOrientationPortrait, stockOrientationReversePortrait, #endif #if GTK_CHECK_VERSION(2,14,0) stockPageSetup, #endif stockPaste, stockPreferences, stockPrint, #if GTK_CHECK_VERSION(2,14,0) stockPrintError, stockPrintPaused, stockPrintReport, stockPrintWarning, #endif stockPrintPreview, stockProperties, stockQuit, stockRedo, stockRefresh, stockRemove, stockRevertToSaved, stockSave, stockSaveAs, #if GTK_CHECK_VERSION(2,10,0) stockSelectAll, #endif stockSelectColor, stockSelectFont, stockSortAscending, stockSortDescending, stockSpellCheck, stockStop, stockStrikethrough, stockUndelete, stockUnderline, stockUndo, stockUnindent, stockYes, stockZoom100, stockZoomFit, stockZoomIn, stockZoomOut ) where -- The StockItem structure is completely marshaled to Haskell. It is -- possible to marshal all strings lazily because the string pointers are -- valid throughout the lifetime of the application. The only drawback it -- that a stock item that is replaced by the another item with the same -- name will never be freed. This deficiency is built into Gtk however. -- import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import System.Glib.GList (GSList, fromGSListRev) import Graphics.UI.Gtk.Gdk.Events (Modifier) import Graphics.UI.Gtk.Gdk.Keys (KeyVal) -- | A synonym for a standard button or icon. -- type StockId = DefaultGlibString -- Although the structure itself is allocated dynamically, its contents -- are not. All string pointers are constant throughout the lifetime of -- the application. We do not need to marshal these Strings to Haskell if -- they are not needed. -- -- | The description of a stock item. -- data StockItem = StockItem { siStockId :: StockId, siLabel :: DefaultGlibString, siModifier:: [Modifier], siKeyval :: KeyVal, siTransDom:: DefaultGlibString } instance Storable StockItem where sizeOf _ = #const sizeof(GtkStockItem) alignment _ = alignment (undefined::CString) peek siPtr = do (stockId :: CString) <- #{peek GtkStockItem, stock_id} siPtr (label :: CString) <- #{peek GtkStockItem, label} siPtr (modifier :: #gtk2hs_type GdkModifierType) <- #{peek GtkStockItem, modifier} siPtr (keyval :: #gtk2hs_type guint) <- #{peek GtkStockItem, keyval} siPtr (transDom :: CString) <- #{peek GtkStockItem, translation_domain} siPtr return $ StockItem { siStockId = unsafePerformIO $ peekUTFString' stockId, siLabel = unsafePerformIO $ peekUTFString' label, -- &%!?$ c2hs and hsc should agree on types siModifier = toFlags (fromIntegral modifier), siKeyval = keyval, siTransDom = unsafePerformIO $ peekUTFString' transDom } where peekUTFString' :: CString -> IO DefaultGlibString peekUTFString' strPtr | strPtr==nullPtr = return "" | otherwise = peekUTFString strPtr poke siPtr (StockItem { siStockId = stockId, siLabel = label, siModifier= modifier, siKeyval = keyval, siTransDom= transDom }) = do stockIdPtr <- newUTFString stockId #{poke GtkStockItem, stock_id} siPtr stockIdPtr labelPtr <- newUTFString label #{poke GtkStockItem, label} siPtr labelPtr #{poke GtkStockItem, modifier} siPtr ((fromIntegral (fromFlags modifier))::#{gtk2hs_type GdkModifierType}) #{poke GtkStockItem, keyval} siPtr ((fromIntegral keyval)::#{gtk2hs_type guint}) transDomPtr<- newUTFString transDom #{poke GtkStockItem, translation_domain} siPtr transDomPtr -- | Add new stock items to Gtk. -- -- Using stock_add_static would be possible if we used g_malloc to reserve -- space since the allocated space might actually be freed when another -- stock item with the same name is added. stockAddItem :: [StockItem] -> IO () stockAddItem [] = return () stockAddItem sis = let items = length sis in do allocaArray items $ \aPtr -> do pokeArray aPtr sis stock_add aPtr (fromIntegral items) -- | Lookup an item in stock. -- stockLookupItem :: StockId -> IO (Maybe StockItem) stockLookupItem stockId = alloca $ \siPtr -> withUTFString stockId $ \strPtr -> do res <- stock_lookup strPtr siPtr if (toBool res) then liftM Just $ peek siPtr else return Nothing -- | Produce a list of all known stock identifiers. -- -- * Retrieve a list of all known stock identifiers. These can either be -- added by 'stockAddItem' or by adding items to a -- 'Graphics.UI.Gtk.General.IconFactory.IconFactory'. -- -- * The list is sorted alphabetically (sorting is not Unicode aware). -- stockListIds :: IO [StockId] stockListIds = do lPtr <- stock_list_ids sPtrs <- fromGSListRev lPtr res <- mapM readUTFString sPtrs return res foreign import ccall unsafe "gtk_stock_add" stock_add :: Ptr StockItem -> #{gtk2hs_type guint} -> IO () foreign import ccall unsafe "gtk_stock_lookup" stock_lookup :: CString -> Ptr StockItem -> IO #gtk2hs_type gboolean foreign import ccall unsafe "gtk_stock_list_ids" stock_list_ids :: IO GSList #if GTK_CHECK_VERSION(2,6,0) -- | <> stockAbout :: StockId stockAbout = #{const_str GTK_STOCK_ABOUT} #else stockAbout = stockMissingImage #endif -- | <> stockAdd :: StockId stockAdd = #{const_str GTK_STOCK_ADD} -- | <> stockApply :: StockId stockApply = #{const_str GTK_STOCK_APPLY} -- | <> stockBold :: StockId stockBold = #{const_str GTK_STOCK_BOLD} -- | <> stockCancel :: StockId stockCancel = #{const_str GTK_STOCK_CANCEL} #if GTK_CHECK_VERSION(2,16,0) -- | <> stockCapsLockWarning :: StockId stockCapsLockWarning = #{const_str GTK_STOCK_CAPS_LOCK_WARNING} #endif -- | <> stockCDROM :: StockId stockCDROM = #{const_str GTK_STOCK_CDROM} -- | <> stockClear :: StockId stockClear = #{const_str GTK_STOCK_CLEAR} -- | <> stockClose :: StockId stockClose = #{const_str GTK_STOCK_CLOSE} #if GTK_CHECK_VERSION(2,2,0) -- | <> stockColorPicker :: StockId stockColorPicker = #{const_str GTK_STOCK_COLOR_PICKER} #else stockColorPicker = stockMissingImage #endif -- | <> stockConvert :: StockId stockConvert = #{const_str GTK_STOCK_CONVERT} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockConnect :: StockId stockConnect = #{const_str GTK_STOCK_CONNECT} #else stockConnect = stockMissingImage #endif -- | <> stockCopy :: StockId stockCopy = #{const_str GTK_STOCK_COPY} -- | <> stockCut :: StockId stockCut = #{const_str GTK_STOCK_CUT} -- | <> stockDelete :: StockId stockDelete = #{const_str GTK_STOCK_DELETE} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockDialogAuthentication :: StockId stockDialogAuthentication = #{const_str GTK_STOCK_DIALOG_AUTHENTICATION} #else stockDialogAuthentication = stockDialogQuestion #endif -- | <> stockDialogError :: StockId stockDialogError = #{const_str GTK_STOCK_DIALOG_ERROR} -- | <> stockDialogInfo :: StockId stockDialogInfo = #{const_str GTK_STOCK_DIALOG_INFO} -- | <> stockDialogQuestion :: StockId stockDialogQuestion = #{const_str GTK_STOCK_DIALOG_QUESTION} -- | <> stockDialogWarning :: StockId stockDialogWarning = #{const_str GTK_STOCK_DIALOG_WARNING} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockDirectory :: StockId stockDirectory = #{const_str GTK_STOCK_DIRECTORY} #else stockDirectory = stockMissingImage #endif #if GTK_CHECK_VERSION(2,12,0) -- | stockDiscard :: StockId stockDiscard = #{const_str GTK_STOCK_DISCARD} #endif #if GTK_CHECK_VERSION(2,6,0) -- | <> stockDisconnect :: StockId stockDisconnect = #{const_str GTK_STOCK_DISCONNECT} #else stockDisconnect = stockMissingImage #endif -- | <> stockDnd :: StockId stockDnd = #{const_str GTK_STOCK_DND} -- | <> stockDndMultiple :: StockId stockDndMultiple = #{const_str GTK_STOCK_DND_MULTIPLE} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockEdit :: StockId stockEdit = #{const_str GTK_STOCK_EDIT} #else stockEdit = stockMissingImage #endif -- | <> stockExecute :: StockId stockExecute = #{const_str GTK_STOCK_EXECUTE} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockFile :: StockId stockFile = #{const_str GTK_STOCK_FILE} #else stockFile = stockMissingImage #endif -- | <> stockFind :: StockId stockFind = #{const_str GTK_STOCK_FIND} -- | <> stockFindAndRelpace :: StockId stockFindAndRelpace = #{const_str GTK_STOCK_FIND_AND_REPLACE} -- | <> stockFloppy :: StockId stockFloppy = #{const_str GTK_STOCK_FLOPPY} #if GTK_CHECK_VERSION(2,8,0) -- | <> stockFullscreen :: StockId stockFullscreen = #{const_str GTK_STOCK_FULLSCREEN} #else stockFullscreen = stockMissingImage #endif -- | <> stockGotoBottom :: StockId stockGotoBottom = #{const_str GTK_STOCK_GOTO_BOTTOM} -- | <> -- <> stockGotoFirst :: StockId stockGotoFirst = #{const_str GTK_STOCK_GOTO_FIRST} -- | <> -- <> stockGotoLast :: StockId stockGotoLast = #{const_str GTK_STOCK_GOTO_LAST} -- | <> stockGotoTop :: StockId stockGotoTop = #{const_str GTK_STOCK_GOTO_TOP} -- | <> -- <> stockGoBack :: StockId stockGoBack = #{const_str GTK_STOCK_GO_BACK} -- | <> stockGoDown :: StockId stockGoDown = #{const_str GTK_STOCK_GO_DOWN} -- | <> -- <> stockGoForward :: StockId stockGoForward = #{const_str GTK_STOCK_GO_FORWARD} -- | <> stockGoUp :: StockId stockGoUp = #{const_str GTK_STOCK_GO_UP} #if GTK_CHECK_VERSION(2,4,0) -- | <> stockHarddisk :: StockId stockHarddisk = #{const_str GTK_STOCK_HARDDISK} #else stockHarddisk = stockMissingImage #endif -- | <> stockHelp :: StockId stockHelp = #{const_str GTK_STOCK_HELP} -- | <> stockHome :: StockId stockHome = #{const_str GTK_STOCK_HOME} #if GTK_CHECK_VERSION(2,4,0) -- | <> -- <> stockIndent :: StockId stockIndent = #{const_str GTK_STOCK_INDENT} #else stockIndent = stockMissingImage #endif -- | <> stockIndex :: StockId stockIndex = #{const_str GTK_STOCK_INDEX} #if GTK_CHECK_VERSION(2,8,0) -- | <> stockInfo :: StockId stockInfo = #{const_str GTK_STOCK_INFO} #else stockInfo = stockMissingImage #endif -- | <> stockItalic :: StockId stockItalic = #{const_str GTK_STOCK_ITALIC} -- | <> -- <> stockJumpTo :: StockId stockJumpTo = #{const_str GTK_STOCK_JUMP_TO} -- | <> stockJustifyCenter :: StockId stockJustifyCenter = #{const_str GTK_STOCK_JUSTIFY_CENTER} -- | <> stockJustifyFill :: StockId stockJustifyFill = #{const_str GTK_STOCK_JUSTIFY_FILL} -- | <> stockJustifyLeft :: StockId stockJustifyLeft = #{const_str GTK_STOCK_JUSTIFY_LEFT} -- | <> stockJustifyRight :: StockId stockJustifyRight = #{const_str GTK_STOCK_JUSTIFY_RIGHT} -- | <> stockLeaveFullscreen :: StockId stockLeaveFullscreen = #{const_str GTK_STOCK_LEAVE_FULLSCREEN} -- | <> stockMissingImage :: StockId stockMissingImage = #{const_str GTK_STOCK_MISSING_IMAGE} #if GTK_CHECK_VERSION(2,6,0) -- | <> -- <> stockMediaForward :: StockId stockMediaForward = #{const_str GTK_STOCK_MEDIA_FORWARD} -- | <> -- <> stockMediaNext :: StockId stockMediaNext = #{const_str GTK_STOCK_MEDIA_NEXT} -- | <> stockMediaPause :: StockId stockMediaPause = #{const_str GTK_STOCK_MEDIA_PAUSE} -- | <> -- <> stockMediaPlay :: StockId stockMediaPlay = #{const_str GTK_STOCK_MEDIA_PLAY} -- | <> -- <> stockMediaPrevious :: StockId stockMediaPrevious = #{const_str GTK_STOCK_MEDIA_PREVIOUS} -- | <> stockMediaRecord :: StockId stockMediaRecord = #{const_str GTK_STOCK_MEDIA_RECORD} -- | <> -- <> stockMediaRewind :: StockId stockMediaRewind = #{const_str GTK_STOCK_MEDIA_REWIND} -- | <> stockMediaStop :: StockId stockMediaStop = #{const_str GTK_STOCK_MEDIA_STOP} #else stockMediaForward = stockMissingImage stockMediaNext = stockMissingImage stockMediaPause = stockMissingImage stockMediaPlay = stockMissingImage stockMediaPrevious = stockMissingImage stockMediaRecord = stockMissingImage stockMediaRewind = stockMissingImage stockMediaStop = stockMissingImage #endif #if GTK_CHECK_VERSION(2,4,0) -- | <> stockNetwork :: StockId stockNetwork = #{const_str GTK_STOCK_NETWORK} #else stockNetwork = stockMissingImage #endif -- | <> stockNew :: StockId stockNew = #{const_str GTK_STOCK_NEW} -- | <> stockNo :: StockId stockNo = #{const_str GTK_STOCK_NO} -- | <> stockOk :: StockId stockOk = #{const_str GTK_STOCK_OK} -- | <> stockOpen :: StockId stockOpen = #{const_str GTK_STOCK_OPEN} #if GTK_CHECK_VERSION(2,10,0) -- | <> stockOrientationLandscape :: StockId stockOrientationLandscape = #{const_str GTK_STOCK_ORIENTATION_LANDSCAPE} -- | <> stockOrientationReverseLandscape :: StockId stockOrientationReverseLandscape = #{const_str GTK_STOCK_ORIENTATION_REVERSE_LANDSCAPE} -- | <> stockOrientationPortrait :: StockId stockOrientationPortrait = #{const_str GTK_STOCK_ORIENTATION_PORTRAIT} -- | <> stockOrientationReversePortrait :: StockId stockOrientationReversePortrait = #{const_str GTK_STOCK_ORIENTATION_REVERSE_PORTRAIT} #else stockOrientationLandscape = stockMissingImage stockOrientationReverseLandscape = stockMissingImage stockOrientationPortrait = stockMissingImage stockOrientationReversePortrait = stockMissingImage #endif #if GTK_CHECK_VERSION(2,14,0) -- | <> stockPageSetup :: StockId stockPageSetup = #{const_str GTK_STOCK_PAGE_SETUP} #endif -- | <> stockPaste :: StockId stockPaste = #{const_str GTK_STOCK_PASTE} -- | <> stockPreferences :: StockId stockPreferences = #{const_str GTK_STOCK_PREFERENCES} -- | <> stockPrint :: StockId stockPrint = #{const_str GTK_STOCK_PRINT} #if GTK_CHECK_VERSION(2,14,0) -- | <> stockPrintError :: StockId stockPrintError = #{const_str GTK_STOCK_PRINT_ERROR} -- | <> stockPrintPaused :: StockId stockPrintPaused = #{const_str GTK_STOCK_PRINT_PAUSED} -- | <> stockPrintReport :: StockId stockPrintReport = #{const_str GTK_STOCK_PRINT_REPORT} -- | <> stockPrintWarning :: StockId stockPrintWarning = #{const_str GTK_STOCK_PRINT_WARNING} #endif -- | <> stockPrintPreview :: StockId stockPrintPreview = #{const_str GTK_STOCK_PRINT_PREVIEW} -- | <> stockProperties :: StockId stockProperties = #{const_str GTK_STOCK_PROPERTIES} -- | <> stockQuit :: StockId stockQuit = #{const_str GTK_STOCK_QUIT} -- | <> -- <> stockRedo :: StockId stockRedo = #{const_str GTK_STOCK_REDO} -- | <> stockRefresh :: StockId stockRefresh = #{const_str GTK_STOCK_REFRESH} -- | <> stockRemove :: StockId stockRemove = #{const_str GTK_STOCK_REMOVE} -- | <> -- <> stockRevertToSaved :: StockId stockRevertToSaved = #{const_str GTK_STOCK_REVERT_TO_SAVED} -- | <> stockSave :: StockId stockSave = #{const_str GTK_STOCK_SAVE} -- | <> stockSaveAs :: StockId stockSaveAs = #{const_str GTK_STOCK_SAVE_AS} #if GTK_CHECK_VERSION(2,10,0) -- | <> stockSelectAll :: StockId stockSelectAll = #{const_str GTK_STOCK_SELECT_ALL} #else stockSelectAll = stockMissingImage #endif -- | <> stockSelectColor :: StockId stockSelectColor = #{const_str GTK_STOCK_SELECT_COLOR} -- | <> stockSelectFont :: StockId stockSelectFont = #{const_str GTK_STOCK_SELECT_FONT} -- | <> stockSortAscending :: StockId stockSortAscending = #{const_str GTK_STOCK_SORT_ASCENDING} -- | <> stockSortDescending :: StockId stockSortDescending = #{const_str GTK_STOCK_SORT_DESCENDING} -- | <> stockSpellCheck :: StockId stockSpellCheck = #{const_str GTK_STOCK_SPELL_CHECK} -- | <> stockStop :: StockId stockStop = #{const_str GTK_STOCK_STOP} -- | <> stockStrikethrough :: StockId stockStrikethrough = #{const_str GTK_STOCK_STRIKETHROUGH} -- | <> -- <> stockUndelete :: StockId stockUndelete = #{const_str GTK_STOCK_UNDELETE} -- | <> stockUnderline :: StockId stockUnderline = #{const_str GTK_STOCK_UNDERLINE} -- | <> -- <> stockUndo :: StockId stockUndo = #{const_str GTK_STOCK_UNDO} #if GTK_CHECK_VERSION(2,4,0) -- | <> -- <> stockUnindent :: StockId stockUnindent = #{const_str GTK_STOCK_UNINDENT} #else stockUnindent = stockMissingImage #endif -- | <> stockYes :: StockId stockYes = #{const_str GTK_STOCK_YES} -- | <> stockZoom100 :: StockId stockZoom100 = #{const_str GTK_STOCK_ZOOM_100} -- | <> stockZoomFit :: StockId stockZoomFit = #{const_str GTK_STOCK_ZOOM_FIT} -- | <> stockZoomIn :: StockId stockZoomIn = #{const_str GTK_STOCK_ZOOM_IN} -- | <> stockZoomOut :: StockId stockZoomOut = #{const_str GTK_STOCK_ZOOM_OUT} gtk-0.15.9/Graphics/UI/Gtk/General/Structs.hsc0000644000000000000000000012107307346545000017115 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- -*-haskell-*- #include #include #include "template-hsc-gtk2hs.h" #if GTK_MAJOR_VERSION >= 3 #include #endif -- GIMP Toolkit (GTK) Structures -- -- Author : Axel Simon -- -- Created: 2 May 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 -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- module Graphics.UI.Gtk.General.Structs ( Point, Rectangle(..), Color(..), #if GTK_MAJOR_VERSION >= 3 RGBA(..), #endif #if GTK_MAJOR_VERSION < 3 GCValues(..), pokeGCValues, newGCValues, widgetGetState, widgetGetSavedState, #endif Allocation, Requisition(..), treeIterSize, textIterSize, inputError, #if GTK_MAJOR_VERSION < 3 dialogGetUpper, dialogGetActionArea, fileSelectionGetButtons, #endif ResponseId(..), fromResponse, toResponse, #if !defined(WIN32) || GTK_CHECK_VERSION(2,8,0) NativeWindowId, toNativeWindowId, fromNativeWindowId, nativeWindowIdNone, #endif drawableGetID, #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED toolbarChildButton, toolbarChildToggleButton, toolbarChildRadioButton, #endif #endif IconSize(..), #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED comboGetList, #endif widgetGetDrawWindow, widgetGetSize, windowGetFrame, #endif styleGetForeground, styleGetBackground, styleGetLight, styleGetMiddle, styleGetDark, styleGetText, styleGetBase, styleGetAntiAliasing, #if GTK_MAJOR_VERSION < 3 colorSelectionDialogGetColor, colorSelectionDialogGetOkButton, colorSelectionDialogGetCancelButton, colorSelectionDialogGetHelpButton, dragContextGetActions, dragContextSetActions, dragContextGetSuggestedAction, dragContextSetSuggestedAction, dragContextGetAction, dragContextSetAction, #endif SortColumnId, treeSortableDefaultSortColumnId, tagInvalid, selectionPrimary, selectionSecondary, selectionClipboard, targetString, selectionTypeAtom, selectionTypeInteger, selectionTypeString, #if GTK_MAJOR_VERSION < 3 selectionDataGetType, #endif withTargetEntries, KeymapKey (..) ) where import Control.Monad (liftM) import Data.IORef import Control.Exception (handle, ErrorCall(..)) import System.Glib.FFI import System.Glib.UTFString ( UTFCorrection, ofsToUTF ) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import System.Glib.GObject (makeNewGObject) import Graphics.UI.Gtk.Types #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Enums (Function, Fill, SubwindowMode, LineStyle, CapStyle, JoinStyle) #endif import Graphics.UI.Gtk.General.Enums (StateType) import Graphics.UI.Gtk.General.DNDTypes (InfoId, Atom(Atom) , SelectionTag, TargetTag, SelectionTypeTag) import Graphics.Rendering.Pango.Structs ( Color(..), Rectangle(..) ) #if !defined(WIN32) || GTK_CHECK_VERSION(2,14,0) #else import Unsafe.Coerce #endif -- | Represents the x and y coordinate of a point. -- type Point = (Int, Int) instance Storable Point where sizeOf _ = #{const sizeof(GdkPoint)} alignment _ = alignment (undefined:: #gtk2hs_type gint) peek ptr = do (x_ ::#gtk2hs_type gint) <- #{peek GdkPoint, x} ptr (y_ ::#gtk2hs_type gint) <- #{peek GdkPoint, y} ptr return $ (fromIntegral x_, fromIntegral y_) poke ptr (x, y) = do #{poke GdkPoint, x} ptr ((fromIntegral x)::#gtk2hs_type gint) #{poke GdkPoint, y} ptr ((fromIntegral y)::#gtk2hs_type gint) instance Storable Rectangle where sizeOf _ = #{const sizeof(GdkRectangle)} alignment _ = alignment (undefined:: #gtk2hs_type gint) peek ptr = do (x_ ::#gtk2hs_type gint) <- #{peek GdkRectangle, x} ptr (y_ ::#gtk2hs_type gint) <- #{peek GdkRectangle, y} ptr (width_ ::#gtk2hs_type gint) <- #{peek GdkRectangle, width} ptr (height_ ::#gtk2hs_type gint) <- #{peek GdkRectangle, height} ptr return $ Rectangle (fromIntegral x_) (fromIntegral y_) (fromIntegral width_) (fromIntegral height_) poke ptr (Rectangle x y width height) = do #{poke GdkRectangle, x} ptr ((fromIntegral x)::#gtk2hs_type gint) #{poke GdkRectangle, y} ptr ((fromIntegral y)::#gtk2hs_type gint) #{poke GdkRectangle, width} ptr ((fromIntegral width)::#gtk2hs_type gint) #{poke GdkRectangle, height} ptr ((fromIntegral height)::#gtk2hs_type gint) instance Storable Color where sizeOf _ = #{const sizeof(GdkColor)} alignment _ = alignment (undefined::#gtk2hs_type guint32) peek ptr = do red <- #{peek GdkColor, red} ptr green <- #{peek GdkColor, green} ptr blue <- #{peek GdkColor, blue} ptr return $ Color red green blue poke ptr (Color red green blue) = do #{poke GdkColor, pixel} ptr (0::#{gtk2hs_type gint32}) #{poke GdkColor, red} ptr red #{poke GdkColor, green} ptr green #{poke GdkColor, blue} ptr blue #if GTK_MAJOR_VERSION < 3 cPtr <- gdkColormapGetSystem gdkColormapAllocColor cPtr ptr 0 1 #endif return () #if GTK_MAJOR_VERSION >= 3 data RGBA = RGBA Double Double Double Double instance Storable RGBA where sizeOf _ = #{const sizeof(GdkRGBA)} alignment _ = alignment (undefined::#gtk2hs_type guint32) peek ptr = do red <- #{peek GdkRGBA, red} ptr green <- #{peek GdkRGBA, green} ptr blue <- #{peek GdkRGBA, blue} ptr alpha <- #{peek GdkRGBA, alpha} ptr return $ RGBA red green blue alpha poke ptr (RGBA red green blue alpha) = do #{poke GdkRGBA, red} ptr red #{poke GdkRGBA, green} ptr green #{poke GdkRGBA, blue} ptr blue #{poke GdkRGBA, alpha} ptr alpha return () #endif #if GTK_MAJOR_VERSION < 3 type ColorMap = () foreign import ccall unsafe "gdk_colormap_get_system" gdkColormapGetSystem :: IO (Ptr ColorMap) foreign import ccall unsafe "gdk_colormap_alloc_color" gdkColormapAllocColor :: Ptr ColorMap -> Ptr Color -> CInt -> CInt -> IO CInt foreign import ccall unsafe "gdk_colormap_query_color" gdkColormapQueryColor :: Ptr ColorMap -> CULong -> Ptr Color -> IO () -- entry GC -- | Intermediate data structure for 'GC's. -- -- * If @graphicsExposure@ is set then copying portions into a -- drawable will generate an @\"exposure\"@ event, even if the -- destination area is not currently visible. -- -- Removed in Gtk3. data GCValues = GCValues { foreground :: Color, background :: Color, function :: Function, fill :: Fill, tile :: Maybe Pixmap, stipple :: Maybe Pixmap, clipMask :: Maybe Pixmap, subwindowMode :: SubwindowMode, tsXOrigin :: Int, tsYOrigin :: Int, clipXOrigin:: Int, clipYOrigin:: Int, graphicsExposure :: Bool, lineWidth :: Int, lineStyle :: LineStyle, capStyle :: CapStyle, joinStyle :: JoinStyle } instance Storable GCValues where sizeOf _ = #{const sizeof(GdkGCValues)} alignment _ = alignment (undefined::Color) peek ptr = do -- gdk_gc_get_values does not fill in the r,g,b members of the foreground -- and background colours (it only fills in the allocated pixel value), -- so we have to fill them in here: let foregroundPtr, backgroundPtr :: Ptr Color foregroundPtr = #{ptr GdkGCValues, foreground} ptr backgroundPtr = #{ptr GdkGCValues, background} ptr (foregroundPixelPtr :: CULong) <- #{peek GdkColor, pixel} foregroundPtr (backgroundPixelPtr :: CULong) <- #{peek GdkColor, pixel} backgroundPtr colormapPtr <- gdkColormapGetSystem gdkColormapQueryColor colormapPtr foregroundPixelPtr foregroundPtr gdkColormapQueryColor colormapPtr backgroundPixelPtr backgroundPtr foreground_ <- peek (#{ptr GdkGCValues, foreground} ptr) background_ <- peek (#{ptr GdkGCValues, background} ptr) (function_ :: #{gtk2hs_type GdkFunction}) <- #{peek GdkGCValues, function} ptr (fill_ :: #{gtk2hs_type GdkFill}) <- #{peek GdkGCValues, fill} ptr tile_ <- do pPtr <- #{peek GdkGCValues, tile} ptr if (pPtr==nullPtr) then return Nothing else liftM Just $ makeNewGObject mkPixmap $ return pPtr stipple_ <- do pPtr <- #{peek GdkGCValues, stipple} ptr if (pPtr==nullPtr) then return Nothing else liftM Just $ makeNewGObject mkPixmap $ return pPtr clipMask_ <- do pPtr <- #{peek GdkGCValues, clip_mask} ptr if (pPtr==nullPtr) then return Nothing else liftM Just $ makeNewGObject mkPixmap $ return pPtr (subwindow_ :: #{gtk2hs_type GdkSubwindowMode}) <- #{peek GdkGCValues, subwindow_mode} ptr (tsXOrigin_ :: #{gtk2hs_type gint}) <- #{peek GdkGCValues, ts_x_origin} ptr (tsYOrigin_ :: #{gtk2hs_type gint}) <- #{peek GdkGCValues, ts_y_origin} ptr (clipXOrigin_:: #{gtk2hs_type gint}) <- #{peek GdkGCValues, clip_x_origin} ptr (clipYOrigin_:: #{gtk2hs_type gint}) <- #{peek GdkGCValues, clip_y_origin} ptr (graphics_ :: #{gtk2hs_type gint}) <- #{peek GdkGCValues, graphics_exposures} ptr (lineWidth_ :: #{gtk2hs_type gint}) <- #{peek GdkGCValues, line_width} ptr (lineStyle_ :: #{gtk2hs_type GdkLineStyle}) <- #{peek GdkGCValues, line_style} ptr (capStyle_ :: #{gtk2hs_type GdkCapStyle}) <- #{peek GdkGCValues, cap_style} ptr (joinStyle_ :: #{gtk2hs_type GdkJoinStyle}) <- #{peek GdkGCValues, join_style} ptr return $ GCValues { foreground = foreground_, background = background_, function = (toEnum.fromIntegral) function_, fill = (toEnum.fromIntegral) fill_, tile = tile_, stipple = stipple_, clipMask = clipMask_, subwindowMode = (toEnum.fromIntegral) subwindow_, tsXOrigin = fromIntegral tsXOrigin_, tsYOrigin = fromIntegral tsYOrigin_, clipXOrigin= fromIntegral clipXOrigin_, clipYOrigin= fromIntegral clipYOrigin_, graphicsExposure = toBool graphics_, lineWidth = fromIntegral lineWidth_, lineStyle = (toEnum.fromIntegral) lineStyle_, capStyle = (toEnum.fromIntegral) capStyle_, joinStyle = (toEnum.fromIntegral) joinStyle_ } poke = error "GCValues poke undefined (not sure why)" pokeGCValues :: Ptr GCValues -> GCValues -> IO CInt pokeGCValues ptr (GCValues { foreground = foreground_, background = background_, function = function_, fill = fill_, tile = tile_, stipple = stipple_, clipMask = clipMask_, subwindowMode = subwindow_, tsXOrigin = tsXOrigin_, tsYOrigin = tsYOrigin_, clipXOrigin= clipXOrigin_, clipYOrigin= clipYOrigin_, graphicsExposure = graphics_, lineWidth = lineWidth_, lineStyle = lineStyle_, capStyle = capStyle_, joinStyle = joinStyle_ }) = do r <- newIORef 0 add r #{const GDK_GC_FOREGROUND } $ poke (#{ptr GdkGCValues, foreground} ptr) foreground_ add r #{const GDK_GC_BACKGROUND } $ poke (#{ptr GdkGCValues, background} ptr) background_ add r #{const GDK_GC_FUNCTION } $ #{poke GdkGCValues, function} ptr (fromIntegral (fromEnum function_):: #{gtk2hs_type GdkFunction}) add r #{const GDK_GC_FILL } $ #{poke GdkGCValues, fill} ptr (fromIntegral (fromEnum fill_):: #{gtk2hs_type GdkFill}) case tile_ of Nothing -> return () Just tile_ -> add r #{const GDK_GC_TILE} $ withForeignPtr (unPixmap tile_) $ #{poke GdkGCValues, tile} ptr case stipple_ of Nothing -> return () Just stipple_ -> add r #{const GDK_GC_STIPPLE} $ withForeignPtr (unPixmap stipple_) $ #{poke GdkGCValues, stipple} ptr case clipMask_ of Nothing -> return () Just clipMask_ -> add r #{const GDK_GC_CLIP_MASK } $ withForeignPtr (unPixmap clipMask_) $ #{poke GdkGCValues, clip_mask} ptr add r #{const GDK_GC_SUBWINDOW } $ #{poke GdkGCValues, subwindow_mode} ptr (fromIntegral (fromEnum subwindow_):: #{gtk2hs_type GdkSubwindowMode}) add r #{const GDK_GC_TS_X_ORIGIN } $ #{poke GdkGCValues, ts_x_origin } ptr (fromIntegral tsXOrigin_:: #{gtk2hs_type gint}) add r #{const GDK_GC_TS_Y_ORIGIN } $ #{poke GdkGCValues, ts_y_origin } ptr (fromIntegral tsYOrigin_:: #{gtk2hs_type gint}) add r #{const GDK_GC_CLIP_X_ORIGIN } $ #{poke GdkGCValues, clip_x_origin } ptr (fromIntegral clipXOrigin_:: #{gtk2hs_type gint}) add r #{const GDK_GC_CLIP_Y_ORIGIN } $ #{poke GdkGCValues, clip_y_origin } ptr (fromIntegral clipYOrigin_:: #{gtk2hs_type gint}) add r #{const GDK_GC_EXPOSURES } $ #{poke GdkGCValues, graphics_exposures } ptr (fromBool graphics_:: #{gtk2hs_type gint}) add r #{const GDK_GC_LINE_WIDTH } $ #{poke GdkGCValues, line_width } ptr (fromIntegral lineWidth_:: #{gtk2hs_type gint}) add r #{const GDK_GC_LINE_STYLE } $ #{poke GdkGCValues, line_style } ptr (fromIntegral (fromEnum lineStyle_):: #{gtk2hs_type GdkLineStyle}) add r #{const GDK_GC_CAP_STYLE } $ #{poke GdkGCValues, cap_style } ptr (fromIntegral (fromEnum capStyle_):: #{gtk2hs_type GdkCapStyle}) add r #{const GDK_GC_JOIN_STYLE } $ #{poke GdkGCValues, join_style } ptr (fromIntegral (fromEnum joinStyle_):: #{gtk2hs_type GdkJoinStyle}) readIORef r where add :: IORef CInt -> CInt -> IO () -> IO () add r mVal act = handle (\(ErrorCall _) -> return ()) $ do act modifyIORef r (\val -> val+mVal) -- constant newGCValues An empty record of 'GCValues'. -- -- * Use this value instead of the constructor to avoid compiler wanings -- about uninitialized fields. -- -- Removed in Gtk3. newGCValues :: GCValues newGCValues = GCValues { foreground = undefined, background = undefined, function = undefined, fill = undefined, tile = Nothing, stipple = Nothing, clipMask = Nothing, subwindowMode = undefined, tsXOrigin = undefined, tsYOrigin = undefined, clipXOrigin= undefined, clipYOrigin= undefined, graphicsExposure = undefined, lineWidth = undefined, lineStyle = undefined, capStyle = undefined, joinStyle = undefined } #endif -- Widget related methods #if GTK_MAJOR_VERSION < 3 -- | Retrieve the current state of the widget. -- -- * The state refers to different modes of user interaction, see -- 'StateType' for more information. -- -- Removed in Gtk3. widgetGetState :: WidgetClass w => w -> IO StateType widgetGetState w = liftM (\x -> toEnum (fromIntegral (x :: #gtk2hs_type guint8))) $ withForeignPtr ((unWidget . toWidget) w) $ #{peek GtkWidget,state} -- | Retrieve the current state of the widget. -- -- * If a widget is turned insensitive, the previous state is stored in -- a specific location. This function retrieves this previous state. -- -- Removed in Gtk3. widgetGetSavedState :: WidgetClass w => w -> IO StateType widgetGetSavedState w = liftM (\x -> toEnum (fromIntegral (x :: #gtk2hs_type guint8))) $ withForeignPtr ((unWidget . toWidget) w) $ #{peek GtkWidget,saved_state} #endif -- | Allocation -- -- * For Widget's 'Graphics.UI.Gtk.Abstract.Widget.sizeAllocate' signal. -- The @x@ and @y@ values of the rectangle refer to the widgets position -- relative to its parent window. -- type Allocation = Rectangle -- | Requisition -- -- * For 'Graphics.UI.Gtk.Abstract.Widget.widgetSizeRequest'. The values -- represent the desired width and height of the widget. -- data Requisition = Requisition Int Int deriving (Eq,Show) instance Storable Requisition where sizeOf _ = #{const sizeof(GtkRequisition)} alignment _ = alignment (undefined::#gtk2hs_type gint) peek ptr = do (width_ ::#gtk2hs_type gint) <- #{peek GtkRequisition, width} ptr (height_ ::#gtk2hs_type gint) <- #{peek GtkRequisition, height} ptr return $ Requisition (fromIntegral width_) (fromIntegral height_) poke ptr (Requisition width height) = do #{poke GtkRequisition, width} ptr ((fromIntegral width)::#gtk2hs_type gint) #{poke GtkRequisition, height} ptr ((fromIntegral height)::#gtk2hs_type gint) -- SpinButton related mothods -- If an invalid input has been put into a SpinButton the input function may -- reject this value by returning this value. inputError :: #{gtk2hs_type gint} inputError = #{const GTK_INPUT_ERROR} -- The TreeIter struct is not used by itself. But we have to allocate space -- for it in module TreeModel. treeIterSize :: Int treeIterSize = #{const sizeof(GtkTreeIter)} -- The TextIter struct can be a local variable in a C program. We have to -- store it on the heap. -- textIterSize :: Int textIterSize = #{const sizeof(GtkTextIter)} -- Dialog related methods #if GTK_MAJOR_VERSION < 3 -- | Get the upper part of a dialog. -- -- * The upper part of a dialog window consists of a 'VBox'. -- Add the required widgets into this box. -- dialogGetUpper :: DialogClass dc => dc -> IO VBox dialogGetUpper dc = makeNewObject mkVBox $ liftM castPtr $ withForeignPtr ((unDialog.toDialog) dc) #{peek GtkDialog, vbox} -- | Extract the action area of a dialog box. -- -- * This -- is useful to add some special widgets that cannot be added with -- dialogAddActionWidget. -- dialogGetActionArea :: DialogClass dc => dc -> IO HBox dialogGetActionArea dc = makeNewObject mkHBox $ liftM castPtr $ withForeignPtr ((unDialog.toDialog) dc) #{peek GtkDialog, action_area} #endif -- | Some constructors that can be used as response -- numbers for dialogs. -- data ResponseId -- | GTK returns this if a response widget has no @response_id@, -- or if the dialog gets programmatically hidden or destroyed. = ResponseNone -- | GTK won't return these unless you pass them in as -- the response for an action widget. They are for your convenience. | ResponseReject | ResponseAccept -- ^ (as above) -- | If the dialog is deleted. | ResponseDeleteEvent -- | \"Ok\" was pressed. -- -- * This value is returned from the \"Ok\" stock dialog button. | ResponseOk -- | \"Cancel\" was pressed. -- -- * These value is returned from the \"Cancel\" stock dialog button. | ResponseCancel -- | \"Close\" was pressed. -- -- * This value is returned from the \"Close\" stock dialog button. | ResponseClose -- | \"Yes\" was pressed. -- -- * This value is returned from the \"Yes\" stock dialog button. | ResponseYes -- | \"No\" was pressed. -- -- * This value is returned from the \"No\" stock dialog button. | ResponseNo -- | \"Apply\" was pressed. -- -- * This value is returned from the \"Apply\" stock dialog button. | ResponseApply -- | \"Help\" was pressed. -- -- * This value is returned from the \"Help\" stock dialog button. | ResponseHelp -- | A user-defined response -- -- * This value is returned from a user defined button | ResponseUser Int deriving (Show, Eq) fromResponse :: Integral a => ResponseId -> a fromResponse ResponseNone = -1 fromResponse ResponseReject = -2 fromResponse ResponseAccept = -3 fromResponse ResponseDeleteEvent = -4 fromResponse ResponseOk = -5 fromResponse ResponseCancel = -6 fromResponse ResponseClose = -7 fromResponse ResponseYes = -8 fromResponse ResponseNo = -9 fromResponse ResponseApply = -10 fromResponse ResponseHelp = -11 fromResponse (ResponseUser i) = fromIntegral i toResponse :: Integral a => a -> ResponseId toResponse (-1) = ResponseNone toResponse (-2) = ResponseReject toResponse (-3) = ResponseAccept toResponse (-4) = ResponseDeleteEvent toResponse (-5) = ResponseOk toResponse (-6) = ResponseCancel toResponse (-7) = ResponseClose toResponse (-8) = ResponseYes toResponse (-9) = ResponseNo toResponse (-10) = ResponseApply toResponse (-11) = ResponseHelp toResponse i = ResponseUser $ fromIntegral i #if !defined(WIN32) || GTK_CHECK_VERSION(2,8,0) -- | The identifier of a window of the underlying windowing system. -- #if defined(GDK_NATIVE_WINDOW_POINTER) && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) --GDK Quartz also defined GDK_NATIVE_WINDOW_POINTER newtype NativeWindowId = NativeWindowId (Ptr ()) deriving (Eq, Show) unNativeWindowId :: NativeWindowId -> Ptr a unNativeWindowId (NativeWindowId id) = castPtr id toNativeWindowId :: Ptr a -> NativeWindowId toNativeWindowId = NativeWindowId . castPtr fromNativeWindowId :: NativeWindowId -> Ptr a fromNativeWindowId = castPtr . unNativeWindowId nativeWindowIdNone :: NativeWindowId nativeWindowIdNone = NativeWindowId nullPtr #elif defined(HAVE_QUARTZ_GTK) || defined(GDK_WINDOWING_QUARTZ) || (defined(WIN32) && GTK_MAJOR_VERSION >= 3) newtype NativeWindowId = NativeWindowId (Maybe DrawWindow) deriving (Eq) unNativeWindowId :: NativeWindowId -> Maybe DrawWindow unNativeWindowId (NativeWindowId id) = id toNativeWindowId :: Maybe DrawWindow -> NativeWindowId toNativeWindowId = NativeWindowId fromNativeWindowId :: NativeWindowId -> Maybe DrawWindow fromNativeWindowId = unNativeWindowId nativeWindowIdNone :: NativeWindowId nativeWindowIdNone = NativeWindowId Nothing #else #if GTK_MAJOR_VERSION < 3 newtype NativeWindowId = NativeWindowId #{gtk2hs_type GdkNativeWindow} deriving (Eq, Show) #else newtype NativeWindowId = NativeWindowId #{gtk2hs_type Window} deriving (Eq, Show) #endif unNativeWindowId :: Integral a => NativeWindowId -> a unNativeWindowId (NativeWindowId id) = fromIntegral id toNativeWindowId :: Integral a => a -> NativeWindowId toNativeWindowId = NativeWindowId . fromIntegral fromNativeWindowId :: Integral a => NativeWindowId -> a fromNativeWindowId = fromIntegral . unNativeWindowId nativeWindowIdNone :: NativeWindowId nativeWindowIdNone = NativeWindowId 0 #endif #endif #if GTK_MAJOR_VERSION < 3 #if defined(WIN32) foreign import ccall unsafe "gdk_win32_drawable_get_handle" gdk_win32_drawable_get_handle :: (Ptr Drawable) -> IO (Ptr a) #elif !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) foreign import ccall unsafe "gdk_x11_drawable_get_xid" gdk_x11_drawable_get_xid :: (Ptr Drawable) -> IO CInt #endif #else #if !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) && !defined(WIN32) foreign import ccall unsafe "gdk_x11_window_get_xid" gdk_x11_drawable_get_xid :: (Ptr DrawWindow) -> IO CInt #endif #endif -- | Get 'NativeWindowId' of 'Drawable'. #if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) drawableGetID :: DrawableClass d => d -> IO NativeWindowId #else drawableGetID :: DrawWindowClass d => d -> IO NativeWindowId #endif drawableGetID d = liftM toNativeWindowId $ #if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) (\(Drawable drawable) -> #else (\(DrawWindow drawable) -> #endif #if defined(WIN32) && GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,14,0) #else -- GTK-2.12 is a bit sloppy about the distinction between pointers and -- 32-bit ints, so we have to mimic that sloppiness here liftM unsafeCoerce $ #endif withForeignPtr drawable gdk_win32_drawable_get_handle #elif !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) && !defined(WIN32) withForeignPtr drawable gdk_x11_drawable_get_xid #else return $ Just (DrawWindow drawable) #endif #if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) ) (toDrawable d) #else ) (toDrawWindow d) #endif #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- Static values for different Toolbar widgets. -- -- * c2hs and hsc should agree on types! -- -- Removed in Gtk3. toolbarChildButton, toolbarChildToggleButton, toolbarChildRadioButton :: CInt -- \#gtk2hs_type GtkToolbarChildType toolbarChildButton = #const GTK_TOOLBAR_CHILD_BUTTON toolbarChildToggleButton = #const GTK_TOOLBAR_CHILD_TOGGLEBUTTON toolbarChildRadioButton = #const GTK_TOOLBAR_CHILD_RADIOBUTTON #endif #endif -- | The size of an icon in pixels. -- -- * This enumeration contains one case that is not exported and which -- is used when new sizes are registered using -- 'Graphics.UI.Gtk.General.IconFactory.iconSizeRegister'. -- -- * Applying 'show' to this type will reveal the name of the size -- that is registered with Gtk+. -- data IconSize -- | Don't scale but use any of the available sizes. = IconSizeInvalid -- | Icon size to use in next to menu items in drop-down menus. | IconSizeMenu -- | Icon size for small toolbars. | IconSizeSmallToolbar -- | Icon size for larger toolbars. | IconSizeLargeToolbar -- | Icon size for icons in buttons, next to the label. | IconSizeButton -- | Icon size for icons in drag-and-drop. | IconSizeDnd -- | Icon size for icons next to dialog text. | IconSizeDialog | IconSizeUser Int deriving (Eq) instance Enum IconSize where toEnum #{const GTK_ICON_SIZE_INVALID} = IconSizeInvalid toEnum #{const GTK_ICON_SIZE_MENU} = IconSizeMenu toEnum #{const GTK_ICON_SIZE_SMALL_TOOLBAR} = IconSizeSmallToolbar toEnum #{const GTK_ICON_SIZE_LARGE_TOOLBAR} = IconSizeLargeToolbar toEnum #{const GTK_ICON_SIZE_BUTTON} = IconSizeButton toEnum #{const GTK_ICON_SIZE_DND} = IconSizeDnd toEnum #{const GTK_ICON_SIZE_DIALOG} = IconSizeDialog toEnum n = IconSizeUser n fromEnum IconSizeInvalid = #{const GTK_ICON_SIZE_INVALID} fromEnum IconSizeMenu = #{const GTK_ICON_SIZE_MENU} fromEnum IconSizeSmallToolbar = #{const GTK_ICON_SIZE_SMALL_TOOLBAR} fromEnum IconSizeLargeToolbar = #{const GTK_ICON_SIZE_LARGE_TOOLBAR} fromEnum IconSizeButton = #{const GTK_ICON_SIZE_BUTTON} fromEnum IconSizeDnd = #{const GTK_ICON_SIZE_DND} fromEnum IconSizeDialog = #{const GTK_ICON_SIZE_DIALOG} fromEnum (IconSizeUser n) = n -- entry Widget Combo #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Extract the List container from a 'Combo' box. -- -- Removed in Gtk3. comboGetList :: Combo -> IO List comboGetList c = withForeignPtr (unCombo c) $ \cPtr -> makeNewObject mkList $ #{peek GtkCombo, list} cPtr #endif #endif -- FileSelection related methods #if GTK_MAJOR_VERSION < 3 -- | Extract the buttons of a fileselection. -- fileSelectionGetButtons :: FileSelectionClass fsel => fsel -> IO (Button, Button) fileSelectionGetButtons fsel = do ok <- butPtrToButton #{peek GtkFileSelection, ok_button} cancel <- butPtrToButton #{peek GtkFileSelection, cancel_button} return (ok,cancel) where butPtrToButton bp = makeNewObject mkButton $ liftM castPtr $ withForeignPtr ((unFileSelection . toFileSelection) fsel) bp #endif #if GTK_MAJOR_VERSION < 3 -- DrawingArea related methods -- | Retrieves the 'DrawWindow' that the widget draws onto. -- -- This function throws an error if the widget has not yet been realized, since -- a widget does not allocate its window resources until just before it is -- displayed on the screen. You can use the -- 'Graphics.UI.Gtk.Abstract.Widget.onRealize' signal to give you the -- opportunity to use a widget's 'DrawWindow' as soon as it has been created -- but before the widget is displayed. -- -- Removed in Gtk3. widgetGetDrawWindow :: WidgetClass widget => widget -> IO DrawWindow widgetGetDrawWindow da = withForeignPtr (unWidget.toWidget $ da) $ \da' -> do drawWindowPtr <- #{peek GtkWidget, window} da' if drawWindowPtr == nullPtr then fail "widgetGetDrawWindow: no DrawWindow available (the widget is probably not realized)" else makeNewGObject mkDrawWindow (return $ castPtr drawWindowPtr) -- | Returns the current size. -- -- * This information may be out of date if the user is resizing the window. -- -- Removed in Gtk3. widgetGetSize :: WidgetClass widget => widget -> IO (Int, Int) widgetGetSize da = withForeignPtr (unWidget.toWidget $ da) $ \wPtr -> do (width :: #{gtk2hs_type gint}) <- #{peek GtkAllocation, width} (#{ptr GtkWidget, allocation} wPtr) (height :: #{gtk2hs_type gint}) <- #{peek GtkAllocation, height} (#{ptr GtkWidget, allocation} wPtr) return (fromIntegral width, fromIntegral height) -- Window related methods -- | Retrieves the frame 'DrawWindow' that contains a 'Window'. -- -- Removed in Gtk3. windowGetFrame :: WindowClass widget => widget -> IO (Maybe DrawWindow) windowGetFrame da = withForeignPtr (unWidget.toWidget $ da) $ \da' -> do drawWindowPtr <- #{peek GtkWindow, frame} da' if drawWindowPtr == nullPtr then return Nothing else liftM Just $ makeNewGObject mkDrawWindow (return $ castPtr drawWindowPtr) #endif -- Styles related methods -- | Retrieve the the foreground color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetForeground :: Style -> StateType -> IO Color styleGetForeground st ty = withForeignPtr (unStyle st) $ \stPtr -> do peekElemOff (#{ptr GtkStyle, fg} stPtr) (fromEnum ty) -- | Retrieve the background color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetBackground :: Style -> StateType -> IO Color styleGetBackground st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, bg} stPtr) (fromEnum ty) -- | Retrieve a light color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetLight :: Style -> StateType -> IO Color styleGetLight st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, light} stPtr) (fromEnum ty) -- | Retrieve a middle color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetMiddle :: Style -> StateType -> IO Color styleGetMiddle st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, mid} stPtr) (fromEnum ty) -- | Retrieve a dark color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetDark :: Style -> StateType -> IO Color styleGetDark st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, dark} stPtr) (fromEnum ty) -- | Retrieve the text color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetText :: Style -> StateType -> IO Color styleGetText st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, text} stPtr) (fromEnum ty) -- | Retrieve the base color. -- -- * The base color is the standard text background of a widget. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetBase :: Style -> StateType -> IO Color styleGetBase st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, base} stPtr) (fromEnum ty) -- | Retrieve the color for drawing anti-aliased text. -- -- * The anti-aliasing color is the color which is used when the rendering -- of a character does not make it clear if a certain pixel should be set -- or not. This color is between the text and the base color. -- -- * The parameter @state@ determines for which widget -- state (one of 'StateType') the 'Color' should be retrieved. -- Use 'widgetGetState' to determine the current state of the -- widget. -- styleGetAntiAliasing :: Style -> StateType -> IO Color styleGetAntiAliasing st ty = withForeignPtr (unStyle st) $ \stPtr -> peekElemOff (#{ptr GtkStyle, text_aa} stPtr) (fromEnum ty) #if GTK_MAJOR_VERSION < 3 -- | Retrieve the ColorSelection object contained within the dialog. -- -- Removed in Gtk3. colorSelectionDialogGetColor :: ColorSelectionDialog -> IO ColorSelection colorSelectionDialogGetColor cd = makeNewObject mkColorSelection $ liftM castPtr $ withForeignPtr (unColorSelectionDialog cd) #{peek GtkColorSelectionDialog, colorsel} -- | Retrieve the OK button widget contained within the dialog. -- -- Removed in Gtk3. colorSelectionDialogGetOkButton :: ColorSelectionDialog -> IO Button colorSelectionDialogGetOkButton cd = makeNewObject mkButton $ liftM castPtr $ withForeignPtr (unColorSelectionDialog cd) #{peek GtkColorSelectionDialog, ok_button} -- | Retrieve the Cancel button widget contained within the dialog. -- -- Removed in Gtk3. colorSelectionDialogGetCancelButton :: ColorSelectionDialog -> IO Button colorSelectionDialogGetCancelButton cd = makeNewObject mkButton $ liftM castPtr $ withForeignPtr (unColorSelectionDialog cd) #{peek GtkColorSelectionDialog, cancel_button} -- | Retrieve the Help button widget contained within the dialog. -- -- Removed in Gtk3. colorSelectionDialogGetHelpButton :: ColorSelectionDialog -> IO Button colorSelectionDialogGetHelpButton cd = makeNewObject mkButton $ liftM castPtr $ withForeignPtr (unColorSelectionDialog cd) #{peek GtkColorSelectionDialog, help_button} dragContextGetActions :: DragContext -> IO Int dragContextGetActions dc = liftM (fromIntegral :: #{gtk2hs_type int} -> Int) $ withForeignPtr (unDragContext dc) #{peek GdkDragContext, actions} dragContextSetActions :: DragContext -> Int -> IO () dragContextSetActions dc val = withForeignPtr (unDragContext dc) $ \ptr -> #{poke GdkDragContext, actions} ptr (fromIntegral val :: #{gtk2hs_type int}) dragContextGetAction :: DragContext -> IO Int dragContextGetAction dc = liftM (fromIntegral :: #{gtk2hs_type int} -> Int) $ withForeignPtr (unDragContext dc) #{peek GdkDragContext, action} dragContextSetAction :: DragContext -> Int -> IO () dragContextSetAction dc val = withForeignPtr (unDragContext dc) $ \ptr -> #{poke GdkDragContext, action} ptr (fromIntegral val :: #{gtk2hs_type int}) dragContextGetSuggestedAction :: DragContext -> IO Int dragContextGetSuggestedAction dc = liftM (fromIntegral :: #{gtk2hs_type int} -> Int) $ withForeignPtr (unDragContext dc) #{peek GdkDragContext, suggested_action} dragContextSetSuggestedAction :: DragContext -> Int -> IO () dragContextSetSuggestedAction dc val = withForeignPtr (unDragContext dc) $ \ptr -> #{poke GdkDragContext, suggested_action} ptr (fromIntegral val :: #{gtk2hs_type int}) #endif -- | ID number of a sort column. -- -- * A 'SortColumnId' is a logical number to which a sorting function can -- be associated. The number does not have to coincide with any column -- number. type SortColumnId = Int -- | A special 'SortColumnId' to indicated that the default sorting function is used. -- treeSortableDefaultSortColumnId :: SortColumnId treeSortableDefaultSortColumnId = #{const GTK_TREE_SORTABLE_DEFAULT_SORT_COLUMN_ID} intToAtom :: Int -> Atom intToAtom = Atom . plusPtr nullPtr -- | An invalid 'TargetTag', 'SelectionTag', 'SelectionTypeTag' or 'PropertyTag'. -- tagInvalid :: Atom tagInvalid = intToAtom #{const GDK_NONE} -- | The primary selection (the currently highlighted text in X11 that can -- in many applications be pasted using the middle button). selectionPrimary :: SelectionTag selectionPrimary = intToAtom #{const GDK_SELECTION_PRIMARY} -- | The secondary selection. Rarely used. selectionSecondary :: SelectionTag selectionSecondary = intToAtom #{const GDK_SELECTION_SECONDARY} -- | The modern clipboard that is filled by copy or cut commands. selectionClipboard :: SelectionTag selectionClipboard = intToAtom #{const GDK_SELECTION_CLIPBOARD} -- | If this target is provided by a selection, then the data is a string. targetString :: TargetTag targetString = intToAtom #{const GDK_TARGET_STRING} -- | The type indicating that the associated data is itself a (list of) -- 'Graphics.UI.Gtk.General.Selection.Atom's. selectionTypeAtom :: SelectionTypeTag selectionTypeAtom = intToAtom #{const GDK_SELECTION_TYPE_ATOM} -- | The type indicating that the associated data consists of integers. selectionTypeInteger :: SelectionTypeTag selectionTypeInteger = intToAtom #{const GDK_SELECTION_TYPE_INTEGER} -- | The type indicating that the associated data is a string without further -- information on its encoding. selectionTypeString :: SelectionTypeTag selectionTypeString = intToAtom #{const GDK_SELECTION_TYPE_STRING} #if GTK_MAJOR_VERSION < 3 -- | Extract the type field of SelectionData*. This should be in the -- Selection modules but c2hs chokes on the 'type' field. selectionDataGetType :: Ptr () -> IO SelectionTypeTag selectionDataGetType selPtr = liftM intToAtom $ #{peek GtkSelectionData, type} selPtr #endif -- A type that identifies a target. This is needed to marshal arrays of -- GtkTargetEntries. data TargetEntry = TargetEntry (Ptr #{gtk2hs_type gchar}) InfoId -- brain damaged API: the whole selection API doesn't need GtkTargetEntry -- structure, but stupid Clipboard has two functions that only provide this -- interface. Thus, convert the efficient Atoms back into strings, have -- the clipboard functions convert them back to string before we get a -- chance to free the freshly allocated strings. withTargetEntries :: [(TargetTag, InfoId)] -> (Int -> Ptr () -> IO a) -> IO a withTargetEntries tags fun = do ptrsInfo <- mapM (\(Atom tag, info) -> gdk_atom_name tag >>= \strPtr -> return (TargetEntry strPtr info)) tags res <- withArrayLen ptrsInfo (\len ptr -> fun len (castPtr ptr)) mapM_ (\(TargetEntry ptr _) -> g_free ptr) ptrsInfo return res foreign import ccall unsafe "gdk_atom_name" gdk_atom_name :: Ptr () -> IO (Ptr #{gtk2hs_type gchar}) foreign import ccall unsafe "g_free" g_free :: Ptr #{gtk2hs_type gchar} -> IO () instance Storable TargetEntry where sizeOf _ = #{const sizeof(GtkTargetEntry)} alignment _ = alignment (undefined::#gtk2hs_type guint32) peek ptr = undefined poke ptr (TargetEntry cPtr info) = do #{poke GtkTargetEntry, target} ptr cPtr #{poke GtkTargetEntry, flags} ptr (0::#{gtk2hs_type guint}) #{poke GtkTargetEntry, info} ptr info -- | A 'KeymapKey' is a hardware key that can be mapped to a keyval. data KeymapKey = KeymapKey { keycode :: Int -- ^ @keycode@ the hardware keycode. This is an identifying number for a physical key. ,group :: Int -- ^ @group@ indicates movement in a horizontal direction. -- Usually groups are used for two different languages. -- In group 0, a key might have two English characters, -- and in group 1 it might have two Hebrew characters. -- The Hebrew characters will be printed on the key next to the English characters. -- indicates which symbol on the key will be used, -- in a vertical direction. So on a standard US keyboard, the ,level :: Int -- ^ @level@ key with the number "1" on it also has the exclamation -- point ("!") character on it. The level -- indicates whether to use the "1" or the "!" symbol. The letter keys are considered to -- have a lowercase letter at level 0, and an uppercase letter at level 1, though only -- the uppercase letter is printed. } deriving (Eq, Show) instance Storable KeymapKey where sizeOf _ = #{const sizeof(GdkKeymapKey)} alignment _ = alignment (undefined::#gtk2hs_type gint) peek ptr = do (keycode_ ::#gtk2hs_type guint) <- #{peek GdkKeymapKey, keycode} ptr (group_ ::#gtk2hs_type gint) <- #{peek GdkKeymapKey, group} ptr (level_ ::#gtk2hs_type gint) <- #{peek GdkKeymapKey, level} ptr return $ KeymapKey (fromIntegral keycode_) (fromIntegral group_) (fromIntegral level_) poke ptr (KeymapKey keycode group level) = do #{poke GdkKeymapKey, keycode} ptr ((fromIntegral keycode)::#gtk2hs_type guint) #{poke GdkKeymapKey, group} ptr ((fromIntegral group)::#gtk2hs_type gint) #{poke GdkKeymapKey, level} ptr ((fromIntegral level)::#gtk2hs_type gint) gtk-0.15.9/Graphics/UI/Gtk/General/Style.chs0000644000000000000000000001015107346545000016540 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Styles -- -- Author : Axel Simon -- -- Created: 13 February 2003 -- -- 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. -- -- TODO -- -- It seems sensible to treat Styles as read only. The only way to modify -- a style should be for the programmer to apply the RcStyle patches directly -- to the widget. -- -- Bind the draw... functions, they might be useful. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Customization of widgets. -- module Graphics.UI.Gtk.General.Style ( -- * Description -- -- | Styles are attached to widgets and determine how particular parts are -- drawn and with what color. Thus they are should be seen as mandatory when -- one implements a new custom widgets via 'DrawingArea'. Although the -- parameterized drawing function don't have to be used, it is strongly -- advisable (and more robust) to make use of the predefined graphics contexts -- for the different states of a widget (retrieved by -- 'Graphics.UI.Gtk.Abstract.Widget.widgetGetState'). -- -- * Types Style, StyleClass, castToStyle, gTypeStyle, toStyle, -- * Methods styleGetForeground, styleGetBackground, styleGetLight, styleGetMiddle, styleGetDark, styleGetText, styleGetBase, styleGetAntiAliasing, #if GTK_MAJOR_VERSION < 3 stylePaintFlatBox, stylePaintLayout, #endif ) where {# context prefix ="gtk" #} #if GTK_MAJOR_VERSION < 3 import System.Glib.FFI {#import Graphics.Rendering.Pango.Types#} import Graphics.Rendering.Pango.BasicTypes import Graphics.UI.Gtk.General.Structs (Rectangle) import Graphics.UI.Gtk.General.Enums (StateType, ShadowType) #endif {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Structs (styleGetForeground, styleGetBackground, styleGetLight, styleGetMiddle, styleGetDark, styleGetText, styleGetBase, styleGetAntiAliasing) #if GTK_MAJOR_VERSION < 3 stylePaintFlatBox :: WidgetClass widget => Style -> DrawWindow -> StateType -> ShadowType -> Rectangle -> widget -> String -> Int -> Int -> Int -> Int -> IO () stylePaintFlatBox style window stateType shadowType clipRect widget detail x y width height = with clipRect $ \rectPtr -> withCString detail $ \detailPtr -> {# call paint_flat_box #} style window ((fromIntegral.fromEnum) stateType) ((fromIntegral.fromEnum) shadowType) (castPtr rectPtr) (toWidget widget) detailPtr (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) stylePaintLayout :: WidgetClass widget => Style -> DrawWindow -> StateType -> Bool -> Rectangle -> widget -> String -> Int -> Int -> PangoLayout -> IO () stylePaintLayout style window stateType useText clipRect widget detail x y (PangoLayout _ layout) = with clipRect $ \rectPtr -> withCString detail $ \detailPtr -> {# call gtk_paint_layout #} style window ((fromIntegral.fromEnum) stateType) (fromBool useText) (castPtr rectPtr) (toWidget widget) detailPtr (fromIntegral x) (fromIntegral y) layout #endif gtk-0.15.9/Graphics/UI/Gtk/General/Threading.hs0000644000000000000000000000233207346545000017204 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) General -- -- Author : Axel Simon -- -- Created: 9 May 2009 -- -- Copyright (C) 2009 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) -- -- Support for the threaded RTS of ghc. -- -- This file contains functions that are needed by other library wrappers that build -- on Gtk2Hs. An application should not need this function nor include this file. -- module Graphics.UI.Gtk.General.Threading ( objectUnrefFromMainloop ) where import System.Glib.FFI foreign import ccall unsafe "hsgthread.h >k2hs_g_object_unref_from_mainloop" objectUnrefFromMainloop :: FinalizerPtr a gtk-0.15.9/Graphics/UI/Gtk/General/hsgthread.c0000644000000000000000000001513507346545000017065 0ustar0000000000000000/* We would use the g_thread_supported macro here, but unfortunately on * windows GHCi's dynamic linker cannot cope with references to global * variables imported from dlls. * * So instead of asking glib if we (or indeed) anyone else has initialised * the glib gthread system, we keep track of it ourselves. We still have to * do it in C land so the state survives :reload in GHCi. So there is the * danger in a mixed language program, of someone else initialising the * glib thread system and us not being aware of it. :-( * * Besides the interaction with ghci, we provide a variant of g_object_unref * that is used in all objects of Gtk+ and those libraries that build on Gtk+. * This variant enqueues the object to be finalized and adds an idle handler * into the main loop of Gtk+ that will call the actual finalizers on the * enqueued objects. The aim is to ensure that finalizers for objects that * may hold Xlib or Win32 resources are only run from the thread that runs the * main Gtk+ loop. If this is not ensured then bad things happen at least on * Win32 since that API is making use of thread-local storage that is not * present if the finalizers, that are run by the GC in a different thread, * call back into Win32 without this thread-local storage. * * Also g_static_mutex_lock and g_static_mutex_unlock cause linking problems * in ghci on Windows 7 (namely: HSgtk-0.10.5.o: unknown symbol * `__imp__g_threads_got_initialized'), so we use a Win32 critical section * instead. */ #define DEFINED_LPTYPELIB #define DEFINDE_LPTYPEINFO #define DEFINED_LPTYPECOMP #define DEFINE_LPCREATETYPEINFO #define DEFINED_LPDISPATCH #include #include #include "hsgthread.h" #if defined( WIN32 ) #include #include #include #endif #undef DEBUG static int threads_initialised = 0; #if defined( WIN32 ) static CRITICAL_SECTION gtk2hs_finalizer_mutex; #else static GMutex gtk2hs_finalizer_mutex; #endif static GSource* gtk2hs_finalizer_source; static guint gtk2hs_finalizer_id; static GArray* gtk2hs_finalizers; gboolean gtk2hs_run_finalizers(gpointer data); #if defined( WIN32 ) && GLIB_CHECK_VERSION(2,32,0) static GRecMutex recursive_mutex; void imp_rec_lock() { g_rec_mutex_lock(&recursive_mutex); } void imp_rec_unlock() { g_rec_mutex_unlock(&recursive_mutex); } #endif /* Initialize the default _fmode on WIN32. */ void gtk2hs_initialise (void) { #if defined( WIN32 ) && defined( GTK2HS_SET_FMODE_BINARY ) /* Some Windows GTK binaries (current Fedora MinGW ones) do */ /* not open files in binary mode. This is a work around. */ HANDLE handle = LoadLibrary("MSVCRT.dll"); if(!handle) { fprintf(stderr, "Warning: failed to load MSVCRT.dll, "); fprintf(stderr, "binary mode was not set!\n"); return; } int *_fmode_ptr = GetProcAddress(handle, "_fmode"); if(!_fmode_ptr) { fprintf(stderr, "Warning: failed to load address of _fmode from MSVCRT.dll, "); fprintf(stderr, "binary mode was not set!\n"); return; } *_fmode_ptr = _O_BINARY; #endif } /* Initialize the threads system of Gdk and Gtk. */ void gtk2hs_threads_initialise (void) { #ifdef DEBUG printf("gtk2hs_threads_initialise: threads_initialised=%i, g_thread_get_initialized=%i\n", threads_initialised, g_thread_get_initialized()); #endif if (!threads_initialised) { threads_initialised = 1; #if defined( WIN32 ) InitializeCriticalSection(>k2hs_finalizer_mutex); #else g_mutex_init(>k2hs_finalizer_mutex); #endif #if defined( WIN32 ) && GLIB_CHECK_VERSION(2,32,0) g_rec_mutex_init(&recursive_mutex); gdk_threads_set_lock_functions(imp_rec_lock, imp_rec_unlock); #endif gdk_threads_init(); /* from here onwards, the Gdk lock is held */ gdk_threads_enter(); } } /* Free an object within the Gtk2Hs lock. */ void gtk2hs_g_object_unref_from_mainloop(gpointer object) { int mutex_locked = 0; if (threads_initialised) { #ifdef DEBUG printf("acquiring lock to add a %s object at %lx\n", g_type_name(G_OBJECT_TYPE(object)), (unsigned long) object); printf("value of lock function is %lx\n", (unsigned long) g_thread_functions_for_glib_use.mutex_lock); #endif #if defined( WIN32 ) EnterCriticalSection(>k2hs_finalizer_mutex); #else g_mutex_lock(>k2hs_finalizer_mutex); #endif mutex_locked = 1; } #ifdef DEBUG if (mutex_locked) printf("within mutex: "); printf("adding finalizer to a %s object!\n", g_type_name(G_OBJECT_TYPE(object))); #endif /* Ensure that the idle handler is still installed and that the array of objects that are to be finalized exists. */ if (gtk2hs_finalizer_id==0) { if (gtk2hs_finalizers == NULL) gtk2hs_finalizers = g_array_new(0, 0, sizeof(gpointer)); #ifdef DEBUG printf("creating finalizer list.\n"); #endif if (gtk2hs_finalizer_source != NULL) { #ifdef DEBUG printf("re-initializing finalizer source.\n"); #endif g_source_destroy(gtk2hs_finalizer_source); g_source_unref(gtk2hs_finalizer_source); }; gtk2hs_finalizer_source = g_idle_source_new(); g_source_set_callback(gtk2hs_finalizer_source, >k2hs_run_finalizers, 0, 0); gtk2hs_finalizer_id = g_source_attach(gtk2hs_finalizer_source, NULL); }; /* Add the object to the list. */ g_array_append_val(gtk2hs_finalizers, object); if (mutex_locked) { #ifdef DEBUG printf("releasing lock to add a %s object at %lx\n", g_type_name(G_OBJECT_TYPE(object)), (unsigned long) object); #endif #if defined( WIN32 ) LeaveCriticalSection(>k2hs_finalizer_mutex); #else g_mutex_unlock(>k2hs_finalizer_mutex); #endif } } /* Run the finalizers that have been accumulated. */ gboolean gtk2hs_run_finalizers(gpointer data) { gint index; g_assert(gtk2hs_finalizers!=NULL); gdk_threads_enter(); int mutex_locked = 0; if (threads_initialised) { #ifdef DEBUG printf("acquiring lock to kill objects\n"); #endif #if defined( WIN32 ) EnterCriticalSection(>k2hs_finalizer_mutex); #else g_mutex_lock(>k2hs_finalizer_mutex); #endif mutex_locked = 1; } #ifdef DEBUG printf("running %i finalizers!\n", gtk2hs_finalizers->len); #endif for (index = 0; index < gtk2hs_finalizers->len; index++) g_object_unref(g_array_index (gtk2hs_finalizers, GObject*, index)); g_array_set_size(gtk2hs_finalizers, 0); gtk2hs_finalizer_id = 0; if (mutex_locked) { #ifdef DEBUG printf("releasing lock to kill objects\n"); #endif #if defined( WIN32 ) LeaveCriticalSection(>k2hs_finalizer_mutex); #else g_mutex_unlock(>k2hs_finalizer_mutex); #endif } gdk_threads_leave(); return FALSE; } gtk-0.15.9/Graphics/UI/Gtk/General/hsgthread.h0000644000000000000000000000054207346545000017066 0ustar0000000000000000#include #ifndef HSGTHREAD_H #define HSGTHREAD_H /* Initialize the default _fmode on WIN32 systems. */ void gtk2hs_initialise (void); /* Initialize the threads system of Gdk and Gtk. */ void gtk2hs_threads_initialise (void); /* Free an object within the Gtk+ main loop. */ void gtk2hs_g_object_unref_from_mainloop(gpointer object); #endif gtk-0.15.9/Graphics/UI/Gtk/Layout/0000755000000000000000000000000007346545000014643 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Layout/Alignment.chs0000644000000000000000000002140207346545000017257 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Alignment -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget which controls the alignment and size of its child -- module Graphics.UI.Gtk.Layout.Alignment ( -- * Detail -- -- | The 'Alignment' widget controls the alignment and size of its child -- widget. It has four settings: xscale, yscale, xalign, and yalign. -- -- The scale settings are used to specify how much the child widget should -- expand to fill the space allocated to the 'Alignment'. The values can range -- from 0 (meaning the child doesn't expand at all) to 1 (meaning the child -- expands to fill all of the available space). -- -- The align settings are used to place the child widget within the -- available area. The values range from 0 (top or left) to 1 (bottom or -- right). Of course, if the scale settings are both set to 1, the alignment -- settings have no effect. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Alignment -- @ -- * Types Alignment, AlignmentClass, castToAlignment, gTypeAlignment, toAlignment, -- * Constructors alignmentNew, -- * Methods alignmentSet, #if GTK_CHECK_VERSION(2,4,0) alignmentSetPadding, alignmentGetPadding, #endif -- * Attributes alignmentXAlign, alignmentYAlign, alignmentXScale, alignmentYScale, #if GTK_CHECK_VERSION(2,4,0) alignmentTopPadding, alignmentBottomPadding, alignmentLeftPadding, alignmentRightPadding, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Alignment'. -- alignmentNew :: Float -- ^ @xalign@ - the horizontal alignment of the child widget, -- from 0 (left) to 1 (right). -> Float -- ^ @yalign@ - the vertical alignment of the child widget, -- from 0 (top) to 1 (bottom). -> Float -- ^ @xscale@ - the amount that the child widget expands -- horizontally to fill up unused space, from 0 to 1. A value -- of 0 indicates that the child widget should never expand. A -- value of 1 indicates that the child widget will expand to -- fill all of the space allocated for the 'Alignment'. -> Float -- ^ @yscale@ - the amount that the child widget expands -- vertically to fill up unused space, from 0 to 1. The values -- are similar to @xscale@. -> IO Alignment alignmentNew xalign yalign xscale yscale = makeNewObject mkAlignment $ liftM (castPtr :: Ptr Widget -> Ptr Alignment) $ {# call unsafe alignment_new #} (realToFrac xalign) (realToFrac yalign) (realToFrac xscale) (realToFrac yscale) -------------------- -- Methods -- | Sets the 'Alignment' values. -- alignmentSet :: AlignmentClass self => self -> Float -- ^ @xalign@ - the horizontal alignment of the child widget, from 0 -- (left) to 1 (right). -> Float -- ^ @yalign@ - the vertical alignment of the child widget, from 0 -- (top) to 1 (bottom). -> Float -- ^ @xscale@ - the amount that the child widget expands -- horizontally to fill up unused space, from 0 to 1. A value of 0 -- indicates that the child widget should never expand. A value of 1 -- indicates that the child widget will expand to fill all of the -- space allocated for the 'Alignment'. -> Float -- ^ @yscale@ - the amount that the child widget expands vertically -- to fill up unused space, from 0 to 1. The values are similar to -- @xscale@. -> IO () alignmentSet self xalign yalign xscale yscale = {# call alignment_set #} (toAlignment self) (realToFrac xalign) (realToFrac yalign) (realToFrac xscale) (realToFrac yscale) #if GTK_CHECK_VERSION(2,4,0) -- | Sets the padding on the different sides of the widget. The padding adds -- blank space to the sides of the widget. For instance, this can be used to -- indent the child widget towards the right by adding padding on the left. -- -- * Available since Gtk+ version 2.4 -- alignmentSetPadding :: AlignmentClass self => self -> Int -- ^ @paddingTop@ - the padding at the top of the widget -> Int -- ^ @paddingBottom@ - the padding at the bottom of the widget -> Int -- ^ @paddingLeft@ - the padding at the left of the widget -> Int -- ^ @paddingRight@ - the padding at the right of the widget. -> IO () alignmentSetPadding self paddingTop paddingBottom paddingLeft paddingRight = {# call gtk_alignment_set_padding #} (toAlignment self) (fromIntegral paddingTop) (fromIntegral paddingBottom) (fromIntegral paddingLeft) (fromIntegral paddingRight) -- | Gets the padding on the different sides of the widget. See -- 'alignmentSetPadding'. -- -- * Available since Gtk+ version 2.4 -- alignmentGetPadding :: AlignmentClass self => self -> IO (Int, Int, Int, Int) -- ^ @(paddingTop, paddingBottom, paddingLeft, -- paddingRight)@ - the padding at the top, -- bottom, left and right of the widget. alignmentGetPadding self = alloca $ \paddingTopPtr -> alloca $ \paddingBottomPtr -> alloca $ \paddingLeftPtr -> alloca $ \paddingRightPtr -> do {# call gtk_alignment_get_padding #} (toAlignment self) paddingTopPtr paddingBottomPtr paddingLeftPtr paddingRightPtr paddingTop <- peek paddingTopPtr paddingBottom <- peek paddingBottomPtr paddingLeft <- peek paddingLeftPtr paddingRight <- peek paddingRightPtr return (fromIntegral paddingTop, fromIntegral paddingBottom ,fromIntegral paddingLeft, fromIntegral paddingRight) #endif -------------------- -- Attributes -- | Horizontal position of child in available space. 0.0 is left aligned, 1.0 -- is right aligned. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- alignmentXAlign :: AlignmentClass self => Attr self Float alignmentXAlign = newAttrFromFloatProperty "xalign" -- | Vertical position of child in available space. 0.0 is top aligned, 1.0 is -- bottom aligned. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- alignmentYAlign :: AlignmentClass self => Attr self Float alignmentYAlign = newAttrFromFloatProperty "yalign" -- | If available horizontal space is bigger than needed for the child, how -- much of it to use for the child. 0.0 means none, 1.0 means all. -- -- Allowed values: [0,1] -- -- Default value: 1 -- alignmentXScale :: AlignmentClass self => Attr self Float alignmentXScale = newAttrFromFloatProperty "xscale" -- | If available vertical space is bigger than needed for the child, how much -- of it to use for the child. 0.0 means none, 1.0 means all. -- -- Allowed values: [0,1] -- -- Default value: 1 -- alignmentYScale :: AlignmentClass self => Attr self Float alignmentYScale = newAttrFromFloatProperty "yscale" #if GTK_CHECK_VERSION(2,4,0) -- | The padding to insert at the top of the widget. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 0 -- alignmentTopPadding :: AlignmentClass self => Attr self Int alignmentTopPadding = newAttrFromUIntProperty "top-padding" -- | The padding to insert at the bottom of the widget. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 0 -- alignmentBottomPadding :: AlignmentClass self => Attr self Int alignmentBottomPadding = newAttrFromUIntProperty "bottom-padding" -- | The padding to insert at the left of the widget. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 0 -- alignmentLeftPadding :: AlignmentClass self => Attr self Int alignmentLeftPadding = newAttrFromUIntProperty "left-padding" -- | The padding to insert at the right of the widget. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 0 -- alignmentRightPadding :: AlignmentClass self => Attr self Int alignmentRightPadding = newAttrFromUIntProperty "right-padding" #endif gtk-0.15.9/Graphics/UI/Gtk/Layout/AspectFrame.chs0000644000000000000000000001160007346545000017532 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget AspectFrame -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A frame that constrains its child to a particular aspect ratio -- module Graphics.UI.Gtk.Layout.AspectFrame ( -- * Detail -- -- | The 'AspectFrame' is useful when you want pack a widget so that it can -- resize but always retains the same aspect ratio. For instance, one might be -- drawing a small preview of a larger image. 'AspectFrame' derives from -- 'Frame', so it can draw a label and a frame around the child. The frame will -- be \"shrink-wrapped\" to the size of the child. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Frame' -- | +----AspectFrame -- @ -- * Types AspectFrame, AspectFrameClass, castToAspectFrame, gTypeAspectFrame, toAspectFrame, -- * Constructors aspectFrameNew, -- * Methods aspectFrameSet, -- * Attributes aspectFrameXAlign, aspectFrameYAlign, aspectFrameRatio, aspectFrameObeyChild, ) where import Control.Monad (liftM) import Data.Maybe (isNothing) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new 'AspectFrame'. -- -- The frame may be augmented with a label which can be set by @frameSetLabel@. -- aspectFrameNew :: Float -- ^ @xalign@ - Horizontal alignment of the child within -- the allocation of the 'AspectFrame'. This ranges from 0.0 -- (left aligned) to 1.0 (right aligned) -> Float -- ^ @yalign@ - Vertical alignment of the child within the -- allocation of the 'AspectFrame'. This ranges from 0.0 -- (left aligned) to 1.0 (right aligned) -> Maybe Float -- ^ @ratio@ - The desired aspect ratio. If @Nothing@ the -- aspect ratio is taken from the requistion of the child. -> IO AspectFrame aspectFrameNew xalign yalign ratio = makeNewObject mkAspectFrame $ liftM (castPtr :: Ptr Widget -> Ptr AspectFrame) $ {# call unsafe aspect_frame_new #} nullPtr (realToFrac xalign) (realToFrac yalign) (maybe 0.0 realToFrac ratio) (fromBool $ isNothing ratio) -------------------- -- Methods -- | Set parameters for an existing 'AspectFrame'. -- aspectFrameSet :: AspectFrameClass self => self -> Float -- ^ @xalign@ - Horizontal alignment of the child within the -- allocation of the 'AspectFrame'. This ranges from 0.0 (left -- aligned) to 1.0 (right aligned) -> Float -- ^ @yalign@ - Vertical alignment of the child within the -- allocation of the 'AspectFrame'. This ranges from 0.0 (left -- aligned) to 1.0 (right aligned) -> Maybe Float -- ^ @ratio@ - The desired aspect ratio. If @Nothing@ the -- aspect ratio is taken from the requistion of the child. -> IO () aspectFrameSet self xalign yalign ratio = {# call aspect_frame_set #} (toAspectFrame self) (realToFrac xalign) (realToFrac yalign) (maybe 0.0 realToFrac ratio) (fromBool $ isNothing ratio) -------------------- -- Attributes -- | X alignment of the child. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- aspectFrameXAlign :: AspectFrameClass self => Attr self Float aspectFrameXAlign = newAttrFromFloatProperty "xalign" -- | Y alignment of the child. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- aspectFrameYAlign :: AspectFrameClass self => Attr self Float aspectFrameYAlign = newAttrFromFloatProperty "yalign" -- | Aspect ratio if obey_child is @False@. -- -- Allowed values: [1e-04,10000] -- -- Default value: 0.5 -- aspectFrameRatio :: AspectFrameClass self => Attr self Float aspectFrameRatio = newAttrFromFloatProperty "ratio" -- | Force aspect ratio to match that of the frame's child. -- -- Default value: @True@ -- aspectFrameObeyChild :: AspectFrameClass self => Attr self Bool aspectFrameObeyChild = newAttrFromBoolProperty "obey-child" gtk-0.15.9/Graphics/UI/Gtk/Layout/Expander.chs0000644000000000000000000002244707346545000017121 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Expander -- -- Author : Duncan Coutts -- -- Created: 24 April 2004 -- -- Copyright (C) 2004-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) -- -- A container which can hide its child -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Layout.Expander ( -- * Detail -- -- | A 'Expander' allows the user to hide or show its child by clicking on an -- expander triangle similar to the triangles used in a 'TreeView'. -- -- Normally you use an expander as you would use any other descendant of -- 'Bin'; you create the child widget and use -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd' to add it to the -- expander. When the expander is toggled, it will take care of showing and -- hiding the child automatically. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Expander -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types Expander, ExpanderClass, castToExpander, gTypeExpander, toExpander, -- * Constructors expanderNew, expanderNewWithMnemonic, -- * Methods expanderSetExpanded, expanderGetExpanded, expanderSetSpacing, expanderGetSpacing, expanderSetLabel, expanderGetLabel, expanderSetUseUnderline, expanderGetUseUnderline, expanderSetUseMarkup, expanderGetUseMarkup, expanderSetLabelWidget, expanderGetLabelWidget, -- * Attributes expanderExpanded, expanderLabel, expanderUseUnderline, expanderUseMarkup, expanderSpacing, expanderLabelWidget, #if GTK_CHECK_VERSION(2,22,0) expanderLabelFill, #endif -- * Signals onActivate, afterActivate, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Signals {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new expander using the given string as the text of the label. -- expanderNew :: GlibString string => string -> IO Expander expanderNew label = makeNewObject mkExpander $ liftM (castPtr :: Ptr Widget -> Ptr Expander) $ withUTFString label $ \labelPtr -> {# call gtk_expander_new #} labelPtr -- | Creates a new expander using @label@ as the text of the label. If -- characters in @label@ are preceded by an underscore, they are underlined. If -- you need a literal underscore character in a label, use \'__\' (two -- underscores). The first underlined character represents a keyboard -- accelerator called a mnemonic. Pressing Alt and that key activates the -- button. -- expanderNewWithMnemonic :: GlibString string => string -- ^ @label@ - the text of the label with an underscore in -- front of the mnemonic character -> IO Expander expanderNewWithMnemonic label = makeNewObject mkExpander $ liftM (castPtr :: Ptr Widget -> Ptr Expander) $ withUTFString label $ \labelPtr -> {# call gtk_expander_new_with_mnemonic #} labelPtr -------------------- -- Methods -- | Sets the state of the expander. Set to @True@, if you want the child -- widget to be revealed, and @False@ if you want the child widget to be -- hidden. -- expanderSetExpanded :: Expander -> Bool -> IO () expanderSetExpanded self expanded = {# call gtk_expander_set_expanded #} self (fromBool expanded) -- | Queries a 'Expander' and returns its current state. Returns @True@ if the -- child widget is revealed. -- -- See 'expanderSetExpanded'. -- expanderGetExpanded :: Expander -> IO Bool expanderGetExpanded self = liftM toBool $ {# call gtk_expander_get_expanded #} self -- | Sets the spacing field of @expander@, which is the number of pixels to -- place between expander and the child. -- expanderSetSpacing :: Expander -> Int -> IO () expanderSetSpacing self spacing = {# call gtk_expander_set_spacing #} self (fromIntegral spacing) -- | Gets the value set by 'expanderSetSpacing'. -- expanderGetSpacing :: Expander -> IO Int -- ^ returns spacing between the expander and child. expanderGetSpacing self = liftM fromIntegral $ {# call gtk_expander_get_spacing #} self -- | Sets the text of the label of the expander to @label@. -- -- This will also clear any previously set labels. -- expanderSetLabel :: GlibString string => Expander -> string -> IO () expanderSetLabel self label = withUTFString label $ \labelPtr -> {# call gtk_expander_set_label #} self labelPtr -- | Fetches the text from the label of the expander, as set by -- 'expanderSetLabel'. -- expanderGetLabel :: GlibString string => Expander -> IO string expanderGetLabel self = {# call gtk_expander_get_label #} self >>= peekUTFString -- | If true, an underline in the text of the expander label indicates the -- next character should be used for the mnemonic accelerator key. -- expanderSetUseUnderline :: Expander -> Bool -- ^ @useUnderline@ - @True@ if underlines in the text indicate -- mnemonics -> IO () expanderSetUseUnderline self useUnderline = {# call gtk_expander_set_use_underline #} self (fromBool useUnderline) -- | Returns whether an embedded underline in the expander label indicates a -- mnemonic. See 'expanderSetUseUnderline'. -- expanderGetUseUnderline :: Expander -> IO Bool -- ^ returns @True@ if an embedded underline in the expander -- label indicates the mnemonic accelerator keys. expanderGetUseUnderline self = liftM toBool $ {# call gtk_expander_get_use_underline #} self -- | Sets whether the text of the label contains markup in Pango's text markup -- language. See 'Graphics.UI.Gtk.Display.Label.labelSetMarkup'. -- expanderSetUseMarkup :: Expander -> Bool -- ^ @useMarkup@ - @True@ if the label's text should be parsed -- for markup -> IO () expanderSetUseMarkup self useMarkup = {# call gtk_expander_set_use_markup #} self (fromBool useMarkup) -- | Returns whether the label's text is interpreted as marked up with the -- Pango text markup language. See 'expanderSetUseMarkup'. -- expanderGetUseMarkup :: Expander -> IO Bool expanderGetUseMarkup self = liftM toBool $ {# call gtk_expander_get_use_markup #} self -- | Set the label widget for the expander. This is the widget that will -- appear embedded alongside the expander arrow. -- expanderSetLabelWidget :: WidgetClass labelWidget => Expander -> labelWidget -- ^ @labelWidget@ - the new label widget -> IO () expanderSetLabelWidget self labelWidget = {# call gtk_expander_set_label_widget #} self (toWidget labelWidget) -- | Retrieves the label widget for the frame. See 'expanderSetLabelWidget'. -- expanderGetLabelWidget :: Expander -> IO Widget -- ^ returns the label widget expanderGetLabelWidget self = makeNewObject mkWidget $ {# call gtk_expander_get_label_widget #} self -------------------- -- Attributes -- | Whether the expander has been opened to reveal the child widget. -- -- Default value: @False@ -- expanderExpanded :: Attr Expander Bool expanderExpanded = newAttr expanderGetExpanded expanderSetExpanded -- | Text of the expander's label. -- expanderLabel :: GlibString string => Attr Expander string expanderLabel = newAttr expanderGetLabel expanderSetLabel -- | If set, an underline in the text indicates the next character should be -- used for the mnemonic accelerator key. -- -- Default value: @False@ -- expanderUseUnderline :: Attr Expander Bool expanderUseUnderline = newAttr expanderGetUseUnderline expanderSetUseUnderline -- | The text of the label includes XML markup. See pango_parse_markup(). -- -- Default value: @False@ -- expanderUseMarkup :: Attr Expander Bool expanderUseMarkup = newAttr expanderGetUseMarkup expanderSetUseMarkup -- | Space to put between the label and the child. -- -- Allowed values: >= 0 -- -- Default value: 0 -- expanderSpacing :: Attr Expander Int expanderSpacing = newAttr expanderGetSpacing expanderSetSpacing -- | A widget to display in place of the usual expander label. -- expanderLabelWidget :: WidgetClass labelWidget => ReadWriteAttr Expander Widget labelWidget expanderLabelWidget = newAttr expanderGetLabelWidget expanderSetLabelWidget #if GTK_CHECK_VERSION(2,22,0) -- | Whether the label widget should fill all available horizontal space. -- -- Default value: 'False' -- expanderLabelFill :: Attr Expander Bool expanderLabelFill = newAttrFromBoolProperty "label-fill" #endif -------------------- -- Signals onActivate, afterActivate :: Expander -> IO () -> IO (ConnectId Expander) onActivate = connect_NONE__NONE "activate" False afterActivate = connect_NONE__NONE "activate" True #endif gtk-0.15.9/Graphics/UI/Gtk/Layout/Fixed.chs0000644000000000000000000001412007346545000016377 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Fixed -- -- Author : Duncan Coutts -- -- Created: 2 August 2004 -- -- Copyright (C) 2004-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) -- -- A container which allows you to position widgets at fixed coordinates -- module Graphics.UI.Gtk.Layout.Fixed ( -- * Detail -- -- | The 'Fixed' widget is a container which can place child widgets at fixed -- positions and with fixed sizes, given in pixels. 'Fixed' performs no -- automatic layout management. -- -- For most applications, you should not use this container! It keeps you -- from having to learn about the other Gtk+ containers, but it results in -- broken applications. With 'Fixed', the following things will result in -- truncated text, overlapping widgets, and other display bugs: -- -- * Themes, which may change widget sizes. -- -- * Fonts other than the one you used to write the app will of course -- change the size of widgets containing text; keep in mind that users may use -- a larger font because of difficulty reading the default, or they may be -- using Windows or the framebuffer port of Gtk+, where different fonts are -- available. -- -- * Translation of text into other languages changes its size. Also, -- display of non-English text will use a different font in many cases. -- -- In addition, the fixed widget can't properly be mirrored in right-to-left -- languages such as Hebrew and Arabic. i.e. normally Gtk+ will flip the -- interface to put labels to the right of the thing they label, but it can't -- do that with 'Fixed'. So your application will not be usable in -- right-to-left languages. -- -- Finally, fixed positioning makes it kind of annoying to add\/remove GUI -- elements, since you have to reposition all the other elements. This is a -- long-term maintenance problem for your application. -- -- If you know none of these things are an issue for your application, and -- prefer the simplicity of 'Fixed', by all means use the widget. But you -- should be aware of the tradeoffs. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Fixed -- @ -- * Types Fixed, FixedClass, castToFixed, gTypeFixed, toFixed, -- * Constructors fixedNew, -- * Methods fixedPut, fixedMove, #if GTK_MAJOR_VERSION < 3 fixedSetHasWindow, fixedGetHasWindow, -- * Attributes fixedHasWindow, #endif -- * Child Attributes fixedChildX, fixedChildY, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.ContainerChildProperties {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Fixed'. -- fixedNew :: IO Fixed fixedNew = makeNewObject mkFixed $ liftM (castPtr :: Ptr Widget -> Ptr Fixed) $ {# call unsafe fixed_new #} -------------------- -- Methods -- | Adds a widget to a 'Fixed' container at the given position. -- fixedPut :: (FixedClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the widget to add. -> (Int, Int) -- ^ @(x,y)@ - the horizontal and vertical position to place -- the widget at. -> IO () fixedPut self widget (x, y) = {# call fixed_put #} (toFixed self) (toWidget widget) (fromIntegral x) (fromIntegral y) -- | Moves a child of a 'Fixed' container to the given position. -- fixedMove :: (FixedClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the child widget. -> (Int, Int) -- ^ @(x,y)@ - the horizontal and vertical position to move the -- widget to. -> IO () fixedMove self widget (x, y) = {# call fixed_move #} (toFixed self) (toWidget widget) (fromIntegral x) (fromIntegral y) #if GTK_MAJOR_VERSION < 3 -- | Sets whether the 'Fixed' widget is created with a separate 'DrawWindow' for -- its window or not. (By default, it will be created with no separate -- 'DrawWindow'). This function must be called while the 'Fixed' is not -- realized, for instance, immediately after the window is created. -- -- This function was added to provide an easy migration path for older -- applications which may expect 'Fixed' to have a separate window. -- -- Removed in Gtk3. Use the Widget version. fixedSetHasWindow :: FixedClass self => self -> Bool -> IO () fixedSetHasWindow self hasWindow = {# call fixed_set_has_window #} (toFixed self) (fromBool hasWindow) -- | Gets whether the 'Fixed' has its own 'DrawWindow'. See -- 'fixedSetHasWindow'. -- -- Removed in Gtk3. Use the Widget version. fixedGetHasWindow :: FixedClass self => self -> IO Bool fixedGetHasWindow self = liftM toBool $ {# call unsafe fixed_get_has_window #} (toFixed self) -------------------- -- Attributes -- | \'hasWindow\' property. See 'fixedGetHasWindow' and 'fixedSetHasWindow' -- -- Removed in Gtk3. Use the Widget version. fixedHasWindow :: FixedClass self => Attr self Bool fixedHasWindow = newAttr fixedGetHasWindow fixedSetHasWindow #endif -------------------- -- Child Attributes -- | X position of child widget. -- -- Default value: 0 -- fixedChildX :: (FixedClass self, WidgetClass child) => child -> Attr self Int fixedChildX = newAttrFromContainerChildIntProperty "x" -- | Y position of child widget. -- -- Default value: 0 -- fixedChildY :: (FixedClass self, WidgetClass child) => child -> Attr self Int fixedChildY = newAttrFromContainerChildIntProperty "y" gtk-0.15.9/Graphics/UI/Gtk/Layout/HBox.chs0000644000000000000000000000442607346545000016210 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HBox -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A horizontal container box -- module Graphics.UI.Gtk.Layout.HBox ( -- * Detail -- -- | 'HBox' is a container that organizes child widgets into a single row. -- -- Use the 'Box' packing interface to determine the arrangement, spacing, -- width, and alignment of 'HBox' children. -- -- All children are allocated the same height. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----HBox -- | +----'Combo' -- | +----'FileChooserButton' -- | +----'Statusbar' -- @ -- * Types HBox, HBoxClass, castToHBox, gTypeHBox, toHBox, -- * Constructors hBoxNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'HBox'. -- hBoxNew :: Bool -- ^ @homogeneous@ - @True@ if all children are to be given equal -- space allotments. -> Int -- ^ @spacing@ - the number of pixels to place by default between -- children. -> IO HBox hBoxNew homogeneous spacing = makeNewObject mkHBox $ liftM (castPtr :: Ptr Widget -> Ptr HBox) $ {# call unsafe hbox_new #} (fromBool homogeneous) (fromIntegral spacing) gtk-0.15.9/Graphics/UI/Gtk/Layout/HButtonBox.chs0000644000000000000000000000554707346545000017411 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HButtonBox -- -- Author : Matthew Walton -- -- Created: 29 April 2004 -- -- Copyright (C) 2004-2005 Matthew Walton -- -- 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) -- -- A container for arranging buttons horizontally -- module Graphics.UI.Gtk.Layout.HButtonBox ( -- * Detail -- -- | A button box should be used to provide a consistent layout of buttons -- throughout your application. The layout\/spacing can be altered by the -- programmer, or if desired, by the user to alter the \'feel\' of a program to -- a small degree. -- -- A 'HButtonBox' is created with 'hButtonBoxNew'. Buttons are packed -- into a button box the same way widgets are added to any other -- container, using -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd'. You can also use -- 'Graphics.UI.Gtk.Abstract.Box.boxPackStart' or -- 'Graphics.UI.Gtk.Abstract.Box.boxPackEnd', but for button boxes -- both these functions work just like -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd', ie., they pack -- the button in a way that depends on the current layout style and on -- whether the button has had -- 'Graphics.UI.Gtk.Abstract.ButtonBox.buttonBoxSetChildSecondary' -- called on it. -- -- The spacing between buttons can be set with -- 'Graphics.UI.Gtk.Abstract.Box.boxSetSpacing'. The arrangement and -- layout of the buttons can be changed with -- 'Graphics.UI.Gtk.Abstract.ButtonBox.buttonBoxSetLayout'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'ButtonBox' -- | +----HButtonBox -- @ -- * Types HButtonBox, HButtonBoxClass, castToHButtonBox, gTypeHButtonBox, toHButtonBox, -- * Constructors hButtonBoxNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new horizontal button box. -- hButtonBoxNew :: IO HButtonBox hButtonBoxNew = makeNewObject mkHButtonBox $ liftM (castPtr :: Ptr Widget -> Ptr HButtonBox) $ {# call unsafe hbutton_box_new #} gtk-0.15.9/Graphics/UI/Gtk/Layout/HPaned.chs0000644000000000000000000000352407346545000016505 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HPaned -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A container with two panes arranged horizontally -- module Graphics.UI.Gtk.Layout.HPaned ( -- * Detail -- -- | The HPaned widget is a container widget with two children arranged -- horizontally. The division between the two panes is adjustable by the user -- by dragging a handle. See 'Paned' for details. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Paned' -- | +----HPaned -- @ -- * Types HPaned, HPanedClass, castToHPaned, gTypeHPaned, toHPaned, -- * Constructors hPanedNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new 'HPaned' -- hPanedNew :: IO HPaned hPanedNew = makeNewObject mkHPaned $ liftM (castPtr :: Ptr Widget -> Ptr HPaned) $ {# call unsafe hpaned_new #} gtk-0.15.9/Graphics/UI/Gtk/Layout/Layout.chs0000644000000000000000000002100307346545000016613 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Layout -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Infinite scrollable area containing child widgets and\/or custom drawing -- module Graphics.UI.Gtk.Layout.Layout ( -- * Detail -- -- | 'Layout' is similar to 'DrawingArea' in that it's a \"blank slate\" and -- doesn't do anything but paint a blank background by default. It's different -- in that it supports scrolling natively (you can add it to a -- 'ScrolledWindow'), and it can contain child widgets, since it's a -- 'Container'. However if you\'re just going to draw, a 'DrawingArea' is a -- better choice since it has lower overhead. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Layout -- @ -- * Types Layout, LayoutClass, castToLayout, gTypeLayout, toLayout, -- * Constructors layoutNew, -- * Methods layoutPut, layoutMove, layoutSetSize, layoutGetSize, layoutGetHAdjustment, layoutGetVAdjustment, layoutSetHAdjustment, layoutSetVAdjustment, layoutGetDrawWindow, -- * Attributes layoutHAdjustment, layoutVAdjustment, layoutWidth, layoutHeight, -- * Child Attributes layoutChildX, layoutChildY, -- * Signals onSetScrollAdjustments, afterSetScrollAdjustments, ) where import Data.Maybe (fromMaybe) import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Abstract.ContainerChildProperties {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Layout'. Unless you have a specific adjustment you'd like -- the layout to use for scrolling, pass @Nothing@ for @hadjustment@ and -- @vadjustment@. -- layoutNew :: Maybe Adjustment -- ^ @hadjustment@ - horizontal scroll adjustment, or -- @Nothing@ -> Maybe Adjustment -- ^ @vadjustment@ - vertical scroll adjustment, or -- @Nothing@ -> IO Layout layoutNew hadjustment vadjustment = makeNewObject mkLayout $ liftM (castPtr :: Ptr Widget -> Ptr Layout) $ {# call unsafe layout_new #} (fromMaybe (Adjustment nullForeignPtr) hadjustment) (fromMaybe (Adjustment nullForeignPtr) vadjustment) -------------------- -- Methods -- | Adds @childWidget@ to @layout@, at position @(x,y)@. @layout@ becomes -- the new parent container of @childWidget@. -- layoutPut :: (LayoutClass self, WidgetClass childWidget) => self -> childWidget -- ^ @childWidget@ - child widget -> Int -- ^ @x@ - X position of child widget -> Int -- ^ @y@ - Y position of child widget -> IO () layoutPut self childWidget x y = {# call layout_put #} (toLayout self) (toWidget childWidget) (fromIntegral x) (fromIntegral y) -- | Moves a current child of @layout@ to a new position. -- layoutMove :: (LayoutClass self, WidgetClass childWidget) => self -> childWidget -- ^ @childWidget@ - a current child of @layout@ -> Int -- ^ @x@ - X position to move to -> Int -- ^ @y@ - Y position to move to -> IO () layoutMove self childWidget x y = {# call layout_move #} (toLayout self) (toWidget childWidget) (fromIntegral x) (fromIntegral y) -- | Sets the size of the scrollable area of the layout. -- layoutSetSize :: LayoutClass self => self -> Int -- ^ @width@ - width of entire scrollable area -> Int -- ^ @height@ - height of entire scrollable area -> IO () layoutSetSize self width height = {# call layout_set_size #} (toLayout self) (fromIntegral width) (fromIntegral height) -- | Gets the size that has been set on the layout, and that determines the -- total extents of the layout's scrollbar area. See 'layoutSetSize'. -- layoutGetSize :: LayoutClass self => self -> IO (Int, Int) -- ^ @(width, height)@ layoutGetSize self = alloca $ \widthPtr -> alloca $ \heightPtr -> do {# call unsafe layout_get_size #} (toLayout self) widthPtr heightPtr width <-peek widthPtr height <- peek heightPtr return (fromIntegral width, fromIntegral height) -- | This function should only be called after the layout has been placed in a -- 'ScrolledWindow' or otherwise configured for scrolling. It returns the -- 'Adjustment' used for communication between the horizontal scrollbar and -- @layout@. -- -- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. -- layoutGetHAdjustment :: LayoutClass self => self -> IO Adjustment -- ^ returns horizontal scroll adjustment layoutGetHAdjustment self = makeNewObject mkAdjustment $ {# call unsafe layout_get_hadjustment #} (toLayout self) -- | This function should only be called after the layout has been placed in a -- 'ScrolledWindow' or otherwise configured for scrolling. It returns the -- 'Adjustment' used for communication between the vertical scrollbar and -- @layout@. -- -- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. -- layoutGetVAdjustment :: LayoutClass self => self -> IO Adjustment -- ^ returns vertical scroll adjustment layoutGetVAdjustment self = makeNewObject mkAdjustment $ {# call unsafe layout_get_vadjustment #} (toLayout self) -- | Sets the horizontal scroll adjustment for the layout. -- -- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. -- layoutSetHAdjustment :: LayoutClass self => self -> Adjustment -- ^ @adjustment@ - new scroll adjustment -> IO () layoutSetHAdjustment self adjustment = {# call layout_set_hadjustment #} (toLayout self) adjustment -- | Sets the vertical scroll adjustment for the layout. -- -- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details. -- layoutSetVAdjustment :: LayoutClass self => self -> Adjustment -- ^ @adjustment@ - new scroll adjustment -> IO () layoutSetVAdjustment self adjustment = {# call layout_set_vadjustment #} (toLayout self) adjustment -- | Retrieves the 'Drawable' part of the layout used for drawing operations. -- layoutGetDrawWindow :: Layout -> IO DrawWindow layoutGetDrawWindow lay = makeNewGObject mkDrawWindow $ {# call layout_get_bin_window #} (toLayout lay) -------------------- -- Attributes -- | The 'Adjustment' for the horizontal position. -- layoutHAdjustment :: LayoutClass self => Attr self Adjustment layoutHAdjustment = newAttr layoutGetHAdjustment layoutSetHAdjustment -- | The 'Adjustment' for the vertical position. -- layoutVAdjustment :: LayoutClass self => Attr self Adjustment layoutVAdjustment = newAttr layoutGetVAdjustment layoutSetVAdjustment -- | The width of the layout. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 100 -- layoutWidth :: LayoutClass self => Attr self Int layoutWidth = newAttrFromUIntProperty "width" -- | The height of the layout. -- -- Allowed values: \<= @('maxBound' :: Int)@ -- -- Default value: 100 -- layoutHeight :: LayoutClass self => Attr self Int layoutHeight = newAttrFromUIntProperty "height" -------------------- -- Child Attributes -- | X position of child widget. -- -- Default value: 0 -- layoutChildX :: (LayoutClass self, WidgetClass child) => child -> Attr self Int layoutChildX = newAttrFromContainerChildIntProperty "x" -- | Y position of child widget. -- -- Default value: 0 -- layoutChildY :: (LayoutClass self, WidgetClass child) => child -> Attr self Int layoutChildY = newAttrFromContainerChildIntProperty "y" -------------------- -- Signals -- | In case the adjustments are replaced, this signal is emitted. -- onSetScrollAdjustments, afterSetScrollAdjustments :: LayoutClass self => self -> (Adjustment -> Adjustment -> IO ()) -> IO (ConnectId self) onSetScrollAdjustments = connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" False afterSetScrollAdjustments = connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" True gtk-0.15.9/Graphics/UI/Gtk/Layout/Notebook.chs0000644000000000000000000013145307346545000017131 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Notebook -- -- Author : Axel Simon, Andy Stewart -- -- Created: 15 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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 -- -- Functions: -- gtk_notebook_set_group -- gtk_notebook_get_group -- gtk_notebook_set_window_creation_hook -- Attributes: -- group -- Signals: -- focusTab -- -- NOTE -- -- Don't binding `group-id` attribute, even set/get_group_id functions is deprecated) -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A tabbed notebook container -- module Graphics.UI.Gtk.Layout.Notebook ( -- * Detail -- -- | The 'Notebook' widget is a 'Container' whose children are pages that can -- be switched between using tab labels along one edge. -- -- There are many configuration options for 'Notebook'. Among other things, -- you can choose on which edge the tabs appear (see 'notebookSetTabPos'), -- whether, if there are too many tabs to fit the noteobook should be made -- bigger or scrolling arrows added (see 'notebookSetScrollable'), and -- whether there will be a popup menu allowing the users to switch pages. (see -- 'notebookEnablePopup') -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Notebook -- @ -- * Types Notebook, NotebookClass, #if GTK_MAJOR_VERSION < 3 NotebookPage, #endif castToNotebook, gTypeNotebook, toNotebook, -- * Constructors notebookNew, -- * Methods notebookAppendPage, notebookAppendPageMenu, notebookPrependPage, notebookPrependPageMenu, notebookInsertPage, notebookInsertPageMenu, notebookRemovePage, notebookPageNum, notebookSetCurrentPage, notebookNextPage, notebookPrevPage, notebookReorderChild, PositionType(..), notebookSetTabPos, notebookGetTabPos, notebookSetShowTabs, notebookGetShowTabs, notebookSetShowBorder, notebookGetShowBorder, notebookSetScrollable, notebookGetScrollable, #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED notebookSetTabBorder, notebookSetTabHBorder, notebookSetTabVBorder, #endif #endif notebookSetPopup, notebookGetCurrentPage, notebookSetMenuLabel, notebookGetMenuLabel, notebookSetMenuLabelText, notebookGetMenuLabelText, notebookGetNthPage, #if GTK_CHECK_VERSION(2,2,0) notebookGetNPages, #endif notebookGetTabLabel, notebookGetTabLabelText, Packing(..), PackType(..), #if GTK_MAJOR_VERSION < 3 notebookQueryTabLabelPacking, notebookSetTabLabelPacking, #ifndef DISABLE_DEPRECATED notebookSetHomogeneousTabs, #endif #endif notebookSetTabLabel, notebookSetTabLabelText, #if GTK_CHECK_VERSION(2,10,0) notebookSetTabReorderable, notebookGetTabReorderable, notebookSetTabDetachable, notebookGetTabDetachable, #endif #if GTK_CHECK_VERSION(2,20,0) notebookSetActionWidget, notebookGetActionWidget, #endif -- * Attributes notebookPage, notebookTabPos, notebookTabBorder, notebookTabHborder, notebookTabVborder, notebookShowTabs, notebookShowBorder, notebookScrollable, notebookEnablePopup, notebookHomogeneous, notebookCurrentPage, -- * Child Attributes notebookChildTabLabel, notebookChildMenuLabel, notebookChildPosition, notebookChildTabPacking, notebookChildTabPackType, notebookChildDetachable, notebookChildReorderable, notebookChildTabExpand, notebookChildTabFill, -- * Style Attributes #if GTK_CHECK_VERSION(2,10,0) notebookStyleArrowSpacing, #endif notebookStyleHasBackwardStepper, notebookStyleHasForwardStepper, notebookStyleHasSecondaryBackwardStepper, notebookStyleHasSecondaryForwardStepper, #if GTK_CHECK_VERSION(2,10,0) notebookStyleTabCurvature, notebookStyleTabOverlap, #endif -- * Signals switchPage, pageAdded, pageRemoved, pageReordered, -- * Deprecated #ifndef DISABLE_DEPRECATED onSwitchPage, afterSwitchPage #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Abstract.ContainerChildProperties import Graphics.UI.Gtk.Display.Label (labelNew) import Graphics.UI.Gtk.General.Enums (Packing(..), toPacking, fromPacking, PackType(..), PositionType(..)) {# context lib="gtk" prefix="gtk" #} #if GTK_MAJOR_VERSION < 3 {#pointer *GtkNotebookPage as NotebookPage foreign newtype #} _ignoreNotebookPage = NotebookPage #endif -------------------- -- Constructors -- | Creates a new 'Notebook' widget with no pages. -- notebookNew :: IO Notebook notebookNew = makeNewObject mkNotebook $ liftM (castPtr :: Ptr Widget -> Ptr Notebook) $ {# call unsafe notebook_new #} -------------------- -- Methods #if GTK_CHECK_VERSION(2,4,0) -- | Appends a page to @notebook@. -- -- The given label will be used for the label widget of the new tab. In case -- the context menu is enabled, this name will also appear in the popup menu. -- If you want to specify something else to go in the tab, use -- 'notebookAppendPageMenu'. -- -- * This function returned @()@ in Gtk+ version 2.2.X and earlier -- notebookAppendPage :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> string -- ^ @tabLabel@ - the label for the page -> IO Int -- ^ returns the index (starting from 0) of the appended page in -- the notebook, or -1 if function fails notebookAppendPage self child tabLabel = do tab <- labelNew (Just tabLabel) liftM fromIntegral $ {# call notebook_append_page #} (toNotebook self) (toWidget child) (toWidget tab) #else -- | Appends a page to @notebook@. -- -- The given label will be used for the label widget of the new tab. In case -- the context menu is enabled, this name will also appear in the popup menu. -- If you want to specify something else to go in the tab, use -- 'notebookAppendPageMenu'. -- -- * This function returns @Int@ in Gtk+ version 2.4.0 and later. -- notebookAppendPage :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> string -- ^ @tabLabel@ - the label for the page -> IO () notebookAppendPage self child tabLabel = do tab <- labelNew (Just tabLabel) {# call notebook_append_page #} (toNotebook self) (toWidget child) (toWidget tab) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Appends a page to @notebook@, specifying the widget to use as the label -- in the popup menu. -- -- Like 'notebookAppendPage' but allows any widget to be used for the label of -- the new tab and the entry in the page-switch popup menu. -- -- * This function returned @()@ in Gtk version 2.2.X and earlier -- notebookAppendPageMenu :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel, WidgetClass menuLabel) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the -- page (usually a 'Label' widget). -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the -- page-switch menu, if that is enabled (usually a 'Label' -- widget). -> IO Int -- ^ returns the index (starting from 0) of the appended page in -- the notebook, or -1 if function fails notebookAppendPageMenu self child tabLabel menuLabel = liftM fromIntegral $ {# call notebook_append_page_menu #} (toNotebook self) (toWidget child) (toWidget tabLabel) (toWidget menuLabel) #else -- | Appends a page to @notebook@, specifying the widget to use as the label -- in the popup menu. -- -- Like 'notebookAppendPage' but allows any widget to be used for the label of -- the new tab and then entry in the page-switch popup menu. -- -- * This function returns @Int@ in Gtk+ version 2.4.0 and later -- notebookAppendPageMenu :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel, WidgetClass menuLabel) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the -- page (usually a 'Label' widget). -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the -- page-switch menu, if that is enabled (usually a 'Label' -- widget). -> IO () notebookAppendPageMenu self child tabLabel menuLabel = {# call notebook_append_page_menu #} (toNotebook self) (toWidget child) (toWidget tabLabel) (toWidget menuLabel) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Prepends a page to @notebook@. -- -- * The given label will be used for the label widget of the new tab. In case -- the context menu is enabled, this name will also appear in the popup menu. If -- you want to specify something else to go in the tab, use -- 'notebookPrependPageMenu'. -- -- * This function returned @()@ in Gtk version 2.2.X and earlier -- notebookPrependPage :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> string -- ^ @tabLabel@ - the label for the page -> IO Int -- ^ returns the index (starting from 0) of the prepended page in -- the notebook, or -1 if function fails notebookPrependPage self child tabLabel = do tab <- labelNew (Just tabLabel) liftM fromIntegral $ {# call notebook_prepend_page #} (toNotebook self) (toWidget child) (toWidget tab) #else -- | Prepends a page to @notebook@. -- -- * The given label will be used for the label widget of the new tab. In case -- the context popup menu is enabled, this name will also appear in the menu. If -- you want to specify something else to go in the tab, use -- 'notebookPrependPageMenu'. -- -- * This function returns @Int@ in Gtk version 2.4.0 and later. -- notebookPrependPage :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> string -- ^ @tabLabel@ - the label for the page -> IO () notebookPrependPage self child tabLabel = do tab <- labelNew (Just tabLabel) {# call notebook_prepend_page #} (toNotebook self) (toWidget child) (toWidget tab) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Prepends a page to @notebook@, specifying the widget to use as the label -- in the popup menu. -- -- Like 'notebookPrependPage' but allows any widget to be used for the label of -- the new tab and then entry in the page-switch popup menu. -- -- * This function returned @()@ in Gtk version 2.2.X and earlier -- notebookPrependPageMenu :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel, WidgetClass menuLabel) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the -- page (usually a 'Label' widget). -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the -- page-switch menu, if that is enabled (usually a 'Label' -- widget). -> IO Int -- ^ returns the index (starting from 0) of the prepended page -- in the notebook, or -1 if function fails notebookPrependPageMenu self child tabLabel menuLabel = liftM fromIntegral $ {# call notebook_prepend_page_menu #} (toNotebook self) (toWidget child) (toWidget tabLabel) (toWidget menuLabel) #else -- | Prepends a page to @notebook@, specifying the widget to use as the label -- in the popup menu. -- -- Like 'notebookPrependPage' but allows any widget to be used for the label of -- the new tab and then entry in the page-switch popup menu. -- -- * This function returns @Int@ in Gtk version 2.4.0 and later -- notebookPrependPageMenu :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel, WidgetClass menuLabel) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the -- page (usually a 'Label' widget). -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the -- page-switch menu, if that is enabled (usually a 'Label' -- widget). -> IO () notebookPrependPageMenu self child tabLabel menuLabel = {# call notebook_prepend_page_menu #} (toNotebook self) (toWidget child) (toWidget tabLabel) (toWidget menuLabel) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Insert a page into @notebook@ at the given position. -- -- * The given label will be used for the label widget of the new tab. In case -- the context menu is enabled, this name will also appear in the popup menu. If -- you want to specify something else to go in the tab, use -- 'notebookInsertPageMenu'. -- -- * This function returned @()@ in Gtk version 2.2.X and earlier -- notebookInsertPage :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> string -- ^ @tabLabel@ - the label for the page -> Int -- ^ @position@ - the index (starting at 0) at which to insert -- the page, or -1 to append the page after all other pages. -> IO Int -- ^ returns the index (starting from 0) of the inserted page in -- the notebook, or -1 if function fails notebookInsertPage self child tabLabel position = do tab <- labelNew (Just tabLabel) liftM fromIntegral $ {# call notebook_insert_page #} (toNotebook self) (toWidget child) (toWidget tab) (fromIntegral position) #else -- | Insert a page into @notebook@ at the given position. -- -- * The given label will be used for the label widget of the new tab. In case -- the context menu is enabled, this name will also appear in the popup menu. If -- you want to specify something else to go in the tab, use -- 'notebookInsertPageMenu'. -- -- * This function returns @Int@ in Gtk version 2.4.0 and later. -- notebookInsertPage :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> string -- ^ @tabLabel@ - the label for the page -> Int -- ^ @position@ - the index (starting at 0) at which to insert -- the page, or -1 to append the page after all other pages. -> IO () notebookInsertPage self child tabLabel position = do tab <- labelNew (Just tabLabel) {# call notebook_insert_page #} (toNotebook self) (toWidget child) (toWidget tab) (fromIntegral position) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Insert a page into @notebook@ at the given position, specifying the -- widget to use as the label in the popup menu. -- -- Like 'notebookInsertPage' but allows any widget to be used for the label of -- the new tab and then entry in the page-switch popup menu. -- -- * This function returned @()@ in Gtk version 2.2.X and earlier -- notebookInsertPageMenu :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel, WidgetClass menuLabel) => self -> child -- ^ @child@ - the 'Widget' to use as the contents of the page. -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the -- page (usually a 'Label' widget). -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the -- page-switch menu, if that is enabled (usually a 'Label' -- widget). -> Int -- ^ @position@ - the index (starting at 0) at which to insert -- the page, or -1 to append the page after all other pages. -> IO Int -- ^ returns the index (starting from 0) of the inserted page in -- the notebook, or -1 if function fails notebookInsertPageMenu self child tabLabel menuLabel position = liftM fromIntegral $ {# call notebook_insert_page_menu #} (toNotebook self) (toWidget child) (toWidget tabLabel) (toWidget menuLabel) (fromIntegral position) #else -- | Insert a page into @notebook@ at the given position, specifying the -- widget to use as the label in the popup menu. -- -- Like 'notebookInsertPage' but allows any widget to be used for the label of -- the new tab and then entry in the page-switch popup menu. -- -- * This function returns @Int@ in Gtk version 2.4.0 and later -- notebookInsertPageMenu ::(NotebookClass nb, WidgetClass child, WidgetClass tab, WidgetClass menu) => nb -> child -- ^ Widget to use as the contents of the page -> tab -- ^ Tab label widget for the page. -> menu -- ^ Menu entry for this tab (usually a 'Label' widget). -> Int -- ^ Position for the new page. -> IO () notebookInsertPageMenu self child tabLabel menuLabel position = {# call notebook_insert_page_menu #} (toNotebook self) (toWidget child) (toWidget tabLabel) (toWidget menuLabel) (fromIntegral position) #endif -- | Removes a page from the notebook given its index in the notebook. -- notebookRemovePage :: NotebookClass self => self -> Int -- ^ @pageNum@ - the index of a notebook page, starting from 0. If -- -1, the last page will be removed. -> IO () notebookRemovePage self pageNum = {# call notebook_remove_page #} (toNotebook self) (fromIntegral pageNum) -- | Query the page the child widget is contained in. -- -- * The function returns the page number if the child was found, Nothing -- otherwise. -- notebookPageNum :: (NotebookClass self, WidgetClass w) => self -> w -> IO (Maybe Int) notebookPageNum nb child = liftM (\page -> if page==(-1) then Nothing else Just (fromIntegral page)) $ {# call unsafe notebook_page_num #} (toNotebook nb) (toWidget child) -- | Switches to the page number @pageNum@. Page numbers start from @0@. -- Use @-1@ to request the last page. -- -- * Note that due to historical reasons, GtkNotebook refuses -- to switch to a page unless the child widget is visible. -- Therefore, it is recommended to show child widgets before -- adding them to a notebook. -- notebookSetCurrentPage :: NotebookClass self => self -> Int -- ^ @pageNum@ - index of the page to switch to, starting from 0. If -- negative, the last page will be used. If greater than the number -- of pages in the notebook, nothing will be done. -> IO () notebookSetCurrentPage self pageNum = {# call notebook_set_current_page #} (toNotebook self) (fromIntegral pageNum) -- | Switches to the next page. Nothing happens if the current page is the -- last page. -- notebookNextPage :: NotebookClass self => self -> IO () notebookNextPage self = {# call notebook_next_page #} (toNotebook self) -- | Switches to the previous page. Nothing happens if the current page is the -- first page. -- notebookPrevPage :: NotebookClass self => self -> IO () notebookPrevPage self = {# call notebook_prev_page #} (toNotebook self) -- | Reorders the page containing @child@, so that it appears in position -- @position@. If @position@ is greater than or equal to the number of children -- in the list or negative, @child@ will be moved to the end of the list. -- notebookReorderChild :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the child to move -> Int -- ^ @position@ - the new position, or -1 to move to the end -> IO () notebookReorderChild self child position = {# call notebook_reorder_child #} (toNotebook self) (toWidget child) (fromIntegral position) -- | Sets the edge at which the tabs for switching pages in the notebook are -- drawn. -- notebookSetTabPos :: NotebookClass self => self -> PositionType -- ^ @pos@ - the edge to draw the tabs at. -> IO () notebookSetTabPos self pos = {# call notebook_set_tab_pos #} (toNotebook self) ((fromIntegral . fromEnum) pos) -- | Gets the edge at which the tabs for switching pages in the notebook are -- drawn. -- notebookGetTabPos :: NotebookClass self => self -> IO PositionType -- ^ returns the edge at which the tabs are drawn notebookGetTabPos self = liftM (toEnum . fromIntegral) $ {# call unsafe notebook_get_tab_pos #} (toNotebook self) -- | Sets whether to show the tabs for the notebook or not. -- notebookSetShowTabs :: NotebookClass self => self -> Bool -- ^ @showTabs@ - @True@ if the tabs should be shown. -> IO () notebookSetShowTabs self showTabs = {# call notebook_set_show_tabs #} (toNotebook self) (fromBool showTabs) -- | Returns whether the tabs of the notebook are shown. See -- 'notebookSetShowTabs'. -- notebookGetShowTabs :: NotebookClass self => self -> IO Bool -- ^ returns @True@ if the tabs are shown notebookGetShowTabs self = liftM toBool $ {# call unsafe notebook_get_show_tabs #} (toNotebook self) -- | Sets whether a bevel will be drawn around the notebook pages. This only -- has a visual effect when the tabs are not shown. See 'notebookSetShowTabs'. -- notebookSetShowBorder :: NotebookClass self => self -> Bool -- ^ @showBorder@ - @True@ if a bevel should be drawn around the -- notebook. -> IO () notebookSetShowBorder self showBorder = {# call notebook_set_show_border #} (toNotebook self) (fromBool showBorder) -- | Returns whether a bevel will be drawn around the notebook pages. See -- 'notebookSetShowBorder'. -- notebookGetShowBorder :: NotebookClass self => self -> IO Bool -- ^ returns @True@ if the bevel is drawn notebookGetShowBorder self = liftM toBool $ {# call unsafe notebook_get_show_border #} (toNotebook self) -- | Sets whether the tab label area will have arrows for scrolling if there -- are too many tabs to fit in the area. -- notebookSetScrollable :: NotebookClass self => self -> Bool -- ^ @scrollable@ - @True@ if scroll arrows should be added -> IO () notebookSetScrollable self scrollable = {# call unsafe notebook_set_scrollable #} (toNotebook self) (fromBool scrollable) -- | Returns whether the tab label area has arrows for scrolling. See -- 'notebookSetScrollable'. -- notebookGetScrollable :: NotebookClass self => self -> IO Bool -- ^ returns @True@ if arrows for scrolling are present notebookGetScrollable self = liftM toBool $ {# call unsafe notebook_get_scrollable #} (toNotebook self) #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Sets the width the border around the tab labels in a notebook. This is -- equivalent to calling @'notebookSetTabHBorder' notebook borderWidth@ -- followed by @'notebookSetTabVBorder' notebook borderWidth@. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. notebookSetTabBorder :: NotebookClass self => self -> Int -- ^ @borderWidth@ - width of the border around the tab labels. -> IO () notebookSetTabBorder self borderWidth = {# call notebook_set_tab_border #} (toNotebook self) (fromIntegral borderWidth) -- | Sets the width of the horizontal border of tab labels. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. notebookSetTabHBorder :: NotebookClass self => self -> Int -- ^ @tabHborder@ - width of the horizontal border of tab labels. -> IO () notebookSetTabHBorder self tabHborder = {# call notebook_set_tab_hborder #} (toNotebook self) (fromIntegral tabHborder) -- | Sets the width of the vertical border of tab labels. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. notebookSetTabVBorder :: NotebookClass self => self -> Int -- ^ @tabVborder@ - width of the vertical border of tab labels. -> IO () notebookSetTabVBorder self tabVborder = {# call notebook_set_tab_vborder #} (toNotebook self) (fromIntegral tabVborder) #endif #endif -- | Enables or disables the popup menu: if the user clicks with the right -- mouse button on the bookmarks, a menu with all the pages will be popped up. -- notebookSetPopup :: NotebookClass self => self -> Bool -> IO () notebookSetPopup self enable = (if enable then {#call notebook_popup_enable#} else {#call notebook_popup_disable#}) (toNotebook self) -- | Returns the page number of the current page. -- notebookGetCurrentPage :: NotebookClass self => self -> IO Int -- ^ returns the index (starting from 0) of the current page in the -- notebook. If the notebook has no pages, then -1 will be returned. notebookGetCurrentPage self = liftM fromIntegral $ {# call unsafe notebook_get_current_page #} (toNotebook self) -- | Changes the menu label for the page containing @child@. -- notebookSetMenuLabel :: (NotebookClass self, WidgetClass child, WidgetClass menuLabel) => self -> child -- ^ @child@ - the child widget -> Maybe menuLabel -- ^ @menuLabel@ - the menu label, or @Nothing@ for -- default -> IO () notebookSetMenuLabel self child menuLabel = {# call notebook_set_menu_label #} (toNotebook self) (toWidget child) (maybe (Widget nullForeignPtr) toWidget menuLabel) -- | Retrieves the menu label widget of the page containing @child@. -- notebookGetMenuLabel :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - a widget contained in a page of -- @notebook@ -> IO (Maybe Widget) -- ^ returns the menu label, or @Nothing@ if the -- notebook page does not have a menu label other than -- the default (the tab label). notebookGetMenuLabel self child = maybeNull (makeNewObject mkWidget) $ {# call unsafe notebook_get_menu_label #} (toNotebook self) (toWidget child) -- | Creates a new label and sets it as the menu label of @child@. -- notebookSetMenuLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the child widget -> string -- ^ @menuText@ - the label text -> IO () notebookSetMenuLabelText self child menuText = withUTFString menuText $ \menuTextPtr -> {# call notebook_set_menu_label_text #} (toNotebook self) (toWidget child) menuTextPtr -- | Retrieves the text of the menu label for the page containing @child@. -- notebookGetMenuLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the child widget of a page of the -- notebook. -> IO (Maybe string) -- ^ returns value: the text of the tab label, or -- @Nothing@ if the widget does not have a menu label -- other than the default menu label, or the menu label -- widget is not a 'Label'. notebookGetMenuLabelText self child = {# call unsafe notebook_get_menu_label_text #} (toNotebook self) (toWidget child) >>= maybePeek peekUTFString -- | Returns the child widget contained in page number @pageNum@. -- notebookGetNthPage :: NotebookClass self => self -> Int -- ^ @pageNum@ - the index of a page in the noteobok, or -- -1 to get the last page. -> IO (Maybe Widget) -- ^ returns the child widget, or @Nothing@ if @pageNum@ -- is out of bounds. notebookGetNthPage self pageNum = maybeNull (makeNewObject mkWidget) $ {# call unsafe notebook_get_nth_page #} (toNotebook self) (fromIntegral pageNum) #if GTK_CHECK_VERSION(2,2,0) -- | Gets the number of pages in a notebook. -- -- * Available since Gtk version 2.2 -- notebookGetNPages :: NotebookClass self => self -> IO Int notebookGetNPages self = liftM fromIntegral $ {# call unsafe notebook_get_n_pages #} (toNotebook self) #endif -- | Returns the tab label widget for the page @child@. @Nothing@ is returned -- if @child@ is not in @notebook@ or if no tab label has specifically been set -- for @child@. -- notebookGetTabLabel :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the page -> IO (Maybe Widget) -- ^ returns the tab label notebookGetTabLabel self child = maybeNull (makeNewObject mkWidget) $ {# call unsafe notebook_get_tab_label #} (toNotebook self) (toWidget child) -- | Retrieves the text of the tab label for the page containing @child@. -- notebookGetTabLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - a widget contained in a page of -- @notebook@ -> IO (Maybe string) -- ^ returns value: the text of the tab label, or -- @Nothing@ if the tab label widget is not a 'Label'. notebookGetTabLabelText self child = {# call unsafe notebook_get_tab_label_text #} (toNotebook self) (toWidget child) >>= maybePeek peekUTFString #if GTK_MAJOR_VERSION < 3 -- | Query the packing attributes for the tab label of the page containing -- @child@. -- -- Removed in Gtk3. notebookQueryTabLabelPacking :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the page -> IO (Packing,PackType) notebookQueryTabLabelPacking self child = alloca $ \expPtr -> alloca $ \fillPtr -> alloca $ \packPtr -> do {# call unsafe notebook_query_tab_label_packing #} (toNotebook self) (toWidget child) expPtr fillPtr packPtr expand <- liftM toBool $ peek expPtr fill <- liftM toBool $ peek fillPtr pt <- liftM (toEnum . fromIntegral) $ peek packPtr return (toPacking expand fill, pt) -- | Sets the packing parameters for the tab label of the page containing -- @child@. See 'Graphics.UI.Gtk.Abstract.Box.boxPackStart' for the exact -- meaning of the parameters. -- -- Removed in Gtk3. notebookSetTabLabelPacking :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the child widget -> Packing -> PackType -- ^ @packType@ - the position of the bookmark -> IO () notebookSetTabLabelPacking self child pack packType = {# call notebook_set_tab_label_packing #} (toNotebook self) (toWidget child) (fromBool expand) (fromBool fill) ((fromIntegral . fromEnum) packType) where (expand, fill) = fromPacking pack #ifndef DISABLE_DEPRECATED -- | Sets whether the tabs must have all the same size or not. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. notebookSetHomogeneousTabs :: NotebookClass self => self -> Bool -- ^ @homogeneous@ - @True@ if all tabs should be the same size. -> IO () notebookSetHomogeneousTabs self homogeneous = {# call notebook_set_homogeneous_tabs #} (toNotebook self) (fromBool homogeneous) #endif #endif -- | Changes the tab label for @child@. -- notebookSetTabLabel :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel) => self -> child -- ^ @child@ - the page -> tabLabel -- ^ @tabLabel@ - the tab label widget to use -> IO () notebookSetTabLabel self child tabLabel = {# call notebook_set_tab_label #} (toNotebook self) (toWidget child) (toWidget tabLabel) -- | Creates a new label and sets it as the tab label for the page containing -- @child@. -- notebookSetTabLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self -> child -- ^ @child@ - the page -> string -- ^ @tabText@ - the label text -> IO () notebookSetTabLabelText self child tabText = withUTFString tabText $ \tabTextPtr -> {# call notebook_set_tab_label_text #} (toNotebook self) (toWidget child) tabTextPtr #if GTK_CHECK_VERSION(2,10,0) -- | Sets whether the notebook tab can be reordered via drag and drop or not. -- -- * Available since Gtk version 2.10 -- notebookSetTabReorderable :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - a child page -> Bool -- ^ @reorderable@ - whether the tab is reorderable or not. -> IO () notebookSetTabReorderable self child reorderable = {# call notebook_set_tab_reorderable #} (toNotebook self) (toWidget child) (fromBool reorderable) -- | Gets whether the tab can be reordered via drag and drop or not. -- -- * Available since Gtk version 2.10 -- notebookGetTabReorderable :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the child page -> IO Bool -- ^ return @True@ if the tab is reorderable. notebookGetTabReorderable self child = liftM toBool $ {# call notebook_get_tab_reorderable #} (toNotebook self) (toWidget child) -- | Sets whether the tab can be detached from notebook to another notebook or widget. -- -- Note that 2 notebooks must share a common group identificator (see gtk_notebook_set_group_id()) to allow automatic tabs interchange between them. -- -- If you want a widget to interact with a notebook through DnD (i.e.: accept dragged tabs from it) it must be set as a drop destination and accept the target "GTK_NOTEBOOK_TAB". -- The notebook will fill the selection with a GtkWidget** pointing to the child widget that corresponds to the dropped tab. -- -- If you want a notebook to accept drags from other widgets, you will have to set your own DnD code to do it. -- -- * Available since Gtk version 2.10 -- notebookSetTabDetachable :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the child page -> Bool -- ^ @detachable@ - whether the tab is detachable or not -> IO () notebookSetTabDetachable self child detachable = {# call notebook_set_tab_detachable #} (toNotebook self) (toWidget child) (fromBool detachable) -- | Returns whether the tab contents can be detached from notebook. -- -- * Available since Gtk version 2.10 -- notebookGetTabDetachable :: (NotebookClass self, WidgetClass child) => self -> child -- ^ @child@ - the child page -> IO Bool -- ^ return @True@ if the tab is detachable. notebookGetTabDetachable self child = liftM toBool $ {# call notebook_get_tab_detachable #} (toNotebook self) (toWidget child) #endif #if GTK_CHECK_VERSION(2,20,0) -- | Sets widget as one of the action widgets. Depending on the pack type the widget will be placed -- before or after the tabs. You can use a 'Box' if you need to pack more than one widget on the same -- side. -- -- Note that action widgets are "internal" children of the notebook and thus not included in the list -- returned from 'containerForeach'. -- -- * Available since Gtk version 2.20 -- notebookSetActionWidget :: (NotebookClass self, WidgetClass widget) => self -> widget -> PackType -- ^ @packType@ pack type of the action widget -> IO () notebookSetActionWidget self widget packType = {#call gtk_notebook_set_action_widget #} (toNotebook self) (toWidget widget) ((fromIntegral . fromEnum) packType) -- | Gets one of the action widgets. See 'notebookSetActionWidget'. -- -- * Available since Gtk version 2.20 -- notebookGetActionWidget :: NotebookClass self => self -> PackType -- ^ @packType@ pack type of the action widget to receive -> IO (Maybe Widget) notebookGetActionWidget self packType = maybeNull (makeNewObject mkWidget) $ {#call gtk_notebook_get_action_widget #} (toNotebook self) ((fromIntegral . fromEnum) packType) #endif -------------------- -- Attributes -- | The index of the current page. -- -- Allowed values: >= 0 -- -- Default value: 0 -- notebookPage :: NotebookClass self => Attr self Int notebookPage = newAttrFromIntProperty "page" -- | Which side of the notebook holds the tabs. -- -- Default value: 'PosTop' -- notebookTabPos :: NotebookClass self => Attr self PositionType notebookTabPos = newAttr notebookGetTabPos notebookSetTabPos -- | Width of the border around the tab labels. -- -- Default value: 2 -- notebookTabBorder :: NotebookClass self => WriteAttr self Int notebookTabBorder = writeAttrFromUIntProperty "tab-border" -- | Width of the horizontal border of tab labels. -- -- Default value: 2 -- notebookTabHborder :: NotebookClass self => Attr self Int notebookTabHborder = newAttrFromUIntProperty "tab-hborder" -- | Width of the vertical border of tab labels. -- -- Default value: 2 -- notebookTabVborder :: NotebookClass self => Attr self Int notebookTabVborder = newAttrFromUIntProperty "tab-vborder" -- | Whether tabs should be shown or not. -- -- Default value: @True@ -- notebookShowTabs :: NotebookClass self => Attr self Bool notebookShowTabs = newAttr notebookGetShowTabs notebookSetShowTabs -- | Whether the border should be shown or not. -- -- Default value: @True@ -- notebookShowBorder :: NotebookClass self => Attr self Bool notebookShowBorder = newAttr notebookGetShowBorder notebookSetShowBorder -- | If @True@, scroll arrows are added if there are too many tabs to fit. -- -- Default value: @False@ -- notebookScrollable :: NotebookClass self => Attr self Bool notebookScrollable = newAttr notebookGetScrollable notebookSetScrollable -- | If @True@, pressing the right mouse button on the notebook pops up a menu -- that you can use to go to a page. -- -- Default value: @False@ -- notebookEnablePopup :: NotebookClass self => Attr self Bool notebookEnablePopup = newAttrFromBoolProperty "enable-popup" -- | Whether tabs should have homogeneous sizes. -- -- Default value: @False@ -- notebookHomogeneous :: NotebookClass self => Attr self Bool notebookHomogeneous = newAttrFromBoolProperty "homogeneous" -- | Switches to the page number @pageNum@. -- -- Note that due to historical reasons, 'Notebook' refuses to switch to a -- page unless the child widget is visible. Therefore, it is recommended to -- show child widgets before adding them to a notebook. -- -- Returns the page number of the current page. -- notebookCurrentPage :: NotebookClass self => Attr self Int notebookCurrentPage = newAttr notebookGetCurrentPage notebookSetCurrentPage -------------------- -- Child Attributes -- | The string displayed on the child's tab label. -- -- Default value: @Nothing@ -- notebookChildTabLabel :: (NotebookClass self, WidgetClass child, GlibString string) => child -> Attr self string notebookChildTabLabel = newAttrFromContainerChildStringProperty "tab-label" -- | The string displayed in the child's menu entry. -- -- Default value: @Nothing@ -- notebookChildMenuLabel :: (NotebookClass self, WidgetClass child, GlibString string) => child -> Attr self string notebookChildMenuLabel = newAttrFromContainerChildStringProperty "menu-label" -- | The index of the child in the parent. -- -- Allowed values: >= -1 -- -- Default value: 0 -- notebookChildPosition :: (NotebookClass self, WidgetClass child) => child -> Attr self Int notebookChildPosition = newAttrFromContainerChildIntProperty "position" -- | The packing style of the child's tab. -- -- Default value: 'PackGrow' -- notebookChildTabPacking :: (NotebookClass self, WidgetClass child) => child -> Attr self Packing notebookChildTabPacking child = newAttr (\container -> do expand <- containerChildGetPropertyBool "tab-expand" child container fill <- containerChildGetPropertyBool "tab-fill" child container return (toPacking expand fill)) (\container packing -> case fromPacking packing of (expand, fill) -> do containerChildSetPropertyBool "tab-expand" child container expand containerChildSetPropertyBool "tab-fill" child container fill) -- | A 'PackType' indicating whether the child is packed with reference to the -- start or end of the parent. -- -- Default value: 'PackStart' -- notebookChildTabPackType :: (NotebookClass self, WidgetClass child) => child -> Attr self PackType notebookChildTabPackType = newAttrFromContainerChildEnumProperty "tab-pack" {# call pure unsafe gtk_pack_type_get_type #} -- | Whether the tab is detachable. -- -- Default value: @False@ -- notebookChildDetachable :: NotebookClass self => Attr self Bool notebookChildDetachable = newAttrFromBoolProperty "detachable" -- | Whether the tab is reorderable by user action or not. -- -- Default value: @False@ -- notebookChildReorderable :: NotebookClass self => Attr self Bool notebookChildReorderable = newAttrFromBoolProperty "reorderable" -- | Whether to expand the child's tab or not. -- -- Default value : @False@ -- notebookChildTabExpand :: NotebookClass self => Attr self Bool notebookChildTabExpand = newAttrFromBoolProperty "tab-expand" -- | Whether the child's tab should fill the allocated area or not. -- -- Default value : @False@ -- notebookChildTabFill :: NotebookClass self => Attr self Bool notebookChildTabFill = newAttrFromBoolProperty "tab-fill" #if GTK_CHECK_VERSION(2,10,0) -- | The 'notebookStyleArrowSpacing' property defines the spacing between the scroll arrows and the tabs. -- -- Allowed values: >= 0 -- -- Default value: 0 -- -- * Available since Gtk version 2.10 -- notebookStyleArrowSpacing :: NotebookClass self => ReadAttr self Bool notebookStyleArrowSpacing = readAttrFromBoolProperty "arrow-spacing" #endif -- | The 'notebookStyleHasBackwardStepper' property determines whether the standard backward arrow button is displayed. -- -- Default value: @True@ -- -- * Available since Gtk version 2.4 -- notebookStyleHasBackwardStepper :: NotebookClass self => ReadAttr self Bool notebookStyleHasBackwardStepper = readAttrFromBoolProperty "has-backward-stepper" -- | The 'notebookStyleHasForwardStepper' property determines whether the standard forward arrow button is displayed. -- -- Default value : @True@ -- -- * Available since Gtk version 2.4 -- notebookStyleHasForwardStepper :: NotebookClass self => ReadAttr self Bool notebookStyleHasForwardStepper = readAttrFromBoolProperty "has-forward-stepper" -- | The 'notebookStyleHasSecondaryBackwardStepper' property determines whether a second backward arrow button is displayed on the opposite end of the tab area. -- -- Default value: @False@ -- -- * Available since Gtk version 2.4 -- notebookStyleHasSecondaryBackwardStepper :: NotebookClass self => ReadAttr self Bool notebookStyleHasSecondaryBackwardStepper = readAttrFromBoolProperty "has-secondary-backward-stepper" -- | The 'notebookStyleHasSecondaryForwardStepper' property determines whether a second forward arrow button is displayed on the opposite end of the tab area. -- -- Default value: @False@ -- -- * Available since Gtk version 2.4 -- notebookStyleHasSecondaryForwardStepper :: NotebookClass self => ReadAttr self Bool notebookStyleHasSecondaryForwardStepper = readAttrFromBoolProperty "has-secondary-forward-stepper" #if GTK_CHECK_VERSION(2,10,0) -- | The 'notebookStyleTabCurvature' property defines size of tab curvature. -- -- Allowed values: >= 0 -- -- Default value: 1 -- -- * Available since Gtk version 2.10 -- notebookStyleTabCurvature :: NotebookClass self => ReadAttr self Int notebookStyleTabCurvature = readAttrFromIntProperty "tab-curvature" -- | The 'notebookStyleTabOverlap' property defines size of tab overlap area. -- -- Default value: 2 -- -- * Available since Gtk version 2.10 -- notebookStyleTabOverlap :: NotebookClass self => ReadAttr self Int notebookStyleTabOverlap = readAttrFromIntProperty "tab-overlap" #endif -------------------- -- Signals -- | Emitted when the user or a function changes the current page. -- switchPage :: NotebookClass self => Signal self (Int -> IO ()) switchPage = Signal (\after obj act -> connect_PTR_WORD__NONE "switch-page" after obj (\_ page -> act (fromIntegral page))) #if GTK_CHECK_VERSION(2,10,0) -- | The 'pageReordered' signal is emitted in the notebook right after a page has been reordered. -- -- * Available since Gtk+ version 2.10 -- pageReordered :: NotebookClass self => Signal self (Widget -> Int -> IO ()) pageReordered = Signal (connect_OBJECT_INT__NONE "page-reordered") -- | The 'pageRemoved' signal is emitted in the notebook right after a page is removed from the notebook. -- -- * Available since Gtk+ version 2.10 -- pageRemoved :: NotebookClass self => Signal self (Widget -> Int -> IO ()) pageRemoved = Signal (connect_OBJECT_INT__NONE "page-removed") -- | The 'pageAdded' signal is emitted in the notebook right after a page is added to the notebook. -- -- * Available since Gtk+ version 2.10 -- pageAdded :: NotebookClass self => Signal self (Widget -> Int -> IO ()) pageAdded = Signal (connect_OBJECT_INT__NONE "page-added") #endif -- * Deprecated #ifndef DISABLE_DEPRECATED -- | This signal is emitted when a new page is -- selected. -- onSwitchPage, afterSwitchPage :: NotebookClass nb => nb -> (Int -> IO ()) -> IO (ConnectId nb) onSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" (const $ return ()) False nb (\_ page -> fun (fromIntegral page)) afterSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page" (const $ return ()) True nb (\_ page -> fun (fromIntegral page)) #endif gtk-0.15.9/Graphics/UI/Gtk/Layout/Table.chs0000644000000000000000000003615607346545000016404 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Table -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The table widget is a container in which widgets can be aligned in cells. -- module Graphics.UI.Gtk.Layout.Table ( -- * Detail -- -- | The 'Table' functions allow the programmer to arrange widgets in rows and -- columns, making it easy to align many widgets next to each other, -- horizontally and vertically. -- -- Tables are created with a call to 'tableNew', the size of which can later -- be changed with 'tableResize'. -- -- Widgets can be added to a table using 'tableAttach' or the more -- convenient (but slightly less flexible) 'tableAttachDefaults'. -- -- To alter the space next to a specific row, use 'tableSetRowSpacing', and -- for a column, 'tableSetColSpacing'. -- -- The gaps between /all/ rows or columns can be changed by calling -- 'tableSetRowSpacings' or 'tableSetColSpacings' respectively. -- -- 'tableSetHomogeneous', can be used to set whether all cells in the table -- will resize themselves to the size of the largest widget in the table. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Table -- @ -- * Types Table, TableClass, castToTable, gTypeTable, toTable, -- * Constructors tableNew, -- * Methods tableResize, AttachOptions(..), tableAttach, tableAttachDefaults, tableSetRowSpacing, tableGetRowSpacing, tableSetColSpacing, tableGetColSpacing, tableSetRowSpacings, tableGetDefaultRowSpacing, tableSetColSpacings, tableGetDefaultColSpacing, tableSetHomogeneous, tableGetHomogeneous, #if GTK_CHECK_VERSION(2,22,0) tableGetSize, #endif -- * Attributes tableNRows, tableNColumns, tableRowSpacing, tableColumnSpacing, tableHomogeneous, -- * Child Attributes tableChildLeftAttach, tableChildRightAttach, tableChildTopAttach, tableChildBottomAttach, tableChildXOptions, tableChildYOptions, tableChildXPadding, tableChildYPadding, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags (fromFlags) import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (AttachOptions(..)) import Graphics.UI.Gtk.Abstract.ContainerChildProperties {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Used to create a new table widget. An initial size must be given by -- specifying how many rows and columns the table should have, although this -- can be changed later with 'tableResize'. @rows@ and @columns@ must both be -- in the range 0 .. 65535. -- tableNew :: Int -- ^ @rows@ - The number of rows the new table should have. -> Int -- ^ @columns@ - The number of columns the new table should have. -> Bool -- ^ @homogeneous@ - If set to @True@, all table cells are -- resized to the size of the cell containing the largest widget. -> IO Table tableNew rows columns homogeneous = makeNewObject mkTable $ liftM (castPtr :: Ptr Widget -> Ptr Table) $ {# call unsafe table_new #} (fromIntegral rows) (fromIntegral columns) (fromBool homogeneous) -------------------- -- Methods -- | Change the dimensions of an already existing table. -- tableResize :: TableClass self => self -> Int -- ^ @rows@ - The new number of rows. -> Int -- ^ @columns@ - The new number of columns. -> IO () tableResize self rows columns = {# call table_resize #} (toTable self) (fromIntegral rows) (fromIntegral columns) -- | Adds a widget to a table. The number of \'cells\' that a widget will -- occupy is specified by @leftAttach@, @rightAttach@, @topAttach@ and -- @bottomAttach@. These each represent the leftmost, rightmost, uppermost and -- lowest column and row numbers of the table. (Columns and rows are indexed -- from zero). -- tableAttach :: (TableClass self, WidgetClass child) => self -> child -- ^ @child@ - The widget to add. -> Int -- ^ @leftAttach@ - the column number to attach the left -- side of a child widget to. -> Int -- ^ @rightAttach@ - the column number to attach the right -- side of a child widget to. -> Int -- ^ @topAttach@ - the row number to attach the top of a -- child widget to. -> Int -- ^ @bottomAttach@ - the row number to attach the bottom -- of a child widget to. -> [AttachOptions] -- ^ @xoptions@ - Used to specify the properties of the -- child widget when the table is resized. -> [AttachOptions] -- ^ @yoptions@ - The same as xoptions, except this field -- determines behaviour of vertical resizing. -> Int -- ^ @xpadding@ - An integer value specifying the padding -- on the left and right of the widget being added to the -- table. -> Int -- ^ @ypadding@ - The amount of padding above and below -- the child widget. -> IO () tableAttach self child leftAttach rightAttach topAttach bottomAttach xoptions yoptions xpadding ypadding = {# call table_attach #} (toTable self) (toWidget child) (fromIntegral leftAttach) (fromIntegral rightAttach) (fromIntegral topAttach) (fromIntegral bottomAttach) ((fromIntegral . fromFlags) xoptions) ((fromIntegral . fromFlags) yoptions) (fromIntegral xpadding) (fromIntegral ypadding) -- | As there are many options associated with 'tableAttach', this convenience -- function provides the programmer with a means to add children to a table -- with identical padding and expansion options. The values used for the -- 'AttachOptions' are @['Expand', 'Fill']@, and the padding is set to 0. -- tableAttachDefaults :: (TableClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - The child widget to add. -> Int -- ^ @leftAttach@ - The column number to attach the left side of -- the child widget to. -> Int -- ^ @rightAttach@ - The column number to attach the right side of -- the child widget to. -> Int -- ^ @topAttach@ - The row number to attach the top of the child -- widget to. -> Int -- ^ @bottomAttach@ - The row number to attach the bottom of the -- child widget to. -> IO () tableAttachDefaults self widget leftAttach rightAttach topAttach bottomAttach = {# call table_attach_defaults #} (toTable self) (toWidget widget) (fromIntegral leftAttach) (fromIntegral rightAttach) (fromIntegral topAttach) (fromIntegral bottomAttach) -- | Changes the space between a given table row and its surrounding rows. -- tableSetRowSpacing :: TableClass self => self -> Int -- ^ @row@ - row number whose spacing will be changed. -> Int -- ^ @spacing@ - number of pixels that the spacing should take up. -> IO () tableSetRowSpacing self row spacing = {# call table_set_row_spacing #} (toTable self) (fromIntegral row) (fromIntegral spacing) -- | Gets the amount of space between row @row@, and row @row@ + 1. See -- 'tableSetRowSpacing'. -- tableGetRowSpacing :: TableClass self => self -> Int -- ^ @row@ - a row in the table, 0 indicates the first row -> IO Int -- ^ returns the row spacing tableGetRowSpacing self row = liftM fromIntegral $ {# call unsafe table_get_row_spacing #} (toTable self) (fromIntegral row) -- | Alters the amount of space between a given table column and the adjacent -- columns. -- tableSetColSpacing :: TableClass self => self -> Int -- ^ @column@ - the column whose spacing should be changed. -> Int -- ^ @spacing@ - number of pixels that the spacing should take up. -> IO () tableSetColSpacing self column spacing = {# call table_set_col_spacing #} (toTable self) (fromIntegral column) (fromIntegral spacing) -- | Gets the amount of space between column @col@, and column @col@ + 1. See -- 'tableSetColSpacing'. -- tableGetColSpacing :: TableClass self => self -> Int -- ^ @column@ - a column in the table, 0 indicates the first column -> IO Int -- ^ returns the column spacing tableGetColSpacing self column = liftM fromIntegral $ {# call unsafe table_get_col_spacing #} (toTable self) (fromIntegral column) -- | Sets the space between every row in @table@ equal to @spacing@. -- tableSetRowSpacings :: TableClass self => self -> Int -- ^ @spacing@ - the number of pixels of space to place between -- every row in the table. -> IO () tableSetRowSpacings self spacing = {# call table_set_row_spacings #} (toTable self) (fromIntegral spacing) -- | Gets the default row spacing for the table. This is the spacing that will -- be used for newly added rows. (See 'tableSetRowSpacings') -- tableGetDefaultRowSpacing :: TableClass self => self -> IO Int -- ^ returns the default row spacing tableGetDefaultRowSpacing self = liftM fromIntegral $ {# call unsafe table_get_default_row_spacing #} (toTable self) -- | Sets the space between every column in @table@ equal to @spacing@. -- tableSetColSpacings :: TableClass self => self -> Int -- ^ @spacing@ - the number of pixels of space to place between -- every column in the table. -> IO () tableSetColSpacings self spacing = {# call table_set_col_spacings #} (toTable self) (fromIntegral spacing) -- | Gets the default column spacing for the table. This is the spacing that -- will be used for newly added columns. (See 'tableSetColSpacings') -- tableGetDefaultColSpacing :: TableClass self => self -> IO Int -- ^ returns the default column spacing tableGetDefaultColSpacing self = liftM fromIntegral $ {# call unsafe table_get_default_col_spacing #} (toTable self) -- | Changes the homogeneous property of table cells, ie. whether all cells are -- an equal size or not. -- tableSetHomogeneous :: TableClass self => self -> Bool -- ^ @homogeneous@ - Set to @True@ to ensure all table cells are the -- same size. Set to @False@ if this is not your desired behaviour. -> IO () tableSetHomogeneous self homogeneous = {# call table_set_homogeneous #} (toTable self) (fromBool homogeneous) -- | Returns whether the table cells are all constrained to the same width and -- height. (See 'tableSetHomogeneous') -- tableGetHomogeneous :: TableClass self => self -> IO Bool -- ^ returns @True@ if the cells are all constrained to the same -- size tableGetHomogeneous self = liftM toBool $ {# call unsafe table_get_homogeneous #} (toTable self) #if GTK_CHECK_VERSION(2,22,0) -- | Returns the size of 'Table'. -- -- * Available since Gtk+ version 2.22 -- tableGetSize :: TableClass self => self -> IO (Int, Int) -- ^ returns (rows, columns) of table tableGetSize self = alloca $ \ rowsPtr -> alloca $ \ columnsPtr -> do {# call unsafe gtk_table_get_size #} (toTable self) rowsPtr columnsPtr rows <- peek rowsPtr columns <- peek columnsPtr return (fromIntegral rows, fromIntegral columns) #endif -------------------- -- Attributes -- | The number of rows in the table. -- -- Default value: 0 -- tableNRows :: TableClass self => Attr self Int tableNRows = newAttrFromUIntProperty "n-rows" -- | The number of columns in the table. -- -- Default value: 0 -- tableNColumns :: TableClass self => Attr self Int tableNColumns = newAttrFromUIntProperty "n-columns" -- | The amount of space between two consecutive rows. -- -- Default value: 0 -- tableRowSpacing :: TableClass self => Attr self Int tableRowSpacing = newAttrFromUIntProperty "row-spacing" -- | The amount of space between two consecutive columns. -- -- Default value: 0 -- tableColumnSpacing :: TableClass self => Attr self Int tableColumnSpacing = newAttrFromUIntProperty "column-spacing" -- | If @True@ this means the table cells are all the same width\/height. -- -- Default value: @False@ -- tableHomogeneous :: TableClass self => Attr self Bool tableHomogeneous = newAttr tableGetHomogeneous tableSetHomogeneous -------------------- -- Child Attributes -- | The column number to attach the left side of the child to. -- -- Allowed values: \<= 65535 -- -- Default value: 0 -- tableChildLeftAttach :: (TableClass self, WidgetClass child) => child -> Attr self Int tableChildLeftAttach = newAttrFromContainerChildUIntProperty "left-attach" -- | The column number to attach the right side of a child widget to. -- -- Allowed values: [1,65535] -- -- Default value: 1 -- tableChildRightAttach :: (TableClass self, WidgetClass child) => child -> Attr self Int tableChildRightAttach = newAttrFromContainerChildUIntProperty "right-attach" -- | The row number to attach the top of a child widget to. -- -- Allowed values: \<= 65535 -- -- Default value: 0 -- tableChildTopAttach :: (TableClass self, WidgetClass child) => child -> Attr self Int tableChildTopAttach = newAttrFromContainerChildUIntProperty "top-attach" -- | The row number to attach the bottom of the child to. -- -- Allowed values: [1,65535] -- -- Default value: 1 -- tableChildBottomAttach :: (TableClass self, WidgetClass child) => child -> Attr self Int tableChildBottomAttach = newAttrFromContainerChildUIntProperty "bottom-attach" -- | Options specifying the horizontal behaviour of the child. -- -- Default value: @['Expand', 'Fill']@ -- tableChildXOptions :: (TableClass self, WidgetClass child) => child -> Attr self [AttachOptions] tableChildXOptions = newAttrFromContainerChildFlagsProperty "x-options" {# call pure unsafe gtk_attach_options_get_type #} -- | Options specifying the vertical behaviour of the child. -- -- Default value: @['Expand', 'Fill']@ -- tableChildYOptions :: (TableClass self, WidgetClass child) => child -> Attr self [AttachOptions] tableChildYOptions = newAttrFromContainerChildFlagsProperty "y-options" {# call pure unsafe gtk_attach_options_get_type #} -- | Extra space to put between the child and its left and right neighbors, in -- pixels. -- -- Allowed values: \<= 65535 -- -- Default value: 0 -- tableChildXPadding :: (TableClass self, WidgetClass child) => child -> Attr self Int tableChildXPadding = newAttrFromContainerChildUIntProperty "x-padding" -- | Extra space to put between the child and its upper and lower neighbors, -- in pixels. -- -- Allowed values: \<= 65535 -- -- Default value: 0 -- tableChildYPadding :: (TableClass self, WidgetClass child) => child -> Attr self Int tableChildYPadding = newAttrFromContainerChildUIntProperty "y-padding" gtk-0.15.9/Graphics/UI/Gtk/Layout/VBox.chs0000644000000000000000000000444407346545000016226 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VBox -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A vertical container box -- module Graphics.UI.Gtk.Layout.VBox ( -- * Detail -- -- | 'VBox' is a container that organizes child widgets into a single column. -- -- Use the 'Box' packing interface to determine the arrangement, spacing, -- height, and alignment of 'VBox' children. -- -- All children are allocated the same width. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----VBox -- | +----'ColorSelection' -- | +----'FileChooserWidget' -- | +----'FontSelection' -- @ -- * Types VBox, VBoxClass, castToVBox, gTypeVBox, toVBox, -- * Constructors vBoxNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'VBox'. -- vBoxNew :: Bool -- ^ @homogeneous@ - @True@ if all children are to be given equal -- space allotments. -> Int -- ^ @spacing@ - the number of pixels to place by default between -- children. -> IO VBox vBoxNew homogeneous spacing = makeNewObject mkVBox $ liftM (castPtr :: Ptr Widget -> Ptr VBox) $ {# call unsafe vbox_new #} (fromBool homogeneous) (fromIntegral spacing) gtk-0.15.9/Graphics/UI/Gtk/Layout/VButtonBox.chs0000644000000000000000000000554307346545000017423 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VButtonBox -- -- Author : Matthew Walton -- -- Created: 28 April 2004 -- -- Copyright (C) 2004-2005 Matthew Walton -- -- 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) -- -- A container for arranging buttons vertically -- module Graphics.UI.Gtk.Layout.VButtonBox ( -- * Detail -- -- | A button box should be used to provide a consistent layout of buttons -- throughout your application. The layout\/spacing can be altered by the -- programmer, or if desired, by the user to alter the \'feel\' of a program to -- a small degree. -- -- A 'VButtonBox' is created with 'vButtonBoxNew'. Buttons are packed -- into a button box the same way widgets are added to any other -- container, using -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd'. You can also use -- 'Graphics.UI.Gtk.Abstract.Box.boxPackStart' or -- 'Graphics.UI.Gtk.Abstract.Box.boxPackEnd', but for button boxes -- both these functions work just like -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd', ie., they pack -- the button in a way that depends on the current layout style and on -- whether the button has had -- 'Graphics.UI.Gtk.Abstract.ButtonBox.buttonBoxSetChildSecondary' -- called on it. -- -- The spacing between buttons can be set with -- 'Graphics.UI.Gtk.Abstract.Box.boxSetSpacing'. The arrangement and -- layout of the buttons can be changed with -- 'Graphics.UI.Gtk.Abstract.ButtonBox.buttonBoxSetLayout'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'ButtonBox' -- | +----VButtonBox -- @ -- * Types VButtonBox, VButtonBoxClass, castToVButtonBox, gTypeVButtonBox, toVButtonBox, -- * Constructors vButtonBoxNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new vertical button box. -- vButtonBoxNew :: IO VButtonBox vButtonBoxNew = makeNewObject mkVButtonBox $ liftM (castPtr :: Ptr Widget -> Ptr VButtonBox) $ {# call unsafe vbutton_box_new #} gtk-0.15.9/Graphics/UI/Gtk/Layout/VPaned.chs0000644000000000000000000000352007346545000016517 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VPaned -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A container with two panes arranged vertically -- module Graphics.UI.Gtk.Layout.VPaned ( -- * Detail -- -- | The VPaned widget is a container widget with two children arranged -- vertically. The division between the two panes is adjustable by the user by -- dragging a handle. See 'Paned' for details. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Paned' -- | +----VPaned -- @ -- * Types VPaned, VPanedClass, castToVPaned, gTypeVPaned, toVPaned, -- * Constructors vPanedNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new 'VPaned' -- vPanedNew :: IO VPaned vPanedNew = makeNewObject mkVPaned $ liftM (castPtr :: Ptr Widget -> Ptr VPaned) $ {# call unsafe vpaned_new #} gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/0000755000000000000000000000000007346545000016575 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs0000644000000000000000000001651707346545000021767 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CheckMenuItem -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A menu item with a check box -- module Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem ( -- * Detail -- -- | A 'CheckMenuItem' is a menu item that maintains the state of a boolean -- value in addition to a 'MenuItem's usual role in activating application -- code. -- -- A check box indicating the state of the boolean value is displayed at the -- left side of the 'MenuItem'. Activating the 'MenuItem' toggles the value. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Item' -- | +----'MenuItem' -- | +----CheckMenuItem -- | +----'RadioMenuItem' -- @ -- * Types CheckMenuItem, CheckMenuItemClass, castToCheckMenuItem, gTypeCheckMenuItem, toCheckMenuItem, -- * Constructors checkMenuItemNew, checkMenuItemNewWithLabel, checkMenuItemNewWithMnemonic, -- * Methods checkMenuItemSetActive, checkMenuItemGetActive, checkMenuItemEmitToggled, checkMenuItemSetInconsistent, checkMenuItemGetInconsistent, #if GTK_CHECK_VERSION(2,4,0) checkMenuItemGetDrawAsRadio, checkMenuItemSetDrawAsRadio, #endif -- * Attributes checkMenuItemActive, checkMenuItemInconsistent, #if GTK_CHECK_VERSION(2,4,0) checkMenuItemDrawAsRadio, #endif -- * Signals checkMenuItemToggled ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'CheckMenuItem'. -- checkMenuItemNew :: IO CheckMenuItem checkMenuItemNew = makeNewObject mkCheckMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr CheckMenuItem) $ {# call unsafe check_menu_item_new #} -- | Creates a new 'CheckMenuItem' with a label. -- checkMenuItemNewWithLabel :: GlibString string => string -- ^ @label@ - the string to use for the label. -> IO CheckMenuItem checkMenuItemNewWithLabel label = makeNewObject mkCheckMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr CheckMenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe check_menu_item_new_with_label #} labelPtr -- | Creates a new 'CheckMenuItem' containing a label. The label will be -- created using 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic', so -- underscores in @label@ indicate the mnemonic for the menu item. -- checkMenuItemNewWithMnemonic :: GlibString string => string -- ^ @label@ - The text of the button, with an underscore -- in front of the mnemonic character -> IO CheckMenuItem checkMenuItemNewWithMnemonic label = makeNewObject mkCheckMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr CheckMenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe check_menu_item_new_with_mnemonic #} labelPtr -------------------- -- Methods -- | Sets the active state of the menu item's check box. -- checkMenuItemSetActive :: CheckMenuItemClass self => self -> Bool -> IO () checkMenuItemSetActive self isActive = {# call check_menu_item_set_active #} (toCheckMenuItem self) (fromBool isActive) -- | Returns whether the check menu item is active. See -- 'checkMenuItemSetActive'. -- checkMenuItemGetActive :: CheckMenuItemClass self => self -> IO Bool checkMenuItemGetActive self = liftM toBool $ {# call unsafe check_menu_item_get_active #} (toCheckMenuItem self) -- | Emits the toggled signal. -- checkMenuItemEmitToggled :: CheckMenuItemClass self => self -> IO () checkMenuItemEmitToggled self = {# call check_menu_item_toggled #} (toCheckMenuItem self) -- | If the user has selected a range of elements (such as some text or -- spreadsheet cells) that are affected by a boolean setting, and the current -- values in that range are inconsistent, you may want to display the check in -- an \"in between\" state. This function turns on \"in between\" display. -- Normally you would turn off the inconsistent state again if the user -- explicitly selects a setting. This has to be done manually, -- 'checkMenuItemSetInconsistent' only affects visual appearance, it doesn't -- affect the semantics of the widget. -- checkMenuItemSetInconsistent :: CheckMenuItemClass self => self -> Bool -> IO () checkMenuItemSetInconsistent self setting = {# call check_menu_item_set_inconsistent #} (toCheckMenuItem self) (fromBool setting) -- | Query if the menu check is drawn as inconsistent (in between). See -- 'checkMenuItemSetInconsistent'. -- checkMenuItemGetInconsistent :: CheckMenuItemClass self => self -> IO Bool checkMenuItemGetInconsistent self = liftM toBool $ {# call unsafe check_menu_item_get_inconsistent #} (toCheckMenuItem self) #if GTK_CHECK_VERSION(2,4,0) -- | Sets whether the menu item is drawn like a 'RadioMenuItem'. -- -- * Available since Gtk+ version 2.4 -- checkMenuItemSetDrawAsRadio :: CheckMenuItemClass self => self -> Bool -> IO () checkMenuItemSetDrawAsRadio self drawAsRadio = {# call check_menu_item_set_draw_as_radio #} (toCheckMenuItem self) (fromBool drawAsRadio) -- | Returns whether the menu item is drawn like a 'RadioMenuItem'. -- -- * Available since Gtk+ version 2.4 -- checkMenuItemGetDrawAsRadio :: CheckMenuItemClass self => self -> IO Bool checkMenuItemGetDrawAsRadio self = liftM toBool $ {# call unsafe check_menu_item_get_draw_as_radio #} (toCheckMenuItem self) #endif -------------------- -- Attributes -- | Whether the menu item is checked. -- -- Default value: @False@ -- checkMenuItemActive :: CheckMenuItemClass self => Attr self Bool checkMenuItemActive = newAttr checkMenuItemGetActive checkMenuItemSetActive -- | Whether to display an \"inconsistent\" state. -- -- Default value: @False@ -- checkMenuItemInconsistent :: CheckMenuItemClass self => Attr self Bool checkMenuItemInconsistent = newAttr checkMenuItemGetInconsistent checkMenuItemSetInconsistent #if GTK_CHECK_VERSION(2,4,0) -- | Whether the menu item looks like a radio menu item. -- -- Default value: @False@ -- checkMenuItemDrawAsRadio :: CheckMenuItemClass self => Attr self Bool checkMenuItemDrawAsRadio = newAttr checkMenuItemGetDrawAsRadio checkMenuItemSetDrawAsRadio #endif -- | This signal is emitted when the state of the check box is changed. -- checkMenuItemToggled :: CheckMenuItemClass self => Signal self (IO ()) checkMenuItemToggled = Signal (connect_NONE__NONE "toggled") gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/Combo.chs0000644000000000000000000001560207346545000020337 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Combo -- -- Author : Axel Simon -- -- Created: 2 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. -- -- TODO -- -- The combo_set_item_string function is not bound as we do not handle -- arbitrary widgets yet. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A text entry field with a dropdown list -- -- * Warning: this module is deprecated and should not be used in -- newly-written code. -- -- This module is empty in Gtk3 as Combo has been removed. module Graphics.UI.Gtk.MenuComboToolbar.Combo ( -- * Detail -- -- | The 'Combo' widget consists of a single-line text entry field and a -- drop-down list. The drop-down list is displayed when the user clicks on a -- small arrow button to the right of the entry field. -- -- List elements -- can contain arbitrary widgets, but if an element is not a plain label, then -- you must use the 'comboSetItemString' function. This sets the string which -- will be placed in the text entry field when the item is selected. -- -- By default, the user can step through the items in the list using the -- arrow (cursor) keys, though this behaviour can be turned off with -- 'comboSetUseArrows'. -- -- As of Gtk+ 2.4, 'Combo' has been deprecated in favor of 'ComboBox'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'HBox' -- | +----Combo -- @ #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- * Types Combo, ComboClass, castToCombo, gTypeCombo, toCombo, -- * Constructors comboNew, -- * Methods comboSetPopdownStrings, comboSetValueInList, comboSetUseArrows, comboSetUseArrowsAlways, comboSetCaseSensitive, comboDisableActivate, -- * Attributes comboEnableArrowKeys, comboEnableArrowsAlways, comboCaseSensitive, comboAllowEmpty, comboValueInList, #endif #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Abstract.Widget (widgetShow) import Graphics.UI.Gtk.Abstract.Container (containerAdd) {#import Graphics.UI.Gtk.Types#} #ifndef DISABLE_DEPRECATED import Graphics.UI.Gtk.General.Structs (comboGetList) #endif {# context lib="gtk" prefix="gtk" #} #ifndef DISABLE_DEPRECATED -------------------- -- Constructors -- Create a new Combo text entry field. -- comboNew :: IO Combo comboNew = makeNewObject mkCombo $ liftM castPtr $ {# call unsafe combo_new #} -------------------- -- Methods -- | Insert a set of Strings into the -- 'Combo' drop down list. -- comboSetPopdownStrings :: (ComboClass self, GlibString string) => self -> [string] -> IO () comboSetPopdownStrings self strs = do list <- comboGetList (toCombo self) {#call list_clear_items#} list 0 (-1) mapM_ (\str -> do li <- makeNewObject mkWidget $ liftM castPtr $ withUTFString str {#call unsafe list_item_new_with_label#} widgetShow li containerAdd list li) strs -- | Specifies whether the value entered in the text entry field must match -- one of the values in the list. If this is set then the user will not be able -- to perform any other action until a valid value has been entered. -- -- If an empty field is acceptable, the @okIfEmpty@ parameter should be -- @True@. -- comboSetValueInList :: ComboClass self => self -> Bool -- ^ @val@ - @True@ if the value entered must match one of the -- values in the list. -> Bool -- ^ @okIfEmpty@ - @True@ if an empty value is considered valid. -> IO () comboSetValueInList self val okIfEmpty = {# call unsafe combo_set_value_in_list #} (toCombo self) (fromBool val) (fromBool okIfEmpty) -- | Specifies if the arrow (cursor) keys can be used to step through the -- items in the list. This is on by default. -- comboSetUseArrows :: ComboClass self => self -> Bool -> IO () comboSetUseArrows self val = {# call unsafe combo_set_use_arrows #} (toCombo self) (fromBool val) -- | Obsolete function, does nothing. -- comboSetUseArrowsAlways :: ComboClass self => self -> Bool -> IO () comboSetUseArrowsAlways self val = {# call unsafe combo_set_use_arrows_always #} (toCombo self) (fromBool val) -- | Specifies whether the text entered into the 'Entry' field and the text in -- the list items is case sensitive. -- -- This may be useful, for example, when you have called -- 'comboSetValueInList' to limit the values entered, but you are not worried -- about differences in case. -- comboSetCaseSensitive :: ComboClass self => self -> Bool -> IO () comboSetCaseSensitive self val = {# call unsafe combo_set_case_sensitive #} (toCombo self) (fromBool val) -- | Stops the 'Combo' widget from showing the popup list when the 'Entry' -- emits the \"activate\" signal, i.e. when the Return key is pressed. This may -- be useful if, for example, you want the Return key to close a dialog -- instead. -- comboDisableActivate :: ComboClass self => self -> IO () comboDisableActivate self = {# call unsafe combo_disable_activate #} (toCombo self) -------------------- -- Attributes -- | Whether the arrow keys move through the list of items. -- -- Default value: @True@ -- comboEnableArrowKeys :: ComboClass self => Attr self Bool comboEnableArrowKeys = newAttrFromBoolProperty "enable-arrow-keys" -- | Obsolete property, ignored. -- -- Default value: @True@ -- comboEnableArrowsAlways :: ComboClass self => Attr self Bool comboEnableArrowsAlways = newAttrFromBoolProperty "enable-arrows-always" -- | Whether list item matching is case sensitive. -- -- Default value: @False@ -- comboCaseSensitive :: ComboClass self => Attr self Bool comboCaseSensitive = newAttrFromBoolProperty "case-sensitive" -- | Whether an empty value may be entered in this field. -- -- Default value: @True@ -- comboAllowEmpty :: ComboClass self => Attr self Bool comboAllowEmpty = newAttrFromBoolProperty "allow-empty" -- | Whether entered values must already be present in the list. -- -- Default value: @False@ -- comboValueInList :: ComboClass self => Attr self Bool comboValueInList = newAttrFromBoolProperty "value-in-list" #endif #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs0000644000000000000000000006451607346545000021020 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ComboBox -- -- Author : Duncan Coutts -- -- Created: 25 April 2004 -- -- Copyright (C) 2004-2007 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 (depends on GHC) -- -- A widget used to choose from a list of items. -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.ComboBox ( -- * Detail -- -- | A 'ComboBox' is a widget that allows the user to choose from a list of -- valid choices. The 'ComboBox' displays the selected choice. When activated, -- the 'ComboBox' displays a popup which allows the user to make a new choice. -- The style in which the selected value is displayed, and the style of the -- popup is determined by the current theme. It may be similar to a -- 'OptionMenu', or similar to a Windows-style combo box. -- -- Unlike its predecessors 'Combo' and 'OptionMenu', the 'ComboBox' uses the -- model-view pattern; the list of valid choices is specified in the form of a -- tree model, and the display of the choices can be adapted to the data in -- the model by using cell renderers, as you would in a tree view. This is -- possible since 'ComboBox' implements the 'CellLayout' interface. The tree -- model holding the valid choices is not restricted to a flat list, it can be -- a real tree, and the popup will reflect the tree structure. -- -- In addition to the general model-view API, 'ComboBox' offers the function -- 'comboBoxNewText' which creates a text-only combo box. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----ComboBox -- | +----'ComboBoxEntry' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ComboBox, ComboBoxClass, castToComboBox, gTypeComboBox, toComboBox, ComboBoxText, -- * Constructors comboBoxNew, #if GTK_CHECK_VERSION(2,24,0) comboBoxNewWithEntry, #endif comboBoxNewText, comboBoxNewWithModel, #if GTK_CHECK_VERSION(2,24,0) comboBoxNewWithModelAndEntry, #endif -- * Methods -- ** Simple Text API comboBoxSetModelText, comboBoxGetModelText, comboBoxAppendText, comboBoxInsertText, comboBoxPrependText, comboBoxRemoveText, comboBoxGetActiveText, -- ** Standard API #if GTK_CHECK_VERSION(2,6,0) comboBoxGetWrapWidth, #endif comboBoxSetWrapWidth, #if GTK_CHECK_VERSION(2,6,0) comboBoxGetRowSpanColumn, #endif comboBoxSetRowSpanColumn, #if GTK_CHECK_VERSION(2,6,0) comboBoxGetColumnSpanColumn, #endif comboBoxSetColumnSpanColumn, comboBoxGetActive, comboBoxSetActive, comboBoxGetActiveIter, comboBoxSetActiveIter, comboBoxGetModel, comboBoxSetModel, comboBoxPopup, comboBoxPopdown, #if GTK_CHECK_VERSION(2,6,0) comboBoxSetRowSeparatorSource, comboBoxSetAddTearoffs, comboBoxGetAddTearoffs, #if GTK_CHECK_VERSION(2,10,0) comboBoxSetTitle, comboBoxGetTitle, #endif comboBoxSetFocusOnClick, comboBoxGetFocusOnClick, #endif -- * Attributes comboBoxModel, comboBoxWrapWidth, #if GTK_CHECK_VERSION(2,6,0) comboBoxRowSpanColumn, comboBoxColumnSpanColumn, #endif comboBoxActive, #if GTK_CHECK_VERSION(2,6,0) comboBoxAddTearoffs, comboBoxHasFrame, comboBoxFocusOnClick, #if GTK_CHECK_VERSION(2,10,0) comboBoxTearoffTitle, comboBoxPopupShown, comboBoxTitle, #endif #endif #if GTK_CHECK_VERSION(2,24,0) comboBoxGetHasEntry, comboBoxSetEntryTextColumn, comboBoxGetEntryTextColumn, #endif -- * Signals changed, -- * Deprecated #ifndef DISABLE_DEPRECATED onChanged, afterChanged, #endif #endif ) where import Control.Monad (liftM) import Data.Text (Text) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} hiding (ListStore) {#import Graphics.UI.Gtk.ModelView.Types#} (receiveTreeIter, comboQuark) {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.ModelView.CustomStore#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} import Graphics.UI.Gtk.ModelView.ListStore ( ListStore, listStoreNew, listStoreInsert, listStorePrepend, listStoreAppend, listStoreRemove, listStoreSafeGetValue ) import Graphics.UI.Gtk.ModelView.CellLayout ( cellLayoutSetAttributes, cellLayoutPackStart, cellLayoutClear ) import Graphics.UI.Gtk.ModelView.CellRendererText ( cellRendererTextNew, cellText) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new empty 'ComboBox'. -- comboBoxNew :: IO ComboBox comboBoxNew = makeNewObject mkComboBox $ liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $ {# call gtk_combo_box_new #} #if GTK_CHECK_VERSION(2,24,0) -- | Creates a new empty 'ComboBox' with an entry. -- -- * Available since Gtk+ version 2.24 -- comboBoxNewWithEntry :: IO ComboBox comboBoxNewWithEntry = makeNewObject mkComboBox $ liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $ {# call gtk_combo_box_new_with_entry #} #endif -- | Convenience function which constructs a new text combo box that is a -- 'ComboBox' just displaying strings. This function internally calls -- 'comboBoxSetModelText' after creating a new combo box. -- comboBoxNewText :: IO ComboBox comboBoxNewText = do combo <- comboBoxNew comboBoxSetModelText combo return combo -- %hash c:2570 -- | Creates a new 'ComboBox' with the model initialized to @model@. -- comboBoxNewWithModel :: TreeModelClass model => model -- ^ @model@ - A 'TreeModel'. -> IO ComboBox comboBoxNewWithModel model = makeNewObject mkComboBox $ liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $ {# call gtk_combo_box_new_with_model #} (toTreeModel model) #if GTK_CHECK_VERSION(2,24,0) -- | Creates a new empty 'ComboBox' with an entry and with the model initialized to @model@. -- -- * Available since Gtk+ version 2.24 -- comboBoxNewWithModelAndEntry :: TreeModelClass model => model -- ^ @model@ - A 'TreeModel'. -> IO ComboBox comboBoxNewWithModelAndEntry model = makeNewObject mkComboBox $ liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $ {# call gtk_combo_box_new_with_model_and_entry #} (toTreeModel model) #endif -------------------- -- Methods -- the text API -- | Create a combo box that holds strings. -- -- This function stores a 'Graphics.UI.Gtk.ModelView.ListStore' with the -- widget and sets the model to the list store. The widget can contain only -- strings. The model can be retrieved with 'comboBoxGetModel'. The list -- store can be retrieved with 'comboBoxGetModelText'. -- Any existing model or renderers are removed before setting the new text -- model. -- Note that the functions 'comboBoxAppendText', 'comboBoxInsertText', -- 'comboBoxPrependText', 'comboBoxRemoveText' and 'comboBoxGetActiveText' -- can be called on a combo box only once 'comboBoxSetModelText' is called. -- type ComboBoxText = Text comboBoxSetModelText :: ComboBoxClass self => self -> IO (ListStore ComboBoxText) comboBoxSetModelText combo = do cellLayoutClear (toComboBox combo) store <- listStoreNew ([] :: [ComboBoxText]) comboBoxSetModel combo (Just store) #if GTK_CHECK_VERSION(2,24,0) let colId = makeColumnIdString 0 customStoreSetColumn store colId id comboBoxSetEntryTextColumn (toComboBox combo) colId #endif ren <- cellRendererTextNew cellLayoutPackStart (toComboBox combo) ren True cellLayoutSetAttributes (toComboBox combo) ren store (\a -> [cellText := a]) objectSetAttribute comboQuark combo (Just store) return store -- | Retrieve the model that was created with 'comboBoxSetModelText'. -- comboBoxGetModelText :: ComboBoxClass self => self -> IO (ListStore ComboBoxText) comboBoxGetModelText self = do (Just store) <- objectGetAttributeUnsafe comboQuark (toComboBox self) return store -- %hash c:7228 d:5c35 -- | Appends @string@ to the list of strings stored in @comboBox@. Note that -- you can only use this function with combo boxes constructed with -- 'comboBoxNewText'. Returns the index of the appended text. -- comboBoxAppendText :: ComboBoxClass self => self -> ComboBoxText -> IO Int comboBoxAppendText self text = do store <- comboBoxGetModelText self listStoreAppend store text -- %hash c:41de d:8ab0 -- | Inserts @string@ at @position@ in the list of strings stored in -- @comboBox@. Note that you can only use this function with combo boxes -- constructed with 'comboBoxNewText'. -- comboBoxInsertText :: ComboBoxClass self => self -> Int -- ^ @position@ - An index to insert @text@. -> ComboBoxText -- ^ @text@ - A string. -> IO () comboBoxInsertText self position text = do store <- comboBoxGetModelText self listStoreInsert store position text -- %hash c:98ea d:9fab -- | Prepends @string@ to the list of strings stored in @comboBox@. Note that -- you can only use this function with combo boxes constructed with -- 'comboBoxNewText'. -- comboBoxPrependText :: ComboBoxClass self => self -> ComboBoxText -> IO () comboBoxPrependText self text = do store <- comboBoxGetModelText self listStorePrepend store text -- %hash c:7ff6 d:ffbf -- | Removes the string at @position@ from @comboBox@. Note that you can only -- use this function with combo boxes constructed with 'comboBoxNewText'. -- comboBoxRemoveText :: ComboBoxClass self => self -> Int -- ^ @position@ - Index of the item to remove. -> IO () comboBoxRemoveText self position = do store <- comboBoxGetModelText self listStoreRemove store position -- | Returns the currently active string in @comboBox@ or @Nothing@ if none is -- selected. Note that you can only use this function with combo boxes -- constructed with 'comboBoxNewText'. -- comboBoxGetActiveText :: ComboBoxClass self => self -> IO (Maybe ComboBoxText) comboBoxGetActiveText self = do activeId <- comboBoxGetActive self if activeId < 0 then return Nothing else do listStore <- comboBoxGetModelText self listStoreSafeGetValue listStore activeId #if GTK_CHECK_VERSION(2,6,0) -- %hash d:566e -- | Returns the wrap width which is used to determine the number of columns -- for the popup menu. If the wrap width is larger than 1, the combo box is in -- table mode. -- -- * Available since Gtk+ version 2.6 -- comboBoxGetWrapWidth :: ComboBoxClass self => self -> IO Int comboBoxGetWrapWidth self = liftM fromIntegral $ {# call gtk_combo_box_get_wrap_width #} (toComboBox self) #endif -- | Sets the wrap width of the combo box to be @width@. The wrap width is -- basically the preferred number of columns when you want the popup to be -- laid out in a table. -- comboBoxSetWrapWidth :: ComboBoxClass self => self -> Int -> IO () comboBoxSetWrapWidth self width = {# call gtk_combo_box_set_wrap_width #} (toComboBox self) (fromIntegral width) #if GTK_CHECK_VERSION(2,6,0) -- | Gets the column with row span information for @comboBox@. -- -- * Available since Gtk+ version 2.6 -- comboBoxGetRowSpanColumn :: ComboBoxClass self => self -> IO (ColumnId row Int) comboBoxGetRowSpanColumn self = liftM (makeColumnIdInt . fromIntegral) $ {# call gtk_combo_box_get_row_span_column #} (toComboBox self) #endif -- %hash d:f80b -- | Sets the column with row span information for @comboBox@ to be @rowSpan@. -- The row span column contains integers which indicate how many rows an item -- should span. -- comboBoxSetRowSpanColumn :: ComboBoxClass self => self -> ColumnId row Int -> IO () comboBoxSetRowSpanColumn self rowSpan = {# call gtk_combo_box_set_row_span_column #} (toComboBox self) ((fromIntegral . columnIdToNumber) rowSpan) #if GTK_CHECK_VERSION(2,6,0) -- | Gets the source of the column span information for the combo box. -- -- * Available since Gtk+ version 2.6 -- comboBoxGetColumnSpanColumn :: ComboBoxClass self => self -> IO (ColumnId row Int) comboBoxGetColumnSpanColumn self = liftM (makeColumnIdInt . fromIntegral) $ {# call gtk_combo_box_get_column_span_column #} (toComboBox self) #endif -- %hash d:4303 -- | Sets the source of the column span information for the combo box. The -- column span source contains integers which indicate how many columns an -- item should span. -- comboBoxSetColumnSpanColumn :: ComboBoxClass self => self -> ColumnId row Int -> IO () comboBoxSetColumnSpanColumn self columnSpan = {# call gtk_combo_box_set_column_span_column #} (toComboBox self) ((fromIntegral . columnIdToNumber) columnSpan) -- %hash c:e719 d:e6a -- | Returns the index of the currently active item, or -1 if there is no -- active item. If the model is a non-flat treemodel, and the active item is -- not an immediate child of the root of the tree, this function returns -- @'treePathGetIndices' path !! 0@, where @path@ is the 'TreePath' of the -- active item. -- comboBoxGetActive :: ComboBoxClass self => self -> IO Int -- ^ returns An integer which is the index of the currently active -- item, or -1 if there's no active item. comboBoxGetActive self = liftM fromIntegral $ {# call gtk_combo_box_get_active #} (toComboBox self) -- %hash c:3572 d:fbed -- | Sets the active item of @comboBox@ to be the item at @index@. -- comboBoxSetActive :: ComboBoxClass self => self -> Int -- ^ @index@ - An index in the model passed during construction, or -1 -- to have no active item. -> IO () comboBoxSetActive self index = {# call gtk_combo_box_set_active #} (toComboBox self) (fromIntegral index) -- %hash c:744a d:e897 -- | Returns a 'TreeIter' that points to the current active item, if it -- exists, or @Nothing@ if there is no current active item. -- comboBoxGetActiveIter :: ComboBoxClass self => self -> IO (Maybe TreeIter) comboBoxGetActiveIter self = receiveTreeIter $ \iterPtr -> {# call gtk_combo_box_get_active_iter #} (toComboBox self) iterPtr -- %hash c:9a70 -- | Sets the current active item to be the one referenced by @iter@. @iter@ -- must correspond to a path of depth one. -- comboBoxSetActiveIter :: ComboBoxClass self => self -> TreeIter -- ^ @iter@ - The 'TreeIter'. -> IO () comboBoxSetActiveIter self iter = with iter $ \iterPtr -> {# call gtk_combo_box_set_active_iter #} (toComboBox self) iterPtr -- %hash c:2460 -- | Returns the 'TreeModel' which is acting as data source for @comboBox@. -- comboBoxGetModel :: ComboBoxClass self => self -> IO (Maybe TreeModel) -- ^ returns A 'TreeModel' which was passed during -- construction. comboBoxGetModel self = maybeNull (makeNewGObject mkTreeModel) $ {# call unsafe gtk_combo_box_get_model #} (toComboBox self) -- %hash c:f5d0 -- | Sets the model used by @comboBox@ to be @model@. Will unset a previously -- set model (if applicable). If model is @Nothing@, then it will unset the -- model. -- -- Note that this function does not clear the cell renderers, you have to call -- 'comboBoxCellLayoutClear' yourself if you need to set up different cell -- renderers for the new model. -- comboBoxSetModel :: (ComboBoxClass self, TreeModelClass model) => self -> Maybe model -> IO () comboBoxSetModel self model = {# call gtk_combo_box_set_model #} (toComboBox self) (maybe (TreeModel nullForeignPtr) toTreeModel model) -- | Pops up the menu or dropdown list of the combo box. -- -- This function is mostly intended for use by accessibility technologies; -- applications should have little use for it. -- comboBoxPopup :: ComboBoxClass self => self -> IO () comboBoxPopup self = {# call gtk_combo_box_popup #} (toComboBox self) -- %hash c:32a4 d:463e -- | Hides the menu or dropdown list of @comboBox@. -- -- This function is mostly intended for use by accessibility technologies; -- applications should have little use for it. -- comboBoxPopdown :: ComboBoxClass self => self -> IO () comboBoxPopdown self = {# call gtk_combo_box_popdown #} (toComboBox self) #if GTK_CHECK_VERSION(2,6,0) -- %hash c:6fec d:a050 -- | Installs a mapping from the model to a row separator flag, which is used -- to determine whether a row should be drawn as a separator. If the row -- separator mapping is @Nothing@, no separators are drawn. This is the -- default value. -- -- * Available since Gtk+ version 2.6 -- comboBoxSetRowSeparatorSource :: (ComboBoxClass self, TreeModelClass (model row), TypedTreeModelClass model) => self -- ^ the 'ComboBox' widget -> Maybe (model row, row -> Bool) -- ^ The model and a function to extract a Boolean from it. -> IO () comboBoxSetRowSeparatorSource self Nothing = {# call gtk_combo_box_set_row_separator_func #} (toComboBox self) nullFunPtr nullPtr nullFunPtr comboBoxSetRowSeparatorSource self (Just (model, extract)) = do funPtr <- mkRowSeparatorFunc $ \_ iterPtr _ -> do iter <- peek iterPtr value <- customStoreGetRow model iter return (fromBool $ extract value) {# call gtk_combo_box_set_row_separator_func #} (toComboBox self) funPtr (castFunPtrToPtr funPtr) destroyFunPtr {#pointer TreeViewRowSeparatorFunc#} foreign import ccall "wrapper" mkRowSeparatorFunc :: (Ptr TreeModel -> Ptr TreeIter -> Ptr () -> IO {#type gboolean #}) -> IO TreeViewRowSeparatorFunc -- %hash c:5bf8 -- | Sets whether the popup menu should have a tearoff menu item. -- -- * Available since Gtk+ version 2.6 -- comboBoxSetAddTearoffs :: ComboBoxClass self => self -> Bool -- ^ @addTearoffs@ - @True@ to add tearoff menu items -> IO () comboBoxSetAddTearoffs self addTearoffs = {# call gtk_combo_box_set_add_tearoffs #} (toComboBox self) (fromBool addTearoffs) -- | Gets the current value of the :add-tearoffs property. -- comboBoxGetAddTearoffs :: ComboBoxClass self => self -> IO Bool comboBoxGetAddTearoffs self = liftM toBool $ {# call gtk_combo_box_get_add_tearoffs #} (toComboBox self) #if GTK_CHECK_VERSION(2,10,0) -- %hash c:64db d:ecde -- | Sets the menu's title in tearoff mode. -- -- * Available since Gtk+ version 2.10 -- comboBoxSetTitle :: (ComboBoxClass self, GlibString string) => self -> string -- ^ @title@ - a title for the menu in tearoff mode. -> IO () comboBoxSetTitle self title = withUTFString title $ \titlePtr -> {# call gtk_combo_box_set_title #} (toComboBox self) titlePtr -- %hash c:9f54 d:e396 -- | Gets the current title of the menu in tearoff mode. See -- 'comboBoxSetAddTearoffs'. -- -- * Available since Gtk+ version 2.10 -- comboBoxGetTitle :: (ComboBoxClass self, GlibString string) => self -> IO string -- ^ returns the menu's title in tearoff mode. comboBoxGetTitle self = {# call gtk_combo_box_get_title #} (toComboBox self) >>= peekUTFString #endif #if GTK_CHECK_VERSION(2,24,0) -- | Returns whether the combo box has an entry. -- -- * Available since Gtk+ version 2.24 -- comboBoxGetHasEntry :: ComboBoxClass self => self -> IO Bool -- ^ returns whether there is an entry in @self@. comboBoxGetHasEntry self = liftM toBool $ {# call gtk_combo_box_get_has_entry #} (toComboBox self) -- | Sets the model column which combo_box should use to get strings from -- to be @textColumn@. The column text_column in the model of @comboBox@ -- must be of type ComboBoxText. -- -- This is only relevant if @comboBox@ has been created with "has-entry" -- as True. -- -- * Available since Gtk+ version 2.24 -- comboBoxSetEntryTextColumn :: ComboBoxClass comboBox => comboBox -> ColumnId row ComboBoxText -- ^ @textColumn@ - A column in model to get the strings from for the internal entry. -> IO () comboBoxSetEntryTextColumn comboBox textColumn = {# call gtk_combo_box_set_entry_text_column #} (toComboBox comboBox) ((fromIntegral . columnIdToNumber) textColumn) -- | Returns the column which @comboBox@ is using to get the strings from to -- display in the internal entry. -- -- * Available since Gtk+ version 2.24 -- comboBoxGetEntryTextColumn :: ComboBoxClass comboBox => comboBox -> IO (ColumnId row ComboBoxText) -- ^ returns a column in the data source model of @comboBox@. comboBoxGetEntryTextColumn comboBox = liftM (makeColumnIdString . fromIntegral) $ {# call gtk_combo_box_get_entry_text_column #} (toComboBox comboBox) #endif -- %hash c:fe18 -- | Sets whether the combo box will grab focus when it is clicked with the -- mouse. Making mouse clicks not grab focus is useful in places like toolbars -- where you don't want the keyboard focus removed from the main area of the -- application. -- -- * Available since Gtk+ version 2.6 -- comboBoxSetFocusOnClick :: ComboBoxClass self => self -> Bool -- ^ @focusOnClick@ - whether the combo box grabs focus when clicked -- with the mouse -> IO () comboBoxSetFocusOnClick self focusOnClick = {# call gtk_combo_box_set_focus_on_click #} (toComboBox self) (fromBool focusOnClick) -- %hash c:9168 -- | Returns whether the combo box grabs focus when it is clicked with the -- mouse. See 'comboBoxSetFocusOnClick'. -- -- * Available since Gtk+ version 2.6 -- comboBoxGetFocusOnClick :: ComboBoxClass self => self -> IO Bool -- ^ returns @True@ if the combo box grabs focus when it is -- clicked with the mouse. comboBoxGetFocusOnClick self = liftM toBool $ {# call gtk_combo_box_get_focus_on_click #} (toComboBox self) #else foreign import ccall "wrapper" dummyForStub :: (CInt -> IO ()) -> IO (FunPtr (CInt -> IO ())) #endif -------------------- -- Attributes -- %hash c:c23c -- | The model from which the combo box takes the values shown in the list. -- comboBoxModel :: (ComboBoxClass self, TreeModelClass treeModel) => ReadWriteAttr self TreeModel treeModel comboBoxModel = newAttrFromObjectProperty "model" {# call pure unsafe gtk_tree_model_get_type #} -- %hash c:ea5e -- | If wrap-width is set to a positive value, the list will be displayed in -- multiple columns, the number of columns is determined by wrap-width. -- -- Allowed values: >= 0 -- -- Default value: 0 -- comboBoxWrapWidth :: ComboBoxClass self => Attr self Int comboBoxWrapWidth = newAttrFromIntProperty "wrap-width" #if GTK_CHECK_VERSION(2,6,0) -- %hash c:a445 -- | The values of that column are used to determine how many rows a value in -- the list will span. Therefore, the values in the model column pointed to by -- this property must be greater than zero and not larger than wrap-width. -- -- Default value: 'invalidColumnId' -- -- * Available since Gtk+ version 2.6 -- comboBoxRowSpanColumn :: ComboBoxClass self => Attr self (ColumnId row Int) comboBoxRowSpanColumn = newAttr comboBoxGetRowSpanColumn comboBoxSetRowSpanColumn -- %hash c:7ec7 -- | The values of that column are used to determine how many columns a value -- in the list will span. -- -- Default value: 'invalidColumnId' -- -- * Available since Gtk+ version 2.6 -- comboBoxColumnSpanColumn :: ComboBoxClass self => Attr self (ColumnId row Int) comboBoxColumnSpanColumn = newAttr comboBoxGetColumnSpanColumn comboBoxSetColumnSpanColumn #endif -- %hash c:f777 d:507b -- | The item which is currently active. This value only makes sense for -- a list model. -- comboBoxActive :: ComboBoxClass self => Attr self Int comboBoxActive = newAttrFromIntProperty "active" #if GTK_CHECK_VERSION(2,6,0) -- %hash c:585b d:2096 -- | The add-tearoffs property controls whether generated menus have tearoff -- menu items. -- -- Note that this only affects menu style combo boxes. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.6 -- comboBoxAddTearoffs :: ComboBoxClass self => Attr self Bool comboBoxAddTearoffs = newAttrFromBoolProperty "add-tearoffs" -- %hash d:94cc -- | The has-frame property controls whether a frame is drawn around the -- entry. -- -- Default value: @True@ -- -- * Available since Gtk+ version 2.6 -- comboBoxHasFrame :: ComboBoxClass self => Attr self Bool comboBoxHasFrame = newAttrFromBoolProperty "has-frame" #endif -- %hash c:4808 -- | Whether the combo box grabs focus when it is clicked with the mouse. -- -- Default value: @True@ -- comboBoxFocusOnClick :: ComboBoxClass self => Attr self Bool comboBoxFocusOnClick = newAttrFromBoolProperty "focus-on-click" #if GTK_CHECK_VERSION(2,10,0) -- %hash c:c1e3 d:ddac -- | A title that may be displayed by the window manager when the popup is -- torn-off. -- -- Default value: \"\" -- -- * Available since Gtk+ version 2.10 -- comboBoxTearoffTitle :: (ComboBoxClass self, GlibString string) => Attr self string comboBoxTearoffTitle = newAttrFromStringProperty "tearoff-title" -- %hash c:efa9 d:89e5 -- | Whether the combo boxes dropdown is popped up. Note that this property is -- mainly useful because it allows you to connect to notify::popup-shown. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.10 -- comboBoxPopupShown :: ComboBoxClass self => ReadAttr self Bool comboBoxPopupShown = readAttrFromBoolProperty "popup-shown" -- %hash c:52a1 d:79e8 -- | \'title\' property. See 'comboBoxGetTitle' and 'comboBoxSetTitle' -- -- * Available since Gtk+ version 2.10 -- comboBoxTitle :: (ComboBoxClass self, GlibString string) => Attr self string comboBoxTitle = newAttr comboBoxGetTitle comboBoxSetTitle #endif -------------------- -- Signals -- %hash c:4cee d:36c9 -- | The changed signal is emitted when the active item is changed. The can be -- due to the user selecting a different item from the list, or due to a call -- to 'comboBoxSetActiveIter'. It will also be emitted while typing into a -- 'ComboBoxEntry', as well as when selecting an item from the -- 'ComboBoxEntry''s list. -- changed :: ComboBoxClass self => Signal self (IO ()) changed = Signal (connect_NONE__NONE "changed") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- %hash c:c149 onChanged :: ComboBoxClass self => self -> IO () -> IO (ConnectId self) onChanged = connect_NONE__NONE "changed" False {-# DEPRECATED onChanged "instead of 'onChanged obj' use 'on obj changed'" #-} -- %hash c:5e28 afterChanged :: ComboBoxClass self => self -> IO () -> IO (ConnectId self) afterChanged = connect_NONE__NONE "changed" True {-# DEPRECATED afterChanged "instead of 'afterChanged obj' use 'after obj changed'" #-} #endif #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs0000644000000000000000000001736207346545000022037 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ComboBoxEntry -- -- Author : Duncan Coutts -- -- Created: 25 April 2004 -- -- Copyright (C) 2004-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) -- -- A text entry field with a dropdown list -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry ( -- * Detail -- -- | A 'ComboBoxEntry' is a widget that allows the user to choose from a list -- of valid choices or enter a different value. It is very similar to a -- 'ComboBox', but it displays the selected value in an entry to allow -- modifying it. -- -- In contrast to a 'ComboBox', the underlying model of a 'ComboBoxEntry' must -- always have a text column (see 'comboBoxEntrySetTextColumn'), and the entry -- will show the content of the text column in the selected row. To get the -- text from the entry, use 'comboBoxEntryGetActiveText'. -- -- The 'Graphics.UI.Gtk.MenuComboToolbar.ComboBox.changed' signal will be -- emitted while typing into a 'ComboBoxEntry', as well as when selecting an -- item from the 'ComboBoxEntry''s list. Use 'comboBoxGetActive' or -- 'comboBoxGetActiveIter' to discover whether an item was actually selected -- from the list. -- -- Connect to the activate signal of the 'Entry' (use 'binGetChild') to detect -- when the user actually finishes entering text. -- -- * This module is deprecated and the functionality removed in Gtk3. It is -- therefore empty in Gtk3. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'ComboBox' -- | +----ComboBoxEntry -- @ #if GTK_MAJOR_VERSION < 3 #if GTK_CHECK_VERSION(2,4,0) -- * Types ComboBoxEntry, ComboBoxEntryClass, castToComboBoxEntry, gTypeComboBoxEntry, toComboBoxEntry, -- * Constructors comboBoxEntryNew, comboBoxEntryNewText, comboBoxEntryNewWithModel, -- * Methods comboBoxEntrySetModelText, comboBoxEntrySetTextColumn, comboBoxEntryGetTextColumn, #if GTK_CHECK_VERSION(2,6,0) comboBoxEntryGetActiveText, #endif -- * Attributes comboBoxEntryTextColumn, #endif #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} hiding ( ListStore ) import Graphics.UI.Gtk.ModelView.Types import Graphics.UI.Gtk.MenuComboToolbar.ComboBox {#import Graphics.UI.Gtk.ModelView.CustomStore#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} import Graphics.UI.Gtk.ModelView.ListStore ( ListStore, listStoreNew ) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'ComboBoxEntry' which has a 'Entry' as child. After -- construction, you should set a model using 'comboBoxSetModel' and a -- text column using 'comboBoxEntrySetTextColumn'. -- comboBoxEntryNew :: IO ComboBoxEntry comboBoxEntryNew = makeNewObject mkComboBoxEntry $ liftM (castPtr :: Ptr Widget -> Ptr ComboBoxEntry) $ {# call gtk_combo_box_entry_new #} -- | Creates a new 'ComboBoxEntry' with a store containing strings. -- See 'comboBoxEntrySetModelText'. -- comboBoxEntryNewText :: IO ComboBoxEntry comboBoxEntryNewText = do combo <- comboBoxEntryNew comboBoxEntrySetModelText combo return combo -- | Creates a new 'ComboBoxEntry' which has a 'Entry' as child and a list of -- strings as popup. You can get the 'Entry' from a 'ComboBoxEntry' using -- 'binGetChild'. To add and remove strings from the list, just modify @model@ -- using its data manipulation API. -- comboBoxEntryNewWithModel :: TreeModelClass model => model -- ^ @model@ - A 'CustomStore'. -> IO ComboBoxEntry comboBoxEntryNewWithModel model = do combo <- comboBoxEntryNew comboBoxSetModel combo (Just model) return combo -------------------- -- Methods -- | Set a model that holds strings. -- -- This function stores a 'Graphics.UI.Gtk.ModelView.ListStore' with the -- widget and sets the model to the list store. The widget can contain only -- strings. The model can be retrieved with 'comboBoxGetModel'. The list -- store can be retrieved with 'comboBoxGetModelText'. -- Any existing model or renderers are removed before setting the new text -- model. -- In order to respond to new texts that the user enters, it is necessary to -- connect to the 'Graphics.UI.Gtk.Entry.Entry.entryActivated' signal of the -- contained 'Graphics.UI.Gtk.Entry.Entry.Entry' and insert the text into the -- text model which can be retrieved with -- 'Graphics.UI.Gtk.MenuComboToolbar.ComboBox.comboBoxGetModelText'. -- Note that the functions 'comboBoxAppendText', 'comboBoxInsertText', -- 'comboBoxPrependText', 'comboBoxRemoveText' and 'comboBoxGetActiveText' -- can be called on a combo box only once 'comboBoxEntrySetModelText' is -- called. -- comboBoxEntrySetModelText :: ComboBoxEntryClass self => self -> IO (ListStore String) comboBoxEntrySetModelText combo = do store <- listStoreNew ([] :: [String]) comboBoxSetModel combo (Just store) let colId = makeColumnIdString 0 customStoreSetColumn store colId id comboBoxEntrySetTextColumn (toComboBoxEntry combo) colId objectSetAttribute comboQuark (toComboBoxEntry combo) (Just store) return store -- %hash c:b7d7 d:2818 -- | Sets the model column should be use to get strings from to -- be @textColumn@. -- comboBoxEntrySetTextColumn :: (ComboBoxEntryClass self, GlibString string) => self -> ColumnId row string -- ^ @textColumn@ - A column in @model@ to get the strings from. -> IO () comboBoxEntrySetTextColumn self textColumn = {# call gtk_combo_box_entry_set_text_column #} (toComboBoxEntry self) (fromIntegral (columnIdToNumber textColumn)) -- %hash c:a3e3 d:6441 -- | Returns the column which is used to get the strings from. -- comboBoxEntryGetTextColumn :: (ComboBoxEntryClass self, GlibString string) => self -> IO (ColumnId row string) -- ^ returns A column in the data source model of @entryBox@. comboBoxEntryGetTextColumn self = liftM (makeColumnIdString . fromIntegral) $ {# call gtk_combo_box_entry_get_text_column #} (toComboBoxEntry self) #if GTK_CHECK_VERSION(2,6,0) -- | Retrieve the text currently in the entry. -- -- * Returns @Nothing@ if no text is selected or entered. -- -- * Available in Gtk 2.6 or higher. -- comboBoxEntryGetActiveText :: (ComboBoxEntryClass self, GlibString string) => self -> IO (Maybe string) comboBoxEntryGetActiveText self = do strPtr <- {# call gtk_combo_box_get_active_text #} (toComboBox self) if strPtr == nullPtr then return Nothing else liftM Just $ peekUTFString (castPtr strPtr) #endif -------------------- -- Attributes -- %hash c:84ff d:be07 -- | A column in the data source model to get the strings from. -- -- Allowed values: >= 0 -- -- Default value: 'Graphics.UI.Gtk.ModelView.CustomStore.invalidColumnId' -- comboBoxEntryTextColumn :: (ComboBoxEntryClass self, GlibString string) => Attr self (ColumnId row string) comboBoxEntryTextColumn = newAttr comboBoxEntryGetTextColumn comboBoxEntrySetTextColumn #endif #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs0000644000000000000000000001213007346545000021757 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ImageMenuItem -- -- Author : Jonas Svensson -- -- Created: 12 Aug 2002 -- -- Copyright (C) 2002 Jonas Svensson -- -- 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 -- -- imageMenuItemNewFromSock should also have a AccelGroup argument -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A menu item with an icon -- module Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem ( -- * Detail -- -- | A 'ImageMenuItem' is a menu item which has an icon next to the text -- label. -- -- Note that the user can disable display of menu icons, so make sure to -- still fill in the text label. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Item' -- | +----'MenuItem' -- | +----ImageMenuItem -- @ -- * Types ImageMenuItem, ImageMenuItemClass, castToImageMenuItem, gTypeImageMenuItem, toImageMenuItem, -- * Constructors imageMenuItemNew, imageMenuItemNewFromStock, imageMenuItemNewWithLabel, imageMenuItemNewWithMnemonic, -- * Methods imageMenuItemSetImage, imageMenuItemGetImage, -- * Attributes imageMenuItemImage, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'ImageMenuItem' with an empty label. -- imageMenuItemNew :: IO ImageMenuItem imageMenuItemNew = makeNewObject mkImageMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr ImageMenuItem) $ {# call unsafe image_menu_item_new #} -- | Creates a new 'ImageMenuItem' containing the image and text from a stock -- item. -- imageMenuItemNewFromStock :: StockId -- ^ @stockId@ - the name of the stock item. -> IO ImageMenuItem imageMenuItemNewFromStock stockId = makeNewObject mkImageMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr ImageMenuItem) $ withUTFString stockId $ \stockIdPtr -> {# call unsafe image_menu_item_new_from_stock #} stockIdPtr (AccelGroup nullForeignPtr) -- | Creates a new 'ImageMenuItem' containing a label. -- imageMenuItemNewWithLabel :: GlibString string => string -- ^ @label@ - the text of the menu item. -> IO ImageMenuItem imageMenuItemNewWithLabel label = makeNewObject mkImageMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr ImageMenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe image_menu_item_new_with_label #} labelPtr -- | Creates a new 'ImageMenuItem' containing a label. The label will be -- created using 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic', so -- underscores in @label@ indicate the mnemonic for the menu item. -- imageMenuItemNewWithMnemonic :: GlibString string => string -- ^ @label@ - the text of the menu item, with an -- underscore in front of the mnemonic character -> IO ImageMenuItem imageMenuItemNewWithMnemonic label = makeNewObject mkImageMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr ImageMenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe image_menu_item_new_with_mnemonic #} labelPtr -------------------- -- Methods -- | Sets the image of the image menu item to the given widget. Note that it -- depends on the \"show-menu-images\" setting whether the image will be -- displayed or not. -- imageMenuItemSetImage :: (ImageMenuItemClass self, WidgetClass image) => self -> image -- ^ @image@ - a widget to set as the image for the menu item. -> IO () imageMenuItemSetImage self image = {# call unsafe image_menu_item_set_image #} (toImageMenuItem self) (toWidget image) -- | Gets the widget that is currently set as the image. -- See 'imageMenuItemSetImage'. -- imageMenuItemGetImage :: ImageMenuItemClass self => self -> IO (Maybe Widget) -- ^ returns the widget set as image of or @Nothing@ if -- none has been set. imageMenuItemGetImage self = maybeNull (makeNewObject mkWidget) $ {# call unsafe image_menu_item_get_image #} (toImageMenuItem self) -------------------- -- Attributes -- | Child widget to appear next to the menu text. -- imageMenuItemImage :: (ImageMenuItemClass self, WidgetClass image) => ReadWriteAttr self (Maybe Widget) image imageMenuItemImage = newAttr imageMenuItemGetImage imageMenuItemSetImage gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/Menu.chs0000644000000000000000000003616507346545000020213 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Menu -- -- Author : Axel Simon -- -- Created: 21 May 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. -- -- TODO -- -- The following not bound functions might be useful: -- menuSetAccelGroup, menuSetAccelGroup, menuReposition -- -- The function menuPopup at a specific position is difficult to bind: -- The callback function that determines at which position the menu is -- to be shown is kept after the call returns. Maybe we could destroy -- this function pointer with a destroy event? -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A menu widget -- module Graphics.UI.Gtk.MenuComboToolbar.Menu ( -- * Detail -- -- | A 'Menu' is a 'MenuShell' that implements a drop down menu consisting of -- a list of 'MenuItem' objects which can be navigated and activated by the -- user to perform application functions. -- -- A 'Menu' is most commonly dropped down by activating a 'MenuItem' in a -- 'MenuBar' or popped up by activating a 'MenuItem' in another 'Menu'. -- -- A 'Menu' can also be popped up by activating a 'OptionMenu'. Other -- composite widgets such as the 'Notebook' can pop up a 'Menu' as well. -- -- Applications can display a 'Menu' as a popup menu by calling the -- 'menuPopup' function. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'MenuShell' -- | +----Menu -- @ -- * Types Menu, MenuClass, castToMenu, gTypeMenu, toMenu, -- * Constructors menuNew, -- * Methods menuReorderChild, menuPopup, menuSetAccelGroup, menuGetAccelGroup, menuSetAccelPath, menuSetTitle, menuGetTitle, menuPopdown, menuReposition, menuGetActive, menuSetActive, menuSetTearoffState, menuGetTearoffState, menuAttachToWidget, menuDetach, menuGetAttachWidget, #if GTK_CHECK_VERSION(2,2,0) menuSetScreen, #endif #if GTK_CHECK_VERSION(2,4,0) menuSetMonitor, menuAttach, #endif #if GTK_CHECK_VERSION(2,6,0) menuGetForAttachWidget, #endif -- * Attributes #if GTK_CHECK_VERSION(2,6,0) menuTearoffState, #endif menuAccelGroup, menuActive, menuTitle, -- * Child Attributes menuChildLeftAttach, menuChildRightAttach, menuChildTopAttach, menuChildBottomAttach, ) where import Control.Monad (liftM) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.ContainerChildProperties import Graphics.UI.Gtk.Gdk.Events (MouseButton, TimeStamp) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Menu'. -- menuNew :: IO Menu menuNew = makeNewObject mkMenu $ liftM (castPtr :: Ptr Widget -> Ptr Menu) $ {# call unsafe menu_new #} -------------------- -- Methods -- | Moves a 'MenuItem' to a new position within the 'Menu'. -- menuReorderChild :: (MenuClass self, MenuItemClass child) => self -> child -- ^ @child@ - the 'MenuItem' to move. -> Int -- ^ @position@ - the new position to place @child@. Positions are -- numbered from 0 to n-1. -> IO () menuReorderChild self child position = {# call menu_reorder_child #} (toMenu self) (toWidget child) (fromIntegral position) -- | Popup a context menu where a button press occurred. -- -- * This function must be called in response to a button click. It opens -- the given menu at a place determined by the last emitted event (hence -- the requirement that this function is called as response to a button -- press signal). -- menuPopup :: MenuClass self => self -- ^ The menu to be shown. -> Maybe (MouseButton, TimeStamp) -- ^ The mouse button returned by 'Graphics.UI.Gtk.Gdk.EventM.eventButton' and -- the time of the event returned by 'Graphics.UI.Gtk.Gdk.eventTime'. These -- values are used to match the corresponding release of the button. If this -- context menu is shown by programmatic means, supply @Nothing@. -> IO () menuPopup self (Just (b,t)) = {# call menu_popup #} (toMenu self) (Widget nullForeignPtr) (Widget nullForeignPtr) nullFunPtr nullPtr ((fromIntegral . fromEnum) b) (fromIntegral t) menuPopup self Nothing = do t <- {# call unsafe get_current_event_time #} {# call menu_popup #} (toMenu self) (Widget nullForeignPtr) (Widget nullForeignPtr) nullFunPtr nullPtr 0 t -- | Set the 'AccelGroup' which holds global accelerators for the menu. This -- accelerator group needs to also be added to all windows that this menu is -- being used in with 'windowAddAccelGroup', in order for those windows to -- support all the accelerators contained in this group. -- menuSetAccelGroup :: MenuClass self => self -> AccelGroup -- ^ @accelGroup@ - the 'AccelGroup' to be associated with the -- menu. -> IO () menuSetAccelGroup self accelGroup = {# call menu_set_accel_group #} (toMenu self) accelGroup -- | Gets the 'AccelGroup' which holds global accelerators for the menu. See -- 'menuSetAccelGroup'. -- menuGetAccelGroup :: MenuClass self => self -> IO AccelGroup -- ^ returns the 'AccelGroup' associated with the menu. menuGetAccelGroup self = makeNewGObject mkAccelGroup $ {# call unsafe menu_get_accel_group #} (toMenu self) -- | Sets an accelerator path for this menu from which accelerator paths for -- its immediate children, its menu items, can be constructed. The main purpose -- of this function is to spare the programmer the inconvenience of having to -- call 'menuItemSetAccelPath' on each menu item that should support runtime -- user changeable accelerators. Instead, by just calling 'menuSetAccelPath' on -- their parent, each menu item of this menu, that contains a label describing -- its purpose, automatically gets an accel path assigned. -- -- For example, a menu containing menu items \"New\" and \"Exit\", will, after -- calling -- -- > menu `menuSetAccelPath` "/File" -- -- assign its items the accel paths: @\"\\/File\/New\"@ and -- @\"\\/File\/Exit\"@. -- -- Assigning accel paths to menu items then enables the user to change their -- accelerators at runtime. More details about accelerator paths and their -- default setups can be found at 'accelMapAddEntry'. -- menuSetAccelPath :: (MenuClass self, GlibString string) => self -> string -- ^ @accelPath@ - a valid accelerator path -> IO () menuSetAccelPath self accelPath = withUTFString accelPath $ \accelPathPtr -> {# call menu_set_accel_path #} (toMenu self) accelPathPtr -- | Sets the title string for the menu. The title is displayed when the menu -- is shown as a tearoff menu. -- menuSetTitle :: (MenuClass self, GlibString string) => self -> string -> IO () menuSetTitle self title = withUTFString title $ \titlePtr -> {# call unsafe menu_set_title #} (toMenu self) titlePtr -- | Returns the title of the menu. See 'menuSetTitle'. -- menuGetTitle :: (MenuClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the title of the menu, or @Nothing@ if the -- menu has no title set on it. menuGetTitle self = {# call unsafe menu_get_title #} (toMenu self) >>= maybePeek peekUTFString -- | Removes the menu from the screen. -- menuPopdown :: MenuClass self => self -> IO () menuPopdown self = {# call menu_popdown #} (toMenu self) -- | Repositions the menu according to its position function. -- menuReposition :: MenuClass self => self -> IO () menuReposition self = {# call menu_reposition #} (toMenu self) -- | Returns the selected menu item from the menu. This is used by the -- 'OptionMenu'. -- menuGetActive :: MenuClass self => self -> IO MenuItem -- ^ returns the 'MenuItem' that was last selected in the menu. -- If a selection has not yet been made, the first menu item is -- selected. menuGetActive self = makeNewObject mkMenuItem $ throwIfNull "menuGetActive: menu contains no menu items." $ liftM castPtr $ {# call menu_get_active #} (toMenu self) -- | Selects the specified menu item within the menu. This is used by the -- 'OptionMenu' and should not be used by anyone else. -- menuSetActive :: MenuClass self => self -> Int -- ^ @index@ - the index of the menu item to select. Index values -- are from 0 to n-1. -> IO () menuSetActive self index = {# call menu_set_active #} (toMenu self) (fromIntegral index) -- | Changes the tearoff state of the menu. A menu is normally displayed as -- drop down menu which persists as long as the menu is active. It can also be -- displayed as a tearoff menu which persists until it is closed or reattached. -- menuSetTearoffState :: MenuClass self => self -> Bool -- ^ @tornOff@ - If @True@, menu is displayed as a tearoff menu. -> IO () menuSetTearoffState self tornOff = {# call menu_set_tearoff_state #} (toMenu self) (fromBool tornOff) -- | Returns whether the menu is torn off. See 'menuSetTearoffState'. -- menuGetTearoffState :: MenuClass self => self -> IO Bool -- ^ returns @True@ if the menu is currently torn off. menuGetTearoffState self = liftM toBool $ {# call unsafe menu_get_tearoff_state #} (toMenu self) -- | Attach this menu to another widget. -- menuAttachToWidget :: (MenuClass self, WidgetClass attachWidget) => self -> attachWidget -> IO () menuAttachToWidget self attachWidget = {# call menu_attach_to_widget #} (toMenu self) (toWidget attachWidget) nullFunPtr -- | Detach this menu from the widget it is attached to. -- menuDetach :: MenuClass self => self -> IO () menuDetach self = {# call menu_detach #} (toMenu self) -- | Get the widget this menu is attached to. Returns Nothing if this is a -- tearoff (context) menu. -- menuGetAttachWidget :: MenuClass self => self -> IO (Maybe Widget) menuGetAttachWidget self = do wPtr <- {#call unsafe menu_get_attach_widget#} (toMenu self) if wPtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkWidget (return wPtr) #if GTK_CHECK_VERSION(2,2,0) -- | Sets the 'Screen' on which the menu will be displayed. -- -- * Available since Gtk+ version 2.2 -- menuSetScreen :: MenuClass self => self -> Maybe Screen -- ^ @screen@ - a 'Screen', or @Nothing@ if the screen should -- be determined by the widget the menu is attached to. -> IO () menuSetScreen self screen = {# call menu_set_screen #} (toMenu self) (fromMaybe (Screen nullForeignPtr) screen) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Informs Gtk+ on which monitor a menu should be popped up. See -- 'screenGetMonitorGeometry'. -- -- * Available since Gtk+ version 2.4 -- menuSetMonitor :: MenuClass self => self -> Int -- ^ @monitorNum@ - the number of the monitor on which the menu -- should be popped up -> IO () menuSetMonitor self monitorNum = {# call menu_set_monitor #} (toMenu self) (fromIntegral monitorNum) -- | Adds a new 'MenuItem' to a (table) menu. The number of \'cells\' that an -- item will occupy is specified by @leftAttach@, @rightAttach@, @topAttach@ -- and @bottomAttach@. These each represent the leftmost, rightmost, uppermost -- and lower column and row numbers of the table. (Columns and rows are indexed -- from zero). -- -- Note that this function is not related to 'menuDetach'. -- -- * Available since Gtk+ version 2.4 -- menuAttach :: (MenuClass self, MenuItemClass child) => self -> child -- ^ @child@ - a 'MenuItem'. -> Int -- ^ @leftAttach@ - The column number to attach the left side of the -- item to. -> Int -- ^ @rightAttach@ - The column number to attach the right side of -- the item to. -> Int -- ^ @topAttach@ - The row number to attach the top of the item to. -> Int -- ^ @bottomAttach@ - The row number to attach the bottom of the -- item to. -> IO () menuAttach self child leftAttach rightAttach topAttach bottomAttach = {# call gtk_menu_attach #} (toMenu self) (toWidget child) (fromIntegral leftAttach) (fromIntegral rightAttach) (fromIntegral topAttach) (fromIntegral bottomAttach) #endif #if GTK_CHECK_VERSION(2,6,0) -- | Returns a list of the menus which are attached to this widget. -- -- * Available since Gtk+ version 2.6 -- menuGetForAttachWidget :: WidgetClass widget => widget -- ^ @widget@ - a 'Widget' -> IO [Menu] menuGetForAttachWidget widget = {# call gtk_menu_get_for_attach_widget #} (toWidget widget) >>= fromGList >>= mapM (\elemPtr -> makeNewObject mkMenu (return elemPtr)) #endif -------------------- -- Attributes -- | A title that may be displayed by the window manager when this menu is -- torn-off. -- -- Default value: \"\" -- menuTitle :: (MenuClass self, GlibString string) => Attr self string menuTitle = newAttrFromStringProperty "tearoff-title" #if GTK_CHECK_VERSION(2,6,0) -- | A boolean that indicates whether the menu is torn-off. -- -- Default value: @False@ -- menuTearoffState :: MenuClass self => Attr self Bool menuTearoffState = newAttr menuGetTearoffState menuSetTearoffState #endif -- | \'accelGroup\' property. See 'menuGetAccelGroup' and 'menuSetAccelGroup' -- menuAccelGroup :: MenuClass self => Attr self AccelGroup menuAccelGroup = newAttr menuGetAccelGroup menuSetAccelGroup -- | \'active\' property. See 'menuGetActive' and 'menuSetActive' -- menuActive :: MenuClass self => ReadWriteAttr self MenuItem Int menuActive = newAttr menuGetActive menuSetActive -------------------- -- Child Attributes -- | The column number to attach the left side of the child to. -- -- Allowed values: >= -1 -- -- Default value: -1 -- menuChildLeftAttach :: (MenuClass self, WidgetClass child) => child -> Attr self Int menuChildLeftAttach = newAttrFromContainerChildIntProperty "left-attach" -- | The column number to attach the right side of the child to. -- -- Allowed values: >= -1 -- -- Default value: -1 -- menuChildRightAttach :: (MenuClass self, WidgetClass child) => child -> Attr self Int menuChildRightAttach = newAttrFromContainerChildIntProperty "right-attach" -- | The row number to attach the top of the child to. -- -- Allowed values: >= -1 -- -- Default value: -1 -- menuChildTopAttach :: (MenuClass self, WidgetClass child) => child -> Attr self Int menuChildTopAttach = newAttrFromContainerChildIntProperty "top-attach" -- | The row number to attach the bottom of the child to. -- -- Allowed values: >= -1 -- -- Default value: -1 -- menuChildBottomAttach :: (MenuClass self, WidgetClass child) => child -> Attr self Int menuChildBottomAttach = newAttrFromContainerChildIntProperty "bottom-attach" gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/MenuBar.chs0000644000000000000000000001123307346545000020625 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget MenuBar -- -- Author : Axel Simon -- -- Created: 21 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A subclass widget for 'MenuShell' which holds 'MenuItem' widgets -- module Graphics.UI.Gtk.MenuComboToolbar.MenuBar ( -- * Detail -- -- | The 'MenuBar' is a subclass of 'MenuShell' which contains one to many -- 'MenuItem'. The result is a standard menu bar which can hold many menu -- items. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'MenuShell' -- | +----MenuBar -- @ -- * Types MenuBar, MenuBarClass, castToMenuBar, gTypeMenuBar, toMenuBar, #if GTK_CHECK_VERSION(2,8,0) PackDirection(..), #endif -- * Constructors menuBarNew, -- * Methods #if GTK_CHECK_VERSION(2,8,0) menuBarSetPackDirection, menuBarGetPackDirection, menuBarSetChildPackDirection, menuBarGetChildPackDirection, #endif -- * Attributes #if GTK_CHECK_VERSION(2,8,0) menuBarPackDirection, menuBarChildPackDirection, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,8,0) -- | Determines how to pack a menu bar: left-to-right, right-to-left, -- top-to-bottom or bottom-to-top. {# enum PackDirection {underscoreToCase} #} #endif -------------------- -- Constructors -- | Creates the new 'MenuBar' -- menuBarNew :: IO MenuBar menuBarNew = makeNewObject mkMenuBar $ liftM (castPtr :: Ptr Widget -> Ptr MenuBar) $ {# call unsafe menu_bar_new #} -------------------- -- Methods #if GTK_CHECK_VERSION(2,8,0) -- | Sets how items should be packed inside a menubar. -- -- * Available since Gtk+ version 2.8 -- menuBarSetPackDirection :: MenuBarClass self => self -> PackDirection -- ^ @packDir@ - a new 'PackDirection'. -> IO () menuBarSetPackDirection self packDir = {# call gtk_menu_bar_set_pack_direction #} (toMenuBar self) ((fromIntegral . fromEnum) packDir) -- | Retrieves the current pack direction of the menubar. See -- 'menuBarSetPackDirection'. -- -- * Available since Gtk+ version 2.8 -- menuBarGetPackDirection :: MenuBarClass self => self -> IO PackDirection -- ^ returns the pack direction menuBarGetPackDirection self = liftM (toEnum . fromIntegral) $ {# call gtk_menu_bar_get_pack_direction #} (toMenuBar self) -- | Sets how widgets should be packed inside the children of a menubar. -- -- * Available since Gtk+ version 2.8 -- menuBarSetChildPackDirection :: MenuBarClass self => self -> PackDirection -- ^ @childPackDir@ - a new 'PackDirection'. -> IO () menuBarSetChildPackDirection self childPackDir = {# call gtk_menu_bar_set_child_pack_direction #} (toMenuBar self) ((fromIntegral . fromEnum) childPackDir) -- | Retrieves the current child pack direction of the menubar. See -- 'menuBarSetChildPackDirection'. -- -- * Available since Gtk+ version 2.8 -- menuBarGetChildPackDirection :: MenuBarClass self => self -> IO PackDirection -- ^ returns the child pack direction menuBarGetChildPackDirection self = liftM (toEnum . fromIntegral) $ {# call gtk_menu_bar_get_child_pack_direction #} (toMenuBar self) #endif -------------------- -- Attributes #if GTK_CHECK_VERSION(2,8,0) -- | The pack direction of the menubar. It determines how menuitems are -- arranged in the menubar. -- -- Default value: 'PackDirectionLtr' -- menuBarPackDirection :: MenuBarClass self => Attr self PackDirection menuBarPackDirection = newAttr menuBarGetPackDirection menuBarSetPackDirection -- | The pack direction of the menubar. It determines how the widgets -- contained in child menuitems are arranged. -- -- Default value: 'PackDirectionLtr' -- menuBarChildPackDirection :: MenuBarClass self => Attr self PackDirection menuBarChildPackDirection = newAttr menuBarGetChildPackDirection menuBarSetChildPackDirection #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs0000644000000000000000000003147607346545000021032 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget MenuItem -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- NOTES -- -- This widget derives from 'Item'. Since CList and CTree are deprecated, it -- is the only child of that widget. The three signals defined by Item are -- therefore bound in this module. -- -- TODO -- -- figure out what the signals \"toggle-size-allocate\" and -- \"toggle-size-request\" are good for and bind them if useful -- -- figure out if the connectToToggle signal is useful at all -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The widget used for item in menus -- module Graphics.UI.Gtk.MenuComboToolbar.MenuItem ( -- * Detail -- -- | The 'MenuItem' widget and the derived widgets are the only valid children -- for menus. Their function is to correctly handle highlighting, alignment, -- events and submenus. -- -- As it derives from 'Bin' it can hold any valid child widget, although only -- a few are really useful. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Item' -- | +----MenuItem -- | +----'CheckMenuItem' -- | +----'ImageMenuItem' -- | +----'SeparatorMenuItem' -- | +----'TearoffMenuItem' -- @ -- * Types MenuItem, MenuItemClass, castToMenuItem, gTypeMenuItem, toMenuItem, -- * Constructors menuItemNew, menuItemNewWithLabel, menuItemNewWithMnemonic, -- * Methods #if GTK_CHECK_VERSION(2,16,0) menuItemSetLabel, menuItemGetLabel, menuItemSetUseUnderline, menuItemGetUseUnderline, #endif menuItemSetSubmenu, menuItemGetSubmenu, menuItemRemoveSubmenu, menuItemEmitSelect, menuItemEmitDeselect, menuItemEmitActivate, menuItemSetRightJustified, menuItemGetRightJustified, menuItemSetAccelPath, -- * Attributes menuItemSubmenu, menuItemRightJustified, #if GTK_CHECK_VERSION(2,16,0) menuItemLabel, menuItemUseUnderline, #endif -- * Signals menuItemActivatedItem, menuItemActivated, menuItemActivateItem, menuItemActivate, menuItemSelect, menuItemDeselect, menuItemToggle, #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- * Deprecated onActivateItem, afterActivateItem, onActivateLeaf, afterActivateLeaf, onSelect, afterSelect, onDeselect, afterDeselect, onToggle, afterToggle #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'MenuItem'. -- menuItemNew :: IO MenuItem menuItemNew = makeNewObject mkMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr MenuItem) $ {# call unsafe menu_item_new #} -- | Creates a new 'MenuItem' whose child is a 'Label'. -- menuItemNewWithLabel :: GlibString string => string -- ^ @label@ - the text for the label -> IO MenuItem menuItemNewWithLabel label = makeNewObject mkMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr MenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe menu_item_new_with_label #} labelPtr -- | Creates a new 'MenuItem' containing a label. The label will be created -- using 'labelNewWithMnemonic', so underscores in @label@ indicate the -- mnemonic for the menu item. -- menuItemNewWithMnemonic :: GlibString string => string -- ^ @label@ - The text of the label, with an underscore in -- front of the mnemonic character -> IO MenuItem menuItemNewWithMnemonic label = makeNewObject mkMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr MenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe menu_item_new_with_mnemonic #} labelPtr -------------------- -- Methods #if GTK_CHECK_VERSION(2,16,0) -- | Sets text on the MenuItem label menuItemSetLabel :: (MenuItemClass self, GlibString string) => self -> string -> IO () menuItemSetLabel self label = withUTFString label $ {# call gtk_menu_item_set_label #} (toMenuItem self) -- | Gets text on the MenuItem label menuItemGetLabel :: (MenuItemClass self, GlibString string) => self -> IO string menuItemGetLabel self = {# call gtk_menu_item_get_label #} (toMenuItem self) >>= \strPtr -> if strPtr == nullPtr then return "" else peekUTFString strPtr -- | If True, an underline in the text indicates the next character should be used for the mnemonic accelerator key. -- menuItemSetUseUnderline :: (MenuItemClass self) => self -> Bool -> IO () menuItemSetUseUnderline self = {# call gtk_menu_item_set_use_underline #} (toMenuItem self) . fromBool -- | Checks if an underline in the text indicates the next character should be used for the mnemonic accelerator key. -- menuItemGetUseUnderline :: (MenuItemClass self) => self -> IO Bool menuItemGetUseUnderline self = liftM toBool $ {# call gtk_menu_item_get_use_underline #} (toMenuItem self) #endif -- | Sets the item's submenu, or changes it. -- menuItemSetSubmenu :: (MenuItemClass self, MenuClass submenu) => self -> submenu -> IO () menuItemSetSubmenu self submenu = {# call menu_item_set_submenu #} (toMenuItem self) (toWidget submenu) -- | Gets the submenu underneath this menu item, if any. See -- 'menuItemSetSubmenu'. -- menuItemGetSubmenu :: MenuItemClass self => self -> IO (Maybe Widget) -- ^ returns submenu for this menu item, or @Nothing@ if -- none. menuItemGetSubmenu self = maybeNull (makeNewObject mkWidget) $ {# call unsafe menu_item_get_submenu #} (toMenuItem self) -- | Removes the item's submenu. -- menuItemRemoveSubmenu :: MenuItemClass self => self -> IO () menuItemRemoveSubmenu self = {# call menu_item_set_submenu #} (toMenuItem self) (Widget $ unsafePerformIO $ newForeignPtr_ nullPtr) -- | Select the menu item. Emits the \"select\" signal on the item. -- menuItemEmitSelect :: MenuItemClass self => self -> IO () menuItemEmitSelect self = {# call menu_item_select #} (toMenuItem self) -- | Deselect the menu item. Emits the \"deselect\" signal on the item. -- menuItemEmitDeselect :: MenuItemClass self => self -> IO () menuItemEmitDeselect self = {# call menu_item_deselect #} (toMenuItem self) -- | Simulate a click on the menu item. Emits the \"activate\" signal on the item. -- menuItemEmitActivate :: MenuItemClass self => self -> IO () menuItemEmitActivate self = {# call menu_item_activate #} (toMenuItem self) -- | Sets whether the menu item appears justified at the right side of a menu -- bar. This was traditionally done for \"Help\" menu items, but is now -- considered a bad idea. (If the widget layout is reversed for a right-to-left -- language like Hebrew or Arabic, right-justified-menu-items appear at the -- left.) -- menuItemSetRightJustified :: MenuItemClass self => self -> Bool -- ^ @rightJustified@ - if @True@ the menu item will appear at the -- far right if added to a menu bar. -> IO () menuItemSetRightJustified self rightJustified = {# call menu_item_set_right_justified #} (toMenuItem self) (fromBool rightJustified) -- | Gets whether the menu item appears justified at the right side of the -- menu bar. -- menuItemGetRightJustified :: MenuItemClass self => self -> IO Bool menuItemGetRightJustified self = liftM toBool $ {# call unsafe menu_item_get_right_justified #} (toMenuItem self) -- | Set the accelerator path on the menu item, through which runtime changes of -- the menu item's accelerator caused by the user can be identified and saved -- to persistent storage (see 'accelMapSave' on this). To setup a default -- accelerator for this menu item, call 'accelMapAddEntry' with the same accel -- path. See also 'accelMapAddEntry' on the specifics of accelerator paths, and -- 'menuSetAccelPath' for a more convenient variant of this function. -- -- This function is basically a convenience wrapper that handles calling -- 'widgetSetAccelPath' with the appropriate accelerator group for the menu -- item. -- -- Note that you do need to set an accelerator on the parent menu with -- 'menuSetAccelGroup' for this to work. -- menuItemSetAccelPath :: (MenuItemClass self, GlibString string) => self -> Maybe string -- ^ @accelPath@ - accelerator path, corresponding to this -- menu item's functionality, or @Nothing@ to unset the -- current path. -> IO () menuItemSetAccelPath self accelPath = maybeWith withUTFString accelPath $ \accelPathPtr -> {# call menu_item_set_accel_path #} (toMenuItem self) accelPathPtr -------------------- -- Attributes -- | \'submenu\' property. See 'menuItemGetSubmenu' and 'menuItemSetSubmenu' -- menuItemSubmenu :: (MenuItemClass self, MenuClass submenu) => ReadWriteAttr self (Maybe Widget) submenu menuItemSubmenu = newAttr menuItemGetSubmenu menuItemSetSubmenu -- | \'rightJustified\' property. See 'menuItemGetRightJustified' and -- 'menuItemSetRightJustified' -- menuItemRightJustified :: MenuItemClass self => Attr self Bool menuItemRightJustified = newAttr menuItemGetRightJustified menuItemSetRightJustified #if GTK_CHECK_VERSION(2,16,0) -- | \'label\' property. See 'menuItemSetLabel' and 'menuItemGetLabel' -- menuItemLabel :: (MenuItemClass self, GlibString string) => Attr self string menuItemLabel = newAttr menuItemGetLabel menuItemSetLabel -- | \'useUnderline\' property. See 'menuItemSetUseUnderline' and -- 'menuItemGetUseEUnderline' -- menuItemUseUnderline :: MenuItemClass self => Attr self Bool menuItemUseUnderline = newAttr menuItemGetUseUnderline menuItemSetUseUnderline #endif -------------------- -- Signals -- | The user has chosen the menu item. -- -- * This is the only function applications normally connect to. -- It is not emitted if the item has a submenu. -- menuItemActivated :: MenuItemClass self => Signal self (IO ()) menuItemActivated = Signal (connect_NONE__NONE "activate") -- | Deprecated. See 'menuItemActivated'. menuItemActivate :: MenuItemClass self => Signal self (IO ()) menuItemActivate = menuItemActivated -- | Emitted when the user chooses a menu item that has a submenu. -- -- * This signal is not emitted if the menu item does not have a -- submenu. -- menuItemActivatedItem :: MenuItemClass self => Signal self (IO ()) menuItemActivatedItem = Signal (connect_NONE__NONE "activate-item") -- | Deprecated. See 'menuItemActivatedItem'. menuItemActivateItem :: MenuItemClass self => Signal self (IO ()) menuItemActivateItem = menuItemActivatedItem -- | This signal is emitted when the item is selected. -- menuItemSelect :: MenuItemClass i => Signal i (IO ()) menuItemSelect = Signal (connect_NONE__NONE "select") -- | This signal is emitted when the item is deselected. -- menuItemDeselect :: MenuItemClass i => Signal i (IO ()) menuItemDeselect = Signal (connect_NONE__NONE "deselect") -- | This signal is emitted when the item is toggled. -- menuItemToggle :: MenuItemClass i => Signal i (IO ()) menuItemToggle = Signal (connect_NONE__NONE "toggle") #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -------------------- -- Deprecated Signals onActivateLeaf, afterActivateLeaf :: MenuItemClass self => self -> IO () -> IO (ConnectId self) onActivateLeaf = connect_NONE__NONE "activate" False afterActivateLeaf = connect_NONE__NONE "activate" True onActivateItem, afterActivateItem :: MenuItemClass self => self -> IO () -> IO (ConnectId self) onActivateItem = connect_NONE__NONE "activate-item" False afterActivateItem = connect_NONE__NONE "activate-item" True onSelect, afterSelect :: ItemClass i => i -> IO () -> IO (ConnectId i) onSelect = connect_NONE__NONE "select" False afterSelect = connect_NONE__NONE "select" True onDeselect, afterDeselect :: ItemClass i => i -> IO () -> IO (ConnectId i) onDeselect = connect_NONE__NONE "deselect" False afterDeselect = connect_NONE__NONE "deselect" True onToggle, afterToggle :: ItemClass i => i -> IO () -> IO (ConnectId i) onToggle = connect_NONE__NONE "toggle" False afterToggle = connect_NONE__NONE "toggle" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/MenuShell.chs0000644000000000000000000002371407346545000021177 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget MenuShell -- -- Author : Axel Simon -- -- Created: 21 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A base class for menu objects -- module Graphics.UI.Gtk.MenuComboToolbar.MenuShell ( -- * Detail -- -- | A 'MenuShell' is the abstract base class used to derive the 'Menu' and -- 'MenuBar' subclasses. -- -- A 'MenuShell' is a container of 'MenuItem' objects arranged in a list -- which can be navigated, selected, and activated by the user to perform -- application functions. A 'MenuItem' can have a submenu associated with it, -- allowing for nested hierarchical menus. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----MenuShell -- | +----'MenuBar' -- | +----'Menu' -- @ -- * Types MenuShell, MenuShellClass, castToMenuShell, gTypeMenuShell, toMenuShell, -- * Methods menuShellAppend, menuShellPrepend, menuShellInsert, menuShellDeactivate, menuShellActivateItem, menuShellSelectItem, menuShellDeselect, #if GTK_CHECK_VERSION(2,2,0) menuShellSelectFirst, #endif #if GTK_CHECK_VERSION(2,4,0) menuShellCancel, #endif #if GTK_CHECK_VERSION(2,8,0) menuShellSetTakeFocus, menuShellGetTakeFocus, #endif -- * Attributes #if GTK_CHECK_VERSION(2,8,0) menuShellTakeFocus, #endif -- * Signals onActivateCurrent, afterActivateCurrent, onCancel, afterCancel, onDeactivated, afterDeactivated, MenuDirectionType(..), onMoveCurrent, afterMoveCurrent, onSelectionDone, afterSelectionDone ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (MenuDirectionType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Adds a new 'MenuItem' to the end of the menu shell's item list. -- menuShellAppend :: (MenuShellClass self, MenuItemClass child) => self -> child -- ^ @child@ - The 'MenuItem' to add. -> IO () menuShellAppend self child = {# call menu_shell_append #} (toMenuShell self) (toWidget child) -- | Adds a new 'MenuItem' to the beginning of the menu shell's item list. -- menuShellPrepend :: (MenuShellClass self, MenuItemClass child) => self -> child -- ^ @child@ - The 'MenuItem' to add. -> IO () menuShellPrepend self child = {# call menu_shell_prepend #} (toMenuShell self) (toWidget child) -- | Adds a new 'MenuItem' to the menu shell's item list at the position -- indicated by @position@. -- menuShellInsert :: (MenuShellClass self, MenuItemClass child) => self -> child -- ^ @child@ - The 'MenuItem' to add. -> Int -- ^ @position@ - The position in the item list where @child@ is -- added. Positions are numbered from 0 to n-1. -> IO () menuShellInsert self child position = {# call menu_shell_insert #} (toMenuShell self) (toWidget child) (fromIntegral position) -- | Deactivates the menu shell. Typically this results in the menu shell -- being erased from the screen. -- menuShellDeactivate :: MenuShellClass self => self -> IO () menuShellDeactivate self = {# call menu_shell_deactivate #} (toMenuShell self) -- | Activates the menu item within the menu shell. If the menu was deactivated -- and @forceDeactivate@ is set, the previously deactivated menu is reactivated. -- menuShellActivateItem :: (MenuShellClass self, MenuItemClass menuItem) => self -> menuItem -- ^ @menuItem@ - The 'MenuItem' to activate. -> Bool -- ^ @forceDeactivate@ - If @True@, force the deactivation of the -- menu shell after the menu item is activated. -> IO () menuShellActivateItem self menuItem forceDeactivate = {# call menu_shell_activate_item #} (toMenuShell self) (toWidget menuItem) (fromBool forceDeactivate) -- | Selects the menu item from the menu shell. -- menuShellSelectItem :: (MenuShellClass self, MenuItemClass menuItem) => self -> menuItem -- ^ @menuItem@ - The 'MenuItem' to select. -> IO () menuShellSelectItem self menuItem = {# call menu_shell_select_item #} (toMenuShell self) (toWidget menuItem) -- | Deselects the currently selected item from the menu shell, if any. -- menuShellDeselect :: MenuShellClass self => self -> IO () menuShellDeselect self = {# call menu_shell_deselect #} (toMenuShell self) #if GTK_CHECK_VERSION(2,2,0) -- | Select the first visible or selectable child of the menu shell; don't -- select tearoff items unless the only item is a tearoff item. -- -- * Available since Gtk+ version 2.2 -- menuShellSelectFirst :: MenuShellClass self => self -> Bool -- ^ @searchSensitive@ - if @True@, search for the first selectable -- menu item, otherwise select nothing if the first item isn't -- sensitive. This should be @False@ if the menu is being popped up -- initially. -> IO () menuShellSelectFirst self searchSensitive = {# call gtk_menu_shell_select_first #} (toMenuShell self) (fromBool searchSensitive) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Cancels the selection within the menu shell. -- -- * Available since Gtk+ version 2.4 -- menuShellCancel :: MenuShellClass self => self -> IO () menuShellCancel self = {# call gtk_menu_shell_cancel #} (toMenuShell self) #endif #if GTK_CHECK_VERSION(2,8,0) -- | If @takeFocus@ is @True@ (the default) the menu shell will take the -- keyboard focus so that it will receive all keyboard events which is needed -- to enable keyboard navigation in menus. -- -- Setting @takeFocus@ to @False@ is useful only for special applications -- like virtual keyboard implementations which should not take keyboard focus. -- -- The @takeFocus@ state of a menu or menu bar is automatically propagated -- to submenus whenever a submenu is popped up, so you don't have to worry -- about recursively setting it for your entire menu hierarchy. Only when -- programmatically picking a submenu and popping it up manually, the -- @takeFocus@ property of the submenu needs to be set explicitly. -- -- Note that setting it to @False@ has side-effects: -- -- If the focus is in some other app, it keeps the focus and keynav in the -- menu doesn't work. Consequently, keynav on the menu will only work if the -- focus is on some toplevel owned by the onscreen keyboard. -- -- To avoid confusing the user, menus with @takeFocus@ set to @False@ should -- not display mnemonics or accelerators, since it cannot be guaranteed that -- they will work. -- -- * Available since Gtk+ version 2.8 -- menuShellSetTakeFocus :: MenuShellClass self => self -> Bool -- ^ @takeFocus@ - @True@ if the menu shell should take the keyboard -- focus on popup. -> IO () menuShellSetTakeFocus self takeFocus = {# call gtk_menu_shell_set_take_focus #} (toMenuShell self) (fromBool takeFocus) -- | Returns @True@ if the menu shell will take the keyboard focus on popup. -- -- * Available since Gtk+ version 2.8 -- menuShellGetTakeFocus :: MenuShellClass self => self -> IO Bool -- ^ returns @True@ if the menu shell will take the keyboard focus -- on popup. menuShellGetTakeFocus self = liftM toBool $ {# call gtk_menu_shell_get_take_focus #} (toMenuShell self) #endif -------------------- -- Attributes #if GTK_CHECK_VERSION(2,8,0) -- | A boolean that determines whether the menu and its submenus grab the -- keyboard focus. See 'menuShellSetTakeFocus' and 'menuShellGetTakeFocus'. -- -- Default value: @True@ -- menuShellTakeFocus :: MenuShellClass self => Attr self Bool menuShellTakeFocus = newAttr menuShellGetTakeFocus menuShellSetTakeFocus #endif -------------------- -- Signals -- | This signal is called if an item is -- activated. The boolean flag @hide@ is True whenever the menu will -- behidden after this action. -- onActivateCurrent, afterActivateCurrent :: MenuShellClass self => self -> (Bool -> IO ()) -> IO (ConnectId self) onActivateCurrent = connect_BOOL__NONE "activate-current" False afterActivateCurrent = connect_BOOL__NONE "activate-current" True -- | This signal will be emitted when a selection is -- aborted and thus does not lead to an activation. This is in contrast to the -- @selection@ done signal which is always emitted. -- onCancel, afterCancel :: MenuShellClass self => self -> IO () -> IO (ConnectId self) onCancel = connect_NONE__NONE "cancel" False afterCancel = connect_NONE__NONE "cancel" True -- | This signal is sent whenever the menu shell -- is deactivated (hidden). -- onDeactivated, afterDeactivated :: MenuShellClass self => self -> IO () -> IO (ConnectId self) onDeactivated = connect_NONE__NONE "deactivate" False afterDeactivated = connect_NONE__NONE "deactivate" True -- | This signal is emitted for each move the -- cursor makes. -- onMoveCurrent, afterMoveCurrent :: MenuShellClass self => self -> (MenuDirectionType -> IO ()) -> IO (ConnectId self) onMoveCurrent = connect_ENUM__NONE "move-current" False afterMoveCurrent = connect_ENUM__NONE "move-current" True -- | This signal is emitted when the user -- finished using the menu. Note that this signal is emitted even if no menu -- item was activated. -- onSelectionDone, afterSelectionDone :: MenuShellClass self => self -> IO () -> IO (ConnectId self) onSelectionDone = connect_NONE__NONE "selection-done" False afterSelectionDone = connect_NONE__NONE "selection-done" True gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/MenuToolButton.chs0000644000000000000000000001613707346545000022242 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget MenuToolButton -- -- Author : Duncan Coutts -- -- Created: 7 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) -- -- A 'ToolItem' containing a button with an additional dropdown menu -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.MenuComboToolbar.MenuToolButton ( -- * Detail -- -- | A 'MenuToolButton' is a 'ToolItem' that contains a button and a small -- additional button with an arrow. When clicked, the arrow button pops up a -- dropdown menu. -- -- Use 'menuToolButtonNew' to create a new 'MenuToolButton'. Use -- 'menuToolButtonNewFromStock' to create a new 'MenuToolButton' containing a -- stock item. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'ToolItem' -- | +----'ToolButton' -- | +----MenuToolButton -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types MenuToolButton, MenuToolButtonClass, castToMenuToolButton, gTypeMenuToolButton, toMenuToolButton, -- * Constructors menuToolButtonNew, menuToolButtonNewFromStock, -- * Methods menuToolButtonSetMenu, menuToolButtonGetMenu, #if GTK_MAJOR_VERSION < 3 menuToolButtonSetArrowTooltip, #endif #if GTK_CHECK_VERSION(2,12,0) menuToolButtonSetArrowTooltipText, menuToolButtonSetArrowTooltipMarkup, #endif -- * Attributes menuToolButtonMenu, -- * Signals onShowMenu, afterShowMenu, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,6,0) -------------------- -- Constructors -- | Creates a new 'MenuToolButton' using @iconWidget@ as icon and @label@ as -- label. -- menuToolButtonNew :: (WidgetClass iconWidget, GlibString string) => Maybe iconWidget -- ^ @iconWidget@ - a widget that will be used as icon -- widget, or @Nothing@ -> Maybe string -- ^ @label@ - a string that will be used as label, or -- @Nothing@ -> IO MenuToolButton menuToolButtonNew iconWidget label = makeNewObject mkMenuToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr MenuToolButton) $ maybeWith withUTFString label $ \labelPtr -> {# call gtk_menu_tool_button_new #} (maybe (Widget nullForeignPtr) toWidget iconWidget) labelPtr -- | Creates a new 'MenuToolButton'. The new 'MenuToolButton' will contain an -- icon and label from the stock item indicated by @stockId@. -- menuToolButtonNewFromStock :: StockId -- ^ @stockId@ - the name of a stock item -> IO MenuToolButton menuToolButtonNewFromStock stockId = makeNewObject mkMenuToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr MenuToolButton) $ withUTFString stockId $ \stockIdPtr -> {# call gtk_menu_tool_button_new_from_stock #} stockIdPtr -------------------- -- Methods -- | Sets the 'Menu' that is popped up when the user clicks on the arrow. If -- @menu@ is @Nothing@, the arrow button becomes insensitive. -- menuToolButtonSetMenu :: (MenuToolButtonClass self, MenuClass menu) => self -> Maybe menu -- ^ @menu@ - the 'Menu' associated with 'MenuToolButton' -> IO () menuToolButtonSetMenu self menu = {# call gtk_menu_tool_button_set_menu #} (toMenuToolButton self) (maybe (Widget nullForeignPtr) toWidget menu) -- | Gets the 'Menu' associated with 'MenuToolButton'. -- menuToolButtonGetMenu :: MenuToolButtonClass self => self -> IO (Maybe Menu) menuToolButtonGetMenu self = maybeNull (makeNewObject mkMenu) $ liftM (castPtr :: Ptr Widget -> Ptr Menu) $ {# call gtk_menu_tool_button_get_menu #} (toMenuToolButton self) #if GTK_MAJOR_VERSION < 3 -- | Sets the 'Tooltips' object to be used for arrow button which pops up the -- menu. See 'Graphics.UI.Gtk.MenuComboToolbar.ToolItem.toolItemSetTooltip' -- for setting a tooltip on the whole 'MenuToolButton'. -- menuToolButtonSetArrowTooltip :: (MenuToolButtonClass self, GlibString string) => self -> Tooltips -- ^ @tooltips@ - the 'Tooltips' object to be used -> string -- ^ @tipText@ - text to be used as tooltip text for tool item -> string -- ^ @tipPrivate@ - text to be used as private tooltip text -> IO () menuToolButtonSetArrowTooltip self tooltips tipText tipPrivate = withUTFString tipPrivate $ \tipPrivatePtr -> withUTFString tipText $ \tipTextPtr -> {# call gtk_menu_tool_button_set_arrow_tooltip #} (toMenuToolButton self) tooltips tipTextPtr tipPrivatePtr #endif #if GTK_CHECK_VERSION(2,12,0) -- | Sets the tooltip text to be used as tooltip for the arrow button which -- pops up the menu. See 'toolItemSetTooltip' for setting a tooltip on the -- whole 'MenuToolButton'. -- -- * Available since Gtk+ version 2.12 -- menuToolButtonSetArrowTooltipText :: (MenuToolButtonClass self, GlibString string) => self -> string -- ^ @text@ - text to be used as tooltip text for button's arrow -- button -> IO () menuToolButtonSetArrowTooltipText self text = withUTFString text $ \textPtr -> {# call gtk_menu_tool_button_set_arrow_tooltip_text #} (toMenuToolButton self) textPtr -- | Sets the tooltip markup text to be used as tooltip for the arrow button -- which pops up the menu. See 'toolItemSetTooltip' for setting a tooltip on -- the whole 'MenuToolButton'. -- -- * Available since Gtk+ version 2.12 -- menuToolButtonSetArrowTooltipMarkup :: (MenuToolButtonClass self, GlibString markup) => self -> markup -- ^ @markup@ - markup text to be used as tooltip text for button's -- arrow button -> IO () menuToolButtonSetArrowTooltipMarkup self markup = withUTFString markup $ \markupPtr -> {# call gtk_menu_tool_button_set_arrow_tooltip_markup #} (toMenuToolButton self) markupPtr #endif -------------------- -- Attributes -- | The dropdown menu. -- menuToolButtonMenu :: (MenuToolButtonClass self, MenuClass menu) => ReadWriteAttr self (Maybe Menu) (Maybe menu) menuToolButtonMenu = newAttr menuToolButtonGetMenu menuToolButtonSetMenu -------------------- -- Signals -- | -- onShowMenu, afterShowMenu :: MenuToolButtonClass self => self -> IO () -> IO (ConnectId self) onShowMenu = connect_NONE__NONE "show-menu" False afterShowMenu = connect_NONE__NONE "show-menu" True #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/OptionMenu.chs0000644000000000000000000001251507346545000021375 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget OptionMenu -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget used to choose from a list of valid choices -- -- * Warning: this module is deprecated and should not be used in -- newly-written code. It is empty in Gtk3. -- module Graphics.UI.Gtk.MenuComboToolbar.OptionMenu ( -- * Detail -- -- | A 'OptionMenu' is a widget that allows the user to choose from a list of -- valid choices. The 'OptionMenu' displays the selected choice. When activated -- the 'OptionMenu' displays a popup 'Menu' which allows the user to make a new -- choice. -- -- Using a 'OptionMenu' is simple; build a 'Menu', by calling -- 'Graphics.UI.Gtk.MenuComboToolbar.Menu.menuNew', then appending menu items -- to it with 'Graphics.UI.Gtk.MenuComboToolbar.MenuShell.menuShellAppend'. -- Set that menu on the option menu with 'optionMenuSetMenu'. Set the selected -- menu item with 'optionMenuSetHistory'; connect to the \"changed\" signal on -- the option menu; in the \"changed\" signal, check the new selected menu -- item with 'optionMenuGetHistory'. -- -- As of Gtk+ 2.4, 'OptionMenu' has been deprecated in favor of 'ComboBox'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----OptionMenu -- @ #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- * Types OptionMenu, OptionMenuClass, castToOptionMenu, gTypeOptionMenu, toOptionMenu, -- * Constructors optionMenuNew, -- * Methods optionMenuGetMenu, optionMenuSetMenu, optionMenuRemoveMenu, optionMenuSetHistory, optionMenuGetHistory, -- * Attributes optionMenuMenu, -- * Signals onOMChanged, afterOMChanged #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -------------------- -- Constructors -- | Create a new option menu. -- optionMenuNew :: IO OptionMenu optionMenuNew = makeNewObject mkOptionMenu $ liftM castPtr {# call unsafe option_menu_new #} -------------------- -- Methods -- | Returns the 'Menu' associated with the 'OptionMenu'. -- optionMenuGetMenu :: OptionMenuClass self => self -> IO Menu optionMenuGetMenu self = makeNewObject mkMenu $ liftM castPtr $ throwIfNull "optionMenuGetMenu: no menu associated with this option menu." $ {# call unsafe option_menu_get_menu #} (toOptionMenu self) -- | Provides the 'Menu' that is popped up to allow the user to choose a new -- value. You should provide a simple menu avoiding the use of tearoff menu -- items, submenus, and accelerators. -- optionMenuSetMenu :: (OptionMenuClass self, MenuClass menu) => self -> menu -> IO () optionMenuSetMenu self menu = {# call option_menu_set_menu #} (toOptionMenu self) (toWidget menu) -- | Removes the menu from the option menu. -- optionMenuRemoveMenu :: OptionMenuClass self => self -> IO () optionMenuRemoveMenu self = {# call unsafe option_menu_remove_menu #} (toOptionMenu self) -- | Selects the menu item specified by @index@ making it the newly selected -- value for the option menu. -- optionMenuSetHistory :: OptionMenuClass self => self -> Int -- ^ @index@ - the index of the menu item to select. Index values -- are from 0 to n-1. -> IO () optionMenuSetHistory self index = {# call option_menu_set_history #} (toOptionMenu self) (fromIntegral index) -- | Retrieves the index of the currently selected menu item. The menu items -- are numbered from top to bottom, starting with 0. -- optionMenuGetHistory :: OptionMenuClass self => self -> IO Int -- ^ returns index of the selected menu item, or -1 if there are no -- menu items optionMenuGetHistory self = liftM fromIntegral $ {# call unsafe option_menu_get_history #} (toOptionMenu self) -------------------- -- Attributes -- | The menu of options. -- optionMenuMenu :: (OptionMenuClass self, MenuClass menu) => ReadWriteAttr self Menu menu optionMenuMenu = newAttrFromObjectProperty "menu" {# call pure unsafe gtk_menu_get_type #} -------------------- -- Signals -- | This signal is called if the selected option has changed. -- onOMChanged, afterOMChanged :: OptionMenuClass self => self -> IO () -> IO (ConnectId self) onOMChanged = connect_NONE__NONE "changed" False afterOMChanged = connect_NONE__NONE "changed" True #endif #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs0000644000000000000000000001401307346545000021775 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RadioMenuItem -- -- Author : Axel Simon -- -- Created: 21 May 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. -- -- Note: These are not the original Gtk functions as they involve handling a -- Gtk owned GList. The interface is rather oriented towards the RadioButton -- widget interface. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A choice from multiple check menu items -- module Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem ( -- * Detail -- -- | A radio menu item is a check menu item that belongs to a group. At each -- instant exactly one of the radio menu items from a group is selected. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Item' -- | +----'MenuItem' -- | +----'CheckMenuItem' -- | +----RadioMenuItem -- @ -- * Types RadioMenuItem, RadioMenuItemClass, castToRadioMenuItem, gTypeRadioMenuItem, toRadioMenuItem, -- * Constructors radioMenuItemNew, radioMenuItemNewWithLabel, radioMenuItemNewWithMnemonic, radioMenuItemNewFromWidget, radioMenuItemNewWithLabelFromWidget, radioMenuItemNewWithMnemonicFromWidget, -- * Compatibility aliases radioMenuItemNewJoinGroup, radioMenuItemNewJoinGroupWithLabel, radioMenuItemNewJoinGroupWithMnemonic, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'RadioMenuItem'. -- radioMenuItemNew :: IO RadioMenuItem radioMenuItemNew = makeNewObject mkRadioMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ {# call unsafe radio_menu_item_new #} nullPtr -- | Creates a new 'RadioMenuItem' whose child is a simple 'Label'. -- radioMenuItemNewWithLabel :: GlibString string => string -> IO RadioMenuItem radioMenuItemNewWithLabel label = makeNewObject mkRadioMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe radio_menu_item_new_with_label #} nullPtr labelPtr -- | Creates a new 'RadioMenuItem' containing a label. The label will be -- created using 'labelNewWithMnemonic', so underscores in @label@ indicate the -- mnemonic for the menu item. -- radioMenuItemNewWithMnemonic :: GlibString string => string -> IO RadioMenuItem radioMenuItemNewWithMnemonic label = makeNewObject mkRadioMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ withUTFString label $ \labelPtr -> {# call unsafe radio_menu_item_new_with_mnemonic #} nullPtr labelPtr -- | Create a new radio button, adding it to the same group as the group to -- which @groupMember@ belongs. -- radioMenuItemNewFromWidget :: RadioMenuItem -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> IO RadioMenuItem radioMenuItemNewFromWidget groupMember = {# call unsafe radio_menu_item_get_group #} groupMember >>= \groupPtr -> makeNewObject mkRadioMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ {# call unsafe radio_menu_item_new #} groupPtr -- | Create a new radio button with a label, adding it to the same group as the -- group to which @groupMember@ belongs. -- radioMenuItemNewWithLabelFromWidget :: GlibString string => RadioMenuItem -- ^ @groupMember@ - a member of an existing radio button -- group, to which the new radio button will be added. -> string -> IO RadioMenuItem radioMenuItemNewWithLabelFromWidget groupMember label = {# call unsafe radio_menu_item_get_group #} groupMember >>= \groupPtr -> withUTFString label $ \strPtr -> makeNewObject mkRadioMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ {# call unsafe radio_menu_item_new_with_label #} groupPtr strPtr -- | Create a new radio button with a label and attach it to the group of -- another radio button. Underscores in the label string indicate the mnemonic -- for the menu item. -- radioMenuItemNewWithMnemonicFromWidget :: GlibString string => RadioMenuItem -> string -> IO RadioMenuItem radioMenuItemNewWithMnemonicFromWidget groupMember label = {# call unsafe radio_menu_item_get_group #} groupMember >>= \groupPtr -> withUTFString label $ \strPtr -> makeNewObject mkRadioMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr RadioMenuItem) $ {# call unsafe radio_menu_item_new_with_mnemonic #} groupPtr strPtr -- These were added in gtk 2.4, the above Join methods simulate them in earlier -- versions. These aliases are here for compatibility. -- | Alias for 'radioMenuItemNewFromWidget'. radioMenuItemNewJoinGroup = radioMenuItemNewFromWidget -- | Alias for 'radioMenuItemNewWithLabelFromWidget'. radioMenuItemNewJoinGroupWithLabel :: GlibString string => RadioMenuItem -> string -> IO RadioMenuItem radioMenuItemNewJoinGroupWithLabel = radioMenuItemNewWithLabelFromWidget -- | Alias for 'radioMenuItemNewWithMnemonicFromWidget'. radioMenuItemNewJoinGroupWithMnemonic :: GlibString string => RadioMenuItem -> string -> IO RadioMenuItem radioMenuItemNewJoinGroupWithMnemonic = radioMenuItemNewWithMnemonicFromWidget gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/RadioToolButton.chs0000644000000000000000000001410707346545000022367 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RadioToolButton -- -- Author : Duncan Coutts -- -- Created: 7 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) -- -- A toolbar item that contains a radio button -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.RadioToolButton ( -- * Detail -- -- | A 'RadioToolButton' is a 'ToolItem' that contains a radio button, that -- is, a button that is part of a group of toggle buttons where only one button -- can be active at a time. -- -- Use 'radioToolButtonNew' to create a new 'RadioToolButton'. use -- 'radioToolButtonNewFromWidget' to create a new 'RadioToolButton' that is -- part of the same group as an existing 'RadioToolButton'. Use -- 'radioToolButtonNewFromStock' or 'radioToolButtonNewWithStockFromWidget' to -- create a new 'RadioToolButton' containing a stock item. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'ToolItem' -- | +----'ToolButton' -- | +----'ToggleToolButton' -- | +----RadioToolButton -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types RadioToolButton, RadioToolButtonClass, castToRadioToolButton, gTypeRadioToolButton, toRadioToolButton, -- * Constructors radioToolButtonNew, radioToolButtonNewFromStock, radioToolButtonNewFromWidget, radioToolButtonNewWithStockFromWidget, -- * Methods radioToolButtonGetGroup, radioToolButtonSetGroup, -- * Attributes radioToolButtonGroup, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'RadioToolButton', creating a new group. -- radioToolButtonNew :: IO RadioToolButton radioToolButtonNew = makeNewObject mkRadioToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr RadioToolButton) $ {# call gtk_radio_tool_button_new #} nullPtr -- | Creates a new 'RadioToolButton', creating a new group. The new -- 'RadioToolButton' will contain an icon and label from the stock item -- indicated by @stockId@. -- radioToolButtonNewFromStock :: StockId -- ^ @stockId@ - the name of a stock item -> IO RadioToolButton radioToolButtonNewFromStock stockId = makeNewObject mkRadioToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr RadioToolButton) $ withUTFString stockId $ \stockIdPtr -> {# call gtk_radio_tool_button_new_from_stock #} nullPtr stockIdPtr -- | Creates a new 'RadioToolButton' adding it to the same group as -- the group to which @groupMember@ belongs. -- radioToolButtonNewFromWidget :: RadioToolButtonClass groupMember => groupMember -- ^ @groupMember@ - a member of an existing radio group, -- to which the new radio tool button will be added. -> IO RadioToolButton radioToolButtonNewFromWidget group = makeNewObject mkRadioToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr RadioToolButton) $ {# call gtk_radio_tool_button_new_from_widget #} (toRadioToolButton group) -- | Creates a new 'RadioToolButton' adding it to the same group as the group -- to which @groupMember@ belongs. The new 'RadioToolButton' will contain an -- icon and label from the stock item indicated by @stockId@. -- radioToolButtonNewWithStockFromWidget :: RadioToolButtonClass groupMember => groupMember -- ^ @groupMember@ - a member of an existing radio group, -- to which the new radio tool button will be added. -> StockId -- ^ @stockId@ - the name of a stock item -> IO RadioToolButton radioToolButtonNewWithStockFromWidget group stockId = makeNewObject mkRadioToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr RadioToolButton) $ withUTFString stockId $ \stockIdPtr -> {# call gtk_radio_tool_button_new_with_stock_from_widget #} (toRadioToolButton group) stockIdPtr -------------------- -- Methods -- | Returns the radio button group @button@ belongs to. -- radioToolButtonGetGroup :: RadioToolButtonClass self => self -> IO [RadioToolButton] -- ^ returns the group the button belongs to. radioToolButtonGetGroup self = {# call unsafe gtk_radio_tool_button_get_group #} (toRadioToolButton self) >>= readGSList >>= mapM (\elemPtr -> makeNewObject mkRadioToolButton (return elemPtr)) -- | Adds @button@ to @group@, removing it from the group it belonged to -- before. -- radioToolButtonSetGroup :: RadioToolButtonClass self => self -> RadioToolButton -- ^ @groupMember@ - a member of an existing radio group, -- to which the radio tool button will be added. -> IO () radioToolButtonSetGroup self group = {# call unsafe gtk_radio_tool_button_get_group #} group >>= \groupGSList -> {# call gtk_radio_tool_button_set_group #} (toRadioToolButton self) groupGSList -------------------- -- Properties -- | Sets a new group for a radio tool button. -- radioToolButtonGroup :: RadioToolButtonClass self => ReadWriteAttr self [RadioToolButton] RadioToolButton radioToolButtonGroup = newAttr radioToolButtonGetGroup radioToolButtonSetGroup #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/SeparatorMenuItem.chs0000644000000000000000000000411207346545000022676 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget SeparatorMenuItem -- -- Author : Duncan Coutts -- -- Created: 7 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) -- -- A separator used in menus -- module Graphics.UI.Gtk.MenuComboToolbar.SeparatorMenuItem ( -- * Detail -- -- | The 'SeparatorMenuItem' is a separator used to group items within a menu. -- It displays a horizontal line with a shadow to make it appear sunken into -- the interface. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Item' -- | +----'MenuItem' -- | +----SeparatorMenuItem -- @ -- * Types SeparatorMenuItem, SeparatorMenuItemClass, castToSeparatorMenuItem, gTypeSeparatorMenuItem, toSeparatorMenuItem, -- * Constructors separatorMenuItemNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'SeparatorMenuItem'. -- separatorMenuItemNew :: IO SeparatorMenuItem separatorMenuItemNew = makeNewObject mkSeparatorMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr SeparatorMenuItem) $ {# call gtk_separator_menu_item_new #} gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/SeparatorToolItem.chs0000644000000000000000000000727207346545000022721 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget SeparatorToolItem -- -- Author : Duncan Coutts -- -- Created: 7 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) -- -- A toolbar item that separates groups of other toolbar items -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.SeparatorToolItem ( -- * Detail -- -- | A 'SeparatorToolItem' is a 'ToolItem' that separates groups of other -- 'ToolItem's. Depending on the theme, a 'SeparatorToolItem' will often look -- like a vertical line on horizontally docked toolbars. -- -- If the property \"expand\" is @True@ and the property \"draw\" is -- @False@, a 'SeparatorToolItem' will act as a \"spring\" that forces other -- items to the ends of the toolbar. -- -- Use 'separatorToolItemNew' to create a new 'SeparatorToolItem'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'ToolItem' -- | +----SeparatorToolItem -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types SeparatorToolItem, SeparatorToolItemClass, castToSeparatorToolItem, gTypeSeparatorToolItem, toSeparatorToolItem, -- * Constructors separatorToolItemNew, -- * Methods separatorToolItemSetDraw, separatorToolItemGetDraw, -- * Attributes separatorToolItemDraw, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Create a new 'SeparatorToolItem' -- separatorToolItemNew :: IO SeparatorToolItem separatorToolItemNew = makeNewObject mkSeparatorToolItem $ liftM (castPtr :: Ptr ToolItem -> Ptr SeparatorToolItem) $ {# call gtk_separator_tool_item_new #} -------------------- -- Methods -- | Whether the separator tool item is drawn as a vertical line, or just -- blank. Setting this @False@ along with -- 'Graphics.UI.Gtk.MenuComboToolbar.ToolItem.toolItemSetExpand' is useful to -- create an item that forces following items to the end of the toolbar. -- separatorToolItemSetDraw :: SeparatorToolItemClass self => self -> Bool -> IO () separatorToolItemSetDraw self draw = {# call gtk_separator_tool_item_set_draw #} (toSeparatorToolItem self) (fromBool draw) -- | Returns whether the separator tool item is drawn as a line, or just blank. -- See 'separatorToolItemSetDraw'. -- separatorToolItemGetDraw :: SeparatorToolItemClass self => self -> IO Bool separatorToolItemGetDraw self = liftM toBool $ {# call gtk_separator_tool_item_get_draw #} (toSeparatorToolItem self) -------------------- -- Attributes -- | Whether the separator is drawn, or just blank. -- -- Default value: @True@ -- separatorToolItemDraw :: SeparatorToolItemClass self => Attr self Bool separatorToolItemDraw = newAttr separatorToolItemGetDraw separatorToolItemSetDraw #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs0000644000000000000000000000473107346545000022333 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TearoffMenuItem -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A menu item used to tear off and reattach its menu -- module Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem ( -- * Detail -- -- | A 'TearoffMenuItem' is a special 'MenuItem' which is used to tear off and -- reattach its menu. -- -- When its menu is shown normally, the 'TearoffMenuItem' is drawn as a -- dotted line indicating that the menu can be torn off. Activating it causes -- its menu to be torn off and displayed in its own window as a tearoff menu. -- -- When its menu is shown as a tearoff menu, the 'TearoffMenuItem' is drawn -- as a dotted line which has a left pointing arrow graphic indicating that the -- tearoff menu can be reattached. Activating it will erase the tearoff menu -- window. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Item' -- | +----'MenuItem' -- | +----TearoffMenuItem -- @ -- * Types TearoffMenuItem, TearoffMenuItemClass, castToTearoffMenuItem, gTypeTearoffMenuItem, toTearoffMenuItem, -- * Constructors tearoffMenuItemNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'TearoffMenuItem'. -- tearoffMenuItemNew :: IO TearoffMenuItem tearoffMenuItemNew = makeNewObject mkTearoffMenuItem $ liftM (castPtr :: Ptr Widget -> Ptr TearoffMenuItem) $ {# call unsafe tearoff_menu_item_new #} gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ToggleToolButton.chs0000644000000000000000000001123207346545000022546 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToggleToolButton -- -- Author : Duncan Coutts -- -- Created: 7 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) -- -- A 'ToolItem' containing a toggle button -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.ToggleToolButton ( -- * Detail -- -- | A 'ToggleToolButton' is a 'ToolItem' that contains a toggle button. -- -- Use 'toggleToolButtonNew' to create a new 'ToggleToolButton'. Use -- 'toggleToolButtonNewFromStock' to create a new 'ToggleToolButton' containing -- a stock item. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'ToolItem' -- | +----'ToolButton' -- | +----ToggleToolButton -- | +----'RadioToolButton' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ToggleToolButton, ToggleToolButtonClass, castToToggleToolButton, gTypeToggleToolButton, toToggleToolButton, -- * Constructors toggleToolButtonNew, toggleToolButtonNewFromStock, -- * Methods toggleToolButtonSetActive, toggleToolButtonGetActive, -- * Attributes #if GTK_CHECK_VERSION(2,8,0) toggleToolButtonActive, #endif -- * Signals onToolButtonToggled, afterToolButtonToggled, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Returns a new 'ToggleToolButton' -- toggleToolButtonNew :: IO ToggleToolButton toggleToolButtonNew = makeNewObject mkToggleToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr ToggleToolButton) $ {# call gtk_toggle_tool_button_new #} -- | Creates a new 'ToggleToolButton' containing the image and text from a -- stock item. -- -- It is an error if @stockId@ is not a name of a stock item. -- toggleToolButtonNewFromStock :: StockId -- ^ @stockId@ - the name of the stock item -> IO ToggleToolButton toggleToolButtonNewFromStock stockId = makeNewObject mkToggleToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr ToggleToolButton) $ withUTFString stockId $ \stockIdPtr -> {# call gtk_toggle_tool_button_new_from_stock #} stockIdPtr -------------------- -- Methods -- | Sets the status of the toggle tool button. Set to @True@ if you want the -- 'ToggleButton' to be \'pressed in\', and @False@ to raise it. This action -- causes the toggled signal to be emitted. -- toggleToolButtonSetActive :: ToggleToolButtonClass self => self -> Bool -> IO () toggleToolButtonSetActive self isActive = {# call gtk_toggle_tool_button_set_active #} (toToggleToolButton self) (fromBool isActive) -- | Queries a 'ToggleToolButton' and returns its current state. Returns -- @True@ if the toggle button is pressed in and @False@ if it is raised. -- toggleToolButtonGetActive :: ToggleToolButtonClass self => self -> IO Bool toggleToolButtonGetActive self = liftM toBool $ {# call gtk_toggle_tool_button_get_active #} (toToggleToolButton self) -------------------- -- Attributes #if GTK_CHECK_VERSION(2,8,0) -- | If the toggle tool button should be pressed in or not. -- -- Default value: @False@ -- toggleToolButtonActive :: ToggleToolButtonClass self => Attr self Bool toggleToolButtonActive = newAttr toggleToolButtonGetActive toggleToolButtonSetActive #endif -------------------- -- Signals -- | Emitted whenever the toggle tool button changes state. -- onToolButtonToggled, afterToolButtonToggled :: ToggleToolButtonClass self => self -> IO () -> IO (ConnectId self) onToolButtonToggled = connect_NONE__NONE "toggled" False afterToolButtonToggled = connect_NONE__NONE "toggled" True #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs0000644000000000000000000003141707346545000021413 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToolButton -- -- Author : Duncan Coutts -- -- Created: 7 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) -- -- A 'ToolItem' subclass that displays buttons -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.ToolButton ( -- * Detail -- -- | 'ToolButton's are 'ToolItems' containing buttons. -- -- Use 'toolButtonNew' to create a new 'ToolButton'. Use -- 'toolButtonNewWithStock' to create a 'ToolButton' containing a stock item. -- -- The label of a 'ToolButton' is determined by the properties -- \"label_widget\", \"label\", and \"stock_id\". If \"label_widget\" is -- not @Nothing@, -- then that widget is used as the label. Otherwise, if \"label\" is -- not @Nothing@, -- that string is used as the label. Otherwise, if \"stock_id\" is not -- @Nothing@, the label is -- determined by the stock item. Otherwise, the button does not have a label. -- -- The icon of a 'ToolButton' is determined by the properties -- \"icon_widget\" and \"stock_id\". If \"icon_widget\" is not @Nothing@, then -- that widget is used as the icon. Otherwise, if \"stock_id\" is not @Nothing@, -- the icon is determined by the stock item. Otherwise, the button does not have -- a label. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'ToolItem' -- | +----ToolButton -- | +----'MenuToolButton' -- | +----'ToggleToolButton' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ToolButton, ToolButtonClass, castToToolButton, gTypeToolButton, toToolButton, -- * Constructors toolButtonNew, toolButtonNewFromStock, -- * Methods toolButtonSetLabel, toolButtonGetLabel, toolButtonSetUseUnderline, toolButtonGetUseUnderline, toolButtonSetStockId, toolButtonGetStockId, toolButtonSetIconWidget, toolButtonGetIconWidget, toolButtonSetLabelWidget, toolButtonGetLabelWidget, #if GTK_CHECK_VERSION(2,8,0) toolButtonSetIconName, toolButtonGetIconName, #endif -- * Attributes toolButtonLabel, toolButtonUseUnderline, toolButtonLabelWidget, toolButtonStockId, #if GTK_CHECK_VERSION(2,8,0) toolButtonIconName, #endif toolButtonIconWidget, -- * Signals onToolButtonClicked, afterToolButtonClicked, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.StockItems {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'ToolButton' using @iconWidget@ as icon and @label@ as -- label. -- toolButtonNew :: (WidgetClass iconWidget, GlibString string) => Maybe iconWidget -- ^ @iconWidget@ - a widget that will be used as icon -- widget, or @Nothing@ -> Maybe string -- ^ @label@ - a string that will be used as label, or -- @Nothing@ -> IO ToolButton toolButtonNew iconWidget label = makeNewObject mkToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr ToolButton) $ maybeWith withUTFString label $ \labelPtr -> {# call gtk_tool_button_new #} (maybe (Widget nullForeignPtr) toWidget iconWidget) labelPtr -- | Creates a new 'ToolButton' containing the image and text from a stock -- item. -- -- It is an error if @stockId@ is not a name of a stock item. -- toolButtonNewFromStock :: StockId -- ^ @stockId@ - the name of the stock item -> IO ToolButton toolButtonNewFromStock stockId = makeNewObject mkToolButton $ liftM (castPtr :: Ptr ToolItem -> Ptr ToolButton) $ withUTFString stockId $ \stockIdPtr -> {# call gtk_tool_button_new_from_stock #} stockIdPtr -------------------- -- Methods -- | Sets @label@ as the label used for the tool button. The \"label\" -- property only has an effect if not overridden by a non-@Nothing@ -- \"label_widget\" property. If both the \"label_widget\" and \"label\" -- properties are @Nothing@, the label is determined by the \"stock_id\" -- property. If the \"stock_id\" property is also @Nothing@, @button@ will not -- have a label. -- toolButtonSetLabel :: (ToolButtonClass self, GlibString string) => self -> Maybe string -- ^ @label@ - a string that will be used as label, or -- @Nothing@. -> IO () toolButtonSetLabel self label = maybeWith withUTFString label $ \labelPtr -> {# call gtk_tool_button_set_label #} (toToolButton self) labelPtr -- | Returns the label used by the tool button, or @Nothing@ if the tool -- button doesn't have a label. or uses a the label from a stock item. -- toolButtonGetLabel :: (ToolButtonClass self, GlibString string) => self -> IO (Maybe string) toolButtonGetLabel self = {# call gtk_tool_button_get_label #} (toToolButton self) >>= maybePeek peekUTFString -- | If set, an underline in the label property indicates that the next -- character should be used for the mnemonic accelerator key in the overflow -- menu. For example, if the label property is \"_Open\" and @useUnderline@ is -- @True@, the label on the tool button will be \"Open\" and the item on the -- overflow menu will have an underlined \'O\'. -- -- Labels shown on tool buttons never have mnemonics on them; this property -- only affects the menu item on the overflow menu. -- toolButtonSetUseUnderline :: ToolButtonClass self => self -> Bool -> IO () toolButtonSetUseUnderline self useUnderline = {# call gtk_tool_button_set_use_underline #} (toToolButton self) (fromBool useUnderline) -- | Returns whether underscores in the label property are used as mnemonics -- on menu items on the overflow menu. See 'toolButtonSetUseUnderline'. -- toolButtonGetUseUnderline :: ToolButtonClass self => self -> IO Bool toolButtonGetUseUnderline self = liftM toBool $ {# call gtk_tool_button_get_use_underline #} (toToolButton self) -- | Sets the name of the stock item. See 'toolButtonNewFromStock'. The -- stock_id property only has an effect if not overridden by non-@Nothing@ -- \"label\" and \"icon_widget\" properties. -- toolButtonSetStockId :: ToolButtonClass self => self -> Maybe StockId -- ^ @stockId@ - a name of a stock item, or @Nothing@ -> IO () toolButtonSetStockId self stockId = maybeWith withUTFString stockId $ \stockIdPtr -> {# call gtk_tool_button_set_stock_id #} (toToolButton self) stockIdPtr -- | Returns the name of the stock item. See 'toolButtonSetStockId'. -- toolButtonGetStockId :: ToolButtonClass self => self -> IO (Maybe StockId) toolButtonGetStockId self = {# call gtk_tool_button_get_stock_id #} (toToolButton self) >>= maybePeek peekUTFString -- | Sets @icon@ as the widget used as icon on @button@. If @iconWidget@ is -- @Nothing@ the icon is determined by the \"stock_id\" property. If the -- \"stock_id\" property is also @Nothing@, the button will not have an icon. -- toolButtonSetIconWidget :: (ToolButtonClass self, WidgetClass iconWidget) => self -> Maybe iconWidget -- ^ @iconWidget@ - the widget used as icon, or @Nothing@ -> IO () toolButtonSetIconWidget self iconWidget = {# call gtk_tool_button_set_icon_widget #} (toToolButton self) (maybe (Widget nullForeignPtr) toWidget iconWidget) -- | Return the widget used as icon widget on @button@. See -- 'toolButtonSetIconWidget'. -- toolButtonGetIconWidget :: ToolButtonClass self => self -> IO (Maybe Widget) -- ^ returns The widget used as icon on @button@, or -- @Nothing@. toolButtonGetIconWidget self = maybeNull (makeNewObject mkWidget) $ {# call gtk_tool_button_get_icon_widget #} (toToolButton self) -- | Sets @labelWidget@ as the widget that will be used as the label for -- @button@. If @labelWidget@ is @Nothing@ the \"label\" property is used as -- label. If \"label\" is also @Nothing@, the label in the stock item -- determined by the \"stock_id\" property is used as label. If \"stock_id\" is -- also @Nothing@, @button@ does not have a label. -- toolButtonSetLabelWidget :: (ToolButtonClass self, WidgetClass labelWidget) => self -> Maybe labelWidget -- ^ @labelWidget@ - the widget used as label, or -- @Nothing@ -> IO () toolButtonSetLabelWidget self labelWidget = {# call gtk_tool_button_set_label_widget #} (toToolButton self) (maybe (Widget nullForeignPtr) toWidget labelWidget) -- | Returns the widget used as label on @button@. See -- 'toolButtonSetLabelWidget'. -- toolButtonGetLabelWidget :: ToolButtonClass self => self -> IO (Maybe Widget) -- ^ returns The widget used as label on @button@, or -- @Nothing@. toolButtonGetLabelWidget self = maybeNull (makeNewObject mkWidget) $ {# call gtk_tool_button_get_label_widget #} (toToolButton self) #if GTK_CHECK_VERSION(2,8,0) -- | Sets the icon for the tool button from a named themed icon. See the docs -- for 'IconTheme' for more details. The \"icon_name\" property only has an -- effect if not overridden by the \"label\", \"icon_widget\" and \"stock_id\" -- properties. -- -- * Available since Gtk+ version 2.8 -- toolButtonSetIconName :: (ToolButtonClass self, GlibString string) => self -> string -- ^ @iconName@ - the name of the themed icon -> IO () toolButtonSetIconName self iconName = withUTFString iconName $ \iconNamePtr -> {# call gtk_tool_button_set_icon_name #} (toToolButton self) iconNamePtr -- | Returns the name of the themed icon for the tool button, see -- 'toolButtonSetIconName'. -- -- * Available since Gtk+ version 2.8 -- toolButtonGetIconName :: (ToolButtonClass self, GlibString string) => self -> IO string -- ^ returns the icon name or @\"\"@ if the tool button has no -- themed icon. toolButtonGetIconName self = {# call gtk_tool_button_get_icon_name #} (toToolButton self) >>= \strPtr -> if strPtr == nullPtr then return "" else peekUTFString strPtr #endif -------------------- -- Attributes -- | Text to show in the item. -- -- Default value: @Nothing@ -- toolButtonLabel :: (ToolButtonClass self, GlibString string) => Attr self (Maybe string) toolButtonLabel = newAttr toolButtonGetLabel toolButtonSetLabel -- | If set, an underline in the label property indicates that the next -- character should be used for the mnemonic accelerator key in the overflow -- menu. -- -- Default value: @False@ -- toolButtonUseUnderline :: ToolButtonClass self => Attr self Bool toolButtonUseUnderline = newAttr toolButtonGetUseUnderline toolButtonSetUseUnderline -- | Widget to use as the item label. -- toolButtonLabelWidget :: (ToolButtonClass self, WidgetClass labelWidget) => ReadWriteAttr self (Maybe Widget) (Maybe labelWidget) toolButtonLabelWidget = newAttr toolButtonGetLabelWidget toolButtonSetLabelWidget -- | The stock icon displayed on the item. -- -- Default value: @Nothing@ -- toolButtonStockId :: ToolButtonClass self => ReadWriteAttr self (Maybe StockId) (Maybe StockId) toolButtonStockId = newAttr toolButtonGetStockId toolButtonSetStockId #if GTK_CHECK_VERSION(2,8,0) -- | The name of the themed icon displayed on the item. This property only has -- an effect if not overridden by \"label\", \"icon_widget\" or \"stock_id\" -- properties. -- -- Default value: \"\" -- toolButtonIconName :: (ToolButtonClass self, GlibString string) => Attr self string toolButtonIconName = newAttr toolButtonGetIconName toolButtonSetIconName #endif -- | Icon widget to display in the item. -- toolButtonIconWidget :: (ToolButtonClass self, WidgetClass iconWidget) => ReadWriteAttr self (Maybe Widget) (Maybe iconWidget) toolButtonIconWidget = newAttr toolButtonGetIconWidget toolButtonSetIconWidget -------------------- -- Signals -- | This signal is emitted when the tool button is clicked with the mouse or -- activated with the keyboard. -- onToolButtonClicked, afterToolButtonClicked :: ToolButtonClass self => self -> IO () -> IO (ConnectId self) onToolButtonClicked = connect_NONE__NONE "clicked" False afterToolButtonClicked = connect_NONE__NONE "clicked" True #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs0000644000000000000000000003606007346545000021035 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToolItem -- -- Author : Duncan Coutts -- -- Created: 1 August 2004 -- -- Copyright (C) 2004-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) -- -- The base class of widgets that can be added to 'Toolbar' -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.MenuComboToolbar.ToolItem ( -- * Detail -- -- | 'ToolItem's are widgets that can appear on a toolbar. To create a toolbar -- item that contain something else than a button, use 'toolItemNew'. Use -- 'containerAdd' to add a child widget to the tool item. -- -- For toolbar items that contain buttons, see the 'ToolButton', -- 'ToggleToolButton' and 'RadioToolButton' classes. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----ToolItem -- | +----'ToolButton' -- | +----'SeparatorToolItem' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ToolItem, ToolItemClass, castToToolItem, gTypeToolItem, toToolItem, -- * Constructors toolItemNew, -- * Methods toolItemSetHomogeneous, toolItemGetHomogeneous, toolItemSetExpand, toolItemGetExpand, #if GTK_MAJOR_VERSION < 3 toolItemSetTooltip, #endif toolItemSetUseDragWindow, toolItemGetUseDragWindow, toolItemSetVisibleHorizontal, toolItemGetVisibleHorizontal, toolItemSetVisibleVertical, toolItemGetVisibleVertical, toolItemSetIsImportant, toolItemGetIsImportant, IconSize, toolItemGetIconSize, Orientation(..), toolItemGetOrientation, ToolbarStyle(..), toolItemGetToolbarStyle, ReliefStyle(..), toolItemGetReliefStyle, toolItemRetrieveProxyMenuItem, toolItemGetProxyMenuItem, toolItemSetProxyMenuItem, #if GTK_CHECK_VERSION(2,20,0) toolItemGetEllipsizeMode, toolItemGetTextAlignment, toolItemGetTextOrientation, toolItemGetTextSizeGroup, #endif -- * Attributes toolItemVisibleHorizontal, toolItemVisibleVertical, toolItemIsImportant, toolItemExpand, toolItemHomogeneous, toolItemUseDragWindow, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.Rendering.Pango.Enums (EllipsizeMode (..)) import Graphics.UI.Gtk.Misc.SizeGroup {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Structs (IconSize) import Graphics.UI.Gtk.General.Enums (Orientation(..), ToolbarStyle(..), ReliefStyle(..)) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'ToolItem' -- toolItemNew :: IO ToolItem toolItemNew = makeNewObject mkToolItem $ {# call unsafe tool_item_new #} -------------------- -- Methods -- | Sets whether the tool item is to be allocated the same size as other -- homogeneous items. The effect is that all homogeneous items will have the -- same width as the widest of the items. -- toolItemSetHomogeneous :: ToolItemClass self => self -> Bool -- ^ @homogeneous@ - whether @toolItem@ is the same size as other -- homogeneous items -> IO () toolItemSetHomogeneous self homogeneous = {# call tool_item_set_homogeneous #} (toToolItem self) (fromBool homogeneous) -- | Returns whether the tool item is the same size as other homogeneous items. -- See 'toolItemSetHomogeneous'. -- toolItemGetHomogeneous :: ToolItemClass self => self -> IO Bool toolItemGetHomogeneous self = liftM toBool $ {# call unsafe tool_item_get_homogeneous #} (toToolItem self) -- | Sets whether the tool item is allocated extra space when there is more room -- on the toolbar then needed for the items. The effect is that the item gets -- bigger when the toolbar gets bigger and smaller when the toolbar gets -- smaller. -- toolItemSetExpand :: ToolItemClass self => self -> Bool -> IO () toolItemSetExpand self expand = {# call tool_item_set_expand #} (toToolItem self) (fromBool expand) -- | Returns whether the tool item is allocated extra space. See -- 'toolItemSetExpand'. -- toolItemGetExpand :: ToolItemClass self => self -> IO Bool toolItemGetExpand self = liftM toBool $ {# call unsafe tool_item_get_expand #} (toToolItem self) #if GTK_MAJOR_VERSION < 3 -- | Sets the 'Tooltips' object to be used for the tool item, the text to be -- displayed as tooltip on the item and the private text to be used. See -- 'tooltipsSetTip'. -- -- Removed in Gtk3. toolItemSetTooltip :: (ToolItemClass self, GlibString string) => self -> Tooltips -- ^ @tooltips@ - The 'Tooltips' object to be used -> string -- ^ @tipText@ - text to be used as tooltip text for @toolItem@ -> string -- ^ @tipPrivate@ - text to be used as private tooltip text -> IO () toolItemSetTooltip self tooltips tipText tipPrivate = withUTFString tipPrivate $ \tipPrivatePtr -> withUTFString tipText $ \tipTextPtr -> {# call tool_item_set_tooltip #} (toToolItem self) tooltips tipTextPtr tipPrivatePtr #endif -- | Sets whether toolitem has a drag window. When @True@ the tool item can be -- used as a drag source through 'dragSourceSet'. When the tool item has a drag -- window it will intercept all events, even those that would otherwise be sent -- to a child widget. -- toolItemSetUseDragWindow :: ToolItemClass self => self -> Bool -> IO () toolItemSetUseDragWindow self useDragWindow = {# call tool_item_set_use_drag_window #} (toToolItem self) (fromBool useDragWindow) -- | Returns whether the tool item has a drag window. See -- 'toolItemSetUseDragWindow'. -- toolItemGetUseDragWindow :: ToolItemClass self => self -> IO Bool toolItemGetUseDragWindow self = liftM toBool $ {# call unsafe tool_item_get_use_drag_window #} (toToolItem self) -- | Sets whether the tool item is visible when the toolbar is docked -- horizontally. -- toolItemSetVisibleHorizontal :: ToolItemClass self => self -> Bool -> IO () toolItemSetVisibleHorizontal self visibleHorizontal = {# call tool_item_set_visible_horizontal #} (toToolItem self) (fromBool visibleHorizontal) -- | Returns whether the tool item is visible on toolbars that are docked -- horizontally. -- toolItemGetVisibleHorizontal :: ToolItemClass self => self -> IO Bool toolItemGetVisibleHorizontal self = liftM toBool $ {# call unsafe tool_item_get_visible_horizontal #} (toToolItem self) -- | Sets whether the tool item is visible when the toolbar is docked vertically. -- Some tool items, such as text entries, are too wide to be useful on a -- vertically docked toolbar. If @False@ the tool item will -- not appear on toolbars that are docked vertically. -- toolItemSetVisibleVertical :: ToolItemClass self => self -> Bool -> IO () toolItemSetVisibleVertical self visibleVertical = {# call tool_item_set_visible_vertical #} (toToolItem self) (fromBool visibleVertical) -- | Returns whether the tool item is visible when the toolbar is docked -- vertically. See 'toolItemSetVisibleVertical'. -- toolItemGetVisibleVertical :: ToolItemClass self => self -> IO Bool toolItemGetVisibleVertical self = liftM toBool $ {# call unsafe tool_item_get_visible_vertical #} (toToolItem self) -- | Sets whether the tool item should be considered important. The "ToolButton" -- class uses this property to determine whether to show or hide its label when -- the toolbar style is 'ToolbarBothHoriz'. The result is that only tool -- buttons with the \"is important\" property set have labels, an effect known -- as \"priority text\". -- toolItemSetIsImportant :: ToolItemClass self => self -> Bool -> IO () toolItemSetIsImportant self isImportant = {# call tool_item_set_is_important #} (toToolItem self) (fromBool isImportant) -- | Returns whether the tool item is considered important. See -- 'toolItemSetIsImportant' -- toolItemGetIsImportant :: ToolItemClass self => self -> IO Bool toolItemGetIsImportant self = liftM toBool $ {# call unsafe tool_item_get_is_important #} (toToolItem self) -- | Returns the icon size used for the tool item. -- toolItemGetIconSize :: ToolItemClass self => self -> IO IconSize toolItemGetIconSize self = liftM (toEnum . fromIntegral) $ {# call unsafe tool_item_get_icon_size #} (toToolItem self) -- | Returns the orientation used for the tool item. -- toolItemGetOrientation :: ToolItemClass self => self -> IO Orientation toolItemGetOrientation self = liftM (toEnum . fromIntegral) $ {# call unsafe tool_item_get_orientation #} (toToolItem self) -- | Returns the toolbar style used for the tool item. -- -- Possibilities are: -- ['ToolbarBoth'] meaning the tool item should show both an icon and a label, -- stacked vertically -- ['ToolbarIcons'] meaning the toolbar shows only icons -- ['ToolbarText'] meaning the tool item should only show text -- ['ToolbarBothHoriz'] meaning the tool item should show both an icon and a -- label, arranged horizontally -- toolItemGetToolbarStyle :: ToolItemClass self => self -> IO ToolbarStyle toolItemGetToolbarStyle self = liftM (toEnum . fromIntegral) $ {# call unsafe tool_item_get_toolbar_style #} (toToolItem self) -- | Returns the relief style of the tool item. See 'buttonSetReliefStyle'. -- toolItemGetReliefStyle :: ToolItemClass self => self -> IO ReliefStyle toolItemGetReliefStyle self = liftM (toEnum . fromIntegral) $ {# call unsafe tool_item_get_relief_style #} (toToolItem self) -- | Returns the 'MenuItem' that was last set by 'toolItemSetProxyMenuItem', -- ie. the 'MenuItem' that is going to appear in the overflow menu. -- toolItemRetrieveProxyMenuItem :: ToolItemClass self => self -> IO (Maybe Widget) toolItemRetrieveProxyMenuItem self = maybeNull (makeNewObject mkWidget) $ {# call unsafe tool_item_retrieve_proxy_menu_item #} (toToolItem self) -- | If @menuItemId@ matches the string passed to 'toolItemSetProxyMenuItem' -- return the corresponding 'MenuItem'. -- toolItemGetProxyMenuItem :: (ToolItemClass self, GlibString string) => self -> string -- ^ @menuItemId@ - a string used to identify the menu -- item -> IO (Maybe Widget) -- ^ returns The 'MenuItem' passed to -- 'toolItemSetProxyMenuItem', if the @menuItemId@s -- match. toolItemGetProxyMenuItem self menuItemId = maybeNull (makeNewObject mkWidget) $ withUTFString menuItemId $ \menuItemIdPtr -> {# call unsafe tool_item_get_proxy_menu_item #} (toToolItem self) menuItemIdPtr -- | Sets the 'MenuItem' used in the toolbar overflow menu. The @menuItemId@ -- is used to identify the caller of this function and should also be used with -- 'toolItemGetProxyMenuItem'. -- toolItemSetProxyMenuItem :: (ToolItemClass self, MenuItemClass menuItem, GlibString string) => self -> string -- ^ @menuItemId@ - a string used to identify @menuItem@ -> menuItem -- ^ @menuItem@ - a 'MenuItem' to be used in the overflow menu -> IO () toolItemSetProxyMenuItem self menuItemId menuItem = withUTFString menuItemId $ \menuItemIdPtr -> {# call tool_item_set_proxy_menu_item #} (toToolItem self) menuItemIdPtr (toWidget menuItem) #if GTK_CHECK_VERSION(2,20,0) -- | Returns the ellipsize mode used for @toolItem@. Custom subclasses of 'ToolItem' should call this -- function to find out how text should be ellipsized. -- -- * Available since Gtk+ version 2.20 -- toolItemGetEllipsizeMode :: ToolItemClass item => item -> IO EllipsizeMode -- ^ returns a PangoEllipsizeMode indicating how text in @toolItem@ should be ellipsized. toolItemGetEllipsizeMode item = liftM (toEnum . fromIntegral) $ {#call gtk_tool_item_get_ellipsize_mode #} (toToolItem item) -- | Returns the text alignment used for @toolItem@. Custom subclasses of 'ToolItem' should call this -- function to find out how text should be aligned. toolItemGetTextAlignment :: ToolItemClass item => item -> IO Double -- ^ returns a gfloat indicating the horizontal text alignment used for @toolItem@ toolItemGetTextAlignment item = liftM realToFrac $ {#call gtk_tool_item_get_text_alignment #} (toToolItem item) -- | Returns the text orientation used for @toolItem@. Custom subclasses of 'ToolItem' should call this -- function to find out how text should be orientated. toolItemGetTextOrientation :: ToolItemClass item => item -> IO Orientation -- ^ returns a 'Orientation' indicating the orientation used for @toolItem@ toolItemGetTextOrientation item = liftM (toEnum . fromIntegral) $ {#call gtk_tool_item_get_text_orientation #} (toToolItem item) -- | Returns the size group used for labels in @toolItem@. Custom subclasses of 'ToolItem' should call -- this function and use the size group for labels. toolItemGetTextSizeGroup :: ToolItemClass item => item -> IO SizeGroup toolItemGetTextSizeGroup item = makeNewGObject mkSizeGroup $ {#call gtk_tool_item_get_text_size_group #} (toToolItem item) #endif -------------------- -- Attributes -- | Whether the toolbar item is visible when the toolbar is in a horizontal -- orientation. -- -- Default value: @True@ -- toolItemVisibleHorizontal :: ToolItemClass self => Attr self Bool toolItemVisibleHorizontal = newAttr toolItemGetVisibleHorizontal toolItemSetVisibleHorizontal -- | Whether the toolbar item is visible when the toolbar is in a vertical -- orientation. -- -- Default value: @True@ -- toolItemVisibleVertical :: ToolItemClass self => Attr self Bool toolItemVisibleVertical = newAttr toolItemGetVisibleVertical toolItemSetVisibleVertical -- | Whether the toolbar item is considered important. When @True@, toolbar -- buttons show text in 'ToolbarBothHoriz' mode. -- -- Default value: @False@ -- toolItemIsImportant :: ToolItemClass self => Attr self Bool toolItemIsImportant = newAttr toolItemGetIsImportant toolItemSetIsImportant -- | \'expand\' property. See 'toolItemGetExpand' and 'toolItemSetExpand' -- toolItemExpand :: ToolItemClass self => Attr self Bool toolItemExpand = newAttr toolItemGetExpand toolItemSetExpand -- | \'homogeneous\' property. See 'toolItemGetHomogeneous' and -- 'toolItemSetHomogeneous' -- toolItemHomogeneous :: ToolItemClass self => Attr self Bool toolItemHomogeneous = newAttr toolItemGetHomogeneous toolItemSetHomogeneous -- | \'useDragWindow\' property. See 'toolItemGetUseDragWindow' and -- 'toolItemSetUseDragWindow' -- toolItemUseDragWindow :: ToolItemClass self => Attr self Bool toolItemUseDragWindow = newAttr toolItemGetUseDragWindow toolItemSetUseDragWindow #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ToolItemGroup.chs0000644000000000000000000002147407346545000022055 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToolItemGroup -- -- Author : Andy Stewart -- -- Created: 08 Sep 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A sub container used in a tool palette -- -- * Module available since Gtk+ version 2.20 -- module Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup ( -- * Detail -- | A 'ToolItemGroup' is used together with 'ToolPalette' to add 'ToolItems' to a palette like -- container with different categories and drag and drop support. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'ToolItemGroup' -- @ #if GTK_CHECK_VERSION(2,20,0) -- * Types ToolItemGroup, ToolItemGroupClass, castToToolItemGroup, toToolItemGroup, -- * Constructors toolItemGroupNew, -- * Methods toolItemGroupGetDropItem, toolItemGroupGetItemPosition, toolItemGroupGetNItems, toolItemGroupGetNthItem, toolItemGroupInsert, toolItemGroupSetItemPosition, -- * Attributes toolItemGroupCollapsed, toolItemGroupEllipsize, toolItemGroupHeaderRelief, toolItemGroupLabel, toolItemGroupLabelWidget, -- * Child Attributes toolItemGroupChildExpand, toolItemGroupChildFill, toolItemGroupChildHomogeneous, toolItemGroupChildNewRow, toolItemGroupChildPosition, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import System.Glib.UTFString import Graphics.Rendering.Pango.Enums (EllipsizeMode (..)) import Graphics.UI.Gtk.General.Enums (ReliefStyle(..)) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,20,0) -- | Creates a new tool item group with label label. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupNew :: GlibString string => string -- ^ @label@ the label of the new group -> IO ToolItemGroup -- ^ returns a new 'ToolItemGroup'. toolItemGroupNew label = makeNewObject mkToolItemGroup $ liftM (castPtr :: Ptr Widget -> Ptr ToolItemGroup) $ withUTFString label $ \ labelPtr -> {#call gtk_tool_item_group_new #} labelPtr -- | Gets the tool item at position (x, y). -- -- * Available since Gtk+ version 2.20 -- toolItemGroupGetDropItem :: ToolItemGroupClass self => self -> (Int, Int) -> IO ToolItem toolItemGroupGetDropItem group (x, y) = makeNewObject mkToolItem $ {#call gtk_tool_item_group_get_drop_item #} (toToolItemGroup group) (fromIntegral x) (fromIntegral y) -- | Gets the position of item in group as index. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupGetItemPosition :: (ToolItemGroupClass group, ToolItemClass item) => group -- ^ @group@ a 'ToolItemGroup' -> item -- ^ @item@ a 'ToolItem' -> IO Int -- ^ returns the index of item in group or -1 if item is no child of group toolItemGroupGetItemPosition group item = liftM fromIntegral $ {#call gtk_tool_item_group_get_item_position #} (toToolItemGroup group) (toToolItem item) -- | Gets the number of tool items in group. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupGetNItems :: ToolItemGroupClass group => group -> IO Int -- ^ returns the number of tool items in group toolItemGroupGetNItems group = liftM fromIntegral $ {#call gtk_tool_item_group_get_n_items #} (toToolItemGroup group) -- | Gets the tool item at index in group. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupGetNthItem :: ToolItemGroupClass group => group -> Int -- ^ @index@ the index -> IO ToolItem -- ^ returns the 'ToolItem' at index toolItemGroupGetNthItem group index = makeNewObject mkToolItem $ {#call gtk_tool_item_group_get_nth_item #} (toToolItemGroup group) (fromIntegral index) -- | Inserts item at position in the list of children of group. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupInsert :: (ToolItemGroupClass group, ToolItemClass item) => group -- ^ @group@ a 'ToolItemGroup' -> item -- ^ @item@ the 'ToolItem' to insert into group -> Int -- ^ @position@ the position of item in group, starting with 0. -- The position -1 means end of list. -> IO () toolItemGroupInsert group item position = {#call gtk_tool_item_group_insert #} (toToolItemGroup group) (toToolItem item) (fromIntegral position) -- | Sets the position of item in the list of children of group. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupSetItemPosition :: (ToolItemGroupClass group, ToolItemClass item) => group -- ^ @group@ a 'ToolItemGroup' -> item -- ^ @item@ the 'ToolItem' to move to a new position, should be a child of group. -> Int -- ^ @position@ the new position of item in group, starting with 0. The position -1 means end of list. -> IO () toolItemGroupSetItemPosition group item position = {#call gtk_tool_item_group_set_item_position #} (toToolItemGroup group) (toToolItem item) (fromIntegral position) -- | Whether the group has been collapsed and items are hidden. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- toolItemGroupCollapsed :: ToolItemGroupClass group => Attr group Bool toolItemGroupCollapsed = newAttrFromBoolProperty "collapsed" -- | Ellipsize for item group headers. -- -- Default value: EllipsizeNone -- -- * Available since Gtk+ version 2.20 -- toolItemGroupEllipsize :: ToolItemGroupClass group => Attr group EllipsizeMode toolItemGroupEllipsize = newAttrFromEnumProperty "ellipsize" {# call pure unsafe pango_ellipsize_mode_get_type #} -- | Relief of the group header button. -- -- Default value: 'ReliefNormal' -- -- * Available since Gtk+ version 2.20 -- toolItemGroupHeaderRelief :: ToolItemGroupClass group => Attr group ReliefStyle toolItemGroupHeaderRelief = newAttrFromEnumProperty "header-relief" {# call pure unsafe gtk_relief_style_get_type #} -- | The human-readable title of this item group. -- -- Default value: \"\" -- -- * Available since Gtk+ version 2.20 -- toolItemGroupLabel :: GlibString string => ToolItemGroupClass group => Attr group string toolItemGroupLabel = newAttrFromStringProperty "label" -- | A widget to display in place of the usual label. -- -- * Available since Gtk+ version 2.20 -- toolItemGroupLabelWidget :: ToolItemGroupClass group => Attr group Widget toolItemGroupLabelWidget = newAttrFromObjectProperty "label-widget" {# call pure unsafe gtk_widget_get_type #} -- | Whether the item should receive extra space when the group grows. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- toolItemGroupChildExpand :: ToolItemGroupClass group => Attr group Bool toolItemGroupChildExpand = newAttrFromBoolProperty "expand" -- | Whether the item should fill the available space. -- -- Default value: 'True' -- -- * Available since Gtk+ version 2.20 -- toolItemGroupChildFill :: ToolItemGroupClass group => Attr group Bool toolItemGroupChildFill = newAttrFromBoolProperty "fill" -- | Whether the item should be the same size as other homogeneous items. -- -- Default value: 'True' -- -- * Available since Gtk+ version 2.20 -- toolItemGroupChildHomogeneous :: ToolItemGroupClass group => Attr group Bool toolItemGroupChildHomogeneous = newAttrFromBoolProperty "homogeneous" -- | Whether the item should start a new row. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- toolItemGroupChildNewRow :: ToolItemGroupClass group => Attr group Bool toolItemGroupChildNewRow = newAttrFromBoolProperty "new-row" -- | Position of the item within this group. -- -- Allowed values: >= 0 -- -- Default value: 0 -- -- * Available since Gtk+ version 2.20 -- toolItemGroupChildPosition :: ToolItemGroupClass group => Attr group Int toolItemGroupChildPosition = newAttrFromIntProperty "position" #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/ToolPalette.chs0000644000000000000000000002041607346545000021533 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ToolPalette -- -- Author : Andy Stewart -- -- Created: 08 Sep 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A tool palette with categories -- -- * Module available since Gtk+ version 2.20 -- -- TODO: -- -- gtk_tool_palette_add_drag_dest -- gtk_tool_palette_get_drag_item -- gtk_tool_palette_get_drag_target_group -- gtk_tool_palette_get_drag_target_item -- gtk_tool_palette_get_drop_group -- gtk_tool_palette_get_drop_item -- module Graphics.UI.Gtk.MenuComboToolbar.ToolPalette ( -- * Detail -- | A 'ToolPalette' allows you to add 'ToolItems' to a palette-like container with different -- categories and drag and drop support. -- -- A 'ToolPalette' is created with a call to 'toolPaletteNew'. -- -- 'ToolItems' cannot be added directly to a 'ToolPalette' - instead they are added to a -- 'ToolItemGroup' which can than be added to a 'ToolPalette'. To add a 'ToolItemGroup' to a -- 'ToolPalette', use 'containerAdd'. -- -- The easiest way to use drag and drop with 'ToolPalette' is to call 'toolPaletteAddDragDest' -- with the desired drag source palette and the desired drag target widget. Then -- 'toolPaletteGetDragItem' can be used to get the dragged item in the 'dragDataReceived' -- signal handler of the drag target. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'ToolPalette' -- @ #if GTK_CHECK_VERSION(2,20,0) -- * Types ToolPalette, ToolPaletteClass, castToToolPalette, toToolPalette, -- * Enums ToolPaletteDragTargets (..), -- * Constructors toolPaletteNew, -- * Methods toolPaletteUnsetIconSize, toolPaletteUnsetStyle, toolPaletteGetHAdjustment, toolPaletteGetVAdjustment, -- * Attributes toolPaletteSetGroupPosition, toolPaletteGetGroupPosition, toolPaletteIconSize, toolPaletteIconSizeSet, toolPaletteToolbarStyle, -- * Child Attributes toolPaletteChildExclusive, toolPaletteChildExpand, -- * Signals toolPaletteSetScrollAdjustments, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.General.Structs (IconSize (..)) import Graphics.UI.Gtk.General.Enums (ToolbarStyle (..)) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,20,0) -- | Flags used to specify the supported drag targets. {# enum ToolPaletteDragTargets {underscoreToCase} deriving (Eq) #} -- | Creates a new tool palette. -- -- * Available since Gtk+ version 2.20 -- toolPaletteNew :: IO ToolPalette toolPaletteNew = makeNewObject mkToolPalette $ liftM (castPtr :: Ptr Widget -> Ptr ToolPalette) $ {#call gtk_tool_palette_new #} -- | Unsets the tool palette icon size set with 'toolPaletteSetIconSize', so that user -- preferences will be used to determine the icon size. -- -- * Available since Gtk+ version 2.20 -- toolPaletteUnsetIconSize :: ToolPaletteClass self => self -> IO () toolPaletteUnsetIconSize palette = {#call gtk_tool_palette_unset_icon_size #} (toToolPalette palette) -- | Unsets a toolbar style set with 'toolPaletteSetStyle', so that user preferences will be used -- to determine the toolbar style. -- -- * Available since Gtk+ version 2.20 -- toolPaletteUnsetStyle :: ToolPaletteClass self => self -> IO () toolPaletteUnsetStyle palette = {#call gtk_tool_palette_unset_style #} (toToolPalette palette) -- | Gets the horizontal adjustment of the tool palette. -- -- * Available since Gtk+ version 2.20 -- toolPaletteGetHAdjustment :: ToolPaletteClass self => self -> IO Adjustment toolPaletteGetHAdjustment palette = makeNewObject mkAdjustment $ {# call gtk_tool_palette_get_hadjustment #} (toToolPalette palette) -- | Gets the vertical adjustment of the tool palette. -- -- * Available since Gtk+ version 2.20 -- toolPaletteGetVAdjustment :: ToolPaletteClass self => self -> IO Adjustment toolPaletteGetVAdjustment palette = makeNewObject mkAdjustment $ {# call gtk_tool_palette_get_vadjustment #} (toToolPalette palette) -- | Gets the position of group in palette as index. See 'toolPaletteSetGroupPosition'. -- -- * Available since Gtk+ version 2.20 -- toolPaletteGetGroupPosition :: (ToolPaletteClass palette, ToolItemGroupClass group) => palette -> group -> IO Int -- ^ returns the index of group or -1 if group is not a child of palette toolPaletteGetGroupPosition palette group = liftM fromIntegral $ {#call gtk_tool_palette_get_group_position #} (toToolPalette palette) (toToolItemGroup group) -- | Sets the position of the group as an index of the tool palette. If position is 0 the group will -- become the first child, if position is -1 it will become the last child. -- -- * Available since Gtk+ version 2.20 -- toolPaletteSetGroupPosition :: (ToolPaletteClass palette, ToolItemGroupClass group) => palette -> group -> Int -> IO () toolPaletteSetGroupPosition palette group position = {#call gtk_tool_palette_set_group_position #} (toToolPalette palette) (toToolItemGroup group) (fromIntegral position) -- | The size of the icons in a tool palette is normally determined by the 'toolbarIconSize' -- setting. When this property is set, it overrides the setting. -- -- This should only be used for special-purpose tool palettes, normal application tool palettes should -- respect the user preferences for the size of icons. -- -- Default value: 'IconSizeSmallToolbar' -- -- * Available since Gtk+ version 2.20 -- toolPaletteIconSize :: ToolPaletteClass self => Attr self IconSize toolPaletteIconSize = newAttrFromEnumProperty "icon-size" {# call pure unsafe gtk_icon_size_get_type #} -- | Is 'True' if the 'iconSize' property has been set. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- toolPaletteIconSizeSet :: ToolPaletteClass self => Attr self Bool toolPaletteIconSizeSet = newAttrFromBoolProperty "icon-size-set" -- | The style of items in the tool palette. -- -- Default value: 'ToolbarIcons' -- -- * Available since Gtk+ version 2.20 -- toolPaletteToolbarStyle :: ToolPaletteClass self => Attr self ToolbarStyle toolPaletteToolbarStyle = newAttrFromEnumProperty "toolbar-style" {# call pure unsafe gtk_toolbar_style_get_type #} -- | Whether the item group should be the only one that is expanded at a given time. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- toolPaletteChildExclusive :: ToolPaletteClass self => Attr self Bool toolPaletteChildExclusive = newAttrFromBoolProperty "exclusive" -- | Whether the item group should receive extra space when the palette grows. at a given time. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- toolPaletteChildExpand :: ToolPaletteClass self => Attr self Bool toolPaletteChildExpand = newAttrFromBoolProperty "expand" -- | Set the scroll adjustments for the viewport. Usually scrolled containers like 'ScrolledWindow' will -- emit this signal to connect two instances of 'Scrollbar' to the scroll directions of the -- 'Toolpalette'. -- -- * Available since Gtk+ version 2.20 -- toolPaletteSetScrollAdjustments :: ToolPaletteClass self => Signal self (Adjustment -> Adjustment -> IO ()) toolPaletteSetScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set-scroll-adjustments") #endif gtk-0.15.9/Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs0000644000000000000000000006045407346545000020707 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Toolbar -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Create bars of buttons and other widgets -- module Graphics.UI.Gtk.MenuComboToolbar.Toolbar ( -- * Detail -- -- | This widget underwent a significant overhaul in gtk 2.4 and the -- recommended api changed substantially. The old interface is still supported -- but it is not recommended. -- -- * The following information applies to the new interface only. -- -- A toolbar is created with a call to 'toolbarNew'. -- -- A toolbar can contain instances of a subclass of 'ToolItem'. To add a -- 'ToolItem' to the a toolbar, use 'toolbarInsert'. To remove an item from the -- toolbar use 'containerRemove'. To add a button to the toolbar, add an -- instance of 'ToolButton'. -- -- Toolbar items can be visually grouped by adding instances of -- 'SeparatorToolItem' to the toolbar. If a 'SeparatorToolItem' has the -- \"expand\" property set to @True@ and the \"draw\" property set to @False@ -- the effect is to force all following items to the end of the toolbar. -- -- Creating a context menu for the toolbar can be done using -- 'onPopupContextMenu'. #ifndef DISABLE_DEPRECATED -- | * The following information applies to the old interface only. -- -- 'Button's, 'RadioButton's and 'ToggleButton's can be added by referring to -- stock images. Their size can be changed by calling 'toolbarSetIconSize'. In -- contrast, normal widget cannot be added. Due to the bad interface of -- "Toolbar" mnemonics of 'RadioButton's and 'ToggleButton's are not honored. -- -- All the append, insert and prepend functions use an internal function to -- do the actual work. In fact the interface is pretty skrewed up: To insert -- icons by using stock items is definitely the best practice as all other -- images cannot react to 'toolbarSetIconSize' and other theming actions. On -- the other hand 'toolbarInsertStock' always generates simple 'Button's -- but is the only function that is able to insert 'Mnemonic's on the label. -- Our solution is to use 'StockItem's to specify all 'Images' of the -- 'Buttons'. If the user inserts 'RadioButton's or 'ToggleButton's, the stock -- image lookup is done manually. A mnemonic in the labels is sadly not -- honored this way. #endif -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----Toolbar -- @ -- * Types Toolbar, ToolbarClass, castToToolbar, gTypeToolbar, toToolbar, Orientation(..), ToolbarStyle(..), -- * Constructors toolbarNew, -- * Methods #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED toolbarInsertNewButton, toolbarAppendNewButton, toolbarPrependNewButton, toolbarInsertNewToggleButton, toolbarAppendNewToggleButton, toolbarPrependNewToggleButton, toolbarInsertNewRadioButton, toolbarAppendNewRadioButton, toolbarPrependNewRadioButton, toolbarInsertNewWidget, toolbarAppendNewWidget, toolbarPrependNewWidget, #endif toolbarSetOrientation, toolbarGetOrientation, #endif toolbarSetStyle, toolbarGetStyle, toolbarUnsetStyle, #if GTK_MAJOR_VERSION < 3 toolbarSetTooltips, toolbarGetTooltips, #endif IconSize(..), #ifndef DISABLE_DEPRECATED toolbarSetIconSize, #endif toolbarGetIconSize, #if GTK_CHECK_VERSION(2,4,0) toolbarInsert, toolbarGetItemIndex, toolbarGetNItems, toolbarGetNthItem, toolbarGetDropIndex, toolbarSetDropHighlightItem, toolbarSetShowArrow, toolbarGetShowArrow, ReliefStyle(..), toolbarGetReliefStyle, #endif -- * Attributes #if GTK_MAJOR_VERSION < 3 toolbarOrientation, #endif #if GTK_CHECK_VERSION(2,4,0) toolbarShowArrow, #endif #if GTK_CHECK_VERSION(2,8,0) #if GTK_MAJOR_VERSION < 3 toolbarTooltips, #endif #endif toolbarStyle, -- * Child Attributes toolbarChildExpand, toolbarChildHomogeneous, -- * Signals onOrientationChanged, afterOrientationChanged, onStyleChanged, afterStyleChanged, onPopupContextMenu, afterPopupContextMenu, ) where import Control.Monad (liftM) #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED import Data.Maybe (fromJust) import qualified Data.Text as T (filter) import Graphics.UI.Gtk.General.StockItems import Graphics.UI.Gtk.Display.Image (imageNewFromStock) import System.Glib.UTFString #endif #endif import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Abstract.ContainerChildProperties import Graphics.UI.Gtk.General.Enums (Orientation(..), ToolbarStyle(..), ReliefStyle(..)) import Graphics.UI.Gtk.General.Structs ( #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED toolbarChildToggleButton, toolbarChildRadioButton, #endif #endif IconSize(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new toolbar. -- toolbarNew :: IO Toolbar toolbarNew = makeNewObject mkToolbar $ liftM (castPtr :: Ptr Widget -> Ptr Toolbar) $ {# call unsafe toolbar_new #} -------------------- -- Methods #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- Make tooltips or not? -- mkToolText :: GlibString string => Maybe (string,string) -> (CString -> CString -> IO a) -> IO a mkToolText Nothing fun = fun nullPtr nullPtr mkToolText (Just (text,private)) fun = withUTFString text $ \txtPtr -> withUTFString private $ \prvPtr -> fun txtPtr prvPtr -- | Insert a new 'Button' into the 'Toolbar'. -- -- The new 'Button' is created at position @pos@, counting from 0. -- -- The icon and label for the button is referenced by @stockId@ -- which must be a valid entry in the 'Toolbar's Style or the -- default 'IconFactory'. -- -- If you wish to have 'Tooltips' added to this button you can -- specify @Just (tipText, tipPrivate)@ , otherwise specify @Nothing@. -- -- The newly created 'Button' is returned. Use this button to -- add an action function with @\"connectToClicked\"@. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarInsertNewButton :: (ToolbarClass self, GlibString string) => self -> Int -> StockId -> Maybe (string,string) -> IO Button toolbarInsertNewButton self pos stockId tooltips = withUTFString stockId $ \stockPtr -> mkToolText tooltips $ \textPtr privPtr -> makeNewObject mkButton $ liftM castPtr $ {# call unsafe toolbar_insert_stock #} (toToolbar self) stockPtr textPtr privPtr nullFunPtr nullPtr (fromIntegral pos) -- | Append a new 'Button' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarAppendNewButton :: (ToolbarClass self, GlibString string) => self -> StockId -> Maybe (string, string) -> IO Button toolbarAppendNewButton self = toolbarInsertNewButton self (-1) -- | Prepend a new 'Button' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarPrependNewButton :: (ToolbarClass self, GlibString string) => self -> StockId -> Maybe (string, string) -> IO Button toolbarPrependNewButton self = toolbarInsertNewButton self 0 -- | Insert a new 'ToggleButton' into the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarInsertNewToggleButton :: (ToolbarClass self, GlibString string) => self -> Int -> StockId -> Maybe (string, string) -> IO ToggleButton toolbarInsertNewToggleButton self pos stockId tooltips = do mItem <- stockLookupItem stockId item <- case mItem of (Just item) -> return item Nothing -> liftM fromJust $ stockLookupItem stockMissingImage let label = (T.filter (/= '_')) $ siLabel item size <- toolbarGetIconSize (toToolbar self) image <- imageNewFromStock stockId size makeNewObject mkToggleButton $ liftM castPtr $ withUTFString label $ \lblPtr -> mkToolText tooltips $ \textPtr privPtr -> {#call unsafe toolbar_insert_element#} (toToolbar self) toolbarChildToggleButton (Widget nullForeignPtr) lblPtr textPtr privPtr (toWidget image) nullFunPtr nullPtr (fromIntegral pos) -- | Append a new 'ToggleButton' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarAppendNewToggleButton :: (ToolbarClass self, GlibString string) => self -> StockId -> Maybe (string, string) -> IO ToggleButton toolbarAppendNewToggleButton self = toolbarInsertNewToggleButton self (-1) -- | Prepend a new 'ToggleButton' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarPrependNewToggleButton :: (ToolbarClass self, GlibString string) => self -> StockId -> Maybe (string, string) -> IO ToggleButton toolbarPrependNewToggleButton self = toolbarInsertNewToggleButton self 0 -- | Insert a new 'RadioButton' into the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- The @parent@ argument must be set to another -- 'RadioButton' in the group. If @Nothing@ is given, -- a new group is generated (which is the desired behaviour for the -- first button of a group). -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarInsertNewRadioButton :: (ToolbarClass self, RadioButtonClass rb, GlibString string) => self -> Int -> StockId -> Maybe (string,string) -> Maybe rb -> IO RadioButton toolbarInsertNewRadioButton self pos stockId tooltips rb = do mItem <- stockLookupItem stockId item <- case mItem of (Just item) -> return item Nothing -> liftM fromJust $ stockLookupItem stockMissingImage let label = (T.filter (/= '_')) $ siLabel item size <- toolbarGetIconSize (toToolbar self) image <- imageNewFromStock stockId size makeNewObject mkRadioButton $ liftM castPtr $ withUTFString label $ \lblPtr -> mkToolText tooltips $ \textPtr privPtr -> {#call unsafe toolbar_insert_element#} (toToolbar self) toolbarChildRadioButton (maybe (Widget nullForeignPtr) toWidget rb) lblPtr textPtr privPtr (toWidget image) nullFunPtr nullPtr (fromIntegral pos) -- | Append a new 'RadioButton' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarAppendNewRadioButton :: (ToolbarClass self, RadioButtonClass rb, GlibString string) => self -> StockId -> Maybe (string, string) -> Maybe rb -> IO RadioButton toolbarAppendNewRadioButton self = toolbarInsertNewRadioButton self (-1) -- | Prepend a new 'RadioButton' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarPrependNewRadioButton :: (ToolbarClass self, RadioButtonClass rb, GlibString string) => self -> StockId -> Maybe (string, string) -> Maybe rb -> IO RadioButton toolbarPrependNewRadioButton self = toolbarInsertNewRadioButton self 0 -- | Insert an arbitrary widget to the 'Toolbar'. -- -- The 'Widget' should not be a button. Adding 'Button's -- with the 'toolbarInsertButton',... functions with stock -- objects is much better as it takes care of theme handling. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarInsertNewWidget :: (ToolbarClass self, WidgetClass w, GlibString string) => self -> Int -> w -> Maybe (string,string) -> IO () toolbarInsertNewWidget self pos w tooltips = mkToolText tooltips $ \textPtr privPtr -> {# call unsafe toolbar_insert_widget #} (toToolbar self) (toWidget w) textPtr privPtr (fromIntegral pos) -- | Append a new 'Widget' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarAppendNewWidget :: (ToolbarClass self, WidgetClass w, GlibString string) => self -> w -> Maybe (string, string) -> IO () toolbarAppendNewWidget self = toolbarInsertNewWidget self (-1) -- | Prepend a new 'Widget' to the 'Toolbar'. -- -- See 'toolbarInsertNewButton' for details. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. toolbarPrependNewWidget :: (ToolbarClass self, WidgetClass w, GlibString string) => self -> w -> Maybe (string, string) -> IO () toolbarPrependNewWidget self = toolbarInsertNewWidget self 0 #endif -- | Sets whether a toolbar should appear horizontally or vertically. -- -- Removed in Gtk3. toolbarSetOrientation :: ToolbarClass self => self -> Orientation -> IO () toolbarSetOrientation self orientation = {# call toolbar_set_orientation #} (toToolbar self) ((fromIntegral . fromEnum) orientation) -- | Retrieves the current orientation of the toolbar. See -- 'toolbarSetOrientation'. -- -- Removed in Gtk3. toolbarGetOrientation :: ToolbarClass self => self -> IO Orientation toolbarGetOrientation self = liftM (toEnum . fromIntegral) $ {# call unsafe toolbar_get_orientation #} (toToolbar self) #endif -- | Alters the view of the toolbar to display either icons only, text only, or -- both. -- toolbarSetStyle :: ToolbarClass self => self -> ToolbarStyle -> IO () toolbarSetStyle self style = {# call toolbar_set_style #} (toToolbar self) ((fromIntegral . fromEnum) style) -- | Retrieves whether the toolbar has text, icons, or both. See -- 'toolbarSetStyle'. -- toolbarGetStyle :: ToolbarClass self => self -> IO ToolbarStyle toolbarGetStyle self = liftM (toEnum . fromIntegral) $ {# call toolbar_get_style #} (toToolbar self) -- | Unsets a toolbar style set with 'toolbarSetStyle', so that user -- preferences will be used to determine the toolbar style. -- toolbarUnsetStyle :: ToolbarClass self => self -> IO () toolbarUnsetStyle self = {# call toolbar_unset_style #} (toToolbar self) #if GTK_MAJOR_VERSION < 3 -- | Sets if the tooltips of a toolbar should be active or not. -- -- Removed in Gtk3. toolbarSetTooltips :: ToolbarClass self => self -> Bool -- ^ @enable@ - set to @False@ to disable the tooltips, or @True@ to -- enable them. -> IO () toolbarSetTooltips self enable = {# call toolbar_set_tooltips #} (toToolbar self) (fromBool enable) -- | Retrieves whether tooltips are enabled. See 'toolbarSetTooltips'. -- -- Removed in Gtk3. toolbarGetTooltips :: ToolbarClass self => self -> IO Bool toolbarGetTooltips self = liftM toBool $ {# call unsafe toolbar_get_tooltips #} (toToolbar self) #endif #ifndef DISABLE_DEPRECATED -- | This function sets the size of stock icons in the toolbar. You can call -- it both before you add the icons and after they\'ve been added. The size you -- set will override user preferences for the default icon size. -- -- It might be sensible to restrict oneself to 'IconSizeSmallToolbar' and -- 'IconSizeLargeToolbar'. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- toolbarSetIconSize :: ToolbarClass self => self -> IconSize -> IO () toolbarSetIconSize self iconSize = {# call toolbar_set_icon_size #} (toToolbar self) ((fromIntegral . fromEnum) iconSize) #endif -- | Retrieves the icon size for the toolbar. See 'toolbarSetIconSize'. -- toolbarGetIconSize :: ToolbarClass self => self -> IO IconSize toolbarGetIconSize self = liftM (toEnum . fromIntegral) $ {# call unsafe toolbar_get_icon_size #} (toToolbar self) #if GTK_CHECK_VERSION(2,4,0) -- | Insert a 'ToolItem' into the toolbar at position @pos@. If @pos@ is 0 the -- item is prepended to the start of the toolbar. If @pos@ is negative, the -- item is appended to the end of the toolbar. -- -- * Available since Gtk version 2.4 -- toolbarInsert :: (ToolbarClass self, ToolItemClass item) => self -> item -- ^ @item@ - a 'ToolItem' -> Int -- ^ @pos@ - the position of the new item -> IO () toolbarInsert self item pos = {# call toolbar_insert #} (toToolbar self) (toToolItem item) (fromIntegral pos) -- | Returns the position of @item@ on the toolbar, starting from 0. It is an -- error if @item@ is not a child of the toolbar. -- -- * Available since Gtk version 2.4 -- toolbarGetItemIndex :: (ToolbarClass self, ToolItemClass item) => self -> item -- ^ @item@ - a 'ToolItem' that is a child of @toolbar@ -> IO Int -- ^ returns the position of item on the toolbar. toolbarGetItemIndex self item = liftM fromIntegral $ {# call unsafe toolbar_get_item_index #} (toToolbar self) (toToolItem item) -- | Returns the number of items on the toolbar. -- -- * Available since Gtk version 2.4 -- toolbarGetNItems :: ToolbarClass self => self -> IO Int toolbarGetNItems self = liftM fromIntegral $ {# call unsafe toolbar_get_n_items #} (toToolbar self) -- | Returns the @n@\'th item on toolbar, or @Nothing@ if the toolbar does not -- contain an @n@'th item. -- -- * Available since Gtk+ version 2.4 -- toolbarGetNthItem :: ToolbarClass self => self -> Int -- ^ @n@ - A position on the toolbar -> IO (Maybe ToolItem) -- ^ returns The @n@'th 'ToolItem' on the toolbar, or -- @Nothing@ if there isn't an @n@\'th item. toolbarGetNthItem self n = maybeNull (makeNewObject mkToolItem) $ {# call unsafe toolbar_get_nth_item #} (toToolbar self) (fromIntegral n) -- | Returns the position corresponding to the indicated point on toolbar. -- This is useful when dragging items to the toolbar: this function returns the -- position a new item should be inserted. -- -- * Available since Gtk version 2.4 -- toolbarGetDropIndex :: ToolbarClass self => self -> (Int, Int) -- ^ @(x, y)@ - coordinate of a point on the toolbar. Note that -- @(x, y)@ are in toolbar coordinates, not window coordinates. -> IO Int -- ^ returns The position corresponding to the point @(x, y)@ on -- the toolbar. toolbarGetDropIndex self (x,y) = liftM fromIntegral $ {# call unsafe toolbar_get_drop_index #} (toToolbar self) (fromIntegral x) (fromIntegral y) -- | Highlights the toolbar to give an idea of what it would look like if @item@ -- was added to toolbar at the position indicated by @index@. If @item@ is -- @Nothing@, highlighting is turned off (and the index is ignored). -- -- The @toolItem@ passed to this function must not be part of any widget -- hierarchy. When an item is set as a drop highlight item it can not added to -- any widget hierarchy or used as highlight item for another toolbar. -- -- * Available since Gtk version 2.4 -- toolbarSetDropHighlightItem :: (ToolbarClass self, ToolItemClass toolItem) => self -> Maybe toolItem -- ^ @toolItem@ - a 'ToolItem', or @Nothing@ to turn of -- highlighting -> Int -- ^ @index@ - a position on the toolbar -> IO () toolbarSetDropHighlightItem self toolItem index = {# call toolbar_set_drop_highlight_item #} (toToolbar self) (maybe (ToolItem nullForeignPtr) toToolItem toolItem) (fromIntegral index) -- | Sets whether to show an overflow menu when the toolbar doesn't have room -- for all items on it. If @True@, items that there are not room are available -- through an overflow menu. -- -- * Available since Gtk version 2.4 -- toolbarSetShowArrow :: ToolbarClass self => self -> Bool -> IO () toolbarSetShowArrow self showArrow = {# call toolbar_set_show_arrow #} (toToolbar self) (fromBool showArrow) -- | Returns whether the toolbar has an overflow menu. See -- 'toolbarSetShowArrow'. -- -- * Available since Gtk+ version 2.4 -- toolbarGetShowArrow :: ToolbarClass self => self -> IO Bool toolbarGetShowArrow self = liftM toBool $ {# call unsafe toolbar_get_show_arrow #} (toToolbar self) -- | Returns the relief style of buttons on the toolbar. See 'buttonSetRelief'. -- -- * Available since Gtk+ version 2.4 -- toolbarGetReliefStyle :: ToolbarClass self => self -> IO ReliefStyle toolbarGetReliefStyle self = liftM (toEnum . fromIntegral) $ {# call unsafe toolbar_get_relief_style #} (toToolbar self) #endif -------------------- -- Attributes #if GTK_MAJOR_VERSION < 3 -- | The orientation of the toolbar. -- -- Default value: 'OrientationHorizontal' -- -- Removed in Gtk3. toolbarOrientation :: ToolbarClass self => Attr self Orientation toolbarOrientation = newAttr toolbarGetOrientation toolbarSetOrientation #endif -- | How to draw the toolbar. -- -- Default value: 'ToolbarIcons' -- toolbarStyle :: ToolbarClass self => Attr self ToolbarStyle toolbarStyle = newAttrFromEnumProperty "toolbar-style" {# call pure unsafe gtk_toolbar_style_get_type #} #if GTK_CHECK_VERSION(2,4,0) -- | If an arrow should be shown if the toolbar doesn't fit. -- -- Default value: @True@ -- toolbarShowArrow :: ToolbarClass self => Attr self Bool toolbarShowArrow = newAttr toolbarGetShowArrow toolbarSetShowArrow #endif #if GTK_MAJOR_VERSION < 3 -- | If the tooltips of the toolbar should be active or not. -- -- Default value: @True@ -- -- Removed in Gtk3. toolbarTooltips :: ToolbarClass self => Attr self Bool toolbarTooltips = newAttr toolbarGetTooltips toolbarSetTooltips #endif -------------------- -- Child Attributes -- | Whether the item should receive extra space when the toolbar grows. -- -- Default value: @True@ -- toolbarChildExpand :: (ToolbarClass self, WidgetClass child) => child -> Attr self Bool toolbarChildExpand = newAttrFromContainerChildBoolProperty "expand" -- | Whether the item should be the same size as other homogeneous items. -- -- Default value: @True@ -- toolbarChildHomogeneous :: (ToolbarClass self, WidgetClass child) => child -> Attr self Bool toolbarChildHomogeneous = newAttrFromContainerChildBoolProperty "homogeneous" -------------------- -- Signals -- | Emitted when the orientation of the toolbar changes. -- onOrientationChanged, afterOrientationChanged :: ToolbarClass self => self -> (Orientation -> IO ()) -> IO (ConnectId self) onOrientationChanged = connect_ENUM__NONE "orientation-changed" False afterOrientationChanged = connect_ENUM__NONE "orientation-changed" True -- | Emitted when the style of the toolbar changes. -- onStyleChanged, afterStyleChanged :: ToolbarClass self => self -> (ToolbarStyle -> IO ()) -> IO (ConnectId self) onStyleChanged = connect_ENUM__NONE "style-changed" False afterStyleChanged = connect_ENUM__NONE "style-changed" True -- | Emitted when the user right-clicks the toolbar or uses the keybinding to -- display a popup menu. -- -- Application developers should handle this signal if they want to display -- a context menu on the toolbar. The context-menu should appear at the -- coordinates given by @x@ and @y@. The mouse button number is given by the -- @button@ parameter. If the menu was popped up using the keyboard, @button@ -- is -1. -- onPopupContextMenu, afterPopupContextMenu :: ToolbarClass self => self -> (Int -> Int -> Int -> IO Bool) -- ^ @(\x y button -> ...)@ - The handler -- should return True if the signal was -- handled, False if not. -> IO (ConnectId self) onPopupContextMenu = connect_INT_INT_INT__BOOL "popup-context-menu" False afterPopupContextMenu = connect_INT_INT_INT__BOOL "popup-context-menu" True gtk-0.15.9/Graphics/UI/Gtk/Misc/0000755000000000000000000000000007346545000014261 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Misc/Accessible.chs0000644000000000000000000000450607346545000017022 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget accessible -- -- Author : Andy Stewart -- -- Created: 23 Oct 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A 'Object' representing an adjustable bounded value -- module Graphics.UI.Gtk.Misc.Accessible ( -- * Detail -- -- | Accessible accessibility support for widgets. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'AtkObject' -- | +----Accessible -- @ #if GTK_CHECK_VERSION(2,22,0) -- * Types Accessible, AccessibleClass, castToAccessible, gTypeAccessible, toAccessible, -- * Methods accessibleGetWidget, accessibleSetWidget #endif ) where #if GTK_CHECK_VERSION(2,22,0) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Gets the 'Widget' corresponding to the 'Accessible'. -- -- * Available since Gtk+ version 2.22 -- accessibleGetWidget :: AccessibleClass self => self -> IO (Maybe Widget) -- ^ returns the 'Widget' corresponding to the 'Accessible', or 'Nothing'. accessibleGetWidget self = maybeNull (makeNewObject mkWidget) $ {# call accessible_get_widget #} (toAccessible self) -- | Sets the 'Widget' corresponding to the 'Accessible'. -- -- * Available since Gtk+ version 2.22 -- accessibleSetWidget :: (AccessibleClass self, WidgetClass widget) => self -- ^ @accessible@ a 'Accessible' -> widget -- ^ @widget@ a 'Widget' -> IO () accessibleSetWidget self widget = {#call accessible_set_widget #} (toAccessible self) (toWidget widget) #endif gtk-0.15.9/Graphics/UI/Gtk/Misc/Adjustment.chs0000644000000000000000000002177607346545000017113 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Adjustment -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A 'Object' representing an adjustable bounded value -- module Graphics.UI.Gtk.Misc.Adjustment ( -- * Detail -- -- | The 'Adjustment' object represents a value which has an associated lower -- and upper bound, together with step and page increments, and a page size. It -- is used within several Gtk+ widgets, including 'SpinButton', 'Viewport', and -- 'Range' (which is a base class for 'HScrollbar', 'VScrollbar', 'HScale', and -- 'VScale'). -- -- The 'Adjustment' object does not update the value itself. Instead it is -- left up to the owner of the 'Adjustment' to control the value. -- -- The owner of the 'Adjustment' typically calls the -- 'adjustmentValueChanged' and 'adjustmentChanged' functions after changing -- the value and its bounds. This results in the emission of the -- \"value_changed\" or \"changed\" signal respectively. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----Adjustment -- @ -- * Types Adjustment, AdjustmentClass, castToAdjustment, gTypeAdjustment, toAdjustment, -- * Constructors adjustmentNew, -- * Methods adjustmentSetLower, adjustmentGetLower, adjustmentSetPageIncrement, adjustmentGetPageIncrement, adjustmentSetPageSize, adjustmentGetPageSize, adjustmentSetStepIncrement, adjustmentGetStepIncrement, adjustmentSetUpper, adjustmentGetUpper, adjustmentSetValue, adjustmentGetValue, adjustmentClampPage, adjustmentAdjChanged, adjustmentValueChanged, -- * Attributes #if GTK_CHECK_VERSION(2,4,0) adjustmentValue, adjustmentLower, adjustmentUpper, adjustmentStepIncrement, adjustmentPageIncrement, adjustmentPageSize, #endif -- * Signals onAdjChanged, afterAdjChanged, onValueChanged, afterValueChanged, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Adjustment'. -- -- The creation function take every value that is contained in the object: -- @value@ is the initial value and should be between the @upper@ and @lower@ -- bounds of the slider. Clicking on the arrows increases this value by -- @stepIncrement@. Clicking in the slider advances by @pageIncrement@. The -- @pageSize@ is needed to determine if the end of the slider is still in the -- range. -- adjustmentNew :: Double -- ^ @value@ - the initial value. -> Double -- ^ @lower@ - the minimum value. -> Double -- ^ @upper@ - the maximum value. -> Double -- ^ @stepIncrement@ - the step increment. -> Double -- ^ @pageIncrement@ - the page increment. -> Double -- ^ @pageSize@ - the page size. -> IO Adjustment adjustmentNew value lower upper stepIncrement pageIncrement pageSize = makeNewObject mkAdjustment $ liftM castPtr $ {# call unsafe adjustment_new #} (realToFrac value) (realToFrac lower) (realToFrac upper) (realToFrac stepIncrement) (realToFrac pageIncrement) (realToFrac pageSize) -------------------- -- Methods -- | Set the lower value. adjustmentSetLower :: Adjustment -> Double -> IO () adjustmentSetLower = objectSetPropertyDouble "lower" -- | Retrieve the lower value. adjustmentGetLower :: Adjustment -> IO Double adjustmentGetLower = objectGetPropertyDouble "lower" -- | Set the page increment value. adjustmentSetPageIncrement :: Adjustment -> Double -> IO () adjustmentSetPageIncrement = objectSetPropertyDouble "page-increment" -- | Retrieve the pageincrement value. adjustmentGetPageIncrement :: Adjustment -> IO Double adjustmentGetPageIncrement = objectGetPropertyDouble "page-increment" -- | Set the page size value. adjustmentSetPageSize :: Adjustment -> Double -> IO () adjustmentSetPageSize = objectSetPropertyDouble "page_size" -- | Retrieve the page size value. adjustmentGetPageSize :: Adjustment -> IO Double adjustmentGetPageSize = objectGetPropertyDouble "page_size" -- | Set the step-increment value. adjustmentSetStepIncrement :: Adjustment -> Double -> IO () adjustmentSetStepIncrement = objectSetPropertyDouble "step-increment" -- | Retrieve the step-increment value. adjustmentGetStepIncrement :: Adjustment -> IO Double adjustmentGetStepIncrement = objectGetPropertyDouble "step-increment" -- | Set the upper value. adjustmentSetUpper :: Adjustment -> Double -> IO () adjustmentSetUpper = objectSetPropertyDouble "upper" -- | Retrieve the upper value. adjustmentGetUpper :: Adjustment -> IO Double adjustmentGetUpper = objectGetPropertyDouble "upper" -- | Sets the current value of the Adjustment object. The value is clamped to -- lie between the adjustment's @lower@ and @upper@ values. See 'adjustmentNew' -- for details of these properties. -- -- Note that for adjustments which are used in a 'Scrollbar', the effective -- range of allowed values goes from @lower@ to @upper - page_size@. -- adjustmentSetValue :: Adjustment -> Double -> IO () adjustmentSetValue self value = {# call adjustment_set_value #} self (realToFrac value) -- | Gets the current value of the adjustment. See 'adjustmentSetValue'. -- adjustmentGetValue :: Adjustment -> IO Double adjustmentGetValue self = liftM realToFrac $ {# call adjustment_get_value #} self -- | Updates the 'Adjustment' @value@ to ensure that the range between @lower@ -- and @upper@ is in the current page (i.e. between @value@ and @value + -- pageSize@). If the range is larger than the page size, then only the start -- of it will be in the current page. A \"changed\" signal will be emitted if -- the value is changed. -- adjustmentClampPage :: Adjustment -> Double -- ^ @lower@ - the lower value. -> Double -- ^ @upper@ - the upper value. -> IO () adjustmentClampPage self lower upper = {# call adjustment_clamp_page #} self (realToFrac lower) (realToFrac upper) -- | Emit the 'onAdjChanged' signal. -- adjustmentAdjChanged :: Adjustment -> IO () adjustmentAdjChanged = {#call adjustment_changed#} -- | Emit the 'onValueChanged' signal. -- -- * When adjusting the or bounds, this function can be called to enforce a -- visual update of the containing widget. -- adjustmentValueChanged :: Adjustment -> IO () adjustmentValueChanged = {#call adjustment_value_changed#} -------------------- -- Attributes #if GTK_CHECK_VERSION(2,4,0) -- | The value of the adjustment. -- -- Default value: 0 -- adjustmentValue :: Attr Adjustment Double adjustmentValue = newAttr adjustmentGetValue adjustmentSetValue -- | The minimum value of the adjustment. -- -- Default value: 0 -- adjustmentLower :: Attr Adjustment Double adjustmentLower = newAttrFromDoubleProperty "lower" -- | The maximum value of the adjustment. Note that values will be restricted -- by @upper - page-size@ if the page-size property is nonzero. -- -- Default value: 0 -- adjustmentUpper :: Attr Adjustment Double adjustmentUpper = newAttrFromDoubleProperty "upper" -- | The step increment of the adjustment. -- -- Default value: 0 -- adjustmentStepIncrement :: Attr Adjustment Double adjustmentStepIncrement = newAttrFromDoubleProperty "step-increment" -- | The page increment of the adjustment. -- -- Default value: 0 -- adjustmentPageIncrement :: Attr Adjustment Double adjustmentPageIncrement = newAttrFromDoubleProperty "page-increment" -- | The page size of the adjustment. Note that the page-size is irrelevant -- and should be set to zero if the adjustment is used for a simple scalar -- value, e.g. in a 'SpinButton'. -- -- Default value: 0 -- adjustmentPageSize :: Attr Adjustment Double adjustmentPageSize = newAttrFromDoubleProperty "page-size" #endif -------------------- -- Signals -- | Emitted when one or more of the 'Adjustment' fields have been changed, -- other than the value field. -- onAdjChanged, afterAdjChanged :: Adjustment -> IO () -> IO (ConnectId Adjustment) onAdjChanged = connect_NONE__NONE "changed" False afterAdjChanged = connect_NONE__NONE "changed" True -- | Emitted when the 'Adjustment' value field has been changed. -- onValueChanged, afterValueChanged :: Adjustment -> IO () -> IO (ConnectId Adjustment) onValueChanged = connect_NONE__NONE "value-changed" False afterValueChanged = connect_NONE__NONE "value-changed" True gtk-0.15.9/Graphics/UI/Gtk/Misc/Arrow.chs0000644000000000000000000000660407346545000016060 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Arrow -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Displays an arrow -- module Graphics.UI.Gtk.Misc.Arrow ( -- * Detail -- -- | 'Arrow' should be used to draw simple arrows that need to point in one of -- the four cardinal directions (up, down, left, or right). The style of the -- arrow can be one of shadow in, shadow out, etched in, or etched out. Note -- that these directions and style types may be amended in versions of Gtk to -- come. -- -- 'Arrow' will fill any space allotted to it, but since it is inherited from -- 'Misc', it can be padded and\/or aligned, to fill exactly the space the -- programmer desires. -- -- Arrows are created with a call to 'arrowNew'. The direction or style of -- an arrow can be changed after creation by using 'arrowSet'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Misc' -- | +----Arrow -- @ -- * Types Arrow, ArrowClass, castToArrow, gTypeArrow, toArrow, ArrowType(..), ShadowType(..), -- * Constructors arrowNew, -- * Methods arrowSet, -- * Attributes arrowArrowType, arrowShadowType, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (ArrowType(..), ShadowType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new arrow widget. -- arrowNew :: ArrowType -> ShadowType -> IO Arrow arrowNew arrowType shadowType = makeNewObject mkArrow $ liftM (castPtr :: Ptr Widget -> Ptr Arrow) $ {# call unsafe arrow_new #} ((fromIntegral . fromEnum) arrowType) ((fromIntegral . fromEnum) shadowType) -------------------- -- Methods -- | Sets the direction and style of the 'Arrow'. -- arrowSet :: ArrowClass self => self -> ArrowType -> ShadowType -> IO () arrowSet self arrowType shadowType = {# call arrow_set #} (toArrow self) ((fromIntegral . fromEnum) arrowType) ((fromIntegral . fromEnum) shadowType) -------------------- -- Attributes -- | The direction the arrow should point. -- -- Default value: 'ArrowRight' -- arrowArrowType :: ArrowClass self => Attr self ArrowType arrowArrowType = newAttrFromEnumProperty "arrow-type" {# call pure unsafe gtk_arrow_type_get_type #} -- | Appearance of the shadow surrounding the arrow. -- -- Default value: 'ShadowOut' -- arrowShadowType :: ArrowClass self => Attr self ShadowType arrowShadowType = newAttrFromEnumProperty "shadow-type" {# call pure unsafe gtk_shadow_type_get_type #} gtk-0.15.9/Graphics/UI/Gtk/Misc/Calendar.chs0000644000000000000000000002556707346545000016510 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Calendar -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Displays a calendar and allows the user to select a date -- module Graphics.UI.Gtk.Misc.Calendar ( -- * Detail -- -- | 'Calendar' is a widget that displays a calendar, one month at a time. It -- can be created with 'calendarNew'. -- -- The month and year currently displayed can be altered with -- 'calendarSelectMonth'. The exact day can be selected from the displayed -- month using 'calendarSelectDay'. -- -- To place a visual marker on a particular day, use 'calendarMarkDay' and -- to remove the marker, 'calendarUnmarkDay'. Alternative, all marks can be -- cleared with 'calendarClearMarks'. -- -- The way in which the calendar itself is displayed can be altered using -- 'calendarSetDisplayOptions'. -- -- The selected date can be retrieved from a 'Calendar' using -- 'calendarGetDate'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Calendar -- @ -- * Types Calendar, CalendarClass, castToCalendar, gTypeCalendar, toCalendar, CalendarDisplayOptions(..), -- * Constructors calendarNew, -- * Methods calendarSelectMonth, calendarSelectDay, calendarMarkDay, calendarUnmarkDay, calendarClearMarks, #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED calendarDisplayOptions, #endif #endif #if GTK_CHECK_VERSION(2,4,0) calendarSetDisplayOptions, calendarGetDisplayOptions, #endif calendarGetDate, #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED calendarFreeze, #endif #endif -- * Attributes calendarYear, calendarMonth, calendarDay, #if GTK_CHECK_VERSION(2,4,0) calendarShowHeading, calendarShowDayNames, calendarNoMonthChange, calendarShowWeekNumbers, #endif -- calendarDisplayOptions, -- * Signals onDaySelected, afterDaySelected, onDaySelectedDoubleClick, afterDaySelectedDoubleClick, onMonthChanged, afterMonthChanged, onNextMonth, afterNextMonth, onNextYear, afterNextYear, onPrevMonth, afterPrevMonth, onPrevYear, afterPrevYear, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags (fromFlags, toFlags) import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (CalendarDisplayOptions(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new calendar, with the current date being selected. -- calendarNew :: IO Calendar calendarNew = makeNewObject mkCalendar $ liftM (castPtr :: Ptr Widget -> Ptr Calendar) $ {# call unsafe calendar_new #} -------------------- -- Methods -- | Shifts the calendar to a different month. -- calendarSelectMonth :: CalendarClass self => self -> Int -- ^ @month@ - a month number between 0 and 11. -> Int -- ^ @year@ - the year the month is in. -> IO () calendarSelectMonth self month year = liftM (const ()) $ {# call calendar_select_month #} (toCalendar self) (fromIntegral month) (fromIntegral year) -- | Selects a day from the current month. -- calendarSelectDay :: CalendarClass self => self -> Int -- ^ @day@ - the day number between 1 and 31, or 0 to unselect the -- currently selected day. -> IO () calendarSelectDay self day = {# call calendar_select_day #} (toCalendar self) (fromIntegral day) -- | Places a visual marker on a particular day. -- calendarMarkDay :: CalendarClass self => self -> Int -- ^ @day@ - the day number to mark between 1 and 31. -> IO () calendarMarkDay self day = liftM (const ()) $ {# call calendar_mark_day #} (toCalendar self) (fromIntegral day) -- | Removes the visual marker from a particular day. -- calendarUnmarkDay :: CalendarClass self => self -> Int -- ^ @day@ - the day number to unmark between 1 and 31. -> IO () calendarUnmarkDay self day = liftM (const ()) $ {# call calendar_unmark_day #} (toCalendar self) (fromIntegral day) -- | Remove all visual markers. -- calendarClearMarks :: CalendarClass self => self -> IO () calendarClearMarks self = {# call calendar_clear_marks #} (toCalendar self) #if GTK_CHECK_VERSION(2,4,0) -- | Sets display options (whether to display the heading and the month -- headings). -- -- * Available since Gtk+ version 2.4 -- calendarSetDisplayOptions :: CalendarClass self => self -> [CalendarDisplayOptions] -> IO () calendarSetDisplayOptions self flags = {# call calendar_set_display_options #} (toCalendar self) ((fromIntegral . fromFlags) flags) -- | Returns the current display options for the calendar. -- -- * Available since Gtk+ version 2.4 -- calendarGetDisplayOptions :: CalendarClass self => self -> IO [CalendarDisplayOptions] calendarGetDisplayOptions self = liftM (toFlags . fromIntegral) $ {# call calendar_get_display_options #} (toCalendar self) #endif #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Sets display options (whether to display the heading and the month -- headings). -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. Use 'calendarSetDisplayOptions' instead. -- -- Removed in Gtk3. calendarDisplayOptions :: CalendarClass self => self -> [CalendarDisplayOptions] -> IO () calendarDisplayOptions self flags = {# call calendar_display_options #} (toCalendar self) ((fromIntegral . fromFlags) flags) #endif #endif -- | Retrieve the currently selected date. -- calendarGetDate :: CalendarClass self => self -> IO (Int,Int,Int) -- ^ @(year, month, day)@ calendarGetDate self = alloca $ \yearPtr -> alloca $ \monthPtr -> alloca $ \dayPtr -> do {# call unsafe calendar_get_date #} (toCalendar self) yearPtr monthPtr dayPtr year <- liftM fromIntegral $ peek yearPtr month <- liftM fromIntegral $ peek monthPtr day <- liftM fromIntegral $ peek dayPtr return (year,month,day) #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED -- | Does nothing. Previously locked the display of the calendar for several -- update operations. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- -- Removed in Gtk3. calendarFreeze :: CalendarClass self => self -> IO a -- ^ An action that performs several update operations on the -- calendar. After the action finnishes all the changes made by it -- are displayed. -> IO a calendarFreeze self update = do {# call unsafe calendar_freeze #} (toCalendar self) res <- update {# call calendar_thaw #} (toCalendar self) return res #endif #endif -------------------- -- Attributes -- | The selected year. -- -- Allowed values: >= 0 -- -- Default value: 0 -- calendarYear :: CalendarClass self => Attr self Int calendarYear = newAttrFromIntProperty "year" -- | The selected month (as a number between 0 and 11). -- -- Allowed values: [0,11] -- -- Default value: 0 -- calendarMonth :: CalendarClass self => Attr self Int calendarMonth = newAttrFromIntProperty "month" -- | The selected day (as a number between 1 and 31, or 0 to unselect the -- currently selected day). -- -- Allowed values: [0,31] -- -- Default value: 0 -- calendarDay :: CalendarClass self => Attr self Int calendarDay = newAttrFromIntProperty "day" #if GTK_CHECK_VERSION(2,4,0) -- | Determines whether a heading is displayed. -- -- Default value: @True@ -- calendarShowHeading :: CalendarClass self => Attr self Bool calendarShowHeading = newAttrFromBoolProperty "show-heading" -- | Determines whether day names are displayed. -- -- Default value: @True@ -- calendarShowDayNames :: CalendarClass self => Attr self Bool calendarShowDayNames = newAttrFromBoolProperty "show-day-names" -- | Determines whether the selected month can be changed. -- -- Default value: @False@ -- calendarNoMonthChange :: CalendarClass self => Attr self Bool calendarNoMonthChange = newAttrFromBoolProperty "no-month-change" -- | Determines whether week numbers are displayed. -- -- Default value: @False@ -- calendarShowWeekNumbers :: CalendarClass self => Attr self Bool calendarShowWeekNumbers = newAttrFromBoolProperty "show-week-numbers" #endif -- | \'displayOptions\' property. See 'calendarGetDisplayOptions' and -- 'calendarSetDisplayOptions' -- --calendarDisplayOptions :: CalendarClass self => Attr self [CalendarDisplayOptions] --calendarDisplayOptions = newAttr -- calendarGetDisplayOptions -- calendarSetDisplayOptions -------------------- -- Signals -- | Emitted when a day was selected. -- onDaySelected, afterDaySelected :: CalendarClass self => self -> IO () -> IO (ConnectId self) onDaySelected = connect_NONE__NONE "day-selected" False afterDaySelected = connect_NONE__NONE "day-selected" True -- | Emitted when a day received a double click. -- onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass self => self -> IO () -> IO (ConnectId self) onDaySelectedDoubleClick = connect_NONE__NONE "day-selected-double-click" False afterDaySelectedDoubleClick = connect_NONE__NONE "day-selected-double-click" True -- | The month changed. -- onMonthChanged, afterMonthChanged :: CalendarClass self => self -> IO () -> IO (ConnectId self) onMonthChanged = connect_NONE__NONE "month-changed" False afterMonthChanged = connect_NONE__NONE "month-changed" True -- | The next month was selected. -- onNextMonth, afterNextMonth :: CalendarClass self => self -> IO () -> IO (ConnectId self) onNextMonth = connect_NONE__NONE "next-month" False afterNextMonth = connect_NONE__NONE "next-month" True -- | The next year was selected. -- onNextYear, afterNextYear :: CalendarClass self => self -> IO () -> IO (ConnectId self) onNextYear = connect_NONE__NONE "next-year" False afterNextYear = connect_NONE__NONE "next-year" True -- | The previous month was selected. -- onPrevMonth, afterPrevMonth :: CalendarClass self => self -> IO () -> IO (ConnectId self) onPrevMonth = connect_NONE__NONE "prev-month" False afterPrevMonth = connect_NONE__NONE "prev-month" True -- | The previous year was selected. -- onPrevYear, afterPrevYear :: CalendarClass self => self -> IO () -> IO (ConnectId self) onPrevYear = connect_NONE__NONE "prev-year" False afterPrevYear = connect_NONE__NONE "prev-year" True gtk-0.15.9/Graphics/UI/Gtk/Misc/DrawingArea.chs0000644000000000000000000000741407346545000017152 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget DrawingArea -- -- Author : Axel Simon -- -- Created: 22 September 2002 -- -- 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget for custom user interface elements -- module Graphics.UI.Gtk.Misc.DrawingArea ( -- * Detail -- -- | The 'DrawingArea' widget is used for creating custom user interface -- elements. It's essentially a blank widget; you can draw on -- the 'Drawable' returned by 'drawingAreaGetDrawWindow'. -- -- After creating a drawing area, the application may want to connect to: -- -- * Mouse and button press signals to respond to input from the user. -- -- * The 'realize' signal to take any necessary actions when the widget is -- instantiated on a particular display. (Create GDK resources in response to -- this signal.) -- -- * The 'configureEvent' signal to take any necessary actions when the -- widget changes size. -- -- * The 'exposeEvent' signal to handle redrawing the contents of the -- widget. -- -- Expose events are normally delivered when a drawing area first comes -- onscreen, or when it's covered by another window and then uncovered -- (exposed). You can also force an expose event by adding to the \"damage -- region\" of the drawing area's window; 'widgetQueueDrawArea' and -- 'windowInvalidateRect' are equally good ways to do this. You\'ll then get an -- expose event for the invalid region. -- -- The available routines for drawing are documented on the GDK Drawing -- Primitives page. -- -- To receive mouse events on a drawing area, you will need to enable them -- with 'widgetAddEvents'. To receive keyboard events, you will need to set the -- 'widgetCanFocus' attribute on the drawing area, and should probably draw some -- user-visible indication that the drawing area is focused. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----DrawingArea -- @ -- * Types DrawingArea, DrawingAreaClass, castToDrawingArea, gTypeDrawingArea, toDrawingArea, -- * Constructors drawingAreaNew, -- * Methods #if GTK_MAJOR_VERSION < 3 drawingAreaGetDrawWindow, drawingAreaGetSize #endif ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Structs (widgetGetDrawWindow, widgetGetSize) #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new drawing area. -- drawingAreaNew :: IO DrawingArea drawingAreaNew = makeNewObject mkDrawingArea $ liftM (castPtr :: Ptr Widget -> Ptr DrawingArea) $ {# call unsafe drawing_area_new #} #if GTK_MAJOR_VERSION < 3 -- | See 'widgetGetDrawWindow' -- -- Removed in Gtk3. drawingAreaGetDrawWindow :: DrawingArea -> IO DrawWindow drawingAreaGetDrawWindow = widgetGetDrawWindow {-# DEPRECATED drawingAreaGetDrawWindow "use widgetGetDrawWindow instead" #-} -- | See 'widgetGetSize' -- -- Removed in Gtk3. drawingAreaGetSize :: DrawingArea -> IO (Int, Int) drawingAreaGetSize = widgetGetSize {-# DEPRECATED drawingAreaGetSize "use widgetGetSize instead" #-} #endif gtk-0.15.9/Graphics/UI/Gtk/Misc/EventBox.chs0000644000000000000000000001172607346545000016521 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget EventBox -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget used to catch events for widgets which do not have their own -- window -- module Graphics.UI.Gtk.Misc.EventBox ( -- * Detail -- -- | The 'EventBox' widget is a subclass of 'Bin' which also has its own -- window. It is useful since it allows you to catch events for widgets which -- do not have their own window. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----EventBox -- @ -- * Types EventBox, EventBoxClass, castToEventBox, gTypeEventBox, toEventBox, -- * Constructors eventBoxNew, -- * Methods #if GTK_CHECK_VERSION(2,4,0) eventBoxSetVisibleWindow, eventBoxGetVisibleWindow, eventBoxSetAboveChild, eventBoxGetAboveChild, -- * Attributes eventBoxVisibleWindow, eventBoxAboveChild, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'EventBox'. -- eventBoxNew :: IO EventBox eventBoxNew = makeNewObject mkEventBox $ liftM (castPtr :: Ptr Widget -> Ptr EventBox) $ {# call unsafe event_box_new #} -------------------- -- Methods #if GTK_CHECK_VERSION(2,4,0) -- | Set whether the event box uses a visible or invisible child window. The -- default is to use visible windows. -- -- In an invisible window event box, the window that that the event box -- creates is a \"input only\" window, which means that it is invisible and only -- serves to receive events. -- -- A visible window event box creates a visible (\"input output\") window that -- acts as the parent window for all the widgets contained in the event box. -- -- You should generally make your event box invisible if you just want to -- trap events. Creating a visible window may cause artifacts that are visible -- to the user, especially if the user is using a theme with gradients or -- pixmaps. -- -- The main reason to create a non input-only event box is if you want to -- set the background to a different color or draw on it. -- -- * Available since Gtk+ version 2.4 -- eventBoxSetVisibleWindow :: EventBox -> Bool -> IO () eventBoxSetVisibleWindow self visibleWindow = {# call event_box_set_visible_window #} self (fromBool visibleWindow) -- | Returns whether the event box has a visible window. See -- 'eventBoxSetVisibleWindow' for details. -- -- * Available since Gtk+ version 2.4 -- eventBoxGetVisibleWindow :: EventBox -> IO Bool eventBoxGetVisibleWindow self = liftM toBool $ {# call unsafe event_box_get_visible_window #} self -- | Set whether the event box window is positioned above the windows of its -- child, as opposed to below it. If the window is above, all events inside the -- event box will go to the event box. If the window is below, events in -- windows of child widgets will first got to that widget, and then to its -- parents. -- -- The default is to keep the window below the child. -- -- * Available since Gtk+ version 2.4 -- eventBoxSetAboveChild :: EventBox -> Bool -> IO () eventBoxSetAboveChild self aboveChild = {# call event_box_set_above_child #} self (fromBool aboveChild) -- | Returns whether the event box window is above or below the windows of its -- child. See 'eventBoxSetAboveChild' for details. -- -- * Available since Gtk+ version 2.4 -- eventBoxGetAboveChild :: EventBox -> IO Bool eventBoxGetAboveChild self = liftM toBool $ {# call unsafe event_box_get_above_child #} self -------------------- -- Attributes -- | Whether the event box is visible, as opposed to invisible and only used -- to trap events. -- -- Default value: @True@ -- eventBoxVisibleWindow :: Attr EventBox Bool eventBoxVisibleWindow = newAttr eventBoxGetVisibleWindow eventBoxSetVisibleWindow -- | Whether the event-trapping window of the eventbox is above the window of -- the child widget as opposed to below it. -- -- Default value: @False@ -- eventBoxAboveChild :: Attr EventBox Bool eventBoxAboveChild = newAttr eventBoxGetAboveChild eventBoxSetAboveChild #endif gtk-0.15.9/Graphics/UI/Gtk/Misc/HandleBox.chs0000644000000000000000000001726607346545000016640 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HandleBox -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- a widget for detachable window portions -- module Graphics.UI.Gtk.Misc.HandleBox ( -- * Detail -- -- | The 'HandleBox' widget allows a portion of a window to be \"torn off\". -- It is a bin widget which displays its child and a handle that the user can -- drag to tear off a separate window (the float window) containing the child -- widget. A thin ghost is drawn in the original location of the handlebox. By -- dragging the separate window back to its original location, it can be -- reattached. -- -- When reattaching, the ghost and float window, must be aligned along one -- of the edges, the snap edge. This either can be specified by the application -- programmer explicitly, or Gtk+ will pick a reasonable default based on the -- handle position. -- -- To make detaching and reattaching the handlebox as minimally confusing as -- possible to the user, it is important to set the snap edge so that the snap -- edge does not move when the handlebox is detached. For instance, if the -- handlebox is packed at the bottom of a VBox, then when the handlebox is -- detached, the bottom edge of the handlebox's allocation will remain fixed as -- the height of the handlebox shrinks, so the snap edge should be set to -- 'PosBottom'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----HandleBox -- @ -- * Types HandleBox, HandleBoxClass, castToHandleBox, gTypeHandleBox, toHandleBox, -- * Constructors handleBoxNew, -- * Methods ShadowType(..), handleBoxSetShadowType, handleBoxGetShadowType, PositionType(..), handleBoxSetHandlePosition, handleBoxGetHandlePosition, handleBoxSetSnapEdge, handleBoxGetSnapEdge, -- * Attributes handleBoxShadowType, handleBoxHandlePosition, handleBoxSnapEdge, handleBoxSnapEdgeSet, -- * Signals onChildAttached, afterChildAttached, onChildDetached, afterChildDetached, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (ShadowType(..), PositionType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new handle box. -- handleBoxNew :: IO HandleBox handleBoxNew = makeNewObject mkHandleBox $ liftM (castPtr :: Ptr Widget -> Ptr HandleBox) $ {# call unsafe handle_box_new #} -------------------- -- Methods -- | Sets the type of shadow to be drawn around the border of the handle box. -- handleBoxSetShadowType :: HandleBoxClass self => self -> ShadowType -> IO () handleBoxSetShadowType self type_ = {# call handle_box_set_shadow_type #} (toHandleBox self) ((fromIntegral . fromEnum) type_) -- | Gets the type of shadow drawn around the handle box. See -- 'handleBoxSetShadowType'. -- handleBoxGetShadowType :: HandleBoxClass self => self -> IO ShadowType -- ^ returns the type of shadow currently drawn around the -- handle box. handleBoxGetShadowType self = liftM (toEnum . fromIntegral) $ {# call unsafe handle_box_get_shadow_type #} (toHandleBox self) -- | Sets the side of the handlebox where the handle is drawn. -- handleBoxSetHandlePosition :: HandleBoxClass self => self -> PositionType -- ^ @position@ - the side of the handlebox where the handle -- should be drawn. -> IO () handleBoxSetHandlePosition self position = {# call handle_box_set_handle_position #} (toHandleBox self) ((fromIntegral . fromEnum) position) -- | Gets the handle position of the handle box. See -- 'handleBoxSetHandlePosition'. -- handleBoxGetHandlePosition :: HandleBoxClass self => self -> IO PositionType -- ^ returns the current handle position. handleBoxGetHandlePosition self = liftM (toEnum . fromIntegral) $ {# call unsafe handle_box_get_handle_position #} (toHandleBox self) -- | Sets the snap edge of the HandleBox. The snap edge is the edge of the -- detached child that must be aligned with the corresponding edge of the -- \"ghost\" left behind when the child was detached to reattach the torn-off -- window. Usually, the snap edge should be chosen so that it stays in the same -- place on the screen when the handlebox is torn off. -- -- If the snap edge is not set, then an appropriate value will be guessed -- from the handle position. If the handle position is 'PosRight' or 'PosLeft', -- then the snap edge will be 'PosTop', otherwise it will be 'PosLeft'. -- handleBoxSetSnapEdge :: HandleBoxClass self => self -> PositionType -> IO () handleBoxSetSnapEdge self edge = {# call handle_box_set_snap_edge #} (toHandleBox self) ((fromIntegral . fromEnum) edge) -- | Gets the edge used for determining reattachment of the handle box. See -- 'handleBoxSetSnapEdge'. -- handleBoxGetSnapEdge :: HandleBoxClass self => self -> IO PositionType handleBoxGetSnapEdge self = liftM (toEnum . fromIntegral) $ {# call unsafe handle_box_get_snap_edge #} (toHandleBox self) -------------------- -- Attributes -- | Appearance of the shadow that surrounds the container. -- -- Default value: 'ShadowEtchedOut' -- handleBoxShadowType :: HandleBoxClass self => Attr self ShadowType handleBoxShadowType = newAttr handleBoxGetShadowType handleBoxSetShadowType -- | Position of the handle relative to the child widget. -- -- Default value: 'PosLeft' -- handleBoxHandlePosition :: HandleBoxClass self => Attr self PositionType handleBoxHandlePosition = newAttr handleBoxGetHandlePosition handleBoxSetHandlePosition -- | Side of the handlebox that's lined up with the docking point to dock the -- handlebox. -- -- Default value: 'PosTop' -- handleBoxSnapEdge :: HandleBoxClass self => Attr self PositionType handleBoxSnapEdge = newAttr handleBoxGetSnapEdge handleBoxSetSnapEdge -- | Whether to use the value from the snap_edge property or a value derived -- from handle_position. -- -- Default value: @False@ -- handleBoxSnapEdgeSet :: HandleBoxClass self => Attr self Bool handleBoxSnapEdgeSet = newAttrFromBoolProperty "snap-edge-set" -------------------- -- Signals -- Note: for these two signals we ignore the given Widget in the handler. -- | This signal is emitted when the contents of the handlebox are reattached -- to the main window. -- onChildAttached, afterChildAttached :: HandleBoxClass self => self -> IO () -> IO (ConnectId self) onChildAttached = connect_NONE__NONE "child-attached" False afterChildAttached = connect_NONE__NONE "child-attached" True -- | This signal is emitted when the contents of the handlebox are detached -- from the main window. -- onChildDetached, afterChildDetached :: HandleBoxClass self => self -> IO () -> IO (ConnectId self) onChildDetached = connect_NONE__NONE "child-detached" False afterChildDetached = connect_NONE__NONE "child-detached" True gtk-0.15.9/Graphics/UI/Gtk/Misc/IMContextSimple.chs0000644000000000000000000000570607346545000020014 0ustar0000000000000000{-# LANGUAGE CPP, ScopedTypeVariables #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget IMContextSimple -- -- Author : Andy Stewart -- -- Created: 24 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- An input method context supporting table-based input methods -- module Graphics.UI.Gtk.Misc.IMContextSimple ( -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'IMContext' -- | +----IMContextSimple -- @ -- * Types IMContextSimple, IMContextSimpleClass, castToIMContextSimple, toIMContextSimple, -- * Constructors imContextSimpleNew, -- * Methods imContextSimpleAddTable, ) where import Control.Monad (liftM) import Data.Map (Map) import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} import qualified Data.Map as M -------------------- -- Constructors -- | Creates a new 'IMContextSimple'. -- imContextSimpleNew :: IO IMContextSimple imContextSimpleNew = wrapNewGObject mkIMContextSimple $ liftM castPtr {# call gtk_im_context_simple_new #} -------------------- -- Methods -- | Adds an additional table to search to the input context. Each row of the table consists of -- @maxSeqLen@ key symbols followed by two 'Int' interpreted as the high and low words of a gunicode -- value. Tables are searched starting from the last added. -- -- The table must be sorted in dictionary order on the numeric value of the key symbol fields. (Values -- beyond the length of the sequence should be zero.) -- imContextSimpleAddTable :: (IMContextSimpleClass self, GlibString string) => self -> Map string string -- ^ @data@ - the table -> Int -- ^ @maxSeqLen@ - Maximum length of a sequence in the table -- (cannot be greater than 'MaxComposeLen') -> Int -- ^ @nSeqs@ - number of sequences in the table -> IO () imContextSimpleAddTable self table maxSeqLen nSeqs = do tableList <- mapM (\(x,y) -> do nx <- newUTFString x ny <- newUTFString y return (nx, ny)) (M.toList table) withArray (concatMap (\(x,y) -> [x, y]) tableList) $ \(tablePtr :: Ptr CString) -> {# call gtk_im_context_simple_add_table #} (toIMContextSimple self) (castPtr tablePtr) (fromIntegral maxSeqLen) (fromIntegral nSeqs) gtk-0.15.9/Graphics/UI/Gtk/Misc/IMMulticontext.chs0000644000000000000000000000407607346545000017714 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget IMMulticontext -- -- Author : Colin McQuillan -- -- Created: 30 April 2009 -- -- Copyright (C) 2009 Colin McQuillan -- -- 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) -- -- An input method context supporting multiple, loadable input methods -- module Graphics.UI.Gtk.Misc.IMMulticontext ( -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'IMContext' -- | +----IMMulticontext -- @ -- * Types IMMulticontext, IMMulticontextClass, castToIMMulticontext, gTypeIMMulticontext, toIMMulticontext, -- * Constructors imMulticontextNew, -- * Methods imMulticontextAppendMenuitems, ) where import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'IMMulticontext'. -- imMulticontextNew :: IO IMContext imMulticontextNew = wrapNewGObject mkIMContext $ {# call im_multicontext_new #} -------------------- -- Methods -- | Add menuitems for various available input methods to a menu; the -- menuitems, when selected, will switch the input method for the context and -- the global default input method. -- imMulticontextAppendMenuitems :: (IMMulticontextClass self, MenuShellClass menushell) => self -> menushell -- ^ @menushell@ - a 'MenuShell' -> IO () imMulticontextAppendMenuitems self menushell = {# call im_multicontext_append_menuitems #} (toIMMulticontext self) (toMenuShell menushell) gtk-0.15.9/Graphics/UI/Gtk/Misc/SizeGroup.chs0000644000000000000000000001511207346545000016707 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget SizeGroup -- -- Author : Duncan Coutts -- -- Created: 2 August 2004 -- -- Copyright (C) 2004-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) -- -- Grouping widgets so they request the same size -- module Graphics.UI.Gtk.Misc.SizeGroup ( -- * Detail -- -- | 'SizeGroup' provides a mechanism for grouping a number of widgets -- together so they all request the same amount of space. This is typically -- useful when you want a column of widgets to have the same size, but you -- can't use a 'Table' widget. -- -- In detail, the size requested for each widget in a 'SizeGroup' is the -- maximum of the sizes that would have been requested for each widget in the -- size group if they were not in the size group. The mode of the size group -- (see 'sizeGroupSetMode') determines whether this applies to the horizontal -- size, the vertical size, or both sizes. -- -- Note that size groups only affect the amount of space requested, not the -- size that the widgets finally receive. If you want the widgets in a -- 'SizeGroup' to actually be the same size, you need to pack them in such a -- way that they get the size they request and not more. For example, if you -- are packing your widgets into a table, you would not include the -- 'Graphics.UI.Gtk.Layout.Table.Fill' flag. -- -- Widgets can be part of multiple size groups; Gtk+ will compute the -- horizontal size of a widget from the horizontal requisition of all widgets -- that can be reached from the widget by a chain of size groups of type -- 'SizeGroupHorizontal' or 'SizeGroupBoth', and the vertical size from the -- vertical requisition of all widgets that can be reached from the widget by a -- chain of size groups of type 'SizeGroupVertical' or 'SizeGroupBoth'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----SizeGroup -- @ -- * Types SizeGroup, SizeGroupClass, castToSizeGroup, gTypeSizeGroup, toSizeGroup, -- * Constructors sizeGroupNew, -- * Methods SizeGroupMode(..), sizeGroupSetMode, sizeGroupGetMode, sizeGroupAddWidget, sizeGroupRemoveWidget, #if GTK_CHECK_VERSION(2,8,0) sizeGroupSetIgnoreHidden, sizeGroupGetIgnoreHidden, #endif -- * Attributes sizeGroupMode, #if GTK_CHECK_VERSION(2,8,0) sizeGroupIgnoreHidden, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} {# enum SizeGroupMode {underscoreToCase} #} -------------------- -- Constructors -- | Create a new 'SizeGroup'. -- sizeGroupNew :: SizeGroupMode -- ^ @mode@ - the mode for the new size group. -> IO SizeGroup sizeGroupNew mode = wrapNewGObject mkSizeGroup $ {# call unsafe size_group_new #} ((fromIntegral . fromEnum) mode) -------------------- -- Methods -- | Adds a widget to a 'SizeGroup'. In the future, the requisition of the -- widget will be determined as the maximum of its requisition and the -- requisition of the other widgets in the size group. Whether this applies -- horizontally, vertically, or in both directions depends on the mode of the -- size group. See 'sizeGroupSetMode'. -- sizeGroupAddWidget :: (SizeGroupClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the 'Widget' to add -> IO () sizeGroupAddWidget self widget = {# call size_group_add_widget #} (toSizeGroup self) (toWidget widget) -- | Gets the current mode of the size group. See 'sizeGroupSetMode'. -- sizeGroupGetMode :: SizeGroupClass self => self -> IO SizeGroupMode -- ^ returns the current mode of the size group. sizeGroupGetMode self = liftM (toEnum . fromIntegral) $ {# call unsafe size_group_get_mode #} (toSizeGroup self) -- | Removes a widget from a 'SizeGroup'. -- sizeGroupRemoveWidget :: (SizeGroupClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - the 'Widget' to remove -> IO () sizeGroupRemoveWidget self widget = {# call size_group_remove_widget #} (toSizeGroup self) (toWidget widget) -- | Sets the 'SizeGroupMode' of the size group. The mode of the size group -- determines whether the widgets in the size group should all have the same -- horizontal requisition 'SizeGroupHorizontal' all have the same vertical -- requisition 'SizeGroupVertical', or should all have the same requisition -- in both directions 'SizeGroupBoth'. -- sizeGroupSetMode :: SizeGroupClass self => self -> SizeGroupMode -- ^ @mode@ - the mode to set for the size group. -> IO () sizeGroupSetMode self mode = {# call size_group_set_mode #} (toSizeGroup self) ((fromIntegral . fromEnum) mode) #if GTK_CHECK_VERSION(2,8,0) -- | Sets whether invisible widgets should be ignored when calculating the -- size. -- -- * Available since Gtk+ version 2.8 -- sizeGroupSetIgnoreHidden :: SizeGroupClass self => self -> Bool -- ^ @ignoreHidden@ - whether hidden widgets should be ignored when -- calculating the size -> IO () sizeGroupSetIgnoreHidden self ignoreHidden = {# call gtk_size_group_set_ignore_hidden #} (toSizeGroup self) (fromBool ignoreHidden) -- | Returns if invisible widgets are ignored when calculating the size. -- -- * Available since Gtk+ version 2.8 -- sizeGroupGetIgnoreHidden :: SizeGroupClass self => self -> IO Bool -- ^ returns @True@ if invisible widgets are ignored. sizeGroupGetIgnoreHidden self = liftM toBool $ {# call gtk_size_group_get_ignore_hidden #} (toSizeGroup self) #endif -------------------- -- Attributes -- | The directions in which the size group affects the requested sizes of its -- component widgets. -- -- Default value: 'SizeGroupHorizontal' -- sizeGroupMode :: SizeGroupClass self => Attr self SizeGroupMode sizeGroupMode = newAttr sizeGroupGetMode sizeGroupSetMode #if GTK_CHECK_VERSION(2,8,0) -- | If @True@, hidden widgets are ignored when determining the size of the -- group. -- -- Default value: @False@ -- sizeGroupIgnoreHidden :: SizeGroupClass self => Attr self Bool sizeGroupIgnoreHidden = newAttr sizeGroupGetIgnoreHidden sizeGroupSetIgnoreHidden #endif gtk-0.15.9/Graphics/UI/Gtk/Misc/Tooltip.chs0000644000000000000000000002056107346545000016416 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Tooltip -- -- Author : Andy Stewart -- -- Created: 24 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Add tips to your widgets -- -- * Module available since Gtk+ version 2.12 -- module Graphics.UI.Gtk.Misc.Tooltip ( -- * Detail -- -- | 'Tooltip' belongs to the new tooltips API that was introduced in Gtk+ -- 2.12 and which deprecates the old 'Tooltips' API. -- -- Basic tooltips can be realized simply by using 'widgetTooltipText' or -- 'widgetTooltipMarkup' without any explicit tooltip object. -- -- When you need a tooltip with a little more fancy contents, like adding an -- image, or you want the tooltip to have different contents per 'TreeView' row -- or cell, you will have to do a little more work: -- -- * Set the 'hasTooltip' property to 'True', this will make GTK+ monitor the widget for motion and -- related events which are needed to determine when and where to show a tooltip. -- -- * Connect to the 'queryTooltip' signal. This signal will be emitted when a tooltip is supposed to -- be shown. One of the arguments passed to the signal handler is a 'Tooltip' object. This is the -- object that we are about to display as a tooltip, and can be manipulated in your callback using -- functions like 'tooltipSetIcon'. There are functions for setting the tooltip's markup, -- setting an image from a stock icon, or even putting in a custom widget. -- -- * Return 'True' from your query-tooltip handler. This causes the tooltip to be show. If you return -- 'False', it will not be shown. -- -- In the probably rare case where you want to have even more control over the tooltip that is about to -- be shown, you can set your own 'Window' which will be used as tooltip window. This works as -- follows: -- -- * Set 'hasTooltip' and connect to 'queryTooltip' as before. -- -- * Use 'widgetSetTooltipWindow' to set a 'Window' created by you as tooltip window. -- -- * In the 'queryTooltip' callback you can access your window using 'widgetGetTooltipWindow' -- and manipulate as you wish. The semantics of the return value are exactly as before, return 'True' -- to show the window, 'False' to not show it. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----Tooltip -- @ #if GTK_CHECK_VERSION(2,12,0) -- * Types Tooltip, TooltipClass, castToTooltip, toTooltip, -- * Methods tooltipSetMarkup, tooltipSetText, tooltipSetIcon, tooltipSetIconFromStock, #if GTK_CHECK_VERSION(2,14,0) tooltipSetIconFromIconName, #endif tooltipSetCustom, tooltipTriggerTooltipQuery, tooltipSetTipArea, #ifdef HAVE_GIO #if GTK_CHECK_VERSION(2,20,0) tooltipSetIconFromGIcon, #endif #endif #endif ) where #if GTK_CHECK_VERSION(2,12,0) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.General.Structs (IconSize(..), Rectangle) {#import Graphics.UI.Gtk.Types#} #ifdef HAVE_GIO {#import System.GIO.Types#} #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Sets the text of the tooltip to be @markup@, which is marked up with the -- Pango text markup language. If @markup@ is 'Nothing', the label will be hidden. -- tooltipSetMarkup :: (TooltipClass self, GlibString markup) => self -> Maybe markup -- ^ @markup@ - a markup string (see Pango markup format) or 'Nothing' -> IO () tooltipSetMarkup self markup = maybeWith withUTFString markup $ \markupPtr -> {# call gtk_tooltip_set_markup #} (toTooltip self) markupPtr -- | Sets the text of the tooltip to be @text@. If @text@ is 'Nothing' -- the label will be hidden. See also 'tooltipSetMarkup'. -- tooltipSetText :: (TooltipClass self, GlibString string) => self -> Maybe string -- ^ @text@ - a text string or 'Nothing' -> IO () tooltipSetText self text = maybeWith withUTFString text $ \textPtr -> {# call gtk_tooltip_set_text #} (toTooltip self) textPtr -- | Sets the icon of the tooltip (which is in front of the text) to be -- @pixbuf@. If @pixbuf@ is 'Nothing' the image will be hidden. -- tooltipSetIcon :: TooltipClass self => self -> Maybe Pixbuf -- ^ @pixbuf@ - a 'Pixbuf' or 'Nothing' -> IO () tooltipSetIcon self pixbuf = {#call tooltip_set_icon#} (toTooltip self) (fromMaybe (Pixbuf nullForeignPtr) pixbuf) -- | Sets the icon of the tooltip (which is in front of the text) to be the -- stock item indicated by @stockId@ with the size indicated by @size@. If -- @stockId@ is 'Nothing' the image will be hidden. -- tooltipSetIconFromStock :: (TooltipClass self, GlibString string) => self -> Maybe string -- ^ @id@ a stock id, or 'Nothing' -> IconSize -- ^ @size@ a stock icon size -> IO () tooltipSetIconFromStock self id size = maybeWith withUTFString id $ \ idPtr -> {#call tooltip_set_icon_from_stock#} (toTooltip self) idPtr ((fromIntegral . fromEnum) size) #if GTK_CHECK_VERSION(2,14,0) -- | Sets the icon of the tooltip (which is in front of the text) to be the -- icon indicated by @iconName@ with the size indicated by @size@. If -- @iconName@ is 'Nothing' the image will be hidden. -- -- * Available since Gtk+ version 2.14 -- tooltipSetIconFromIconName :: (TooltipClass self, GlibString string) => self -> Maybe string -- ^ @iconName@ an icon name, or 'Nothing' -> IconSize -- ^ @size@ a stock icon size -> IO () tooltipSetIconFromIconName self iconName size = maybeWith withUTFString iconName $ \ iconPtr -> {#call tooltip_set_icon_from_icon_name#} (toTooltip self) iconPtr ((fromIntegral . fromEnum) size) #endif -- | Replaces the widget packed into the tooltip with @customWidget@. -- @customWidget@ does not get destroyed when the tooltip goes away. By default -- a box with a 'Image' and 'Label' is embedded in the tooltip, which can be -- configured using 'tooltipSetMarkup' and 'tooltipSetIcon'. -- tooltipSetCustom :: (TooltipClass self, WidgetClass widget) => self -> Maybe widget -- ^ @customWidget@ a 'Widget', or 'Nothing' to unset the old custom widget. -> IO () tooltipSetCustom self customWidget = {#call tooltip_set_custom#} (toTooltip self) (maybe (Widget nullForeignPtr) toWidget customWidget) -- | Triggers a new tooltip query on @display@, in order to update the current -- visible tooltip, or to show\/hide the current tooltip. This function is -- useful to call when, for example, the state of the widget changed by a key -- press. -- tooltipTriggerTooltipQuery :: Display -- ^ @display@ - a 'Display' -> IO () tooltipTriggerTooltipQuery display = {# call gtk_tooltip_trigger_tooltip_query #} display -- | Sets the area of the widget, where the contents of this tooltip apply, to -- be @rect@ (in widget coordinates). This is especially useful for properly -- setting tooltips on 'TreeView' rows and cells, 'IconView' -- -- For setting tooltips on 'TreeView', please refer to the convenience -- functions for this: 'treeViewSetTooltipRow' and 'treeViewSetTooltipCell'. -- tooltipSetTipArea :: TooltipClass self => self -> Rectangle -> IO () tooltipSetTipArea self rect = with rect $ \ rectPtr -> {#call tooltip_set_tip_area#} (toTooltip self) (castPtr rectPtr) #endif #ifdef HAVE_GIO #if GTK_CHECK_VERSION(2,20,0) -- | Sets the icon of the tooltip (which is in front of the text) to be the icon indicated by gicon with -- the size indicated by size. If gicon is 'Nothing', the image will be hidden. tooltipSetIconFromGIcon :: TooltipClass self => self -> Maybe Icon -- ^ @gicon@ a GIcon representing the icon, or 'Nothing'. allow-none. -> IconSize -> IO () tooltipSetIconFromGIcon tooltip icon size = {#call gtk_tooltip_set_icon_from_gicon #} (toTooltip tooltip) (fromMaybe (Icon nullForeignPtr) icon) ((fromIntegral . fromEnum) size) #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Misc/Tooltips.chs0000644000000000000000000001247307346545000016604 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Tooltips -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Add tips to your widgets -- module Graphics.UI.Gtk.Misc.Tooltips ( -- * Detail -- -- | Tooltips are the messages that appear next to a widget when the mouse -- pointer is held over it for a short amount of time. They are especially -- helpful for adding more verbose descriptions of things such as buttons in a -- toolbar. -- -- An individual tooltip belongs to a group of tooltips. A group is created -- with a call to 'tooltipsNew'. Every tooltip in the group can then be turned -- off with a call to 'tooltipsDisable' and enabled with 'tooltipsEnable'. -- #ifndef DISABLE_DEPRECATED -- The length of time the user must keep the mouse over a widget before the -- tip is shown, can be altered with 'tooltipsSetDelay'. This is set on a \'per -- group of tooltips\' basis. -- #endif -- To assign a tip to a particular 'Widget', 'tooltipsSetTip' is used. -- -- To associate 'Tooltips' to a widget it is has to have its own 'DrawWindow'. -- Otherwise the widget must be set into an 'EventBox'. -- -- The default appearance of all tooltips in a program is determined by the -- current Gtk+ theme that the user has selected. -- -- Information about the tooltip (if any) associated with an arbitrary -- widget can be retrieved using 'tooltipsDataGet'. -- -- * This module is deprecated. It is empty in Gtk3. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----Tooltips -- @ #if GTK_MAJOR_VERSION < 3 -- * Types Tooltips, TooltipsClass, castToTooltips, gTypeTooltips, toTooltips, -- * Constructors tooltipsNew, -- * Methods tooltipsEnable, tooltipsDisable, #ifndef DISABLE_DEPRECATED tooltipsSetDelay, #endif tooltipsSetTip, tooltipsDataGet #endif ) where #if GTK_MAJOR_VERSION < 3 import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new group of 'Tooltips'. -- tooltipsNew :: IO Tooltips tooltipsNew = makeNewObject mkTooltips $ {# call unsafe tooltips_new #} -------------------- -- Methods -- | Allows the user to see your tooltips as they navigate your application. -- tooltipsEnable :: TooltipsClass self => self -> IO () tooltipsEnable self = {# call unsafe tooltips_enable #} (toTooltips self) -- | Causes all tooltips in @tooltips@ to become inactive. Any widgets that -- have tips associated with that group will no longer display their tips until -- they are enabled again with 'tooltipsEnable'. -- tooltipsDisable :: TooltipsClass self => self -> IO () tooltipsDisable self = {# call unsafe tooltips_disable #} (toTooltips self) #ifndef DISABLE_DEPRECATED -- | Sets the time between the user moving the mouse over a widget and the -- widget's tooltip appearing. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. -- tooltipsSetDelay :: TooltipsClass self => self -> Int -- ^ @delay@ - the delay in milliseconds -> IO () tooltipsSetDelay self delay = {# call unsafe tooltips_set_delay #} (toTooltips self) (fromIntegral delay) #endif -- | Adds a tooltip containing the message @tipText@ to the specified -- 'Widget'. -- tooltipsSetTip :: (TooltipsClass self, WidgetClass widget, GlibString string) => self -> widget -- ^ @widget@ - the 'Widget' you wish to associate the tip with. -> string -- ^ @tipText@ - a string containing the tip itself. -> string -- ^ @tipPrivate@ - a string of any further information that may be -- useful if the user gets stuck. -> IO () tooltipsSetTip self widget tipText tipPrivate = withUTFString tipPrivate $ \tipPrivatePtr -> withUTFString tipText $ \tipTextPtr -> {# call unsafe tooltips_set_tip #} (toTooltips self) (toWidget widget) tipTextPtr tipPrivatePtr -- | Retrieves any 'Tooltips' previously associated with the given widget. -- tooltipsDataGet :: (WidgetClass w, GlibString string) => w -> IO (Maybe (Tooltips, string, string)) tooltipsDataGet w = do tipDataPtr <- {#call unsafe tooltips_data_get#} (toWidget w) if tipDataPtr == nullPtr then return Nothing else do --next line is a hack, tooltips struct member is at offset 0 tooltips <- makeNewObject mkTooltips (return $ castPtr tipDataPtr) tipText <- {#get TooltipsData->tip_text#} tipDataPtr >>= peekUTFString tipPrivate <- {#get TooltipsData->tip_private#} tipDataPtr >>= peekUTFString return $ Just $ (tooltips, tipText, tipPrivate) #endif gtk-0.15.9/Graphics/UI/Gtk/Misc/Viewport.chs0000644000000000000000000001366007346545000016605 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Viewport -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- Issues: -- -- The binding of this widget is superfluous as far as I can tell. -- -- The only signal this widget registers is \"set-scroll-adjustments\". It is -- not bound because it is meant to be received by the 'Viewport' -- and sent by 'ScrolledWindow'. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- An adapter which makes widgets scrollable -- module Graphics.UI.Gtk.Misc.Viewport ( -- * Detail -- -- | A 'Viewport' is a helper widget that adds Adjustment slots to a -- widget, i.e. the widget becomes scrollable. It can then be put into -- 'ScrolledWindow' and will behave as expected. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Viewport -- @ -- * Types Viewport, ViewportClass, ShadowType(..), castToViewport, gTypeViewport, toViewport, -- * Constructors viewportNew, -- * Methods viewportGetHAdjustment, viewportGetVAdjustment, viewportSetHAdjustment, viewportSetVAdjustment, viewportSetShadowType, viewportGetShadowType, #if GTK_CHECK_VERSION(2,20,0) viewportGetBinWindow, #endif #if GTK_CHECK_VERSION(2,22,0) viewportGetViewWindow, #endif -- * Attributes viewportHAdjustment, viewportVAdjustment, viewportShadowType, ) where import Control.Monad (liftM) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (ShadowType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Viewport' with the given adjustments. -- viewportNew :: Maybe Adjustment -- ^ @hadjustment@ - horizontal adjustment. -> Maybe Adjustment -- ^ @vadjustment@ - vertical adjustment. -> IO Viewport viewportNew hadjustment vadjustment = makeNewObject mkViewport $ liftM (castPtr :: Ptr Widget -> Ptr Viewport) $ {# call unsafe viewport_new #} (fromMaybe (Adjustment nullForeignPtr) hadjustment) (fromMaybe (Adjustment nullForeignPtr) vadjustment) -------------------- -- Methods -- | Returns the horizontal adjustment of the viewport. -- viewportGetHAdjustment :: ViewportClass self => self -> IO Adjustment viewportGetHAdjustment self = makeNewObject mkAdjustment $ {# call unsafe viewport_get_hadjustment #} (toViewport self) -- | Returns the vertical adjustment of the viewport. -- viewportGetVAdjustment :: ViewportClass self => self -> IO Adjustment viewportGetVAdjustment self = makeNewObject mkAdjustment $ {# call unsafe viewport_get_vadjustment #} (toViewport self) -- | Sets the horizontal adjustment of the viewport. -- viewportSetHAdjustment :: ViewportClass self => self -> Adjustment -> IO () viewportSetHAdjustment self adjustment = {# call viewport_set_hadjustment #} (toViewport self) adjustment -- | Sets the vertical adjustment of the viewport. -- viewportSetVAdjustment :: ViewportClass self => self -> Adjustment -> IO () viewportSetVAdjustment self adjustment = {# call viewport_set_vadjustment #} (toViewport self) adjustment -- | Sets the shadow type of the viewport. -- viewportSetShadowType :: ViewportClass self => self -> ShadowType -- ^ @type@ - the new shadow type. -> IO () viewportSetShadowType self type_ = {# call viewport_set_shadow_type #} (toViewport self) ((fromIntegral . fromEnum) type_) -- | Gets the shadow type of the 'Viewport'. See 'viewportSetShadowType'. -- viewportGetShadowType :: ViewportClass self => self -> IO ShadowType -- ^ returns the shadow type viewportGetShadowType self = liftM (toEnum . fromIntegral) $ {# call unsafe viewport_get_shadow_type #} (toViewport self) #if GTK_CHECK_VERSION(2,20,0) -- | Gets the bin window of the 'Viewport'. -- -- * Available since Gtk version 2.20 -- viewportGetBinWindow :: ViewportClass self => self -> IO DrawWindow viewportGetBinWindow self = makeNewGObject mkDrawWindow $ {#call gtk_viewport_get_bin_window #} (toViewport self) #endif #if GTK_CHECK_VERSION(2,22,0) -- | Gets the view window of the 'Viewport'. -- -- * Available since Gtk+ version 2.22 -- viewportGetViewWindow :: ViewportClass self => self -> IO DrawWindow viewportGetViewWindow self = makeNewGObject mkDrawWindow $ {#call gtk_viewport_get_view_window #} (toViewport self) #endif -------------------- -- Attributes -- | The 'Adjustment' that determines the values of the horizontal position -- for this viewport. -- viewportHAdjustment :: ViewportClass self => Attr self Adjustment viewportHAdjustment = newAttr viewportGetHAdjustment viewportSetHAdjustment -- | The 'Adjustment' that determines the values of the vertical position for -- this viewport. -- viewportVAdjustment :: ViewportClass self => Attr self Adjustment viewportVAdjustment = newAttr viewportGetVAdjustment viewportSetVAdjustment -- | Determines how the shadowed box around the viewport is drawn. -- -- Default value: 'ShadowIn' -- viewportShadowType :: ViewportClass self => Attr self ShadowType viewportShadowType = newAttr viewportGetShadowType viewportSetShadowType -------------------- -- Signals gtk-0.15.9/Graphics/UI/Gtk/ModelView.chs0000644000000000000000000000670307346545000015766 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) New model-based tree/list widget system -- -- Author : Duncan Coutts -- -- Created: 9 December 2006 -- -- Copyright (C) 2006 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) -- -- New model-based tree\/list widget system. -- -- This just re-exports the Graphics.UI.Gtk.ModelView.* modules. -- -- * Note: From this version of Gtk2Hs this system will be the default -- so it will not be necessary to explicitly import this module. -- module Graphics.UI.Gtk.ModelView ( module Graphics.UI.Gtk.ModelView.CellLayout, module Graphics.UI.Gtk.ModelView.CellRenderer, module Graphics.UI.Gtk.ModelView.CellRendererCombo, module Graphics.UI.Gtk.ModelView.CellRendererPixbuf, module Graphics.UI.Gtk.ModelView.CellRendererProgress, module Graphics.UI.Gtk.ModelView.CellRendererText, module Graphics.UI.Gtk.ModelView.CellRendererToggle, module Graphics.UI.Gtk.ModelView.CellView, module Graphics.UI.Gtk.MenuComboToolbar.ComboBox, #if GTK_MAJOR_VERSION < 3 module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry, #endif module Graphics.UI.Gtk.ModelView.CustomStore, module Graphics.UI.Gtk.Entry.EntryCompletion, module Graphics.UI.Gtk.ModelView.IconView, module Graphics.UI.Gtk.ModelView.ListStore, module Graphics.UI.Gtk.ModelView.TreeDrag, module Graphics.UI.Gtk.ModelView.TreeModel, module Graphics.UI.Gtk.ModelView.TreeModelSort, module Graphics.UI.Gtk.ModelView.TreeSortable, module Graphics.UI.Gtk.ModelView.TreeRowReference, module Graphics.UI.Gtk.ModelView.TreeSelection, module Graphics.UI.Gtk.ModelView.TreeStore, module Graphics.UI.Gtk.ModelView.TreeView, module Graphics.UI.Gtk.ModelView.TreeViewColumn ) where import Graphics.UI.Gtk.ModelView.CellLayout import Graphics.UI.Gtk.ModelView.CellRenderer import Graphics.UI.Gtk.ModelView.CellRendererCombo import Graphics.UI.Gtk.ModelView.CellRendererPixbuf import Graphics.UI.Gtk.ModelView.CellRendererProgress import Graphics.UI.Gtk.ModelView.CellRendererText import Graphics.UI.Gtk.ModelView.CellRendererToggle import Graphics.UI.Gtk.ModelView.CellView import Graphics.UI.Gtk.MenuComboToolbar.ComboBox -- these moved back to MenuComboToolbar #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry #endif import Graphics.UI.Gtk.ModelView.CustomStore import Graphics.UI.Gtk.Entry.EntryCompletion -- this moved back to Entry import Graphics.UI.Gtk.ModelView.IconView import Graphics.UI.Gtk.ModelView.ListStore import Graphics.UI.Gtk.ModelView.TreeDrag import Graphics.UI.Gtk.ModelView.TreeModel import Graphics.UI.Gtk.ModelView.TreeModelSort import Graphics.UI.Gtk.ModelView.TreeSortable import Graphics.UI.Gtk.ModelView.TreeRowReference import Graphics.UI.Gtk.ModelView.TreeSelection import Graphics.UI.Gtk.ModelView.TreeStore import Graphics.UI.Gtk.ModelView.TreeView import Graphics.UI.Gtk.ModelView.TreeViewColumn gtk-0.15.9/Graphics/UI/Gtk/ModelView/0000755000000000000000000000000007346545000015261 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellEditable.chs0000644000000000000000000001020707346545000020271 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface CellEditable -- -- Author : Andy Stewart -- -- Created: 26 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Interface for widgets which can are used for editing cells -- module Graphics.UI.Gtk.ModelView.CellEditable ( -- * Detail -- -- | The 'CellEditable' interface must be implemented for widgets to be usable -- when editing the contents of a 'TreeView' cell. -- * Class Hierarchy -- -- | -- @ -- | 'GInterface' -- | +----CellEditable -- @ -- * Types CellEditable, CellEditableClass, castToCellEditable, toCellEditable, -- * Methods cellEditableStartEditing, cellEditableEmitEditingDone, cellEditableEmitRemoveWidget, -- * Attributes #if GTK_CHECK_VERSION(2,20,0) cellEditableEditingCanceled, #endif -- * Signals cellEditableEditingDone, cellEditableRemoveWidget, ) where import Control.Monad.Reader.Class (ask) import Control.Monad.Trans (liftIO) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Begins editing on a @cellEditable@. @event@ is the 'Event' that began the editing process. -- cellEditableStartEditing :: CellEditableClass self => self -> EventM EAny () cellEditableStartEditing self = do eventPtr <- ask liftIO $ {# call gtk_cell_editable_start_editing #} (toCellEditable self) (castPtr eventPtr) -- | Emits the 'cellEditableEditingDone' signal. -- cellEditableEmitEditingDone :: CellEditableClass self => self -> IO () cellEditableEmitEditingDone self = {# call gtk_cell_editable_editing_done #} (toCellEditable self) -- | Emits the 'cellEditableRemoveWidget' signal. -- cellEditableEmitRemoveWidget :: CellEditableClass self => self -> IO () cellEditableEmitRemoveWidget self = {# call gtk_cell_editable_remove_widget #} (toCellEditable self) -------------------- -- Attributes #if GTK_CHECK_VERSION(2,20,0) -- | Indicates whether editing on the cell has been canceled. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- cellEditableEditingCanceled :: CellEditableClass self => Attr self Bool cellEditableEditingCanceled = newAttrFromBoolProperty "editing-canceled" #endif -------------------- -- Signals -- | This signal is a sign for the cell renderer to update its value from the -- @cellEditable@. -- -- Implementations of 'CellEditable' are responsible for emitting this -- signal when they are done editing, e.g. 'Entry' is emitting it when the user -- presses Enter. -- -- 'cellEditableEmitEditingDone' is a convenience method for emitting -- ::editing-done. -- cellEditableEditingDone :: CellEditableClass self => Signal self (IO ()) cellEditableEditingDone = Signal (connect_NONE__NONE "editing_done") -- | This signal is meant to indicate that the cell is finished editing, and -- the widget may now be destroyed. -- -- Implementations of 'CellEditable' are responsible for emitting this -- signal when they are done editing. It must be emitted after the -- 'cellEditableEditingDone' signal, to give the cell -- renderer a chance to update the cell's value before the widget is removed. -- -- 'cellEditableEmitRemoveWidget' is a convenience method for emitting -- ::remove-widget. -- cellEditableRemoveWidget :: CellEditableClass self => Signal self (IO ()) cellEditableRemoveWidget = Signal (connect_NONE__NONE "remove_widget") gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellLayout.chs0000644000000000000000000002725507346545000020050 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface CellLayout -- -- Author : Axel Simon -- -- Created: 23 January 2006 -- -- Copyright (C) 2006 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) -- -- An interface for packing cells -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ModelView.CellLayout ( -- * Detail -- -- | 'CellLayout' is an interface which is implemented by all objects which -- provide a 'TreeViewColumn' API for packing cells, setting attributes and data funcs. -- * Class Hierarchy -- | -- @ -- | Interface CellLayout -- | +----'TreeViewColumn' -- | +----'CellView' -- | +----'IconView' -- | +----'EntryCompletion' -- | +----'ComboBox' -- | +----'ComboBoxEntry' -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types CellLayoutClass, toCellLayout, -- * Methods cellLayoutPackStart, cellLayoutPackEnd, cellLayoutReorder, cellLayoutClear, cellLayoutClearAttributes, #if GTK_CHECK_VERSION(2,12,0) cellLayoutGetCells, #endif cellLayoutAddColumnAttribute, cellLayoutSetAttributes, cellLayoutSetAttributeFunc, #endif ) where import System.Glib.FFI import System.Glib.GList import System.Glib.Attributes import System.Glib.GType {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.Types#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} {#import Graphics.UI.Gtk.ModelView.CustomStore#} (treeModelGetRow) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) #if GTK_CHECK_VERSION(2,6,0) instance CellLayoutClass CellView instance CellLayoutClass IconView #endif instance CellLayoutClass EntryCompletion instance CellLayoutClass TreeViewColumn instance CellLayoutClass ComboBox #if GTK_MAJOR_VERSION < 3 instance CellLayoutClass ComboBoxEntry #endif -------------------- -- Methods -- | Packs the @cell@ into the beginning of the cell layout. If @expand@ is -- @False@, then the @cell@ is allocated no more space than it needs. Any -- unused space is divided evenly between cells for which @expand@ is @True@. -- -- Note that reusing the same cell renderer is not supported. -- cellLayoutPackStart :: (CellLayoutClass self, CellRendererClass cell) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> Bool -- ^ @expand@ - @True@ if @cell@ is to be given extra space -- allocated to @cellLayout@. -> IO () cellLayoutPackStart self cell expand = {# call gtk_cell_layout_pack_start #} (toCellLayout self) (toCellRenderer cell) (fromBool expand) -- | Adds the @cell@ to the end of @cellLayout@. If @expand@ is @False@, then -- the @cell@ is allocated no more space than it needs. Any unused space is -- divided evenly between cells for which @expand@ is @True@. -- -- Note that reusing the same cell renderer is not supported. -- cellLayoutPackEnd :: (CellLayoutClass self, CellRendererClass cell) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> Bool -- ^ @expand@ - @True@ if @cell@ is to be given extra space -- allocated to @cellLayout@. -> IO () cellLayoutPackEnd self cell expand = {# call gtk_cell_layout_pack_end #} (toCellLayout self) (toCellRenderer cell) (fromBool expand) -- | Re-inserts @cell@ at @position@. Note that @cell@ has already to be -- packed into @cellLayout@ for this to function properly. -- cellLayoutReorder :: (CellLayoutClass self, CellRendererClass cell) => self -> cell -- ^ @cell@ - A 'CellRenderer' to reorder. -> Int -- ^ @position@ - New position to insert @cell@ at. -> IO () cellLayoutReorder self cell position = {# call gtk_cell_layout_reorder #} (toCellLayout self) (toCellRenderer cell) (fromIntegral position) -- | Remove all renderers from the cell layout. -- cellLayoutClear :: CellLayoutClass self => self -> IO () cellLayoutClear self = {# call gtk_cell_layout_clear #} (toCellLayout self) #if GTK_CHECK_VERSION(2,12,0) -- | Returns the cell renderers which have been added to @cellLayout@. -- -- * Available since Gtk+ version 2.12 -- cellLayoutGetCells :: CellLayoutClass self => self -> IO [CellRenderer] -- ^ returns a list of cell renderers cellLayoutGetCells self = {# call gtk_cell_layout_get_cells #} (toCellLayout self) >>= fromGList >>= mapM (makeNewGObject mkCellRenderer . return) #endif -- | Adds an attribute mapping to the renderer @cell@. The @column@ is -- the 'ColumnId' of the model to get a value from, and the @attribute@ is the -- parameter on @cell@ to be set from the value. So for example if column 2 of -- the model contains strings, you could have the \"text\" attribute of a -- 'CellRendererText' get its values from column 2. -- cellLayoutAddColumnAttribute :: (CellLayoutClass self, CellRendererClass cell) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> ReadWriteAttr cell a v -- ^ @attribute@ - An attribute of a renderer. -> ColumnId row v -- ^ @column@ - The virtual column of the model from which to -- retrieve the attribute. -> IO () cellLayoutAddColumnAttribute self cell attr column = withCString (show attr) $ \attributePtr -> {# call gtk_cell_layout_add_attribute #} (toCellLayout self) (toCellRenderer cell) attributePtr (fromIntegral (columnIdToNumber column)) -- | Specify how a row of the @model@ defines the -- attributes of the 'CellRenderer' @cell@. This is a convenience wrapper -- around 'cellLayoutSetAttributeFunc' in that it sets the cells of the @cell@ -- with the data retrieved from the model. -- -- * Note on using 'Graphics.UI.Gtk.ModelView.TreeModelSort.TreeModelSort' and -- 'Graphics.UI.Gtk.ModelView.TreeModelFilter.TreeModelFilter': These two models -- wrap another model, the so-called child model, instead of storing their own -- data. This raises the problem that the data of cell renderers must be set -- using the child model, while the 'TreeIter's that the view works with refer to -- the model that encapsulates the child model. For convenience, this function -- transparently translates an iterator to the child model before extracting the -- data using e.g. 'Graphics.UI.Gtk.TreeModel.TreeModelSort.treeModelSortConvertIterToChildIter'. -- Hence, it is possible to install the encapsulating model in the view and to -- pass the child model to this function. -- cellLayoutSetAttributes :: (CellLayoutClass self, CellRendererClass cell, TreeModelClass (model row), TypedTreeModelClass model) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> model row -- ^ @model@ - A model containing rows of type @row@. -> (row -> [AttrOp cell]) -- ^ Function to set attributes on the cell renderer. -> IO () cellLayoutSetAttributes self cell model attributes = cellLayoutSetAttributeFunc self cell model $ \iter -> do row <- treeModelGetRow model iter set cell (attributes row) -- | Install a function that looks up a row in the model and sets the -- attributes of the 'CellRenderer' @cell@ using the row's content. -- cellLayoutSetAttributeFunc :: (CellLayoutClass self, CellRendererClass cell, TreeModelClass model) => self -> cell -- ^ @cell@ - A 'CellRenderer'. -> model -- ^ @model@ - A model from which to draw data. -> (TreeIter -> IO ()) -- ^ Function to set attributes on the cell renderer. -> IO () cellLayoutSetAttributeFunc self cell model func = do fPtr <- mkSetAttributeFunc $ \_ cellPtr' modelPtr' iterPtr _ -> do iter <- convertIterFromParentToChildModel iterPtr modelPtr' (toTreeModel model) let (CellRenderer cellPtr) = toCellRenderer cell if unsafeForeignPtrToPtr cellPtr /= cellPtr' then error ("cellLayoutSetAttributeFunc: attempt to set attributes of "++ "a different CellRenderer.") else func iter {#call gtk_cell_layout_set_cell_data_func #} (toCellLayout self) (toCellRenderer cell) fPtr (castFunPtrToPtr fPtr) destroyFunPtr {#pointer CellLayoutDataFunc#} foreign import ccall "wrapper" mkSetAttributeFunc :: (Ptr CellLayout -> Ptr CellRenderer -> Ptr TreeModel -> Ptr TreeIter -> Ptr () -> IO ()) -> IO CellLayoutDataFunc -- Given a 'TreeModelFilter' or a 'TreeModelSort' and a 'TreeIter', get the -- child model of these models and convert the iter to an iter of the child -- model. This is an ugly internal function that is needed for some widgets -- which pass iterators to the callback function of set_cell_data_func that -- refer to some internal TreeModelFilter models that they create around the -- user model. This is a bug but since C programs mostly use the columns -- rather than the cell_layout way to extract attributes, this bug does not -- show up in many programs. Reported in the case of EntryCompletion as bug -- \#551202. -- convertIterFromParentToChildModel :: Ptr TreeIter -- ^ the iterator -> Ptr TreeModel -- ^ the model that we got from the all back -> TreeModel -- ^ the model that we actually want -> IO TreeIter convertIterFromParentToChildModel iterPtr parentModelPtr childModel = let (TreeModel modelFPtr) = childModel modelPtr = unsafeForeignPtrToPtr modelFPtr in if modelPtr==parentModelPtr then peek iterPtr else if typeInstanceIsA (castPtr parentModelPtr) gTypeTreeModelFilter then alloca $ \childIterPtr -> do treeModelFilterConvertIterToChildIter parentModelPtr childIterPtr iterPtr childPtr <- treeModelFilterGetModel parentModelPtr if childPtr==modelPtr then peek childIterPtr else convertIterFromParentToChildModel childIterPtr childPtr childModel else if typeInstanceIsA (castPtr parentModelPtr) gTypeTreeModelSort then alloca $ \childIterPtr -> do treeModelSortConvertIterToChildIter parentModelPtr childIterPtr iterPtr childPtr <- treeModelSortGetModel parentModelPtr if childPtr==modelPtr then peek childIterPtr else convertIterFromParentToChildModel childIterPtr childPtr childModel else do iter <- peek iterPtr error ("CellLayout: don't know how to convert iter "++show iter++ " from model "++show parentModelPtr++" to model "++ show modelPtr++". Is it possible that you are setting the "++ "attributes of a CellRenderer using a different model than "++ "that which was set in the view?") foreign import ccall unsafe "gtk_tree_model_filter_get_model" treeModelFilterGetModel :: Ptr TreeModel -> IO (Ptr TreeModel) foreign import ccall safe "gtk_tree_model_filter_convert_iter_to_child_iter" treeModelFilterConvertIterToChildIter :: Ptr TreeModel -> Ptr TreeIter -> Ptr TreeIter -> IO () foreign import ccall unsafe "gtk_tree_model_sort_get_model" treeModelSortGetModel :: Ptr TreeModel -> IO (Ptr TreeModel) foreign import ccall safe "gtk_tree_model_sort_convert_iter_to_child_iter" treeModelSortConvertIterToChildIter :: Ptr TreeModel -> Ptr TreeIter -> Ptr TreeIter -> IO () -- | Clears all existing attributes previously set with -- 'cellLayoutSetAttributes'. -- cellLayoutClearAttributes :: (CellLayoutClass self, CellRendererClass cell) => self -> cell -- ^ @cell@ - A 'CellRenderer' to clear the attribute mapping on. -> IO () cellLayoutClearAttributes self cell = {# call gtk_cell_layout_clear_attributes #} (toCellLayout self) (toCellRenderer cell) #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRenderer.chs0000644000000000000000000002560207346545000020333 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CellRenderer TreeView -- -- Author : Axel Simon -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2006 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) -- -- An object for rendering a cell in a list, icon or combo box widget. -- module Graphics.UI.Gtk.ModelView.CellRenderer ( -- * Detail -- -- | The 'CellRenderer' is a base class of a set of objects used for rendering -- a cell to a 'Drawable'. These objects are used primarily by the 'TreeView' -- widget, though they aren't tied to them in any specific way. It is worth -- noting that 'CellRenderer' is not a 'Widget' and cannot be treated as such. -- -- The primary use of a 'CellRenderer' is for drawing a certain graphical -- elements on a 'Drawable'. Typically, one cell renderer is used to draw many -- cells on the screen. To this extent, it isn't expected that a -- 'CellRenderer' keep any permanent state around. Instead, any state is set -- just prior to use by changing the attributes of the cell. Then, the cell is -- measured and rendered in the correct location. -- -- Beyond merely rendering a cell, cell renderers can optionally provide -- active user interface elements. A cell renderer can be activatable like -- 'Graphics.UI.Gtk.ModelView.CellRendererToggle', which toggles when it gets -- activated by a mouse click, or it can be editable like -- 'Graphics.UI.Gtk.ModelView.CellRendererText', which allows the user to edit -- the text using a 'Graphics.UI.Gtk.Entry.Entry'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----CellRenderer -- | +----'CellRendererText' -- | +----'CellRendererPixbuf' -- | +----'CellRendererProgress' -- | +----'CellRendererCombo' -- | +----'CellRendererToggle' -- @ -- * Types CellRenderer, CellRendererClass, castToCellRenderer, gTypeCellRenderer, toCellRenderer, CellRendererMode(..), -- * Methods #if GTK_CHECK_VERSION(2,6,0) cellRendererStopEditing, #endif cellRendererGetFixedSize, cellRendererSetFixedSize, -- * Attributes cellMode, cellVisible, cellSensitive, cellXAlign, cellYAlign, cellXPad, cellYPad, cellWidth, cellHeight, cellIsExpander, cellIsExpanded, cellBackground, #if GTK_MAJOR_VERSION < 3 cellBackgroundColor, #endif cellBackgroundSet, -- * Signals #if GTK_CHECK_VERSION(2,6,0) editingStarted, #endif #if GTK_CHECK_VERSION(2,4,0) editingCanceled, #endif -- * Deprecated #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,6,0) onEditingStarted, afterEditingStarted, #endif #if GTK_CHECK_VERSION(2,4,0) onEditingCanceled, afterEditingCanceled, #endif #endif ) where import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes ( Attr, WriteAttr ) import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.GC (Color) #endif {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.ModelView.Types#} {#context lib="gtk" prefix ="gtk"#} {# enum CellRendererMode {underscoreToCase} deriving (Eq) #} #if GTK_CHECK_VERSION(2,6,0) -- %hash c:75b3 d:45ca -- | Informs the cell renderer that the editing is stopped. If @canceled@ is -- @True@, the cell renderer will emit the 'editingCanceled' signal. -- -- * Available since Gtk+ version 2.6 -- cellRendererStopEditing :: CellRendererClass self => self -> Bool -- ^ @canceled@ - @True@ if the editing has been canceled -> IO () cellRendererStopEditing self canceled = {# call gtk_cell_renderer_stop_editing #} (toCellRenderer self) (fromBool canceled) #endif -- %hash c:6d51 d:dc3e -- | Returns @(width, height)@ denoting the size of the fixed size of -- @cell@. If no fixed size is set, returns @-1@ for that value. -- cellRendererGetFixedSize :: CellRendererClass self => self -> IO (Int, Int) -- ^ @(width, height)@ cellRendererGetFixedSize self = alloca $ \widthPtr -> alloca $ \heightPtr -> {# call gtk_cell_renderer_get_fixed_size #} (toCellRenderer self) widthPtr heightPtr >> peek widthPtr >>= \width -> peek heightPtr >>= \height -> return (fromIntegral width, fromIntegral height) -- %hash c:85dc d:5fd4 -- | Sets the renderer size to be explicit, independent of the properties set. -- cellRendererSetFixedSize :: CellRendererClass self => self -> Int -- ^ @width@ - the width of the cell renderer, or -1 -> Int -- ^ @height@ - the height of the cell renderer, or -1 -> IO () cellRendererSetFixedSize self width height = {# call gtk_cell_renderer_set_fixed_size #} (toCellRenderer self) (fromIntegral width) (fromIntegral height) -------------------- -- Attributes -- | Editable mode of the CellRenderer. -- -- Default value: 'CellRendererModeInert' -- cellMode :: CellRendererClass self => Attr self CellRendererMode cellMode = newAttrFromEnumProperty "mode" {# call pure unsafe gtk_cell_renderer_mode_get_type #} -- | Display the cell. -- -- Default value: @True@ -- cellVisible :: CellRendererClass self => Attr self Bool cellVisible = newAttrFromBoolProperty "visible" -- | Display the cell sensitive. -- -- Default value: @True@ -- cellSensitive :: CellRendererClass self => Attr self Bool cellSensitive = newAttrFromBoolProperty "sensitive" -- | The x-align. -- -- Allowed values: @[0,1]@ -- -- Default value: @0.5@ -- cellXAlign :: CellRendererClass self => Attr self Float cellXAlign = newAttrFromFloatProperty "xalign" -- | The y-align. -- -- Allowed values: @[0,1]@ -- -- Default value: @0.5@ -- cellYAlign :: CellRendererClass self => Attr self Float cellYAlign = newAttrFromFloatProperty "yalign" -- | The xpad. -- -- Default value: @0@ -- cellXPad :: CellRendererClass self => Attr self Int cellXPad = newAttrFromUIntProperty "xpad" -- | The ypad. -- -- Default value: @0@ -- cellYPad :: CellRendererClass self => Attr self Int cellYPad = newAttrFromUIntProperty "ypad" -- | The fixed width. -- -- Allowed values: @>= -1@ -- -- Default value: @-1@ -- cellWidth :: CellRendererClass self => Attr self Int cellWidth = newAttrFromIntProperty "width" -- | The fixed height. -- -- Allowed values: @>= -1@ -- -- Default value: @-1@ -- cellHeight :: CellRendererClass self => Attr self Int cellHeight = newAttrFromIntProperty "height" -- | Row has children. -- -- Default value: @False@ -- cellIsExpander :: CellRendererClass self => Attr self Bool cellIsExpander = newAttrFromBoolProperty "is-expander" -- | Row is an expander row, and is expanded. -- -- Default value: @False@ -- cellIsExpanded :: CellRendererClass self => Attr self Bool cellIsExpanded = newAttrFromBoolProperty "is-expanded" -- | Cell background color as a string. -- -- Default value: @\"\"@ -- cellBackground :: (CellRendererClass self, GlibString string) => WriteAttr self string cellBackground = writeAttrFromStringProperty "cell-background" #if GTK_MAJOR_VERSION < 3 -- | Cell background color as a 'Color'. -- -- Removed in Gtk3. cellBackgroundColor :: CellRendererClass self => Attr self Color cellBackgroundColor = newAttrFromBoxedStorableProperty "cell-background-gdk" {# call pure unsafe gdk_color_get_type #} #endif -- | Whether the 'cellBackground' \/ 'cellBackgroundColor' attribute is set. -- -- You can use this to reset the attribute to its default. -- -- Default value: @False@ -- cellBackgroundSet :: CellRendererClass self => Attr self Bool cellBackgroundSet = newAttrFromBoolProperty "cell-background-set" -------------------- -- Signals #if GTK_CHECK_VERSION(2,4,0) -- %hash c:eff4 d:fc12 -- | This signal gets emitted when the user cancels the process of editing a -- cell. For example, an editable cell renderer could be written to cancel -- editing when the user presses Escape. -- -- * Available since Gtk+ version 2.4 -- editingCanceled :: CellRendererClass self => Signal self (IO ()) editingCanceled = Signal (connect_NONE__NONE "editing-canceled") #if GTK_CHECK_VERSION(2,6,0) -- %hash c:41f0 d:49f -- | This signal gets emitted when a cell starts to be edited. The intended -- use of this signal is to do special setup on @editable@, e.g. adding a -- 'EntryCompletion' or setting up additional columns in a 'ComboBox'. -- -- * The widget that is passed to the handler contains the widget that is used -- by the 'CellRenderer' to interact with the user. The widget must be -- casted to the appropriate widget. For instance, a -- 'Graphics.UI.Gtk.ModelView.CellRendererText' uses an -- 'Graphics.UI.Gtk.Entry.Entry' widget, while a -- 'Graphics.UI.Gtk.ModelView.CellRendererCombo' uses a -- 'Graphics.UI.Gtk.ModelView.ComboBox.ComboBox' (if -- 'Graphics.UI.Gtk.ModelView.CellRendererCombo.cellComboHasEntry' is -- @False@) or a 'Graphics.UI.Gtk.ModelView.ComboBoxEntry.ComboBoxEntry' (if -- 'Graphics.UI.Gtk.ModelView.CellRendererCombo.cellComboHasEntry' is -- @True@). -- -- * Available since Gtk+ version 2.6 -- editingStarted :: CellRendererClass self => Signal self (Widget -> TreePath -> IO ()) editingStarted = Signal editingStartedInternal editingStartedInternal after cr act = connect_OBJECT_GLIBSTRING__NONE "editing-started" after cr $ \ce path -> act ce (stringToTreePath path) #endif #endif -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,4,0) -- %hash c:b10f onEditingCanceled :: CellRendererClass self => self -> IO () -> IO (ConnectId self) onEditingCanceled = connect_NONE__NONE "editing-canceled" False {-# DEPRECATED onEditingCanceled "instead of 'onEditingCanceled obj' use 'on obj editingCanceled'" #-} -- %hash c:808e afterEditingCanceled :: CellRendererClass self => self -> IO () -> IO (ConnectId self) afterEditingCanceled = connect_NONE__NONE "editing-canceled" True {-# DEPRECATED afterEditingCanceled "instead of 'afterEditingCanceled obj' use 'after obj editingCanceled'" #-} #if GTK_CHECK_VERSION(2,6,0) -- %hash c:6d9c onEditingStarted :: CellRendererClass self => self -> (Widget -> TreePath -> IO ()) -> IO (ConnectId self) onEditingStarted = editingStartedInternal False {-# DEPRECATED onEditingStarted "instead of 'onEditingStarted obj' use 'on obj editingStarted'" #-} -- %hash c:ef1b afterEditingStarted :: CellRendererClass self => self -> (Widget -> TreePath -> IO ()) -> IO (ConnectId self) afterEditingStarted = editingStartedInternal True {-# DEPRECATED afterEditingStarted "instead of 'afterEditingStarted obj' use 'after obj editingStarted'" #-} #endif #endif #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererAccel.chs0000644000000000000000000001211207346545000021253 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CellRendererAccel -- -- Author : Andy Stewart -- -- Created: 25 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Renders a keyboard accelerator in a cell -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.ModelView.CellRendererAccel ( -- * Detail -- -- | 'CellRendererAccel' displays a keyboard accelerator (i.e. a key -- combination like \-a). If the cell renderer is editable, the -- accelerator can be changed by simply typing the new combination. -- -- The 'CellRendererAccel' cell renderer was added in Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----'CellRendererText' -- | +----CellRendererAccel -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types CellRendererAccel, CellRendererAccelClass, castToCellRendererAccel, toCellRendererAccel, -- * Enums CellRendererAccelMode(..), -- * Constructors cellRendererAccelNew, -- * Attributes cellRendererAccelAccelKey, cellRendererAccelAccelMods, cellRendererAccelKeycode, cellRendererAccelAccelMode, -- * Signals accelEdited, accelCleared, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Gdk.Enums (Modifier) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Gdk.Keys (KeyVal, KeyCode) {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Enums {#enum CellRendererAccelMode {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Constructors -- | Creates a new 'CellRendererAccel'. -- -- * Available since Gtk+ version 2.10 -- cellRendererAccelNew :: IO CellRendererAccel cellRendererAccelNew = makeNewObject mkCellRendererAccel $ liftM castPtr $ {# call gtk_cell_renderer_accel_new #} -------------------- -- Attributes -- | The keyval of the accelerator. -- -- Allowed values: <= GMaxint -- -- Default value: 0 -- -- * Available since Gtk+ version 2.10 -- cellRendererAccelAccelKey :: CellRendererAccelClass self => Attr self Int cellRendererAccelAccelKey = newAttrFromUIntProperty "accel-key" -- | The modifier mask of the accelerator. -- -- * Available since Gtk+ version 2.10 -- cellRendererAccelAccelMods :: CellRendererAccelClass self => Attr self [Modifier] cellRendererAccelAccelMods = newAttrFromFlagsProperty "accel-mods" {# call pure unsafe gdk_modifier_type_get_type #} -- | The hardware keycode of the accelerator. Note that the hardware keycode is only relevant if the key -- does not have a keyval. Normally, the keyboard configuration should assign keyvals to all keys. -- -- Allowed values: <= GMaxint -- -- Default value: 0 -- -- * Available since Gtk+ version 2.10 -- cellRendererAccelKeycode :: CellRendererAccelClass self => Attr self Int cellRendererAccelKeycode = newAttrFromUIntProperty "keycode" -- | Determines if the edited accelerators are GTK+ accelerators. If they are, consumed modifiers are -- suppressed, only accelerators accepted by GTK+ are allowed, and the accelerators are rendered in the -- same way as they are in menus. -- -- Default value: 'CellRendererAccelModeGtk' -- -- * Available since Gtk+ version 2.10 -- cellRendererAccelAccelMode :: CellRendererAccelClass self => Attr self CellRendererAccelMode cellRendererAccelAccelMode = newAttrFromEnumProperty "accel-mode" {# call pure unsafe gtk_cell_renderer_accel_mode_get_type #} -------------------- -- Signals -- | Gets emitted when the user has selected a new accelerator. -- -- * Available since Gtk+ version 2.10 -- accelEdited :: (CellRendererAccelClass self, GlibString string) => Signal self (string -> KeyVal -> Modifier -> KeyCode -> IO ()) accelEdited = Signal (\after obj user -> connect_GLIBSTRING_INT_ENUM_INT__NONE "accel_edited" after obj (\ path keyval modifier keycode -> user path (fromIntegral keyval) modifier (fromIntegral keycode))) -- | Gets emitted when the user has removed the accelerator. -- -- * Available since Gtk+ version 2.10 -- accelCleared :: (CellRendererAccelClass self, GlibString string) => Signal self (string -> IO ()) accelCleared = Signal (connect_GLIBSTRING__NONE "accel_cleared") #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs0000644000000000000000000001043207346545000021306 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CellRendererCombo -- -- Author : Duncan Coutts -- -- Created: 2 November 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) -- -- Renders a combo box in a cell -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.ModelView.CellRendererCombo ( -- * Detail -- -- | 'CellRendererCombo' renders text in a cell like -- 'Graphics.UI.Gtk.ModelView.CellRendererText' from which it is derived. But -- while 'Graphics.UI.Gtk.ModelView.CellRendererText' offers a simple entry to -- edit the text, 'CellRendererCombo' offers a -- 'Graphics.UI.Gtk.ModelView.ComboBox' or -- 'Graphics.UI.Gtk.ModelView.ComboBoxEntry' widget to edit the text. The -- values to display in the combo box are taken from the tree model specified -- in the model property. -- -- The combo cell renderer takes care of adding a text cell renderer to the -- combo box and sets it to display the column specified by its -- 'cellTextModel' property. Further cell renderers can be added in a handler -- for the 'Graphics.UI.Gtk.ModelView.CellRenderer.editingStarted' signal. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----'CellRendererText' -- | +----CellRendererCombo -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types CellRendererCombo, CellRendererComboClass, castToCellRendererCombo, gTypeCellRendererCombo, toCellRendererCombo, -- * Constructors cellRendererComboNew, -- * Attributes cellComboHasEntry, cellComboTextModel #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes (Attr, WriteAttr, writeAttr) import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.Types#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,6,0) -------------------- -- Constructors -- | Creates a new 'CellRendererCombo'. This 'Renderer' allows for displaying -- a fixed set of options the user can choose from. -- cellRendererComboNew :: IO CellRendererCombo cellRendererComboNew = do makeNewObject mkCellRendererCombo $ liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererCombo) $ {# call gtk_cell_renderer_combo_new #} -------------------- -- Attributes -- | If @True@, the cell renderer will allow the user to enter -- values other than the ones in the popup list. -- -- Default value: @True@ -- cellComboHasEntry :: CellRendererComboClass self => Attr self Bool cellComboHasEntry = newAttrFromBoolProperty "has-entry" -- | The tuple containing a model and a column in this model that determine -- the possible strings that can be shown in the combo box. Note that this -- tree model can be a datum in the tree model that is used to populate the -- view in which the 'CellRendererCombo' is part of. In other words, it is -- possible that every 'CellRendererCombo' can show a different set of -- options on each row. -- cellComboTextModel :: ( TreeModelClass (model row), TypedTreeModelClass model, CellRendererComboClass self, GlibString string) => WriteAttr self (model row, ColumnId row string) cellComboTextModel = writeAttr setter where setter cr (model, col) = do objectSetPropertyInt "text-column" cr ((fromIntegral . columnIdToNumber) col) objectSetPropertyGObject {# call fun unsafe gtk_tree_model_get_type #} "model" cr (toTreeModel model) #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererPixbuf.chs0000644000000000000000000001140407346545000021504 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CellRendererPixbuf -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Renders a pixbuf in a cell -- module Graphics.UI.Gtk.ModelView.CellRendererPixbuf ( -- * Detail -- -- | A 'CellRendererPixbuf' can be used to render an image in a cell. It -- allows to render either a given 'Pixbuf' (set via the 'cellPixbuf' -- property) or a stock icon (set via the 'cellPixbufStockId' property). -- -- To support the tree view, 'CellRendererPixbuf' also supports rendering two -- alternative pixbufs, when the -- 'Graphics.UI.Gtk.ModelView.CellRenderer.cellIsExpander' property is @True@. -- If the this property is @True@ and the 'cellPixbufExpanderOpen' property is -- set to a pixbuf, it renders that pixbuf, if the -- 'Graphics.UI.Gtk.ModelView.CellRenderer.cellIsExpanded' property is @False@ -- and the 'cellPixbufExpanderClosed' property is set to a pixbuf, it renders -- that one. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----CellRendererPixbuf -- @ -- * Types CellRendererPixbuf, CellRendererPixbufClass, castToCellRendererPixbuf, gTypeCellRendererPixbuf, toCellRendererPixbuf, -- * Constructors cellRendererPixbufNew, -- * Attributes cellPixbuf, cellPixbufExpanderOpen, cellPixbufExpanderClosed, cellPixbufStockId, cellPixbufStockSize, cellPixbufStockDetail, #if GTK_CHECK_VERSION(2,8,0) cellPixbufIconName, cellPixbufFollowState, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes (Attr) import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new CellRendererPixbuf object. -- cellRendererPixbufNew :: IO CellRendererPixbuf cellRendererPixbufNew = makeNewObject mkCellRendererPixbuf $ liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererPixbuf) $ {# call unsafe cell_renderer_pixbuf_new #} -------------------- -- Attributes -- | The pixbuf to render. -- cellPixbuf :: CellRendererPixbufClass self => Attr self Pixbuf cellPixbuf = newAttrFromObjectProperty "pixbuf" {# call pure unsafe gdk_pixbuf_get_type #} -- | Pixbuf for open expander. -- cellPixbufExpanderOpen :: CellRendererPixbufClass self => Attr self Pixbuf cellPixbufExpanderOpen = newAttrFromObjectProperty "pixbuf-expander-open" {# call pure unsafe gdk_pixbuf_get_type #} -- | Pixbuf for closed expander. -- cellPixbufExpanderClosed :: CellRendererPixbufClass self => Attr self Pixbuf cellPixbufExpanderClosed = newAttrFromObjectProperty "pixbuf-expander-closed" {# call pure unsafe gdk_pixbuf_get_type #} -- | The stock ID of the stock icon to render. -- -- Default value: @\"\"@ -- cellPixbufStockId :: (CellRendererPixbufClass self, GlibString string) => Attr self string cellPixbufStockId = newAttrFromStringProperty "stock-id" -- | The 'IconSize' value that specifies the size of the rendered icon. -- -- Default value: 1 -- cellPixbufStockSize :: CellRendererPixbufClass self => Attr self Int cellPixbufStockSize = newAttrFromUIntProperty "stock-size" -- | Render detail to pass to the theme engine. -- -- Default value: @\"\"@ -- cellPixbufStockDetail :: (CellRendererPixbufClass self, GlibString string) => Attr self string cellPixbufStockDetail = newAttrFromStringProperty "stock-detail" #if GTK_CHECK_VERSION(2,8,0) -- | The name of the themed icon to display. This property only has an effect -- if not overridden by 'cellPixbufStockId' or 'cellPixbuf' attributes. -- -- Default value: @\"\"@ -- cellPixbufIconName :: (CellRendererPixbufClass self, GlibString string) => Attr self string cellPixbufIconName = newAttrFromStringProperty "icon-name" -- | Specifies whether the rendered pixbuf should be colorized according to -- the 'CellRendererState'. -- -- Default value: @False@ -- cellPixbufFollowState :: CellRendererPixbufClass self => Attr self Bool cellPixbufFollowState = newAttrFromBoolProperty "follow-state" #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererProgress.chs0000644000000000000000000000574707346545000022070 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CellRendererProgress -- -- Author : Duncan Coutts -- -- Created: 2 November 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) -- -- Renders numbers as progress bars -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.ModelView.CellRendererProgress ( -- * Detail -- -- | 'CellRendererProgress' renders a numeric value as a progress par in a -- cell. Additionally, it can display a text on top of the progress bar. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----CellRendererProgress -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types CellRendererProgress, CellRendererProgressClass, castToCellRendererProgress, gTypeCellRendererProgress, toCellRendererProgress, -- * Constructors cellRendererProgressNew, -- * Attributes cellProgressValue, cellProgressText, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes (Attr) import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,6,0) -------------------- -- Constructors -- | Creates a new 'CellRendererProgress'. -- cellRendererProgressNew :: IO CellRendererProgress cellRendererProgressNew = makeNewObject mkCellRendererProgress $ liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererProgress) $ {# call gtk_cell_renderer_progress_new #} -------------------- -- Attributes -- | The \"value\" property determines the percentage to which the progress -- bar will be \"filled in\". -- -- Allowed values: @[0,100]@ -- -- Default value: @0@ -- cellProgressValue :: CellRendererProgressClass self => Attr self Int cellProgressValue = newAttrFromIntProperty "value" -- | The 'cellProgressText' attribute determines the label which will be drawn -- over the progress bar. Setting this property to @Nothing@ causes the -- default label to be displayed. Setting this property to an empty string -- causes no label to be displayed. -- -- Default value: @Nothing@ -- cellProgressText :: (CellRendererProgressClass self, GlibString string) => Attr self (Maybe string) cellProgressText = newAttrFromMaybeStringProperty "text" #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererSpin.chs0000644000000000000000000000726007346545000021165 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CellRendererSpin -- -- Author : Andy Stewart -- -- Created: 25 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Renders a spin button in a cell -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.ModelView.CellRendererSpin ( -- * Detail -- -- | 'CellRendererSpin' renders text in a cell like 'CellRendererText' from -- which it is derived. But while 'CellRendererText' offers a simple entry to -- edit the text, 'CellRendererSpin' offers a 'SpinButton' widget. Of course, -- that means that the text has to be parseable as a floating point number. -- -- The range of the spinbutton is taken from the adjustment property of the -- cell renderer, which can be set explicitly or mapped to a column in the tree -- model, like all properties of cell renders. 'CellRendererSpin' also has -- properties for the climb rate and the number of digits to display. Other -- 'SpinButton' properties can be set in a handler for the start-editing -- signal. -- -- The 'CellRendererSpin' cell renderer was added in Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----'CellRendererText' -- | +----CellRendererSpin -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types CellRendererSpin, CellRendererSpinClass, castToCellRendererSpin, toCellRendererSpin, -- * Constructors cellRendererSpinNew, -- * Attributes cellRendererSpinAdjustment, cellRendererSpinClimbRate, cellRendererSpinDigits, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Constructors -- | Creates a new 'CellRendererSpin'. -- -- * Available since Gtk+ version 2.10 -- cellRendererSpinNew :: IO CellRendererSpin cellRendererSpinNew = makeNewObject mkCellRendererSpin $ liftM castPtr {# call gtk_cell_renderer_spin_new #} -------------------- -- Attributes -- | The adjustment that holds the value of the spinbutton. -- -- * Available since Gtk+ version 2.10 -- cellRendererSpinAdjustment :: CellRendererSpinClass self => Attr self Adjustment cellRendererSpinAdjustment = newAttrFromObjectProperty "adjustment" {# call pure unsafe gtk_adjustment_get_type #} -- | The acceleration rate when you hold down a button. -- -- Allowed values: >= 0 -- -- Default value: 0 -- -- * Available since Gtk+ version 2.10 -- cellRendererSpinClimbRate :: CellRendererSpinClass self => Attr self Double cellRendererSpinClimbRate = newAttrFromDoubleProperty "climb-rate" -- | The number of decimal places to display. -- -- Allowed values: <= 20 -- -- Default value: 0 -- -- * Available since Gtk+ version 2.10 -- cellRendererSpinDigits :: CellRendererSpinClass self => Attr self Int cellRendererSpinDigits = newAttrFromUIntProperty "digits" #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererSpinner.chs0000644000000000000000000000744207346545000021674 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CellRendererSpinner -- -- Author : Andy Stewart -- -- Created: 25 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Renders a spinning animation in a cell -- -- * Module available since Gtk+ version 2.20 -- module Graphics.UI.Gtk.ModelView.CellRendererSpinner ( -- * Detail -- | 'CellRendererSpinner' renders a spinning animation in a cell, very similar to 'Spinner'. It can -- often be used as an alternative to a 'CellRendererProgress' for displaying indefinite activity, -- instead of actual progress. -- -- To start the animation in a cell, set the "active" property to 'True' and increment the "pulse" -- property at regular intervals. The usual way to set the cell renderer properties for each cell is -- to bind them to columns in your tree model using e.g. 'treeViewColumnAddAttribute'. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----'CellRendererSpinner' -- @ #if GTK_CHECK_VERSION(2,20,0) -- * Types CellRendererSpinner, CellRendererSpinnerClass, castToCellRendererSpinner, toCellRendererSpinner, -- * Constructors cellRendererSpinnerNew, -- * Attributes cellRendererSpinnerActive, cellRendererSpinnerPulse, cellRendererSpinnerSize, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.General.Structs (IconSize(..)) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,20,0) -- | Returns a new cell renderer which will show a spinner to indicate activity. -- -- * Available since Gtk+ version 2.20 -- cellRendererSpinnerNew :: IO CellRendererSpinner cellRendererSpinnerNew = makeNewObject mkCellRendererSpinner $ liftM castPtr $ {#call gtk_cell_renderer_spinner_new #} -- | Whether the spinner is active (ie. shown) in the cell. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.20 -- cellRendererSpinnerActive :: CellRendererSpinnerClass self => Attr self Bool cellRendererSpinnerActive = newAttrFromBoolProperty "active" -- | Pulse of the spinner. Increment this value to draw the next frame of the spinner animation. Usually, -- you would update this value in a timeout. -- -- The 'Spinner' widget draws one full cycle of the animation per second by default. You can learn -- about the number of frames used by the theme by looking at the 'numSteps' style property and the -- duration of the cycle by looking at 'cycleDuration'. -- -- Default value: 0 -- -- * Available since Gtk+ version 2.20 -- cellRendererSpinnerPulse :: CellRendererSpinnerClass self => Attr self Int cellRendererSpinnerPulse = newAttrFromIntProperty "pulse" -- | The 'IconSize' value that specifies the size of the rendered spinner. -- -- Default value: 'IconSizeMenu' -- -- * Available since Gtk+ version 2.20 -- cellRendererSpinnerSize :: CellRendererSpinnerClass self => Attr self IconSize cellRendererSpinnerSize = newAttrFromEnumProperty "size" {# call pure unsafe gtk_icon_size_get_type #} #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererText.chs0000644000000000000000000004134607346545000021203 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CellRendererText TreeView -- -- Author : Axel Simon -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2006 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) -- -- A 'CellRenderer' which displays a single-line text. -- module Graphics.UI.Gtk.ModelView.CellRendererText ( -- * Detail -- -- | A 'CellRendererText' renders a given text in its cell, using the font, -- color and style information provided by its attributes. The text will be -- ellipsized if it is too long and the ellipsize property allows it. -- -- If the 'cellMode' is 'CellRendererModeEditable', the 'CellRendererText' -- allows the user to edit its text using an 'Entry' widget. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----CellRendererText -- | +----'CellRendererCombo' -- @ -- * Types CellRendererText, CellRendererTextClass, castToCellRendererText, gTypeCellRendererText, toCellRendererText, -- * Constructors cellRendererTextNew, -- * Methods cellRendererTextSetFixedHeightFromFont, -- * Attributes cellText, cellTextMarkup, --cellTextAttributes, cellTextSingleParagraphMode, cellTextBackground, cellTextBackgroundColor, cellTextBackgroundSet, cellTextForeground, cellTextForegroundColor, cellTextForegroundSet, cellTextEditable, cellTextEditableSet, cellTextFont, cellTextFontDesc, cellTextFamily, cellTextFamilySet, cellTextStyle, cellTextStyleSet, cellTextVariant, cellTextVariantSet, cellTextWeight, cellTextWeightSet, cellTextStretch, cellTextStretchSet, cellTextSize, cellTextSizePoints, cellTextSizeSet, cellTextScale, cellTextScaleSet, cellTextRise, cellTextRiseSet, cellTextStrikethrough, cellTextStrikethroughSet, cellTextUnderline, cellTextUnderlineSet, cellTextLanguage, cellTextLanguageSet, #if GTK_CHECK_VERSION(2,6,0) cellTextEllipsize, cellTextEllipsizeSet, cellTextWidthChars, #endif #if GTK_CHECK_VERSION(2,8,0) cellTextWrapMode, cellTextWrapWidth, #endif #if GTK_CHECK_VERSION(2,10,0) cellTextAlignment, #endif -- * Signals edited, -- * Deprecated #ifndef DISABLE_DEPRECATED onEdited, afterEdited #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Properties import System.Glib.Attributes (Attr, WriteAttr) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.ModelView.Types#} import Graphics.UI.Gtk.General.Structs () import Graphics.Rendering.Pango.Enums {#import Graphics.Rendering.Pango.BasicTypes#} ( FontDescription(..), makeNewFontDescription ) {#import Graphics.Rendering.Pango.Layout#} ( LayoutAlignment, LayoutWrapMode ) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new CellRendererText object. -- cellRendererTextNew :: IO CellRendererText cellRendererTextNew = makeNewObject mkCellRendererText $ liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererText) $ {# call unsafe cell_renderer_text_new #} -------------------- -- Methods -- | Sets the height of a renderer to explicitly be determined by the -- 'cellTextFont' and 'Graphics.UI.Gtk.ModelView.CellRenderer.cellYPad' -- attribute set on it. Further changes in these properties do not affect the -- height, so they must be accompanied by a subsequent call to this function. -- Using this function is inflexible, and should really only be used if -- calculating the size of a cell is too slow (ie, a massive number of cells -- displayed). If @numberOfRows@ is -1, then the fixed height is unset, and -- the height is determined by the properties again. -- cellRendererTextSetFixedHeightFromFont :: CellRendererTextClass self => self -> Int -- ^ @numberOfRows@ - Number of rows of text each cell renderer is -- allocated, or -1 -> IO () cellRendererTextSetFixedHeightFromFont self numberOfRows = {# call gtk_cell_renderer_text_set_fixed_height_from_font #} (toCellRendererText self) (fromIntegral numberOfRows) -------------------- -- Properties -- | Text background color as a string. -- -- Default value: @\"\"@ -- cellTextBackground :: (CellRendererClass self, GlibString string) => WriteAttr self string cellTextBackground = writeAttrFromStringProperty "background" -- | Text background color as a 'Color'. -- cellTextBackgroundColor :: CellRendererClass self => Attr self Color cellTextBackgroundColor = newAttrFromBoxedStorableProperty "background-gdk" {# call pure unsafe gdk_color_get_type #} -- | Whether the 'cellTextBackground'\/'cellTextBackgroundColor' attribute is set. -- -- Default value: @False@ -- cellTextBackgroundSet :: CellRendererClass self => Attr self Bool cellTextBackgroundSet = newAttrFromBoolProperty "background-set" -- | Whether the text can be modified by the user. -- cellTextEditable :: CellRendererTextClass self => Attr self Bool cellTextEditable = newAttrFromBoolProperty "editable" -- | Whether the 'cellTextEditable' flag affects text editability. -- cellTextEditableSet :: CellRendererTextClass self => Attr self Bool cellTextEditableSet = newAttrFromBoolProperty "editable-set" #if GTK_CHECK_VERSION(2,6,0) -- | Specifies the preferred place to ellipsize the string, if the cell -- renderer does not have enough room to display the entire string. -- Setting it to 'Graphics.Rendering.Pango.Enums.EllipsizeNone' turns off -- ellipsizing. See the 'cellTextWrapWidth' property for another way of -- making the text fit into a given width. -- -- * Available in Gtk 2.6 or higher. -- cellTextEllipsize :: CellRendererTextClass self => Attr self EllipsizeMode cellTextEllipsize = newAttrFromEnumProperty "ellipsize" {# call pure pango_ellipsize_mode_get_type #} -- | Whether the 'cellTextEllipsize' tag affects the ellipsize mode. -- -- * Available in Gtk 2.6 or higher. -- cellTextEllipsizeSet :: CellRendererTextClass self => Attr self Bool cellTextEllipsizeSet = newAttrFromBoolProperty "ellipsize-set" #endif -- | Name of the font family, e.g. Sans, Helvetica, Times, Monospace. -- cellTextFamily :: (CellRendererTextClass self, GlibString string) => Attr self string cellTextFamily = newAttrFromStringProperty "family" -- | Determines if 'cellTextFamily' has an effect. -- cellTextFamilySet :: CellRendererTextClass self => Attr self Bool cellTextFamilySet = newAttrFromBoolProperty "family-set" -- | Font description as a string. -- cellTextFont :: (CellRendererTextClass self, GlibString string) => Attr self string cellTextFont = newAttrFromStringProperty "font" -- | Font description as a 'Graphics.Rendering.Pango.FontDescription'. -- cellTextFontDesc :: CellRendererTextClass self => Attr self FontDescription cellTextFontDesc = newAttrFromBoxedOpaqueProperty makeNewFontDescription (\(FontDescription fd) act -> withForeignPtr fd act) "font-desc" {# call pure unsafe pango_font_description_get_type #} -- | Text foreground color as a string. -- -- Default value: @\"\"@ -- cellTextForeground :: (CellRendererClass self, GlibString string) => WriteAttr self string cellTextForeground = writeAttrFromStringProperty "foreground" -- | Text foreground color as a 'Color'. -- cellTextForegroundColor :: CellRendererClass self => Attr self Color cellTextForegroundColor = newAttrFromBoxedStorableProperty "foreground-gdk" {# call pure unsafe gdk_color_get_type #} -- | Whether the 'cellTextForeground'\/'cellTextForegroundColor' attribute is set. -- -- Default value: @False@ -- cellTextForegroundSet :: CellRendererClass self => Attr self Bool cellTextForegroundSet = newAttrFromBoolProperty "foreground-set" -- | The language this text is in, as an ISO code. Pango can use this as -- a hint when rendering the text. If you don't understand this parameter, -- you probably don't need it. -- cellTextLanguage :: (CellRendererTextClass self, GlibString string) => Attr self (Maybe string) cellTextLanguage = newAttrFromMaybeStringProperty "language" -- | Whether the 'cellTextLanguage' tag is used, default is @False@. -- cellTextLanguageSet :: CellRendererTextClass self => Attr self Bool cellTextLanguageSet = newAttrFromBoolProperty "language-set" -- | Define a markup string instead of a text. See 'cellText'. -- cellTextMarkup :: (CellRendererTextClass cr, GlibString string) => WriteAttr cr (Maybe string) cellTextMarkup = writeAttrFromMaybeStringProperty "markup" -- %hash c:4e25 d:f7c6 -- | Offset of text above the baseline (below the baseline if rise is -- negative). -- -- Allowed values: >= -2147483647 -- -- Default value: 0 -- cellTextRise :: CellRendererTextClass self => Attr self Int cellTextRise = newAttrFromIntProperty "rise" -- | Whether the 'cellTextRise' tag is used, default is @False@. -- cellTextRiseSet :: CellRendererTextClass self => Attr self Bool cellTextRiseSet = newAttrFromBoolProperty "rise-set" -- | Font scaling factor. Default is 1. -- cellTextScale :: CellRendererTextClass self => Attr self Double cellTextScale = newAttrFromDoubleProperty "scale" -- | Whether the 'cellTextScale' tag is used, default is @False@. -- cellTextScaleSet :: CellRendererTextClass self => Attr self Bool cellTextScaleSet = newAttrFromBoolProperty "scale-set" -- %hash c:d85f d:9cfb -- | Whether or not to keep all text in a single paragraph. -- -- Default value: @False@ -- cellTextSingleParagraphMode :: CellRendererTextClass self => Attr self Bool cellTextSingleParagraphMode = newAttrFromBoolProperty "single-paragraph-mode" -- | Font size in points. -- cellTextSize :: CellRendererTextClass self => Attr self Double cellTextSize = newAttrFromDoubleProperty "size-points" -- %hash c:d281 d:3b0c -- | Font size in points. -- -- Allowed values: >= 0 -- -- Default value: 0 -- cellTextSizePoints :: CellRendererTextClass self => Attr self Double cellTextSizePoints = newAttrFromDoubleProperty "size-points" -- | Whether the 'cellTextSize' tag is used, default is @False@. -- cellTextSizeSet :: CellRendererTextClass self => Attr self Bool cellTextSizeSet = newAttrFromBoolProperty "size-set" -- | Font stretch. -- cellTextStretch :: CellRendererTextClass self => Attr self Stretch cellTextStretch = newAttrFromEnumProperty "stretch" {# call pure pango_stretch_get_type #} -- | Whether the 'cellTextStretch' tag is used, default is @False@. -- cellTextStretchSet :: CellRendererTextClass self => Attr self Bool cellTextStretchSet = newAttrFromBoolProperty "stretch-set" -- | Whether to strike through the text. -- cellTextStrikethrough :: CellRendererTextClass self => Attr self Bool cellTextStrikethrough = newAttrFromBoolProperty "strikethrough" -- | Whether the 'cellTextStrikethrough' tag is used, default is @False@. -- cellTextStrikethroughSet :: CellRendererTextClass self => Attr self Bool cellTextStrikethroughSet = newAttrFromBoolProperty "strikethrough-set" -- | Font style (e.g. normal or italics). -- cellTextStyle :: CellRendererTextClass self => Attr self FontStyle cellTextStyle = newAttrFromEnumProperty "style" {# call pure pango_style_get_type #} -- | Whether the 'cellTextStyle' tag is used, default is @False@. -- cellTextStyleSet :: CellRendererTextClass self => Attr self Bool cellTextStyleSet = newAttrFromBoolProperty "style-set" -- | Define the attribute that specifies the text to be rendered. See -- also 'cellTextMarkup'. -- cellText :: (CellRendererTextClass cr, GlibString string) => Attr cr string cellText = newAttrFromStringProperty "text" -- | Style of underline for this text. -- cellTextUnderline :: CellRendererTextClass self => Attr self Underline cellTextUnderline = newAttrFromEnumProperty "underline" {# call pure pango_underline_get_type #} -- | Whether the 'cellTextUnderline' tag is used, default is @False@. -- cellTextUnderlineSet :: CellRendererTextClass self => Attr self Bool cellTextUnderlineSet = newAttrFromBoolProperty "underline-set" -- | Font variant (e.g. small caps). -- cellTextVariant :: CellRendererTextClass self => Attr self Variant cellTextVariant = newAttrFromEnumProperty "variant" {# call pure pango_variant_get_type #} -- | Whether the 'cellTextVariant' tag is used, default is @False@. -- cellTextVariantSet :: CellRendererTextClass self => Attr self Bool cellTextVariantSet = newAttrFromBoolProperty "variant-set" -- | Font weight, default: 400. -- cellTextWeight :: CellRendererTextClass self => Attr self Int cellTextWeight = newAttrFromIntProperty "weight" -- | Whether the 'cellTextWeight' tag is used, default is @False@. -- cellTextWeightSet :: CellRendererTextClass self => Attr self Bool cellTextWeightSet = newAttrFromBoolProperty "weight-set" #if GTK_CHECK_VERSION(2,6,0) -- | The desired width of the cell, in characters. If this property is set -- to @-1@, the width will be calculated automatically, otherwise the cell -- will request either 3 characters or the property value, whichever is -- greater. -- -- * Available in Gtk 2.6 or higher. -- cellTextWidthChars :: CellRendererTextClass self => Attr self Int cellTextWidthChars = newAttrFromIntProperty "width-chars" #endif #if GTK_CHECK_VERSION(2,8,0) -- | Specifies how to break the string into multiple lines, if the cell -- renderer does not have enough room to display the entire string. -- This property has no effect unless the 'cellTextWrapWidth' property is set. -- -- * Available in Gtk 2.8 or higher. -- cellTextWrapMode :: CellRendererTextClass self => Attr self LayoutWrapMode cellTextWrapMode = newAttrFromEnumProperty "wrap-mode" {# call pure pango_wrap_mode_get_type #} -- | Specifies the width at which the text is wrapped. The wrap-mode -- property can be used to influence at what character positions the -- line breaks can be placed. Setting wrap-width to @-1@ turns wrapping off. -- -- * Available in Gtk 2.8 or higher. -- cellTextWrapWidth :: CellRendererTextClass self => Attr self Int cellTextWrapWidth = newAttrFromIntProperty "wrap-width" #endif #if GTK_CHECK_VERSION(2,10,0) -- %hash c:a59c d:a84a -- | Specifies how to align the lines of text with respect to each other. -- -- Note that this property describes how to align the lines of text in case -- there are several of them. The -- 'Graphics.UI.Gtk.ModelView.CellRenderer.cellXAlign' property of -- 'CellRenderer', on the other hand, sets the horizontal alignment of the -- whole text. -- -- Default value: 'Graphics.Rendering.Pango.Layout.AlignLeft' -- -- * Available since Gtk+ version 2.10 -- cellTextAlignment :: CellRendererTextClass self => Attr self LayoutAlignment cellTextAlignment = newAttrFromEnumProperty "alignment" {# call pure unsafe pango_alignment_get_type #} #endif -------------------- -- Signals -- %hash c:a541 d:18f9 -- | Emitted when the user finished editing a cell. -- -- Whenever editing is finished successfully, this signal is emitted which -- indicates that the model should be updated with the supplied value. -- The value is always a string which matches the 'cellText' attribute of -- 'CellRendererText' (and its derivates like 'CellRendererCombo'). -- -- * This signal is not emitted when editing is disabled (see -- 'cellTextEditable') or when the user aborts editing. -- edited :: (CellRendererTextClass self, GlibString string) => Signal self (TreePath -> string -> IO ()) edited = Signal internalEdited -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- %hash c:76ed onEdited :: (CellRendererTextClass self, GlibString string) => self -> (TreePath -> string -> IO ()) -> IO (ConnectId self) onEdited = internalEdited False {-# DEPRECATED onEdited "instead of 'onEdited obj' use 'on obj edited'" #-} -- %hash c:f70c afterEdited :: (CellRendererTextClass self, GlibString string) => self -> (TreePath -> string -> IO ()) -> IO (ConnectId self) afterEdited = internalEdited True {-# DEPRECATED afterEdited "instead of 'afterEdited obj' use 'after obj edited'" #-} #endif internalEdited :: (CellRendererTextClass cr, GlibString string) => Bool -> cr -> (TreePath -> string -> IO ()) -> IO (ConnectId cr) internalEdited after cr user = connect_GLIBSTRING_GLIBSTRING__NONE "edited" after cr $ \path string -> do user (stringToTreePath path) string gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs0000644000000000000000000001627407346545000021502 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CellRendererToggle -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Renders a toggle button in a cell -- module Graphics.UI.Gtk.ModelView.CellRendererToggle ( -- * Detail -- -- | 'CellRendererToggle' renders a toggle button in a cell. The button is -- drawn as a radio or checkbutton, depending on the radio property. When -- activated, it emits the toggled signal. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'CellRenderer' -- | +----CellRendererToggle -- @ -- * Types CellRendererToggle, CellRendererToggleClass, castToCellRendererToggle, gTypeCellRendererToggle, toCellRendererToggle, -- * Constructors cellRendererToggleNew, -- * Methods cellRendererToggleGetRadio, cellRendererToggleSetRadio, cellRendererToggleGetActive, cellRendererToggleSetActive, -- * Attributes cellToggleActive, cellToggleInconsistent, cellToggleActivatable, cellToggleRadio, cellToggleIndicatorSize, -- * Signals cellToggled, -- * Deprecated #ifndef DISABLE_DEPRECATED onCellToggled, afterCellToggled #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes (Attr) import System.Glib.Properties (newAttrFromBoolProperty, newAttrFromIntProperty) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- %hash c:bafb d:640f -- | Creates a new 'CellRendererToggle'. Adjust rendering parameters using -- object properties. Object properties can be set globally (with -- 'System.Glib.Attributes.set'). Also, within a -- 'Graphics.UI.Gtk.ModelView.TreeViewColumn', you can bind a property to a -- value in a 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' using -- 'Graphics.UI.Gtk.ModelView.CellLayout.cellLayoutSetAttributes'. For -- example, you can bind the 'cellToggleActive' property on the cell renderer -- to a boolean value in the model, thus causing the check button to reflect -- the state of the model. -- cellRendererToggleNew :: IO CellRendererToggle cellRendererToggleNew = makeNewObject mkCellRendererToggle $ liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererToggle) $ {# call unsafe cell_renderer_toggle_new #} -------------------- -- Methods -- %hash c:133b d:c428 -- | If @radio@ is @True@, the cell renderer renders a radio toggle (i.e. a -- toggle in a group of mutually-exclusive toggles). If @False@, it renders a -- check toggle (a standalone boolean option). This can be set globally for -- the cell renderer, or changed just before rendering each cell in the model -- (for 'TreeView', you set up a per-row setting using 'TreeViewColumn' to -- associate model columns with cell renderer properties). -- cellRendererToggleSetRadio :: CellRendererToggleClass self => self -> Bool -- ^ @radio@ - @True@ to make the toggle look like a radio button -> IO () cellRendererToggleSetRadio self radio = {# call cell_renderer_toggle_set_radio #} (toCellRendererToggle self) (fromBool radio) -- %hash c:7f39 d:fe9f -- | Returns whether we\'re rendering radio toggles rather than checkboxes. -- cellRendererToggleGetRadio :: CellRendererToggleClass self => self -> IO Bool -- ^ returns @True@ if we\'re rendering radio toggles rather than -- checkboxes cellRendererToggleGetRadio self = liftM toBool $ {# call cell_renderer_toggle_get_radio #} (toCellRendererToggle self) -- %hash c:4974 d:3d45 -- | Returns whether the cell renderer is active. See -- 'cellRendererToggleSetActive'. -- cellRendererToggleGetActive :: CellRendererToggleClass self => self -> IO Bool -- ^ returns @True@ if the cell renderer is active. cellRendererToggleGetActive self = liftM toBool $ {# call unsafe cell_renderer_toggle_get_active #} (toCellRendererToggle self) -- %hash c:8420 d:5177 -- | Activates or deactivates a cell renderer. -- cellRendererToggleSetActive :: CellRendererToggleClass self => self -> Bool -- ^ @setting@ - the value to set. -> IO () cellRendererToggleSetActive self setting = {# call cell_renderer_toggle_set_active #} (toCellRendererToggle self) (fromBool setting) -------------------- -- Attributes -- %hash c:aed9 d:ab32 -- | The toggle state of the button. -- -- Default value: @False@ -- cellToggleActive :: CellRendererToggleClass self => Attr self Bool cellToggleActive = newAttrFromBoolProperty "active" -- %hash c:85c8 d:8ab1 -- | The inconsistent state of the button. -- -- Default value: @False@ -- cellToggleInconsistent :: CellRendererToggleClass self => Attr self Bool cellToggleInconsistent = newAttrFromBoolProperty "inconsistent" -- %hash c:74e5 d:e41e -- | The toggle button can be activated. -- -- Default value: @True@ -- cellToggleActivatable :: CellRendererToggleClass self => Attr self Bool cellToggleActivatable = newAttrFromBoolProperty "activatable" -- %hash c:61f2 d:5449 -- | Draw the toggle button as a radio button. -- -- Default value: @False@ -- cellToggleRadio :: CellRendererToggleClass self => Attr self Bool cellToggleRadio = newAttrFromBoolProperty "radio" -- %hash c:698 d:47b4 -- | Size of check or radio indicator. -- -- Allowed values: >= 0 -- -- Default value: 12 -- cellToggleIndicatorSize :: CellRendererToggleClass self => Attr self Int cellToggleIndicatorSize = newAttrFromIntProperty "indicator-size" -------------------- -- Signals -- %hash c:33ab d:1ba3 -- | The 'cellToggled' signal is emitted when the cell is toggled. The string -- represents a 'TreePath' into the model and can be converted using -- 'stringToTreePath'. -- cellToggled :: (CellRendererToggleClass self, GlibString string) => Signal self (string -> IO ()) cellToggled = Signal (connect_GLIBSTRING__NONE "toggled") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- %hash c:21f7 onCellToggled :: (CellRendererToggleClass self, GlibString string) => self -> (string -> IO ()) -> IO (ConnectId self) onCellToggled = connect_GLIBSTRING__NONE "toggled" False {-# DEPRECATED onCellToggled "instead of 'onCellToggled obj' use 'on obj cellToggled'" #-} -- %hash c:82f6 afterCellToggled :: (CellRendererToggleClass self, GlibString string) => self -> (string -> IO ()) -> IO (ConnectId self) afterCellToggled = connect_GLIBSTRING__NONE "toggled" True {-# DEPRECATED afterCellToggled "instead of 'afterCellToggled obj' use 'after obj cellToggled'" #-} #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CellView.chs0000644000000000000000000001326407346545000017500 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget CellView -- -- Author : Duncan Coutts -- -- Created: 4 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) -- -- A widget displaying a single row of a 'TreeModel' -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.ModelView.CellView ( -- * Detail -- -- | A 'CellView' displays a single row of a 'TreeModel', using cell renderers -- just like 'TreeView'. 'CellView' doesn't support some of the more complex -- features of 'TreeView', like cell editing and drag and drop. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----CellView -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types CellView, CellViewClass, castToCellView, gTypeCellView, toCellView, -- * Constructors cellViewNew, cellViewNewWithMarkup, cellViewNewWithPixbuf, cellViewNewWithText, -- * Methods cellViewSetModel, cellViewGetSizeOfRow, cellViewSetBackgroundColor, #if GTK_MAJOR_VERSION < 3 cellViewGetCellRenderers, #endif -- * Attributes cellViewBackground #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties (writeAttrFromStringProperty) #if GTK_MAJOR_VERSION < 3 {#import System.Glib.GList#} #endif {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.ModelView.Types#} import Graphics.UI.Gtk.General.Structs (Color, Requisition) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,6,0) -------------------- -- Constructors -- | Creates a new 'CellView' widget. -- cellViewNew :: IO CellView cellViewNew = makeNewObject mkCellView $ liftM (castPtr :: Ptr Widget -> Ptr CellView) $ {# call gtk_cell_view_new #} -- | Creates a new 'CellView' widget, adds a 'CellRendererText' to it, and -- makes its show @markup@. The text can be marked up with the Pango -- text markup language. -- cellViewNewWithMarkup :: GlibString string => string -- ^ @markup@ - the text to display in the cell view -> IO CellView cellViewNewWithMarkup markup = makeNewObject mkCellView $ liftM (castPtr :: Ptr Widget -> Ptr CellView) $ withUTFString markup $ \markupPtr -> {# call gtk_cell_view_new_with_markup #} markupPtr -- | Creates a new 'CellView' widget, adds a 'CellRendererPixbuf' to it, and -- makes its show @pixbuf@. -- cellViewNewWithPixbuf :: Pixbuf -- ^ @pixbuf@ - the image to display in the cell view -> IO CellView cellViewNewWithPixbuf pixbuf = makeNewObject mkCellView $ liftM (castPtr :: Ptr Widget -> Ptr CellView) $ {# call gtk_cell_view_new_with_pixbuf #} pixbuf -- | Creates a new 'CellView' widget, adds a 'CellRendererText' to it, and -- makes its show @text@. -- cellViewNewWithText :: GlibString string => string -- ^ @text@ - the text to display in the cell view -> IO CellView cellViewNewWithText text = makeNewObject mkCellView $ liftM (castPtr :: Ptr Widget -> Ptr CellView) $ withUTFString text $ \textPtr -> {# call gtk_cell_view_new_with_text #} textPtr -------------------- -- Methods -- | Sets the model for @cellView@. If @cellView@ already has a model set, it -- will remove it before setting the new model. If @model@ is @Nothing@, then -- it will unset the old model. -- cellViewSetModel :: (CellViewClass self, TreeModelClass model) => self -> Maybe model -- ^ @model@ - a 'TreeModel' -> IO () cellViewSetModel self model = {# call gtk_cell_view_set_model #} (toCellView self) (maybe (TreeModel nullForeignPtr) toTreeModel model) -- | Returns the size needed by the cell view to display the model -- row pointed to by @path@. -- cellViewGetSizeOfRow :: CellViewClass self => self -> TreePath -- ^ @path@ - a 'TreePath' -> IO Requisition -- ^ returns the size requisition cellViewGetSizeOfRow self path = alloca $ \requisitionPtr -> withTreePath path $ \path -> do {# call gtk_cell_view_get_size_of_row #} (toCellView self) path (castPtr requisitionPtr) peek requisitionPtr -- | Sets the background color of @view@. -- cellViewSetBackgroundColor :: CellViewClass self => self -> Color -- ^ @color@ - the new background color -> IO () cellViewSetBackgroundColor self color = with color $ \colorPtr -> {# call gtk_cell_view_set_background_color #} (toCellView self) (castPtr colorPtr) #if GTK_MAJOR_VERSION < 3 -- | Returns the cell renderers which have been added to @cellView@. -- -- Removed in Gtk3. cellViewGetCellRenderers :: CellViewClass self => self -> IO [CellRenderer] cellViewGetCellRenderers self = {# call gtk_cell_view_get_cell_renderers #} (toCellView self) >>= fromGList >>= mapM (\elemPtr -> makeNewObject mkCellRenderer (return elemPtr)) #endif -------------------- -- Attributes -- | Background color as a string. -- -- Default value: @\"\"@ -- cellViewBackground :: (CellViewClass self, GlibString string) => WriteAttr self string cellViewBackground = writeAttrFromStringProperty "background" #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/CustomStore.chs0000644000000000000000000006466607346545000020271 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) CustomStore TreeModel -- -- Author : Duncan Coutts, Axel Simon -- -- Created: 19 Sep 2005 -- -- Copyright (C) 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. -- #prune -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Allows a custom data structure to be used with the 'TreeView' and other -- widgets that follow the model-view-controller paradigm. The two models -- 'Graphics.UI.Gtk.ModelView.ListStore.ListStore' and -- 'Graphics.UI.Gtk.ModelView.TreeStore.TreeStore' are based on the -- 'CustomStore'. Even if no application-specific tree model -- should be implemented, this module is relevant in that it provides the -- functions 'customStoreSetColumn' and -- 'customStoreGetRow' functions. -- module Graphics.UI.Gtk.ModelView.CustomStore ( -- * The definition of a row-based store. CustomStore, TreeModelFlags(..), TreeModelIface(..), DragSourceIface(..), DragDestIface(..), customStoreNew, customStoreGetRow, customStoreSetColumn, customStoreGetPrivate, customStoreGetStamp, customStoreInvalidateIters, -- for backwards compatibility, not documented treeModelGetRow, treeModelSetColumn, ) where import Control.Monad (liftM) import Control.Monad.Reader (runReaderT) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (fromMaybe) import System.Glib.FFI hiding (maybeNull) import System.Glib.Flags (Flags, fromFlags) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.Types#} import Graphics.UI.Gtk.General.DNDTypes (SelectionDataM, SelectionData) {#import System.Glib.GValue#} (GValue(GValue)) {#import System.Glib.GType#} (GType) import qualified System.Glib.GTypeConstants as GConst {#import System.Glib.GValueTypes#} {#import System.Glib.GValue#} (valueInit) {# context lib="gtk" prefix="gtk" #} -- | These flags indicate various properties of a -- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel'. -- -- * If a model has 'TreeModelItersPersist' set, iterators remain valid after -- a 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' signal was emitted. -- -- * The 'TreeModelListOnly' flag is set if the rows are arranged in a simple -- flat list. This is set in the -- 'Graphics.UI.Gtk.ModelView.ListStore.ListStore' implementation. -- {#enum TreeModelFlags {underscoreToCase} deriving(Bounded)#} instance Flags TreeModelFlags -- A 'CustomStore' is backed by a Gtk2HsStore -- which is an instance of the GtkTreeModel GInterface -- it also stores some extra per-model-type private data -- | A 'CustomStore' is an instance of a Gtk+ 'TreeModel' and can thus be used -- for any widget that stores data in a 'TreeModel'. The user may either -- create an instance of a 'CustomStore' or use one of the pre-defined -- models 'Graphics.UI.Gtk.ModelView.ListStore.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore.TreeStore'. newtype CustomStore private row = CustomStore (ForeignPtr (CustomStore private row)) instance TreeModelClass (CustomStore private row) instance GObjectClass (CustomStore private row) where toGObject (CustomStore tm) = GObject (castForeignPtr tm) unsafeCastGObject = CustomStore . castForeignPtr . unGObject -- | Type synonym for viewing the store as a set of columns. type ColumnMap row = IORef [ColumnAccess row] -- | Create a new 'ColumnMap' value. columnMapNew :: IO (ColumnMap row) columnMapNew = newIORef [] -- | Set or update a column mapping. This function should be used before -- the model is installed into a widget since the number of defined -- columns are only checked once by widgets. customStoreSetColumn :: TypedTreeModelClass model => model row -- ^ the store in which to allocate a new column -> (ColumnId row ty) -- ^ the column that should be set -> (row -> ty) -- ^ the function that sets the property -> IO () customStoreSetColumn model (ColumnId _ setter colId) acc | colId<0 = return () | otherwise = case toTypedTreeModel model of TypedTreeModel model -> do ptr <- withForeignPtr model gtk2hs_store_get_impl impl <- deRefStablePtr ptr let cMap = customStoreColumns impl cols <- readIORef cMap let l = length cols if colId>=l then do let fillers = replicate (colId-l) CAInvalid writeIORef cMap (cols++fillers++[setter acc]) else do let (beg,_:end) = splitAt colId cols writeIORef cMap (beg++setter acc:end) -- this is a backwards compatibility definition treeModelSetColumn :: TypedTreeModelClass model => model row -- ^ the store in which to allocate a new column -> (ColumnId row ty) -- ^ the column that should be set -> (row -> ty) -- ^ the function that sets the property -> IO () treeModelSetColumn = customStoreSetColumn data CustomStoreImplementation model row = CustomStoreImplementation { customStoreColumns :: ColumnMap row, -- provide access via columns customStoreIface :: TreeModelIface row, -- functions implementing a tree model customTreeDragSourceIface :: DragSourceIface model row, -- the drag and drop source interface customTreeDragDestIface :: DragDestIface model row -- the drag and drop dest interface } -- | The 'TreeModelIface' structure contains all functions that are required -- to implement an application-specific 'TreeModel'. data TreeModelIface row = TreeModelIface { -- | Return the flags that are valid for this model. treeModelIfaceGetFlags :: IO [TreeModelFlags], -- | Convert an path into the tree into a more concise 'TreeIter'. -- Return @Nothing@ if the path does not exit. treeModelIfaceGetIter :: TreePath -> IO (Maybe TreeIter), -- convert a path to an iterator -- | Convert an iterator to a path. The iterator will always be valid. treeModelIfaceGetPath :: TreeIter -> IO TreePath, -- convert an iterator to a path -- | Retrieve a row at the given iterator. treeModelIfaceGetRow :: TreeIter -> IO row, -- get the row at an iter -- | Advance the given iterator to the next node at the same level. -- Return @Nothing@ if there is no next node at this level. treeModelIfaceIterNext :: TreeIter -> IO (Maybe TreeIter), -- following row (if any) -- | Advance the given iterator to the first child of this iterator. -- Return @Notihing@ if the node at this iterator has no children. treeModelIfaceIterChildren :: Maybe TreeIter -> IO (Maybe TreeIter), -- first child row (if any) -- | Check if the node at the given iterator has children. treeModelIfaceIterHasChild :: TreeIter -> IO Bool, -- row has any children at all -- | Query the number of children the the node at the given iteratore has. treeModelIfaceIterNChildren :: Maybe TreeIter -> IO Int, -- number of children of a row -- | Ask for an iterator to the @n@th child. Return @Nothing@ if -- no such child exists. treeModelIfaceIterNthChild :: Maybe TreeIter -> Int -> IO (Maybe TreeIter), -- nth child row of a given row -- | Ask for an iterator to the parent of the node. treeModelIfaceIterParent :: TreeIter -> IO (Maybe TreeIter), -- parent row of a row -- | Increase a reference count for this node. A positive reference count -- indicates that the node is used (that is, most likely it is visible) -- in at least one widget. Tracking reference counts for nodes is -- optional but may be useful to infer when a given row can be discarded -- if it was retrieved from an external source. treeModelIfaceRefNode :: TreeIter -> IO (), -- caching hint -- | Decrement the reference count of the given node. treeModelIfaceUnrefNode :: TreeIter -> IO () -- caching hint } -- | A structure containing functions that enable this widget to be used -- as a source in drag-and-drop. data DragSourceIface model row = DragSourceIface { -- | Determine if the row at the given path is draggable. Return -- @False@ if for some reason this row should not be dragged by -- the user. treeDragSourceRowDraggable :: model row -> TreePath -> IO Bool, -- query if the row is draggable -- | Fill in the 'SelectionDataM' structure with information on -- the given node using -- 'Graphics.UI.Gtk.General.Selection.selectionDataSet'. treeDragSourceDragDataGet :: model row -> TreePath -> SelectionDataM Bool, -- store row in selection object -- | The widget is informed that the row at the given path should -- be deleted as the result of this drag. treeDragSourceDragDataDelete:: model row -> TreePath -> IO Bool -- instruct store to delete the row } -- | A structure containing functions that enable this widget to be used -- as a target in drag-and-drop. data DragDestIface model row = DragDestIface { -- | Tell the drag-and-drop mechanism if the row can be dropped at the -- given path. treeDragDestRowDropPossible :: model row -> TreePath -> SelectionDataM Bool, -- query if row drop is possible -- | The data in the 'SelectionDataM' structure should be read using -- 'Graphics.UI.Gtk.General.Selection.selectionDataGet' and -- its information be used to insert a new row at the given path. treeDragDestDragDataReceived:: model row -> TreePath -> SelectionDataM Bool -- insert row from selection object } -- | Create a new store that implements the 'TreeModelIface' interface and -- optionally the 'DragSourceIface' and the 'DragDestIface'. If the latter two -- are set to @Nothing@ a dummy interface is substituted that rejects every -- drag and drop. customStoreNew :: (TreeModelClass (model row), TypedTreeModelClass model) => private -- ^ Any private data the store needs to store. Usually an 'IORef'. -> ((CustomStore private row) -> model row) -> TreeModelIface row -- ^ Functions necessary to implement the 'TreeModel' interface. -> Maybe (DragSourceIface model row) -- ^ Functions to enable this store to generate drag events. -> Maybe (DragDestIface model row) -- ^ Functions to enable this store to receive drag events. -> IO (model row) customStoreNew priv con tmIface mDragSource mDragDest = do cMap <- columnMapNew let dummyDragSource = DragSourceIface { treeDragSourceRowDraggable = \_ _ -> return False, treeDragSourceDragDataGet = \_ _ -> return False, treeDragSourceDragDataDelete = \_ _ -> return False } let dummyDragDest = DragDestIface { treeDragDestRowDropPossible = \_ _ -> return False, treeDragDestDragDataReceived = \_ _ -> return False } implPtr <- newStablePtr CustomStoreImplementation { customStoreColumns = cMap, customStoreIface = tmIface, customTreeDragSourceIface = fromMaybe dummyDragSource mDragSource, customTreeDragDestIface = fromMaybe dummyDragDest mDragDest } privPtr <- newStablePtr priv liftM con $ wrapNewGObject (CustomStore, objectUnref) $ gtk2hs_store_new implPtr privPtr foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_new" gtk2hs_store_new :: StablePtr (CustomStoreImplementation model row) -> StablePtr private -> IO (Ptr (CustomStore private row)) -- | Extract a row of the given model at the given 'TreeIter'. -- customStoreGetRow :: TypedTreeModelClass model => model row -> TreeIter -> IO row customStoreGetRow model iter = case toTypedTreeModel model of TypedTreeModel model -> do impl <- withForeignPtr model gtk2hs_store_get_impl >>= deRefStablePtr treeModelIfaceGetRow (customStoreIface impl) iter -- this is a backwards compatibility definition treeModelGetRow :: TypedTreeModelClass model => model row -> TreeIter -> IO row treeModelGetRow = customStoreGetRow foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_impl" gtk2hs_store_get_impl :: Ptr (TypedTreeModel row) -> IO (StablePtr (CustomStoreImplementation model row)) -- | Return the private data stored in this 'CustomStore'. The private data -- is meant as a container for the data stored in this model. customStoreGetPrivate :: CustomStore private row -> private customStoreGetPrivate (CustomStore model) = unsafePerformIO $ -- this is safe because the priv member is set at -- construction time and never modified after that withForeignPtr model gtk2hs_store_get_priv >>= deRefStablePtr foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_priv" gtk2hs_store_get_priv :: Ptr (CustomStore private row) -> IO (StablePtr private) -- | Query the current value of the stamp that is used to create -- 'TreeIter' iterators. The stamp is compared each time a view -- accesses this store. If the stamp doesn't match, a warning -- is emitted. The stamp should be updated each time a the data -- in the model changes. The rationale is that a view should never -- use a stale 'TreeIter', i.e., one that refers to an old model. -- customStoreGetStamp :: CustomStore private row -> IO CInt customStoreGetStamp (CustomStore model) = withForeignPtr model gtk2hs_store_get_stamp foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_stamp" gtk2hs_store_get_stamp :: Ptr (CustomStore private row) -> IO CInt -- | Create a new stamp. See 'customStoreGetStamp'. -- customStoreInvalidateIters :: CustomStore private row -> IO () customStoreInvalidateIters (CustomStore model) = withForeignPtr model gtk2hs_store_increment_stamp foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_increment_stamp" gtk2hs_store_increment_stamp :: Ptr (CustomStore private row) -> IO () treeModelIfaceGetNColumns_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt treeModelIfaceGetNColumns_static storePtr = do store <- deRefStablePtr storePtr cmap <- readIORef (customStoreColumns store) return (fromIntegral (length cmap)) foreign export ccall "gtk2hs_store_get_n_columns_impl" treeModelIfaceGetNColumns_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt -- Get the 'GType' for a given 'ColumnAccess'. caToGType :: ColumnAccess row -> GType caToGType (CAInt _) = GConst.int caToGType (CABool _) = GConst.bool caToGType (CAString _) = GConst.string caToGType (CAPixbuf _) = {#call fun unsafe gdk_pixbuf_get_type#} caToGType CAInvalid = GConst.int -- to avoid warnings of functions that iterate through all columns treeModelIfaceGetColumnType_static :: StablePtr (CustomStoreImplementation model row) -> CInt -> IO GType treeModelIfaceGetColumnType_static storePtr column = do store <- deRefStablePtr storePtr cols <- readIORef (customStoreColumns store) case drop (fromIntegral column) cols of [] -> return GConst.invalid (ca:_) -> return (caToGType ca) foreign export ccall "gtk2hs_store_get_column_type_impl" treeModelIfaceGetColumnType_static :: StablePtr (CustomStoreImplementation model row) -> CInt -> IO GType treeModelIfaceGetFlags_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt treeModelIfaceGetFlags_static storePtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr liftM (fromIntegral . fromFlags) $ treeModelIfaceGetFlags store foreign export ccall "gtk2hs_store_get_flags_impl" treeModelIfaceGetFlags_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt treeModelIfaceGetIter_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt treeModelIfaceGetIter_static storePtr iterPtr pathPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr path <- peekTreePath pathPtr iter <- treeModelIfaceGetIter store path case iter of Nothing -> return (fromBool False) Just iter -> do poke iterPtr iter return (fromBool True) foreign export ccall "gtk2hs_store_get_iter_impl" treeModelIfaceGetIter_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt treeModelIfaceGetPath_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO (Ptr NativeTreePath) treeModelIfaceGetPath_static storePtr iterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr iter <- peek iterPtr path <- treeModelIfaceGetPath store iter NativeTreePath pathPtr <- newTreePath path return pathPtr foreign export ccall "gtk2hs_store_get_path_impl" treeModelIfaceGetPath_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO (Ptr NativeTreePath) treeModelIfaceGetValue_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> CInt -> Ptr GValue -> IO () treeModelIfaceGetValue_static storePtr iterPtr column gvaluePtr = do store <- deRefStablePtr storePtr iter <- peek iterPtr row <- treeModelIfaceGetRow (customStoreIface store) iter cols <- readIORef (customStoreColumns store) let gVal = (GValue gvaluePtr) 0 <- {# get GValue->g_type #} gvaluePtr case drop (fromIntegral column) cols of [] -> valueInit gVal GConst.invalid -- column number out of range (acc:_) -> case acc of (CAInt ca) -> valueInit gVal GConst.int >> valueSetInt gVal (ca row) (CABool ca) -> valueInit gVal GConst.bool >> valueSetBool gVal (ca row) (CAString ca) -> valueInit gVal GConst.string >> valueSetString gVal (ca row) (CAPixbuf ca) -> valueInit gVal {#call fun unsafe gdk_pixbuf_get_type#} >> valueSetGObject gVal (ca row) CAInvalid -> valueInit gVal GConst.int >> valueSetInt gVal 0 foreign export ccall "gtk2hs_store_get_value_impl" treeModelIfaceGetValue_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> CInt -> Ptr GValue -> IO () treeModelIfaceIterNext_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterNext_static storePtr iterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr iter <- peek iterPtr iter' <- treeModelIfaceIterNext store iter case iter' of Nothing -> return (fromBool False) Just iter' -> do poke iterPtr iter' return (fromBool True) foreign export ccall "gtk2hs_store_iter_next_impl" treeModelIfaceIterNext_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt treeModelIfaceIterChildren_static storePtr iterPtr parentIterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr parentIter <- maybeNull peek parentIterPtr iter <- treeModelIfaceIterChildren store parentIter case iter of Nothing -> return (fromBool False) Just iter -> do poke iterPtr iter return (fromBool True) foreign export ccall "gtk2hs_store_iter_children_impl" treeModelIfaceIterChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt treeModelIfaceIterHasChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterHasChild_static storePtr iterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr iter <- peek iterPtr liftM fromBool $ treeModelIfaceIterHasChild store iter foreign export ccall "gtk2hs_store_iter_has_child_impl" treeModelIfaceIterHasChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterNChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterNChildren_static storePtr iterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr iter <- maybeNull peek iterPtr liftM fromIntegral $ treeModelIfaceIterNChildren store iter foreign export ccall "gtk2hs_store_iter_n_children_impl" treeModelIfaceIterNChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterNthChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt treeModelIfaceIterNthChild_static storePtr iterPtr parentIterPtr n = do store <- liftM customStoreIface $ deRefStablePtr storePtr parentIter <- maybeNull peek parentIterPtr iter <- treeModelIfaceIterNthChild store parentIter (fromIntegral n) case iter of Nothing -> return (fromBool False) Just iter -> do poke iterPtr iter return (fromBool True) foreign export ccall "gtk2hs_store_iter_nth_child_impl" treeModelIfaceIterNthChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt treeModelIfaceIterParent_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt treeModelIfaceIterParent_static storePtr iterPtr childIterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr childIter <- peek childIterPtr iter <- treeModelIfaceIterParent store childIter case iter of Nothing -> return (fromBool False) Just iter -> do poke iterPtr iter return (fromBool True) foreign export ccall "gtk2hs_store_iter_parent_impl" treeModelIfaceIterParent_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt treeModelIfaceRefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO () treeModelIfaceRefNode_static storePtr iterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr iter <- peek iterPtr treeModelIfaceRefNode store iter foreign export ccall "gtk2hs_store_ref_node_impl" treeModelIfaceRefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO () treeModelIfaceUnrefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO () treeModelIfaceUnrefNode_static storePtr iterPtr = do store <- liftM customStoreIface $ deRefStablePtr storePtr iter <- peek iterPtr treeModelIfaceUnrefNode store iter foreign export ccall "gtk2hs_store_unref_node_impl" treeModelIfaceUnrefNode_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO () treeDragSourceRowDraggable_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt treeDragSourceRowDraggable_static mPtr storePtr pathPtr = do model <- makeNewGObject mkTreeModel (return mPtr) store <- liftM customTreeDragSourceIface $ deRefStablePtr storePtr path <- peekTreePath pathPtr liftM fromBool $ treeDragSourceRowDraggable store (unsafeTreeModelToGeneric model) path foreign export ccall "gtk2hs_store_row_draggable_impl" treeDragSourceRowDraggable_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt treeDragSourceDragDataGet_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt treeDragSourceDragDataGet_static mPtr storePtr pathPtr selectionPtr = do model <- makeNewGObject mkTreeModel (return mPtr) store <- liftM customTreeDragSourceIface $ deRefStablePtr storePtr path <- peekTreePath pathPtr liftM fromBool $ runReaderT (treeDragSourceDragDataGet store (unsafeTreeModelToGeneric model) path) selectionPtr foreign export ccall "gtk2hs_store_drag_data_get_impl" treeDragSourceDragDataGet_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt treeDragSourceDragDataDelete_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt treeDragSourceDragDataDelete_static mPtr storePtr pathPtr = do model <- makeNewGObject mkTreeModel (return mPtr) store <- liftM customTreeDragSourceIface $ deRefStablePtr storePtr path <- peekTreePath pathPtr liftM fromBool $ treeDragSourceDragDataDelete store (unsafeTreeModelToGeneric model) path foreign export ccall "gtk2hs_store_drag_data_delete_impl" treeDragSourceDragDataDelete_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> IO CInt treeDragDestDragDataReceived_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt treeDragDestDragDataReceived_static mPtr storePtr pathPtr selectionPtr = do model <- makeNewGObject mkTreeModel (return mPtr) store <- liftM customTreeDragDestIface $ deRefStablePtr storePtr path <- peekTreePath pathPtr liftM fromBool $ runReaderT (treeDragDestDragDataReceived store (unsafeTreeModelToGeneric model) path) selectionPtr foreign export ccall "gtk2hs_store_drag_data_received_impl" treeDragDestDragDataReceived_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt treeDragDestRowDropPossible_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt treeDragDestRowDropPossible_static mPtr storePtr pathPtr selectionPtr = do model <- makeNewGObject mkTreeModel (return mPtr) store <- liftM customTreeDragDestIface $ deRefStablePtr storePtr path <- peekTreePath pathPtr liftM fromBool $ runReaderT (treeDragDestRowDropPossible store (unsafeTreeModelToGeneric model) path) selectionPtr foreign export ccall "gtk2hs_store_row_drop_possible_impl" treeDragDestRowDropPossible_static :: Ptr TreeModel -> StablePtr (CustomStoreImplementation model row) -> Ptr NativeTreePath -> SelectionData -> IO CInt maybeNull :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b) maybeNull marshal ptr | ptr == nullPtr = return Nothing | otherwise = liftM Just (marshal ptr) gtk-0.15.9/Graphics/UI/Gtk/ModelView/Gtk2HsStore.c0000644000000000000000000007556107346545000017562 0ustar0000000000000000#include "Graphics/UI/Gtk/ModelView/Gtk2HsStore.h" /* #define DEBUG */ #ifdef DEBUG #define WHEN_DEBUG(a) a #else #define WHEN_DEBUG(a) #endif static void gtk2hs_store_init (Gtk2HsStore *pkg_tree); static void gtk2hs_store_class_init (Gtk2HsStoreClass *klass); static void gtk2hs_store_tree_model_init (GtkTreeModelIface *iface); static void gtk2hs_store_tree_sortable_init (GtkTreeSortableIface *iface); static void gtk2hs_store_tree_drag_source_init (GtkTreeDragSourceIface *iface); static void gtk2hs_store_tree_drag_dest_init (GtkTreeDragDestIface *iface); static void gtk2hs_store_finalize (GObject *object); static GtkTreeModelFlags gtk2hs_store_get_flags (GtkTreeModel *tree_model); static gint gtk2hs_store_get_n_columns (GtkTreeModel *tree_model); static GType gtk2hs_store_get_column_type (GtkTreeModel *tree_model, gint index); static gboolean gtk2hs_store_get_iter (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreePath *path); static GtkTreePath *gtk2hs_store_get_path (GtkTreeModel *tree_model, GtkTreeIter *iter); static void gtk2hs_store_get_value (GtkTreeModel *tree_model, GtkTreeIter *iter, gint column, GValue *value); static gboolean gtk2hs_store_iter_next (GtkTreeModel *tree_model, GtkTreeIter *iter); static gboolean gtk2hs_store_iter_children (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent); static gboolean gtk2hs_store_iter_has_child (GtkTreeModel *tree_model, GtkTreeIter *iter); static gint gtk2hs_store_iter_n_children (GtkTreeModel *tree_model, GtkTreeIter *iter); static gboolean gtk2hs_store_iter_nth_child (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent, gint n); static gboolean gtk2hs_store_iter_parent (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *child); static void gtk2hs_store_ref_node (GtkTreeModel *tree_model, GtkTreeIter *iter); static void gtk2hs_store_unref_node (GtkTreeModel *tree_model, GtkTreeIter *iter); /* The TreeSortable interface is currently not implemented and may never be. */ static gboolean gtk2hs_store_get_sort_column_id (GtkTreeSortable *sortable, gint *sort_column_id, GtkSortType *order); static void gtk2hs_store_set_sort_column_id (GtkTreeSortable *sortable, gint sort_column_id, GtkSortType order); #if GTK_MAJOR_VERSION < 3 static void gtk2hs_store_set_sort_func (GtkTreeSortable *sortable, gint sort_column_id, GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy); static void gtk2hs_store_set_default_sort_func (GtkTreeSortable *sortable, GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy); #endif static gboolean gtk2hs_store_has_default_sort_func (GtkTreeSortable *sortable); static gboolean gtk2hs_store_row_draggable (GtkTreeDragSource *drag_source, GtkTreePath *path); static gboolean gtk2hs_store_drag_data_get (GtkTreeDragSource *drag_source, GtkTreePath *path, GtkSelectionData *selection_data); static gboolean gtk2hs_store_drag_data_delete (GtkTreeDragSource *drag_source, GtkTreePath *path); static gboolean gtk2hs_store_drag_data_received (GtkTreeDragDest *drag_dest, GtkTreePath *dest_path, GtkSelectionData *selection_data); static gboolean gtk2hs_store_row_drop_possible (GtkTreeDragDest *drag_dest, GtkTreePath *dest_path, GtkSelectionData *selection_data); static GObjectClass *parent_class = NULL; /** * * gtk2hs_store_get_type: here we register our new type and its interfaces * with the type system. If you want to implement * additional interfaces like GtkTreeSortable, you * will need to do it here. * **/ GType gtk2hs_store_get_type (void) { static GType gtk2hs_store_type = 0; if (!gtk2hs_store_type) { static const GTypeInfo gtk2hs_store_info = { sizeof (Gtk2HsStoreClass), NULL, /* base_init */ NULL, /* base_finalize */ (GClassInitFunc) gtk2hs_store_class_init, NULL, /* class finalize */ NULL, /* class_data */ sizeof (Gtk2HsStore), 0, /* n_preallocs */ (GInstanceInitFunc) gtk2hs_store_init }; static const GInterfaceInfo tree_model_info = { (GInterfaceInitFunc) gtk2hs_store_tree_model_init, NULL, NULL }; #if GTK_MAJOR_VERSION < 3 /* The TreeSortable interface is currently not implemented. */ static const GInterfaceInfo tree_sortable_info = { (GInterfaceInitFunc) gtk2hs_store_tree_sortable_init, NULL, NULL }; #endif static const GInterfaceInfo tree_drag_source_info = { (GInterfaceInitFunc) gtk2hs_store_tree_drag_source_init, NULL, NULL }; static const GInterfaceInfo tree_drag_dest_info = { (GInterfaceInitFunc) gtk2hs_store_tree_drag_dest_init, NULL, NULL }; gtk2hs_store_type = g_type_register_static (G_TYPE_OBJECT, "Gtk2HsStore", >k2hs_store_info, (GTypeFlags) 0); g_type_add_interface_static (gtk2hs_store_type, GTK_TYPE_TREE_MODEL, &tree_model_info); /* The TreeSortable interface is currently not implemented. Uncomment to add it. */ /* g_type_add_interface_static (gtk2hs_store_type, GTK_TYPE_TREE_SORTABLE, &tree_sortable_info); */ g_type_add_interface_static (gtk2hs_store_type, GTK_TYPE_TREE_DRAG_SOURCE, &tree_drag_source_info); g_type_add_interface_static (gtk2hs_store_type, GTK_TYPE_TREE_DRAG_DEST, &tree_drag_dest_info); } return gtk2hs_store_type; } /** * * gtk2hs_store_class_init: more boilerplate GObject/GType stuff. * Init callback for the type system, * called once when our new class is created. * **/ static void gtk2hs_store_class_init (Gtk2HsStoreClass *class) { WHEN_DEBUG(g_debug("calling gtk2hs_store_class_init\t\t(%p)\n", class)); GObjectClass *object_class; parent_class = g_type_class_peek_parent (class); object_class = (GObjectClass*) class; object_class->finalize = gtk2hs_store_finalize; } /** * * gtk2hs_store_tree_model_init: init callback for the interface registration * in gtk2hs_store_get_type. Here we override * the GtkTreeModel interface functions that * we implement. * **/ static void gtk2hs_store_tree_model_init (GtkTreeModelIface *iface) { WHEN_DEBUG(g_debug("calling gtk2hs_store_tree_model_init\t(%p)\n", iface)); iface->get_flags = gtk2hs_store_get_flags; iface->get_n_columns = gtk2hs_store_get_n_columns; iface->get_column_type = gtk2hs_store_get_column_type; iface->get_iter = gtk2hs_store_get_iter; iface->get_path = gtk2hs_store_get_path; iface->get_value = gtk2hs_store_get_value; iface->iter_next = gtk2hs_store_iter_next; iface->iter_children = gtk2hs_store_iter_children; iface->iter_has_child = gtk2hs_store_iter_has_child; iface->iter_n_children = gtk2hs_store_iter_n_children; iface->iter_nth_child = gtk2hs_store_iter_nth_child; iface->iter_parent = gtk2hs_store_iter_parent; iface->ref_node = gtk2hs_store_ref_node; iface->unref_node = gtk2hs_store_unref_node; } #if GTK_MAJOR_VERSION < 3 /** * * gtk2hs_store_tree_sortable_init: init callback for the interface registration * in gtk2hs_store_get_type. Here we override * the GtkTreeSortable interface functions that * we implement. * **/ /* The TreeSortable interface is currently not implemented. */ static void gtk2hs_store_tree_sortable_init (GtkTreeSortableIface *iface) { WHEN_DEBUG(g_debug("calling gtk2hs_store_tree_sortable_init\t(%p)\n", iface)); iface->get_sort_column_id = gtk2hs_store_get_sort_column_id; iface->set_sort_column_id = gtk2hs_store_set_sort_column_id; iface->set_sort_func = gtk2hs_store_set_sort_func; iface->set_default_sort_func = gtk2hs_store_set_default_sort_func; iface->has_default_sort_func = gtk2hs_store_has_default_sort_func; } #endif /** * * gtk2hs_store_tree_drag_source_init: init callback for the interface registration * in gtk2hs_store_get_type. Here we override * the GtkTreeDragSource interface functions that * we implement. * **/ static void gtk2hs_store_tree_drag_source_init (GtkTreeDragSourceIface *iface) { WHEN_DEBUG(g_debug("calling gtk2hs_store_tree_drag_source_init\t(%p)\n", iface)); iface->row_draggable = gtk2hs_store_row_draggable; iface->drag_data_get = gtk2hs_store_drag_data_get; iface->drag_data_delete = gtk2hs_store_drag_data_delete; } /** * * gtk2hs_store_tree_drag_dest_init: init callback for the interface registration * in gtk2hs_store_get_type. Here we override * the GtkTreeDragDest interface functions that * we implement. * **/ static void gtk2hs_store_tree_drag_dest_init (GtkTreeDragDestIface *iface) { WHEN_DEBUG(g_debug("calling gtk2hs_store_tree_drag_dest_init\t(%p)\n", iface)); iface->drag_data_received = gtk2hs_store_drag_data_received; iface->row_drop_possible = gtk2hs_store_row_drop_possible; } /** * * gtk2hs_store_init: this is called every time a new custom list object * instance is created (we do that in gtk2hs_store_new). * Initialise the list structure's fields here. * **/ static void gtk2hs_store_init (Gtk2HsStore *store) { WHEN_DEBUG(g_debug("calling gtk2hs_store_init\t\t(%p)\n", store)); store->stamp = g_random_int(); /* Random int to check whether an iter belongs to our model */ } /** * * gtk2hs_store_finalize: this is called just before a custom list is * destroyed. Free dynamically allocated memory here. * **/ static void gtk2hs_store_finalize (GObject *object) { WHEN_DEBUG(g_debug("calling gtk2hs_store_finalize\t(%p)\n", object)); Gtk2HsStore *store = (Gtk2HsStore *) object; g_return_if_fail(GTK2HS_IS_STORE (object)); /* free all memory used by the store */ hs_free_stable_ptr(store->impl); hs_free_stable_ptr(store->priv); /* must chain up - finalize parent */ (* parent_class->finalize) (object); } /** * * gtk2hs_store_get_flags: tells the rest of the world whether our tree model * has any special characteristics. In our case, * we have a list model (instead of a tree), and each * tree iter is valid as long as the row in question * exists, as it only contains a pointer to our struct. * **/ static GtkTreeModelFlags gtk2hs_store_get_flags (GtkTreeModel *tree_model) { WHEN_DEBUG(g_debug("calling gtk2hs_store_get_flags\t\t(%p)\n", tree_model)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), 0); GtkTreeModelFlags result = gtk2hs_store_get_flags_impl(store->impl); WHEN_DEBUG(g_debug("return gtk2hs_store_get_flags\t\t=%#x\n", result)); return result; } /** * * gtk2hs_store_get_n_columns: tells the rest of the world how many data * columns we export via the tree model interface * **/ static gint gtk2hs_store_get_n_columns (GtkTreeModel *tree_model) { WHEN_DEBUG(g_debug("calling gtk2hs_store_get_n_columns\t(%p)\n", tree_model)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), 0); gint result = gtk2hs_store_get_n_columns_impl(store->impl); WHEN_DEBUG(g_debug("return gtk2hs_store_get_n_columns\t=%d\n", result)); return result; } /** * * gtk2hs_store_get_column_type: tells the rest of the world which type of * data an exported model column contains * **/ static GType gtk2hs_store_get_column_type (GtkTreeModel *tree_model, gint index) { WHEN_DEBUG(g_debug("calling gtk2hs_store_get_column_type\t(%p, %d)\n", tree_model, index)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), G_TYPE_INVALID); GType result = gtk2hs_store_get_column_type_impl(store->impl, index); WHEN_DEBUG(g_debug("return gtk2hs_store_get_column_type\t=%s\n", g_type_name(result))); return result; } /** * * gtk2hs_store_get_iter: converts a tree path (physical position) into a * tree iter structure (the content of the iter * fields will only be used internally by our model). * **/ static gboolean gtk2hs_store_get_iter (GtkTreeModel *tree_model, GtkTreeIter *iter, /* out */ GtkTreePath *path /* in */) { WHEN_DEBUG( gchar *path_str = gtk_tree_path_to_string(path); g_debug("calling gtk2hs_store_get_iter\t\t(%p, %p, \"%s\")\n", tree_model, iter, path_str); g_free(path_str); ) Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), FALSE); gboolean result = gtk2hs_store_get_iter_impl(store->impl, iter, path); if (result) iter->stamp = store->stamp; WHEN_DEBUG(g_debug("return gtk2hs_store_get_iter\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } /** * * gtk2hs_store_get_path: converts a tree iter into a tree path (ie. the * physical position of that row in the list). * **/ static GtkTreePath * gtk2hs_store_get_path (GtkTreeModel *tree_model, GtkTreeIter *iter /* in */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_get_path\t\t(%p, %p)\n", tree_model, iter)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), NULL); g_return_val_if_fail (iter->stamp == store->stamp, NULL); GtkTreePath * result = gtk2hs_store_get_path_impl(store->impl, iter); WHEN_DEBUG( gchar *result_str = gtk_tree_path_to_string(result); g_debug("return gtk2hs_store_get_path\t\t=\"%s\"\n", result_str); g_free(result_str); ) return result; } /** * * gtk2hs_store_get_value: Returns a row's exported data columns * (_get_value is what gtk_tree_model_get uses) * **/ static void gtk2hs_store_get_value (GtkTreeModel *tree_model, GtkTreeIter *iter, /* in */ gint column, GValue *value /* out */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_get_value\t\t(%p, %p, %d, %p)\n", tree_model, iter, column, value)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_if_fail (GTK2HS_IS_STORE (tree_model)); g_return_if_fail (iter->stamp == store->stamp); gtk2hs_store_get_value_impl(store->impl, iter, column, value); WHEN_DEBUG( gchar *result = g_strdup_value_contents(value); g_debug("return gtk2hs_store_get_value\t\t=%s\n", result); g_free(result); ) } /** * * gtk2hs_store_iter_next: Takes an iter structure and sets it to point * to the next row. * **/ static gboolean gtk2hs_store_iter_next (GtkTreeModel *tree_model, GtkTreeIter *iter /* in+out */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_iter_next\t\t(%p, %p)\n", tree_model, iter)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), FALSE); gboolean result = gtk2hs_store_iter_next_impl(store->impl, iter); if (result) iter->stamp = store->stamp; WHEN_DEBUG(g_debug("return gtk2hs_store_iter_next\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } /** * * gtk2hs_store_iter_children: Returns TRUE or FALSE depending on whether * the row specified by 'parent' has any children. * If it has children, then 'iter' is set to * point to the first child. Special case: if * 'parent' is NULL, then the first top-level * row should be returned if it exists. * **/ static gboolean gtk2hs_store_iter_children (GtkTreeModel *tree_model, GtkTreeIter *iter, /* out */ GtkTreeIter *parent /* in, maybe NULL */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_iter_children\t(%p, %p, %p)\n", tree_model, iter, parent)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), FALSE); gboolean result = gtk2hs_store_iter_children_impl(store->impl, iter, parent); if (result) iter->stamp = store->stamp; WHEN_DEBUG(g_debug("return gtk2hs_store_iter_children\t=%s\n", result ? "TRUE" : "FALSE")); return result; } /** * * gtk2hs_store_iter_has_child: Returns TRUE or FALSE depending on whether * the row specified by 'iter' has any children. * **/ static gboolean gtk2hs_store_iter_has_child (GtkTreeModel *tree_model, GtkTreeIter *iter /* in */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_iter_has_child\t(%p, %p)\n", tree_model, iter)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), FALSE); /* don't check if iter->stamp == store->stamp; see the thread culminating in * http://sourceforge.net/p/gtk2hs/mailman/message/31887332/ for details */ gboolean result = gtk2hs_store_iter_has_child_impl(store->impl, iter); WHEN_DEBUG(g_debug("return gtk2hs_store_iter_has_child\t=%s\n", result ? "TRUE" : "FALSE")); return result; } /** * * gtk2hs_store_iter_n_children: Returns the number of children the row * specified by 'iter' has. This is usually 0, * as we only have a list and thus do not have * any children to any rows. A special case is * when 'iter' is NULL, in which case we need * to return the number of top-level nodes, * ie. the number of rows in our list. * **/ static gint gtk2hs_store_iter_n_children (GtkTreeModel *tree_model, GtkTreeIter *iter /* in, maybe NULL */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_iter_n_children\t(%p, %p)\n", tree_model, iter)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), 0); g_return_val_if_fail (iter == NULL || iter->stamp == store->stamp, 0); gboolean result = gtk2hs_store_iter_n_children_impl(store->impl, iter); WHEN_DEBUG(g_debug("return gtk2hs_store_iter_n_children\t=%d\n", result)); return result; } /** * * gtk2hs_store_iter_nth_child: If the row specified by 'parent' has any * children, set 'iter' to the n-th child and * return TRUE if it exists, otherwise FALSE. * A special case is when 'parent' is NULL, in * which case we need to set 'iter' to the n-th * row if it exists. * **/ static gboolean gtk2hs_store_iter_nth_child (GtkTreeModel *tree_model, GtkTreeIter *iter, /* out */ GtkTreeIter *parent, /* in, maybe NULL */ gint n) { WHEN_DEBUG(g_debug("calling gtk2hs_store_iter_nth_child\t(%p, %p, %p, %d)\n", tree_model, iter, parent, n)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), FALSE); g_return_val_if_fail (parent == NULL || parent->stamp == store->stamp, FALSE); gboolean result = gtk2hs_store_iter_nth_child_impl(store->impl, iter, parent, n); if (result) iter->stamp = store->stamp; WHEN_DEBUG(g_debug("return gtk2hs_store_iter_nth_child\t=%s\n", result ? "TRUE" : "FALSE")); return result; } /** * * gtk2hs_store_iter_parent: Point 'iter' to the parent node of 'child'. * **/ static gboolean gtk2hs_store_iter_parent (GtkTreeModel *tree_model, GtkTreeIter *iter, /* out */ GtkTreeIter *child /* in */) { WHEN_DEBUG(g_debug("calling gtk2hs_store_iter_parent\t\t(%p, %p, %p)\n", tree_model, iter, child)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_val_if_fail (GTK2HS_IS_STORE (tree_model), FALSE); g_return_val_if_fail (child != NULL, FALSE); g_return_val_if_fail (child->stamp == store->stamp, FALSE); gboolean result = gtk2hs_store_iter_parent_impl(store->impl, iter, child); if (result) iter->stamp = store->stamp; WHEN_DEBUG(g_debug("return gtk2hs_store_iter_parent\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } static void gtk2hs_store_ref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) { WHEN_DEBUG(g_debug("calling gtk2hs_store_ref_node\t\t(%p, %p)\n", tree_model, iter)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_if_fail (GTK2HS_IS_STORE (tree_model)); gtk2hs_store_ref_node_impl(store->impl, iter); } static void gtk2hs_store_unref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) { WHEN_DEBUG(g_debug("calling gtk2hs_store_unref_node\t\t(%p, %p)\n", tree_model, iter)); Gtk2HsStore *store = (Gtk2HsStore *) tree_model; g_return_if_fail (GTK2HS_IS_STORE (tree_model)); g_return_if_fail (iter->stamp == store->stamp); gtk2hs_store_unref_node_impl(store->impl, iter); } static gboolean gtk2hs_store_get_sort_column_id (GtkTreeSortable *sortable, gint *sort_column_id, GtkSortType *order) { WHEN_DEBUG(g_debug("calling gtk2hs_store_get_sort_column_id\t\t(%p)\n", sortable)); return 0; } static void gtk2hs_store_set_sort_column_id (GtkTreeSortable *sortable, gint sort_column_id, GtkSortType order) { WHEN_DEBUG(g_debug("calling gtk2hs_store_set_sort_column_id\t\t(%p)\n", sortable)); return; } #if GTK_MAJOR_VERSION < 3 static void gtk2hs_store_set_sort_func (GtkTreeSortable *sortable, gint sort_column_id, GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy) { WHEN_DEBUG(g_debug("calling gtk2hs_store_set_sort_func\t\t(%p)\n", sortable)); return; } static void gtk2hs_store_set_default_sort_func (GtkTreeSortable *sortable, GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy) { WHEN_DEBUG(g_debug("calling gtk2hs_store_set_default_sort_func\t\t(%p)\n", sortable)); return; } #endif static gboolean gtk2hs_store_has_default_sort_func (GtkTreeSortable *sortable) { WHEN_DEBUG(g_debug("calling gtk2hs_store_has_default_sort_func\t\t(%p)\n", sortable)); return 0; } static gboolean gtk2hs_store_row_draggable (GtkTreeDragSource *drag_source, GtkTreePath *path) { WHEN_DEBUG( gchar *path_str = gtk_tree_path_to_string(path); g_debug("calling gtk2hs_store_row_draggable\t\t(%p, \"%s\")\n", drag_source, path_str); g_free(path_str); ) Gtk2HsStore *store = (Gtk2HsStore *) drag_source; g_return_val_if_fail (GTK2HS_IS_STORE (drag_source), FALSE); gboolean result = gtk2hs_store_row_draggable_impl(drag_source, store->impl, path); WHEN_DEBUG(g_debug("return gtk2hs_store_row_draggable\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } static gboolean gtk2hs_store_drag_data_get (GtkTreeDragSource *drag_source, GtkTreePath *path, GtkSelectionData *selection_data) { WHEN_DEBUG( gchar *path_str = gtk_tree_path_to_string(path); g_debug("calling gtk2hs_store_drag_data_get\t\t(%p, \"%s\", %p)\n", drag_source, path_str, selection_data); g_free(path_str); ) Gtk2HsStore *store = (Gtk2HsStore *) drag_source; g_return_val_if_fail (GTK2HS_IS_STORE (drag_source), FALSE); g_return_val_if_fail (selection_data!=NULL, FALSE); gboolean result = gtk2hs_store_drag_data_get_impl(drag_source, store->impl, path, selection_data); WHEN_DEBUG(g_debug("return gtk2hs_store_drag_data_get\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } static gboolean gtk2hs_store_drag_data_delete (GtkTreeDragSource *drag_source, GtkTreePath *path) { WHEN_DEBUG( gchar *path_str = gtk_tree_path_to_string(path); g_debug("calling gtk2hs_store_drag_data_delete\t\t(%p, \"%s\")\n", drag_source, path_str); g_free(path_str); ) Gtk2HsStore *store = (Gtk2HsStore *) drag_source; g_return_val_if_fail (GTK2HS_IS_STORE (drag_source), FALSE); gboolean result = gtk2hs_store_drag_data_delete_impl(drag_source, store->impl, path); WHEN_DEBUG(g_debug("return gtk2hs_store_drag_data_delete\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } static gboolean gtk2hs_store_drag_data_received (GtkTreeDragDest *drag_dest, GtkTreePath *dest_path, GtkSelectionData *selection_data) { WHEN_DEBUG( gchar *path_str = gtk_tree_path_to_string(dest_path); g_debug("calling gtk2hs_store_drag_data_received\t\t(%p, \"%s\", %p)\n", drag_dest, path_str, selection_data); g_free(path_str); ) Gtk2HsStore *store = (Gtk2HsStore *) drag_dest; g_return_val_if_fail (GTK2HS_IS_STORE (drag_dest), FALSE); g_return_val_if_fail (selection_data!=NULL, FALSE); gboolean result = gtk2hs_store_drag_data_received_impl(drag_dest, store->impl, dest_path, selection_data); WHEN_DEBUG(g_debug("return gtk2hs_store_drag_data_received\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } static gboolean gtk2hs_store_row_drop_possible (GtkTreeDragDest *drag_dest, GtkTreePath *dest_path, GtkSelectionData *selection_data) { WHEN_DEBUG( gchar *path_str = gtk_tree_path_to_string(dest_path); g_debug("calling gtk2hs_store_row_drop_possible\t\t(%p, \"%s\", %p)\n", drag_dest, path_str, selection_data); g_free(path_str); ) Gtk2HsStore *store = (Gtk2HsStore *) drag_dest; g_return_val_if_fail (GTK2HS_IS_STORE (drag_dest), FALSE); g_return_val_if_fail (selection_data!=NULL, FALSE); gboolean result = gtk2hs_store_row_drop_possible_impl(drag_dest, store->impl, dest_path, selection_data); WHEN_DEBUG(g_debug("return gtk2hs_store_row_drop_possible\t\t=%s\n", result ? "TRUE" : "FALSE")); return result; } /** * * gtk2hs_store_new: Create a new custom tree model which delegates to a * Haskell implementation. * **/ Gtk2HsStore * gtk2hs_store_new (HsStablePtr impl, HsStablePtr priv) { WHEN_DEBUG(g_debug("calling gtk2hs_store_new\t\t(%p)\n", impl)); Gtk2HsStore *newstore = (Gtk2HsStore*) g_object_new (GTK2HS_TYPE_STORE, NULL); newstore->impl = impl; newstore->priv = priv; WHEN_DEBUG(g_debug("return gtk2hs_store_new\t\t=%p\n", newstore)); return newstore; } HsStablePtr gtk2hs_store_get_impl (Gtk2HsStore *store) { g_return_val_if_fail(GTK2HS_IS_STORE(store), NULL); return store->impl; } HsStablePtr gtk2hs_store_get_priv (Gtk2HsStore *store) { g_return_val_if_fail(GTK2HS_IS_STORE(store), NULL); return store->priv; } gint gtk2hs_store_get_stamp (Gtk2HsStore *store) { g_return_val_if_fail(GTK2HS_IS_STORE(store), 0); return store->stamp; } void gtk2hs_store_increment_stamp (Gtk2HsStore *store) { g_return_if_fail(GTK2HS_IS_STORE(store)); do { store->stamp++; } while (store->stamp == 0); } gtk-0.15.9/Graphics/UI/Gtk/ModelView/Gtk2HsStore.h0000644000000000000000000000311607346545000017552 0ustar0000000000000000#ifndef __GTK2HS_STORE_H__ #define __GTK2HS_STORE_H__ #include #include "Graphics/UI/Gtk/ModelView/CustomStore_stub.h" G_BEGIN_DECLS #define GTK2HS_TYPE_STORE (gtk2hs_store_get_type ()) #define GTK2HS_STORE(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), GTK2HS_TYPE_STORE, Gtk2HsStore)) #define GTK2HS_STORE_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), GTK2HS_TYPE_STORE, Gtk2HsStoreClass)) #define GTK2HS_IS_STORE(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), GTK2HS_TYPE_STORE)) #define GTK2HS_IS_STORE_CLASS(klass) (G_TYPE_CHECK_CLASS_TYPE ((klass), GTK2HS_TYPE_STORE)) #define GTK2HS_STORE_GET_CLASS(obj) (G_TYPE_INSTANCE_GET_CLASS ((obj), GTK2HS_TYPE_STORE, Gtk2HsStoreClass)) typedef struct _Gtk2HsStore Gtk2HsStore; typedef struct _Gtk2HsStoreClass Gtk2HsStoreClass; struct _Gtk2HsStore { GObject parent; /*< private >*/ HsStablePtr impl; /* a StablePtr CustomStore */ HsStablePtr priv; /* a StablePtr to private data */ gint stamp; /* Random integer to check whether an iter belongs to our model */ }; struct _Gtk2HsStoreClass { GObjectClass parent_class; }; GType gtk2hs_store_get_type (void) G_GNUC_CONST; Gtk2HsStore *gtk2hs_store_new (HsStablePtr, HsStablePtr); HsStablePtr gtk2hs_store_get_impl (Gtk2HsStore *); HsStablePtr gtk2hs_store_get_priv (Gtk2HsStore *); gint gtk2hs_store_get_stamp (Gtk2HsStore *); void gtk2hs_store_increment_stamp (Gtk2HsStore *); G_END_DECLS #endif /* __GTK2HS_STORE_H__ */ gtk-0.15.9/Graphics/UI/Gtk/ModelView/IconView.chs0000644000000000000000000010344407346545000017511 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget IconView -- -- Author : Duncan Coutts -- -- Created: 25 March 2005 -- -- Copyright (C) 2005-2007 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 (depends on GHC) -- -- A widget which displays a list of icons in a grid -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.ModelView.IconView ( -- * Detail -- -- | 'IconView' provides an alternative view on a list model. It displays the -- model as a grid of icons with labels. Like 'TreeView', it allows to select -- one or multiple items (depending on the selection mode, see -- 'iconViewSetSelectionMode'). In addition to selection with the arrow keys, -- 'IconView' supports rubberband selection, which is controlled by dragging -- the pointer. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----IconView -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types IconView, IconViewClass, castToIconView, gTypeIconView, toIconView, -- * Constructors iconViewNew, iconViewNewWithModel, -- * Methods iconViewSetModel, iconViewGetModel, iconViewSetTextColumn, iconViewGetTextColumn, iconViewSetMarkupColumn, iconViewGetMarkupColumn, iconViewSetPixbufColumn, iconViewGetPixbufColumn, iconViewGetPathAtPos, iconViewSelectedForeach, iconViewSetSelectionMode, iconViewGetSelectionMode, #if GTK_MAJOR_VERSION < 3 iconViewSetOrientation, iconViewGetOrientation, #endif iconViewSetColumns, iconViewGetColumns, iconViewSetItemWidth, iconViewGetItemWidth, iconViewSetSpacing, iconViewGetSpacing, iconViewSetRowSpacing, iconViewGetRowSpacing, iconViewSetColumnSpacing, iconViewGetColumnSpacing, iconViewSetMargin, iconViewGetMargin, iconViewSelectPath, iconViewUnselectPath, iconViewPathIsSelected, iconViewGetSelectedItems, iconViewSelectAll, iconViewUnselectAll, iconViewItemActivated, #if GTK_CHECK_VERSION(2,8,0) iconViewGetItemAtPos, iconViewSetCursor, iconViewGetCursor, iconViewScrollToPath, iconViewGetVisibleRange, #if GTK_CHECK_VERSION(2,10,0) iconViewEnableModelDragSource, iconViewEnableModelDragDest, iconViewUnsetModelDragSource, iconViewUnsetModelDragDest, #endif iconViewSetReorderable, iconViewGetReorderable, #endif #if GTK_CHECK_VERSION(2,22,0) iconViewGetItemRow, iconViewGetItemColumn, #endif -- * Attributes iconViewSelectionMode, iconViewTextColumn, iconViewMarkupColumn, iconViewPixbufColumn, iconViewModel, iconViewColumns, iconViewItemWidth, iconViewSpacing, iconViewRowSpacing, iconViewColumnSpacing, iconViewMargin, iconViewOrientation, #if GTK_CHECK_VERSION(2,8,0) iconViewReorderable, #endif #if GTK_CHECK_VERSION(2,22,0) iconViewItemOrientation, #endif -- * Signals setIconViewScrollAdjustments, itemActivated, selectionChanged #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import System.Glib.GList (fromGList) import System.Glib.Flags import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Gdk.Enums (DragAction(..)) import Graphics.UI.Gtk.Gdk.Events (Modifier(..)) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.General.Enums#} (Orientation, SelectionMode) {#import Graphics.UI.Gtk.ModelView.TreeModel#} {#import Graphics.UI.Gtk.ModelView.Types#} {#import Graphics.UI.Gtk.General.DNDTypes#} (TargetList(..)) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,6,0) -------------------- -- Constructors -- | Creates a new 'IconView' widget -- iconViewNew :: IO IconView iconViewNew = makeNewObject mkIconView $ liftM (castPtr :: Ptr Widget -> Ptr IconView) $ {# call gtk_icon_view_new #} -- %hash c:dbf4 -- | Creates a new 'IconView' widget with the model @model@ and defines -- how to extract a string and a pixbuf from the model. -- iconViewNewWithModel :: TreeModelClass model => model -- ^ @model@ - The model. -> IO IconView iconViewNewWithModel model = makeNewObject mkIconView $ liftM (castPtr :: Ptr Widget -> Ptr IconView) $ {# call gtk_icon_view_new_with_model #} (toTreeModel model) -------------------- -- Methods -- %hash c:5ba8 d:c5c8 -- | Sets the model for a 'IconView'. If the @iconView@ already has a model -- set, it will remove it before setting the new model. If @model@ is -- @Nothing@, then it will unset the old model. -- iconViewSetModel :: (IconViewClass self, TreeModelClass model) => self -> Maybe model -- ^ @model@ - The model. -> IO () iconViewSetModel self model = {# call gtk_icon_view_set_model #} (toIconView self) (maybe (TreeModel nullForeignPtr) toTreeModel model) -- %hash c:6709 d:c0c5 -- | Returns the model the 'IconView' is based on. Returns @Nothing@ if the -- model is unset. -- iconViewGetModel :: IconViewClass self => self -> IO (Maybe TreeModel) -- ^ returns a 'TreeModel', or @Nothing@ if none is -- currently being used. iconViewGetModel self = maybeNull (makeNewGObject mkTreeModel) $ {# call unsafe gtk_icon_view_get_model #} (toIconView self) -- %hash c:c3fe d:fb7b -- | Sets the column of the text for entries in the 'IconView'. If a markup -- source is set using 'iconViewSetMarkupSource', then the text source is -- ignored. -- iconViewSetTextColumn :: (IconViewClass self, GlibString string) => self -> ColumnId row string -- ^ @column@ - A column in the currently used model. -> IO () iconViewSetTextColumn self column = {# call gtk_icon_view_set_text_column #} (toIconView self) ((fromIntegral . columnIdToNumber) column) -- | Returns the column with text for @iconView@. -- iconViewGetTextColumn :: (IconViewClass self, GlibString string) => self -> IO (ColumnId row string) -- ^ returns the text column, or 'invalidColumnId' if it's unset. iconViewGetTextColumn self = liftM (makeColumnIdString . fromIntegral) $ {# call gtk_icon_view_get_text_column #} (toIconView self) -- %hash c:995f d:801c -- | Sets the column of the text for entries in the 'IconView' as a markup -- string (see 'Graphics.Rendering.Pango.Markup'). A text source that is set -- using 'iconViewSetTextSource' is ignored once a markup source is set. -- iconViewSetMarkupColumn :: (IconViewClass self, GlibString markup) => self -> ColumnId row markup -- ^ @column@ - A column in the currently used model. -> IO () iconViewSetMarkupColumn self column = {# call gtk_icon_view_set_markup_column #} (toIconView self) ((fromIntegral . columnIdToNumber) column) -- | Returns the column with markup text for @iconView@. -- iconViewGetMarkupColumn :: (IconViewClass self, GlibString markup) => self -> IO (ColumnId row markup) -- ^ returns the markup column, or 'invalidColumnId' if it's unset. iconViewGetMarkupColumn self = liftM (makeColumnIdString . fromIntegral) $ {# call gtk_icon_view_get_markup_column #} (toIconView self) -- %hash c:4079 d:bf8 -- | Sets the column of the 'Graphics.UI.Gtk.Gdk.Pixbuf' for entries in the -- 'IconView'. -- iconViewSetPixbufColumn :: IconViewClass self => self -> ColumnId row Pixbuf -- ^ @column@ - A column in the currently used model. -> IO () iconViewSetPixbufColumn self column = {# call gtk_icon_view_set_pixbuf_column #} (toIconView self) ((fromIntegral . columnIdToNumber) column) -- | Returns the column with pixbufs for @iconView@. -- iconViewGetPixbufColumn :: IconViewClass self => self -> IO (ColumnId row Pixbuf) -- ^ returns the pixbuf column, or 'invalidColumnId' if it's unset. iconViewGetPixbufColumn self = liftM (makeColumnIdPixbuf . fromIntegral) $ {# call gtk_icon_view_get_pixbuf_column #} (toIconView self) -- %hash c:2486 d:5e7 -- | Finds the path at the point (@x@, @y@), relative to widget coordinates. -- See 'iconViewGetItemAtPos', if you are also interested in the cell at the -- specified position. -- iconViewGetPathAtPos :: IconViewClass self => self -> Int -- ^ @x@ - The x position to be identified -> Int -- ^ @y@ - The y position to be identified -> IO TreePath -- ^ returns The 'TreePath' corresponding to the icon or @[]@ -- if no icon exists at that position. iconViewGetPathAtPos self x y = {# call gtk_icon_view_get_path_at_pos #} (toIconView self) (fromIntegral x) (fromIntegral y) >>= fromTreePath -- %hash c:dfc5 -- | Calls a function for each selected icon. Note that the model or selection -- cannot be modified from within this function. -- iconViewSelectedForeach :: IconViewClass self => self -> (TreePath -> IO ()) -- ^ @(\path -> ...)@ - The function to call for each -- selected icon. -> IO () iconViewSelectedForeach self func = do funcPtr <- mkIconViewForeachFunc (\_ tpPtr _ -> do path <- peekTreePath tpPtr func path ) {# call gtk_icon_view_selected_foreach #} (toIconView self) funcPtr nullPtr freeHaskellFunPtr funcPtr {# pointer IconViewForeachFunc #} foreign import ccall "wrapper" mkIconViewForeachFunc :: (Ptr IconView -> Ptr NativeTreePath -> Ptr () -> IO ()) -> IO IconViewForeachFunc -- | Sets the selection mode of the @iconView@. -- iconViewSetSelectionMode :: IconViewClass self => self -> SelectionMode -- ^ @mode@ - The selection mode -> IO () iconViewSetSelectionMode self mode = {# call gtk_icon_view_set_selection_mode #} (toIconView self) ((fromIntegral . fromEnum) mode) -- | Gets the selection mode of the @iconView@. -- iconViewGetSelectionMode :: IconViewClass self => self -> IO SelectionMode -- ^ returns the current selection mode iconViewGetSelectionMode self = liftM (toEnum . fromIntegral) $ {# call gtk_icon_view_get_selection_mode #} (toIconView self) #if GTK_MAJOR_VERSION < 3 -- | Sets the ::orientation property which determines whether the labels are -- drawn beside the icons instead of below. -- iconViewSetOrientation :: IconViewClass self => self -> Orientation -- ^ @orientation@ - the relative position of texts and icons -> IO () iconViewSetOrientation self orientation = {# call gtk_icon_view_set_orientation #} (toIconView self) ((fromIntegral . fromEnum) orientation) -- | Returns the value of the ::orientation property which determines whether -- the labels are drawn beside the icons instead of below. -- iconViewGetOrientation :: IconViewClass self => self -> IO Orientation -- ^ returns the relative position of texts and icons iconViewGetOrientation self = liftM (toEnum . fromIntegral) $ {# call gtk_icon_view_get_orientation #} (toIconView self) #endif -- %hash c:7d23 d:d4e7 -- | Sets the ::columns property which determines in how many columns the -- icons are arranged. If @columns@ is -1, the number of columns will be chosen -- automatically to fill the available area. -- iconViewSetColumns :: IconViewClass self => self -> Int -- ^ @columns@ - the number of columns -> IO () iconViewSetColumns self columns = {# call gtk_icon_view_set_columns #} (toIconView self) (fromIntegral columns) -- %hash c:f0f6 d:fc0e -- | Returns the value of the ::columns property. -- iconViewGetColumns :: IconViewClass self => self -> IO Int -- ^ returns the number of columns, or -1 iconViewGetColumns self = liftM fromIntegral $ {# call gtk_icon_view_get_columns #} (toIconView self) -- %hash c:643e d:b756 -- | Sets the ::item-width property which specifies the width to use for each -- item. If it is set to -1, the icon view will automatically determine a -- suitable item size. -- iconViewSetItemWidth :: IconViewClass self => self -> Int -- ^ @itemWidth@ - the width for each item -> IO () iconViewSetItemWidth self itemWidth = {# call gtk_icon_view_set_item_width #} (toIconView self) (fromIntegral itemWidth) -- %hash c:9f27 d:8569 -- | Returns the value of the ::item-width property. -- iconViewGetItemWidth :: IconViewClass self => self -> IO Int -- ^ returns the width of a single item, or -1 iconViewGetItemWidth self = liftM fromIntegral $ {# call gtk_icon_view_get_item_width #} (toIconView self) -- %hash c:7e61 d:3186 -- | Sets the ::spacing property which specifies the space which is inserted -- between the cells (i.e. the icon and the text) of an item. -- iconViewSetSpacing :: IconViewClass self => self -> Int -- ^ @spacing@ - the spacing -> IO () iconViewSetSpacing self spacing = {# call gtk_icon_view_set_spacing #} (toIconView self) (fromIntegral spacing) -- %hash c:5bc1 d:a1d2 -- | Returns the value of the ::spacing property. -- iconViewGetSpacing :: IconViewClass self => self -> IO Int -- ^ returns the space between cells iconViewGetSpacing self = liftM fromIntegral $ {# call gtk_icon_view_get_spacing #} (toIconView self) -- %hash c:dd08 d:730c -- | Sets the ::row-spacing property which specifies the space which is -- inserted between the rows of the icon view. -- iconViewSetRowSpacing :: IconViewClass self => self -> Int -- ^ @rowSpacing@ - the row spacing -> IO () iconViewSetRowSpacing self rowSpacing = {# call gtk_icon_view_set_row_spacing #} (toIconView self) (fromIntegral rowSpacing) -- %hash c:a040 d:bc37 -- | Returns the value of the ::row-spacing property. -- iconViewGetRowSpacing :: IconViewClass self => self -> IO Int -- ^ returns the space between rows iconViewGetRowSpacing self = liftM fromIntegral $ {# call gtk_icon_view_get_row_spacing #} (toIconView self) -- %hash c:3042 d:b4f8 -- | Sets the ::column-spacing property which specifies the space which is -- inserted between the columns of the icon view. -- iconViewSetColumnSpacing :: IconViewClass self => self -> Int -- ^ @columnSpacing@ - the column spacing -> IO () iconViewSetColumnSpacing self columnSpacing = {# call gtk_icon_view_set_column_spacing #} (toIconView self) (fromIntegral columnSpacing) -- %hash c:3818 d:c1cd -- | Returns the value of the ::column-spacing property. -- iconViewGetColumnSpacing :: IconViewClass self => self -> IO Int -- ^ returns the space between columns iconViewGetColumnSpacing self = liftM fromIntegral $ {# call gtk_icon_view_get_column_spacing #} (toIconView self) -- %hash c:990 d:d43c -- | Sets the ::margin property which specifies the space which is inserted at -- the top, bottom, left and right of the icon view. -- iconViewSetMargin :: IconViewClass self => self -> Int -- ^ @margin@ - the margin -> IO () iconViewSetMargin self margin = {# call gtk_icon_view_set_margin #} (toIconView self) (fromIntegral margin) -- %hash c:a116 d:6fab -- | Returns the value of the ::margin property. -- iconViewGetMargin :: IconViewClass self => self -> IO Int -- ^ returns the space at the borders iconViewGetMargin self = liftM fromIntegral $ {# call gtk_icon_view_get_margin #} (toIconView self) -- %hash c:77b3 -- | Selects the row at @path@. -- iconViewSelectPath :: IconViewClass self => self -> TreePath -- ^ @path@ - The 'TreePath' to be selected. -> IO () iconViewSelectPath self path = withTreePath path $ \path -> {# call gtk_icon_view_select_path #} (toIconView self) path -- %hash c:7e5f -- | Unselects the row at @path@. -- iconViewUnselectPath :: IconViewClass self => self -> TreePath -- ^ @path@ - The 'TreePath' to be unselected. -> IO () iconViewUnselectPath self path = withTreePath path $ \path -> {# call gtk_icon_view_unselect_path #} (toIconView self) path -- %hash c:8ea0 -- | Returns @True@ if the icon pointed to by @path@ is currently selected. If -- @icon@ does not point to a valid location, @False@ is returned. -- iconViewPathIsSelected :: IconViewClass self => self -> TreePath -- ^ @path@ - A 'TreePath' to check selection on. -> IO Bool -- ^ returns @True@ if @path@ is selected. iconViewPathIsSelected self path = liftM toBool $ withTreePath path $ \path -> {# call gtk_icon_view_path_is_selected #} (toIconView self) path -- %hash c:90f8 d:9c43 -- | Creates a list of paths of all selected items. Additionally, if you are -- planning on modifying the model after calling this function, you may want -- to convert the returned list into a list of 'TreeRowReference's. To do -- this, you can use 'treeRowReferenceNew'. -- iconViewGetSelectedItems :: IconViewClass self => self -> IO [TreePath] -- ^ returns a list of 'TreePath's, one for each selected row. iconViewGetSelectedItems self = {# call gtk_icon_view_get_selected_items #} (toIconView self) >>= fromGList >>= mapM fromTreePath -- | Selects all the icons. @iconView@ must has its selection mode set to -- 'SelectionMultiple'. -- iconViewSelectAll :: IconViewClass self => self -> IO () iconViewSelectAll self = {# call gtk_icon_view_select_all #} (toIconView self) -- | Unselects all the icons. -- iconViewUnselectAll :: IconViewClass self => self -> IO () iconViewUnselectAll self = {# call gtk_icon_view_unselect_all #} (toIconView self) -- %hash c:6916 -- | Activates the item determined by @path@. -- iconViewItemActivated :: IconViewClass self => self -> TreePath -- ^ @path@ - The 'TreePath' to be activated -> IO () iconViewItemActivated self path = withTreePath path $ \path -> {# call gtk_icon_view_item_activated #} (toIconView self) path #if GTK_CHECK_VERSION(2,8,0) -- %hash c:3122 d:346e -- | Finds the path at the point (@x@, @y@), relative to widget coordinates. -- In contrast to 'iconViewGetPathAtPos', this function also obtains the cell -- at the specified position. -- -- * Available since Gtk+ version 2.8 -- iconViewGetItemAtPos :: IconViewClass self => self -> Int -- ^ @x@ - The x position to be identified -> Int -- ^ @y@ - The y position to be identified -> IO (Maybe (TreePath, CellRenderer)) -- specified position iconViewGetItemAtPos self x y = alloca $ \pathPtrPtr -> alloca $ \crPtrPtr -> do success <- liftM toBool $ {# call gtk_icon_view_get_item_at_pos #} (toIconView self) (fromIntegral x) (fromIntegral y) (castPtr pathPtrPtr) (castPtr crPtrPtr) if not success then return Nothing else do pathPtr <- peek pathPtrPtr crPtr <- peek crPtrPtr path <- fromTreePath pathPtr cr <- makeNewGObject mkCellRenderer (return crPtr) return (Just (path, cr)) -- %hash c:357b d:32d6 -- | Given @Left path@ as argument , sets the current keyboard focus to be at -- @path@, and selects it. This is useful when you want to focus the user's -- attention on a particular item. If @Right cell@ is given, then focus is -- given to the cell specified by it. Additionally, if @startEditing@ is -- @True@, then editing should be started in the specified cell. -- -- This function is often followed by -- 'Graphics.UI.Gtk.Abstract.Widget.widgetGrabFocus' in order to give keyboard -- focus to the widget. Please note that editing can only happen when the -- widget is realized. -- -- * Available since Gtk+ version 2.8 -- iconViewSetCursor :: (IconViewClass self, CellRendererClass cell) => self -> (Either TreePath cell) -- ^ the path or the cell -> Bool -- ^ @startEditing@ - @True@ if the specified cell should start -- being edited. -> IO () iconViewSetCursor self (Left path) startEditing = withTreePath path $ \path -> {# call gtk_icon_view_set_cursor #} (toIconView self) path (CellRenderer nullForeignPtr) (fromBool startEditing) iconViewSetCursor self (Right cell) startEditing = {# call gtk_icon_view_set_cursor #} (toIconView self) (NativeTreePath nullPtr) (toCellRenderer cell) (fromBool startEditing) -- %hash c:3307 d:9cf8 -- | Return a @path@ and a @cell@ with the current cursor path and cell. If the -- cursor isn't currently set, then @[]@ will be returned for the @path@. If no cell currently has focus, -- then @cell@ will be @Nothing@. -- -- * Available since Gtk+ version 2.8 -- iconViewGetCursor :: IconViewClass self => self -> IO (TreePath, Maybe CellRenderer) -- ^ returns a @path@ to the cursor and a @cell@ if the widget has the input focus iconViewGetCursor self = alloca $ \pathPtrPtr -> alloca $ \crPtrPtr -> do {# call gtk_icon_view_get_cursor #} (toIconView self) (castPtr pathPtrPtr) (castPtr crPtrPtr) pathPtr <- peek pathPtrPtr crPtr <- peek crPtrPtr path <- fromTreePath pathPtr cr <- if crPtr==nullPtr then return Nothing else liftM Just $ makeNewGObject mkCellRenderer (return crPtr) return (path, cr) -- %hash c:1c9e d:20c5 -- | Moves the alignments of @iconView@ to the position specified by @path@. -- @rowAlign@ determines where the row is placed, and @colAlign@ determines -- where @column@ is placed. Both are expected to be between 0.0 and 1.0. 0.0 -- means left\/top alignment, 1.0 means right\/bottom alignment, 0.5 means -- center. -- -- If @useAlign@ is @False@, then the alignment arguments are ignored, and the -- tree does the minimum amount of work to scroll the item onto the screen. -- This means that the item will be scrolled to the edge closest to its -- current position. If the item is currently visible on the screen, nothing -- is done. -- -- This function only works if the model is set, and @path@ is a valid row on -- the model. If the model changes before the @iconView@ is realized, the -- centered path will be modified to reflect this change. -- -- * Available since Gtk+ version 2.8 -- iconViewScrollToPath :: IconViewClass self => self -> TreePath -- ^ @path@ - The path of the item to move to. -> Bool -- ^ @useAlign@ - whether to use alignment arguments, or @False@. -> Float -- ^ @rowAlign@ - The vertical alignment of the item specified by -- @path@. -> Float -- ^ @colAlign@ - The horizontal alignment of the item specified -- by @path@. -> IO () iconViewScrollToPath self path useAlign rowAlign colAlign = withTreePath path $ \path -> {# call gtk_icon_view_scroll_to_path #} (toIconView self) path (fromBool useAlign) (realToFrac rowAlign) (realToFrac colAlign) -- %hash c:8354 d:f7f3 -- | Retrieve the first and last visible path. -- Note that there may be invisible paths in between. -- -- * Available since Gtk+ version 2.8 -- iconViewGetVisibleRange :: IconViewClass self => self -> IO (Maybe (TreePath, TreePath)) -- ^ returns the first and last visible path, the return value -- @Nothing@ if every element is visible iconViewGetVisibleRange self = alloca $ \fPtrPtr -> alloca $ \lPtrPtr -> do success <- liftM toBool $ {# call gtk_icon_view_get_visible_range #} (toIconView self) (castPtr fPtrPtr) (castPtr lPtrPtr) if not success then return Nothing else do fPtr <- peek fPtrPtr lPtr <- peek lPtrPtr f <- fromTreePath fPtr l <- fromTreePath lPtr return (Just (f,l)) #if GTK_CHECK_VERSION(2,10,0) -- %hash c:bd16 d:3f4f -- | Turns @iconView@ into a drag source for automatic DND. -- -- * Available since Gtk+ version 2.10 -- iconViewEnableModelDragSource :: IconViewClass self => self -> [Modifier] -- ^ @startButtonMask@ - Mask of allowed buttons -- to start drag -> TargetList -- ^ @targets@ - the list of targets that the -- the view will support -> [DragAction] -- ^ @actions@ - flags denoting the possible actions -- for a drag from this widget -> IO () iconViewEnableModelDragSource self startButtonMask targets actions = alloca $ \nTargetsPtr -> do tlPtr <- {#call unsafe gtk_target_table_new_from_list#} targets nTargetsPtr nTargets <- peek nTargetsPtr {# call gtk_icon_view_enable_model_drag_source #} (toIconView self) ((fromIntegral . fromFlags) startButtonMask) tlPtr nTargets ((fromIntegral . fromFlags) actions) {#call unsafe gtk_target_table_free#} tlPtr nTargets -- %hash c:b14d d:23d7 -- | Turns @iconView@ into a drop destination for automatic DND. -- -- * Available since Gtk+ version 2.10 -- iconViewEnableModelDragDest :: IconViewClass self => self -> TargetList -- ^ @targets@ - the list of targets that the -- the view will support -> [DragAction] -- ^ @actions@ - flags denoting the possible actions -- for a drop into this widget -> IO () iconViewEnableModelDragDest self targets actions = alloca $ \nTargetsPtr -> do tlPtr <- {#call unsafe gtk_target_table_new_from_list#} targets nTargetsPtr nTargets <- peek nTargetsPtr {# call gtk_icon_view_enable_model_drag_dest #} (toIconView self) tlPtr nTargets ((fromIntegral . fromFlags) actions) -- %hash c:25b0 d:5a6b -- | Undoes the effect of 'iconViewEnableModelDragSource'. -- -- * Available since Gtk+ version 2.10 -- iconViewUnsetModelDragSource :: IconViewClass self => self -> IO () iconViewUnsetModelDragSource self = {# call gtk_icon_view_unset_model_drag_source #} (toIconView self) -- %hash c:d76d d:f18a -- | Undoes the effect of 'iconViewEnableModelDragDest'. -- -- * Available since Gtk+ version 2.10 -- iconViewUnsetModelDragDest :: IconViewClass self => self -> IO () iconViewUnsetModelDragDest self = {# call gtk_icon_view_unset_model_drag_dest #} (toIconView self) #endif -- %hash c:c270 d:b94d -- | Check if icons can be moved around. -- -- * Set whether the user can use drag and drop (DND) to reorder the rows in -- the store. This works on both 'TreeStore' and 'ListStore' models. If @ro@ -- is @True@, then the user can reorder the model by dragging and dropping -- rows. The developer can listen to these changes by connecting to the -- model's signals. If you need to control which rows may be dragged or -- where rows may be dropped, you can override the -- 'Graphics.UI.Gtk.ModelView.CustomStore.treeDragSourceRowDraggable' -- function in the default DND implementation of the model. -- -- * Available since Gtk+ version 2.8 -- iconViewSetReorderable :: IconViewClass self => self -> Bool -- ^ @reorderable@ - @True@, if the list of items can be reordered. -> IO () iconViewSetReorderable self reorderable = {# call gtk_icon_view_set_reorderable #} (toIconView self) (fromBool reorderable) -- %hash c:532 d:1d07 -- | Retrieves whether the user can reorder the list via drag-and-drop. See -- 'iconViewSetReorderable'. -- -- * Available since Gtk+ version 2.8 -- iconViewGetReorderable :: IconViewClass self => self -> IO Bool -- ^ returns @True@ if the list can be reordered. iconViewGetReorderable self = liftM toBool $ {# call gtk_icon_view_get_reorderable #} (toIconView self) #endif #if GTK_CHECK_VERSION(2,22,0) -- | Gets the row in which the item path is currently displayed. Row numbers start at 0. -- -- * Available since Gtk+ version 2.22 -- iconViewGetItemRow :: IconViewClass self => self -> TreePath -- ^ @path@ the 'TreePath' of the item -> IO Int -- ^ returns The row in which the item is displayed iconViewGetItemRow self path = liftM fromIntegral $ withTreePath path $ \path -> {# call gtk_icon_view_get_item_row #} (toIconView self) path -- | Gets the column in which the item path is currently displayed. Column numbers start at 0. -- -- * Available since Gtk+ version 2.22 -- iconViewGetItemColumn :: IconViewClass self => self -> TreePath -- ^ @path@ the 'TreePath' of the item -> IO Int -- ^ returns The column in which the item is displayed iconViewGetItemColumn self path = liftM fromIntegral $ withTreePath path $ \path -> {# call gtk_icon_view_get_item_column #} (toIconView self) path #endif -------------------- -- Attributes -- | The ::selection-mode property specifies the selection mode of icon view. -- If the mode is 'SelectionMultiple', rubberband selection is enabled, for the -- other modes, only keyboard selection is possible. -- -- Default value: 'SelectionSingle' -- iconViewSelectionMode :: IconViewClass self => Attr self SelectionMode iconViewSelectionMode = newAttr iconViewGetSelectionMode iconViewSetSelectionMode -- %hash c:4ce5 d:c77a -- | The 'iconViewPixbufColumn' property contains the number of the model column -- containing the pixbufs which are displayed. Setting this property to -- 'invalidColumnId' turns off the display of pixbufs. -- -- Default value: 'invalidColumnId' -- iconViewPixbufColumn :: IconViewClass self => Attr self (ColumnId row Pixbuf) iconViewPixbufColumn = newAttr iconViewGetPixbufColumn iconViewSetPixbufColumn -- %hash c:702a d:f7ed -- | The 'iconViewTextColumn' property contains the number of the model column -- containing the texts which are displayed. If this property and the -- 'iconViewMarkupColumn' property are both set to 'invalidColumnId', no texts -- are displayed. -- -- Default value: 'invalidColumnId' -- iconViewTextColumn :: (IconViewClass self, GlibString string) => Attr self (ColumnId row string) iconViewTextColumn = newAttr iconViewGetTextColumn iconViewSetTextColumn -- %hash c:37cb d:ee83 -- | The 'iconViewMarkupColumn' property contains the number of the model column -- containing markup information to be displayed. If this property and the -- 'iconViewTextColumn' property are both set to column numbers, it overrides the text -- column. If both are set to 'invalidColumnId', no texts are displayed. -- -- Default value: 'invalidColumnId' -- iconViewMarkupColumn :: (IconViewClass self, GlibString markup) => Attr self (ColumnId row markup) iconViewMarkupColumn = newAttr iconViewGetMarkupColumn iconViewSetMarkupColumn -- %hash c:723d -- | The model for the icon view. -- iconViewModel :: (IconViewClass self, TreeModelClass model) => ReadWriteAttr self (Maybe TreeModel) (Maybe model) iconViewModel = newAttr iconViewGetModel iconViewSetModel -- %hash c:6347 -- | The columns property contains the number of the columns in which the -- items should be displayed. If it is -1, the number of columns will be chosen -- automatically to fill the available area. -- -- Allowed values: >= -1 -- -- Default value: -1 -- iconViewColumns :: IconViewClass self => Attr self Int iconViewColumns = newAttrFromIntProperty "columns" -- %hash c:d0fe d:42c5 -- | The item-width property specifies the width to use for each item. If it -- is set to -1, the icon view will automatically determine a suitable item -- size. -- -- Allowed values: >= -1 -- -- Default value: -1 -- iconViewItemWidth :: IconViewClass self => Attr self Int iconViewItemWidth = newAttrFromIntProperty "item-width" -- %hash c:3813 d:23f9 -- | The spacing property specifies the space which is inserted between the -- cells (i.e. the icon and the text) of an item. -- -- Allowed values: >= 0 -- -- Default value: 0 -- iconViewSpacing :: IconViewClass self => Attr self Int iconViewSpacing = newAttrFromIntProperty "spacing" -- %hash c:6a28 d:8e65 -- | The row-spacing property specifies the space which is inserted between -- the rows of the icon view. -- -- Allowed values: >= 0 -- -- Default value: 6 -- iconViewRowSpacing :: IconViewClass self => Attr self Int iconViewRowSpacing = newAttrFromIntProperty "row-spacing" -- %hash c:56a d:2971 -- | The column-spacing property specifies the space which is inserted between -- the columns of the icon view. -- -- Allowed values: >= 0 -- -- Default value: 6 -- iconViewColumnSpacing :: IconViewClass self => Attr self Int iconViewColumnSpacing = newAttrFromIntProperty "column-spacing" -- %hash c:89de d:8e41 -- | The margin property specifies the space which is inserted at the edges of -- the icon view. -- -- Allowed values: >= 0 -- -- Default value: 6 -- iconViewMargin :: IconViewClass self => Attr self Int iconViewMargin = newAttrFromIntProperty "margin" -- %hash c:b606 d:31c3 -- | The orientation property specifies how the cells (i.e. the icon and the -- text) of the item are positioned relative to each other. -- -- Default value: 'OrientationVertical' -- iconViewOrientation :: IconViewClass self => Attr self Orientation iconViewOrientation = newAttrFromEnumProperty "orientation" {# call pure unsafe gtk_orientation_get_type #} #if GTK_CHECK_VERSION(2,8,0) -- %hash c:f17b d:54d0 -- | The reorderable property specifies if the items can be reordered by DND. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.8 -- iconViewReorderable :: IconViewClass self => Attr self Bool iconViewReorderable = newAttrFromBoolProperty "reorderable" #endif #if GTK_CHECK_VERSION(2,22,0) -- | The item-orientation property specifies how the cells (i.e. the icon and the text) of the item are -- positioned relative to each other. -- -- Default value: 'OrientationVertical' -- -- * Available since Gtk+ version 2.22 -- iconViewItemOrientation :: IconViewClass self => Attr self Orientation iconViewItemOrientation = newAttrFromEnumProperty "item-orientation" {# call pure unsafe gtk_orientation_get_type #} #endif -------------------- -- Signals -- %hash c:4671 d:af3f -- | New scroll adjustment have been set for this widget. -- setIconViewScrollAdjustments :: IconViewClass self => Signal self (Adjustment -> Adjustment -> IO ()) setIconViewScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set-scroll-adjustments") -- %hash c:4090 d:af3f -- | A specific element has been activated (by pressing enter or double clicking). -- itemActivated :: IconViewClass self => Signal self (TreePath -> IO ()) itemActivated = Signal (connect_BOXED__NONE "item-activated" (peekTreePath . castPtr)) -- %hash c:6098 d:af3f -- | The selected item changed. -- selectionChanged :: IconViewClass self => Signal self (IO ()) selectionChanged = Signal (connect_NONE__NONE "selection-changed") #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/ListStore.hs0000644000000000000000000003104407346545000017547 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CustomStore TreeModel -- -- Author : Duncan Coutts, Axel Simon -- -- Created: 11 February 2006 -- -- Copyright (C) 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 (depends on GHC) -- -- Standard model to store list data. -- module Graphics.UI.Gtk.ModelView.ListStore ( -- * Types ListStore, -- * Constructors listStoreNew, listStoreNewDND, -- * Implementation of Interfaces listStoreDefaultDragSourceIface, listStoreDefaultDragDestIface, -- * Methods listStoreIterToIndex, listStoreGetValue, listStoreSafeGetValue, listStoreSetValue, listStoreToList, listStoreGetSize, listStoreInsert, listStorePrepend, listStoreAppend, listStoreRemove, listStoreClear, ) where import Control.Monad (liftM, when) import Data.IORef import Data.Ix (inRange) #if __GLASGOW_HASKELL__>=606 import qualified Data.Sequence as Seq import Data.Sequence (Seq) import qualified Data.Foldable as F #else import qualified Graphics.UI.Gtk.ModelView.Sequence as Seq import Graphics.UI.Gtk.ModelView.Sequence (Seq) #endif import Graphics.UI.Gtk.Types (GObjectClass(..)) -- import Graphics.UI.Gtk.ModelView.Types () import Graphics.UI.Gtk.ModelView.CustomStore import Graphics.UI.Gtk.ModelView.TreeModel import Graphics.UI.Gtk.ModelView.TreeDrag import Control.Monad.Trans ( liftIO ) newtype ListStore a = ListStore (CustomStore (IORef (Seq a)) a) instance TypedTreeModelClass ListStore instance TreeModelClass (ListStore a) instance GObjectClass (ListStore a) where toGObject (ListStore tm) = toGObject tm unsafeCastGObject = ListStore . unsafeCastGObject -- | Create a new 'TreeModel' that contains a list of elements. listStoreNew :: [a] -> IO (ListStore a) listStoreNew xs = listStoreNewDND xs (Just listStoreDefaultDragSourceIface) (Just listStoreDefaultDragDestIface) -- | Create a new 'TreeModel' that contains a list of elements. In addition, specify two -- interfaces for drag and drop. -- listStoreNewDND :: [a] -- ^ the initial content of the model -> Maybe (DragSourceIface ListStore a) -- ^ an optional interface for drags -> Maybe (DragDestIface ListStore a) -- ^ an optional interface to handle drops -> IO (ListStore a) -- ^ the new model listStoreNewDND xs mDSource mDDest = do rows <- newIORef (Seq.fromList xs) customStoreNew rows ListStore TreeModelIface { treeModelIfaceGetFlags = return [TreeModelListOnly], treeModelIfaceGetIter = \[n] -> readIORef rows >>= \rows -> return (if inRange (0, Seq.length rows - 1) n then Just (TreeIter 0 (fromIntegral n) 0 0) else Nothing), treeModelIfaceGetPath = \(TreeIter _ n _ _) -> return [fromIntegral n], treeModelIfaceGetRow = \(TreeIter _ n _ _) -> readIORef rows >>= \rows -> if inRange (0, Seq.length rows - 1) (fromIntegral n) then return (rows `Seq.index` fromIntegral n) else fail "ListStore.getRow: iter does not refer to a valid entry", treeModelIfaceIterNext = \(TreeIter _ n _ _) -> readIORef rows >>= \rows -> if inRange (0, Seq.length rows - 1) (fromIntegral (n+1)) then return (Just (TreeIter 0 (n+1) 0 0)) else return Nothing, treeModelIfaceIterChildren = \index -> readIORef rows >>= \rows -> case index of Nothing | not (Seq.null rows) -> return (Just (TreeIter 0 0 0 0)) _ -> return Nothing, treeModelIfaceIterHasChild = \_ -> return False, treeModelIfaceIterNChildren = \index -> readIORef rows >>= \rows -> case index of Nothing -> return $! Seq.length rows _ -> return 0, treeModelIfaceIterNthChild = \index n -> case index of Nothing -> return (Just (TreeIter 0 (fromIntegral n) 0 0)) _ -> return Nothing, treeModelIfaceIterParent = \_ -> return Nothing, treeModelIfaceRefNode = \_ -> return (), treeModelIfaceUnrefNode = \_ -> return () } mDSource mDDest -- | Convert a 'TreeIter' to an an index into the 'ListStore'. Note that this -- function merely extracts the second element of the 'TreeIter'. listStoreIterToIndex :: TreeIter -> Int listStoreIterToIndex (TreeIter _ n _ _) = fromIntegral n -- | Default drag functions for 'Graphics.UI.Gtk.ModelView.ListStore'. These -- functions allow the rows of the model to serve as drag source. Any row is -- allowed to be dragged and the data set in the 'SelectionDataM' object is -- set with 'treeSetRowDragData', i.e. it contains the model and the -- 'TreePath' to the row. listStoreDefaultDragSourceIface :: DragSourceIface ListStore row listStoreDefaultDragSourceIface = DragSourceIface { treeDragSourceRowDraggable = \_ _-> return True, treeDragSourceDragDataGet = treeSetRowDragData, treeDragSourceDragDataDelete = \model (dest:_) -> do liftIO $ listStoreRemove model dest return True } -- | Default drop functions for 'Graphics.UI.Gtk.ModelView.ListStore'. These -- functions accept a row and insert the row into the new location if it is -- dragged into a tree view -- that uses the same model. listStoreDefaultDragDestIface :: DragDestIface ListStore row listStoreDefaultDragDestIface = DragDestIface { treeDragDestRowDropPossible = \model dest -> do mModelPath <- treeGetRowDragData case mModelPath of Nothing -> return False Just (model', source) -> return (toTreeModel model==toTreeModel model'), treeDragDestDragDataReceived = \model (dest:_) -> do mModelPath <- treeGetRowDragData case mModelPath of Nothing -> return False Just (model', (source:_)) -> if toTreeModel model/=toTreeModel model' then return False else liftIO $ do row <- listStoreGetValue model source listStoreInsert model dest row return True } -- | Extract the value at the given index. -- listStoreGetValue :: ListStore a -> Int -> IO a listStoreGetValue (ListStore model) index = readIORef (customStoreGetPrivate model) >>= return . (`Seq.index` index) -- | Extract the value at the given index. -- listStoreSafeGetValue :: ListStore a -> Int -> IO (Maybe a) listStoreSafeGetValue (ListStore model) index = do seq <- readIORef (customStoreGetPrivate model) return $ if index >=0 && index < Seq.length seq then Just $ seq `Seq.index` index else Nothing -- | Update the value at the given index. The index must exist. -- listStoreSetValue :: ListStore a -> Int -> a -> IO () listStoreSetValue (ListStore model) index value = do modifyIORef (customStoreGetPrivate model) (Seq.update index value) stamp <- customStoreGetStamp model treeModelRowChanged model [index] (TreeIter stamp (fromIntegral index) 0 0) -- | Extract all data from the store. -- listStoreToList :: ListStore a -> IO [a] listStoreToList (ListStore model) = liftM #if __GLASGOW_HASKELL__>=606 F.toList #else Seq.toList #endif $ readIORef (customStoreGetPrivate model) -- | Query the number of elements in the store. listStoreGetSize :: ListStore a -> IO Int listStoreGetSize (ListStore model) = liftM Seq.length $ readIORef (customStoreGetPrivate model) -- | Insert an element in front of the given element. The element is appended -- if the index is greater or equal to the size of the list. listStoreInsert :: ListStore a -> Int -> a -> IO () listStoreInsert (ListStore model) index value = do seq <- readIORef (customStoreGetPrivate model) when (index >= 0) $ do let index' | index > Seq.length seq = Seq.length seq | otherwise = index writeIORef (customStoreGetPrivate model) (insert index' value seq) stamp <- customStoreGetStamp model treeModelRowInserted model [index'] (TreeIter stamp (fromIntegral index') 0 0) where insert :: Int -> a -> Seq a -> Seq a insert i x xs = front Seq.>< x Seq.<| back where (front, back) = Seq.splitAt i xs -- | Prepend the element to the store. listStorePrepend :: ListStore a -> a -> IO () listStorePrepend (ListStore model) value = do modifyIORef (customStoreGetPrivate model) (\seq -> value Seq.<| seq) stamp <- customStoreGetStamp model treeModelRowInserted model [0] (TreeIter stamp 0 0 0) ---- | Prepend a list to the store. Not implemented yet. --listStorePrependList :: ListStore a -> [a] -> IO () --listStorePrependList store list = -- mapM_ (listStoreInsert store 0) (reverse list) -- | Append an element to the store. Returns the index of the inserted -- element. listStoreAppend :: ListStore a -> a -> IO Int listStoreAppend (ListStore model) value = do index <- atomicModifyIORef (customStoreGetPrivate model) (\seq -> (seq Seq.|> value, Seq.length seq)) stamp <- customStoreGetStamp model treeModelRowInserted model [index] (TreeIter stamp (fromIntegral index) 0 0) return index {- listStoreAppendList :: ListStore a -> [a] -> IO () listStoreAppendList (ListStore model) values = do seq <- readIORef (customStoreGetPrivate model) let seq' = Seq.fromList values startIndex = Seq.length seq endIndex = startIndex + Seq.length seq' - 1 writeIORef (customStoreGetPrivate model) (seq Seq.>< seq') stamp <- customStoreGetStamp model flip mapM [startIndex..endIndex] $ \index -> treeModelRowInserted model [index] (TreeIter stamp (fromIntegral index) 0 0) -} -- | Remove the element at the given index. -- listStoreRemove :: ListStore a -> Int -> IO () listStoreRemove (ListStore model) index = do seq <- readIORef (customStoreGetPrivate model) when (index >=0 && index < Seq.length seq) $ do writeIORef (customStoreGetPrivate model) (delete index seq) treeModelRowDeleted model [index] where delete :: Int -> Seq a -> Seq a delete i xs = front Seq.>< Seq.drop 1 back where (front, back) = Seq.splitAt i xs -- | Empty the store. listStoreClear :: ListStore a -> IO () listStoreClear (ListStore model) = -- Since deleting rows can cause callbacks (eg due to selection changes) -- we have to make sure the model is consistent with the view at each -- intermediate step of clearing the store. Otherwise at some intermediate -- stage when the view has only been informed about some deletions, the -- user might query the model expecting to find the remaining rows are there -- but find them deleted. That'd be bad. -- let loop (-1) Seq.EmptyR = return () loop n (seq Seq.:> _) = do writeIORef (customStoreGetPrivate model) seq treeModelRowDeleted model [n] loop (n-1) (Seq.viewr seq) in do seq <- readIORef (customStoreGetPrivate model) loop (Seq.length seq - 1) (Seq.viewr seq) ---- | Permute the rows of the store. Not yet implemented. --listStoreReorder :: ListStore a -> [Int] -> IO () --listStoreReorder store = undefined -- ---- | Swap two rows of the store. Not yet implemented. --listStoreSwap :: ListStore a -> Int -> Int -> IO () --listStoreSwap store = undefined -- ---- | Move the element at the first index in front of the element denoted by ---- the second index. Not yet implemented. --listStoreMoveBefore :: ListStore a -> Int -> Int -> IO () --listStoreMoveBefore store = undefined -- ---- | Move the element at the first index past the element denoted by the ---- second index. Not yet implemented. --listStoreMoveAfter :: ListStore a -> Int -> Int -> IO () --listStoreMoveAfter store = undefined gtk-0.15.9/Graphics/UI/Gtk/ModelView/Sequence.hs0000644000000000000000000012303407346545000017370 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- #hide ----------------------------------------------------------------------------- -- | -- Module : Data.Sequence -- Copyright : (c) Ross Paterson 2005 -- License : BSD-style -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- General purpose finite sequences. -- Apart from being finite and having strict operations, sequences -- also differ from lists in supporting a wider variety of operations -- efficiently. -- -- An amortized running time is given for each operation, with /n/ referring -- to the length of the sequence and /i/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. -- -- The implementation uses 2-3 finger trees annotated with sizes, -- as described in section 4.2 of -- -- * Ralf Hinze and Ross Paterson, -- \"Finger trees: a simple general-purpose data structure\", -- submitted to /Journal of Functional Programming/. -- -- ----------------------------------------------------------------------------- module Graphics.UI.Gtk.ModelView.Sequence ( Seq, -- * Construction empty, -- :: Seq a singleton, -- :: a -> Seq a (<|), -- :: a -> Seq a -> Seq a (|>), -- :: Seq a -> a -> Seq a (><), -- :: Seq a -> Seq a -> Seq a -- * Deconstruction null, -- :: Seq a -> Bool -- ** Views ViewL(..), viewl, -- :: Seq a -> ViewL a ViewR(..), viewr, -- :: Seq a -> ViewR a -- ** Indexing length, -- :: Seq a -> Int index, -- :: Seq a -> Int -> a adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a update, -- :: Int -> a -> Seq a -> Seq a take, -- :: Int -> Seq a -> Seq a drop, -- :: Int -> Seq a -> Seq a splitAt, -- :: Int -> Seq a -> (Seq a, Seq a) -- * Lists fromList, -- :: [a] -> Seq a toList, -- :: Seq a -> [a] -- * Folds -- ** Right associative foldr, -- :: (a -> b -> b) -> b -> Seq a -> b foldr1, -- :: (a -> a -> a) -> Seq a -> a foldr', -- :: (a -> b -> b) -> b -> Seq a -> b foldrM, -- :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b -- ** Left associative foldl, -- :: (a -> b -> a) -> a -> Seq b -> a foldl1, -- :: (a -> a -> a) -> Seq a -> a foldl', -- :: (a -> b -> a) -> a -> Seq b -> a foldlM, -- :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a -- * Transformations reverse, -- :: Seq a -> Seq a #if TESTING valid, #endif ) where import Prelude hiding ( null, length, take, drop, splitAt, foldl, foldl', foldl1, foldr, foldr1, reverse) import qualified Prelude (foldr) import Data.List (intersperse) import qualified Data.List (foldl') #if TESTING import Control.Monad (liftM, liftM2, liftM3, liftM4) import Test.QuickCheck #endif infixr 5 `consTree` infixl 5 `snocTree` infixr 5 >< infixr 5 <|, :< infixl 5 |>, :> class Sized a where size :: a -> Int ------------------------------------------------------------------------ -- Random access sequences ------------------------------------------------------------------------ -- | General-purpose finite sequences. newtype Seq a = Seq (FingerTree (Elem a)) instance Functor Seq where fmap f (Seq xs) = Seq (fmap (fmap f) xs) instance Eq a => Eq (Seq a) where xs == ys = length xs == length ys && toList xs == toList ys instance Ord a => Ord (Seq a) where compare xs ys = compare (toList xs) (toList ys) #if TESTING instance (Show a) => Show (Seq a) where showsPrec p (Seq x) = showsPrec p x #else instance Show a => Show (Seq a) where showsPrec _ xs = showChar '<' . flip (Prelude.foldr ($)) (intersperse (showChar ',') (map shows (toList xs))) . showChar '>' #endif -- Finger trees data FingerTree a = Empty | Single a | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a) #if TESTING deriving Show #endif instance Sized a => Sized (FingerTree a) where size Empty = 0 size (Single x) = size x size (Deep v _ _ _) = v instance Functor FingerTree where fmap _ Empty = Empty fmap f (Single x) = Single (f x) fmap f (Deep v pr m sf) = Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf) {-# INLINE deep #-} deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a deep pr m sf = Deep (size pr + size m + size sf) pr m sf -- Digits data Digit a = One a | Two a a | Three a a a | Four a a a a #if TESTING deriving Show #endif instance Functor Digit where fmap f (One a) = One (f a) fmap f (Two a b) = Two (f a) (f b) fmap f (Three a b c) = Three (f a) (f b) (f c) fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d) instance Sized a => Sized (Digit a) where size xs = foldlDigit (\ i x -> i + size x) 0 xs {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-} digitToTree :: Sized a => Digit a -> FingerTree a digitToTree (One a) = Single a digitToTree (Two a b) = deep (One a) Empty (One b) digitToTree (Three a b c) = deep (Two a b) Empty (One c) digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d) -- Nodes data Node a = Node2 {-# UNPACK #-} !Int a a | Node3 {-# UNPACK #-} !Int a a a #if TESTING deriving Show #endif instance Functor (Node) where fmap f (Node2 v a b) = Node2 v (f a) (f b) fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c) instance Sized (Node a) where size (Node2 v _ _) = v size (Node3 v _ _ _) = v {-# INLINE node2 #-} node2 :: Sized a => a -> a -> Node a node2 a b = Node2 (size a + size b) a b {-# INLINE node3 #-} node3 :: Sized a => a -> a -> a -> Node a node3 a b c = Node3 (size a + size b + size c) a b c nodeToDigit :: Node a -> Digit a nodeToDigit (Node2 _ a b) = Two a b nodeToDigit (Node3 _ a b c) = Three a b c -- Elements newtype Elem a = Elem { getElem :: a } instance Sized (Elem a) where size _ = 1 instance Functor Elem where fmap f (Elem x) = Elem (f x) #ifdef TESTING instance (Show a) => Show (Elem a) where showsPrec p (Elem x) = showsPrec p x #endif ------------------------------------------------------------------------ -- Construction ------------------------------------------------------------------------ -- | /O(1)/. The empty sequence. empty :: Seq a empty = Seq Empty -- | /O(1)/. A singleton sequence. singleton :: a -> Seq a singleton x = Seq (Single (Elem x)) -- | /O(1)/. Add an element to the left end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. (<|) :: a -> Seq a -> Seq a x <| Seq xs = Seq (Elem x `consTree` xs) {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-} consTree :: Sized a => a -> FingerTree a -> FingerTree a consTree a Empty = Single a consTree a (Single b) = deep (One a) Empty (One b) consTree a (Deep s (Four b c d e) m sf) = m `seq` Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf consTree a (Deep s (Three b c d) m sf) = Deep (size a + s) (Four a b c d) m sf consTree a (Deep s (Two b c) m sf) = Deep (size a + s) (Three a b c) m sf consTree a (Deep s (One b) m sf) = Deep (size a + s) (Two a b) m sf -- | /O(1)/. Add an element to the right end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. (|>) :: Seq a -> a -> Seq a Seq xs |> x = Seq (xs `snocTree` Elem x) {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-} {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-} snocTree :: Sized a => FingerTree a -> a -> FingerTree a snocTree Empty a = Single a snocTree (Single a) b = deep (One a) Empty (One b) snocTree (Deep s pr m (Four a b c d)) e = m `seq` Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e) snocTree (Deep s pr m (Three a b c)) d = Deep (s + size d) pr m (Four a b c d) snocTree (Deep s pr m (Two a b)) c = Deep (s + size c) pr m (Three a b c) snocTree (Deep s pr m (One a)) b = Deep (s + size b) pr m (Two a b) -- | /O(log(min(n1,n2)))/. Concatenate two sequences. (><) :: Seq a -> Seq a -> Seq a Seq xs >< Seq ys = Seq (appendTree0 xs ys) -- The appendTree/addDigits gunk below is machine generated appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) appendTree0 Empty xs = xs appendTree0 xs Empty = xs appendTree0 (Single x) xs = x `consTree` xs appendTree0 xs (Single x) = xs `snocTree` x appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) = Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a)) addDigits0 m1 (One a) (One b) m2 = appendTree1 m1 (node2 a b) m2 addDigits0 m1 (One a) (Two b c) m2 = appendTree1 m1 (node3 a b c) m2 addDigits0 m1 (One a) (Three b c d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (One a) (Four b c d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Two a b) (One c) m2 = appendTree1 m1 (node3 a b c) m2 addDigits0 m1 (Two a b) (Two c d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (Two a b) (Three c d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Two a b) (Four c d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Three a b c) (One d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (Three a b c) (Two d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Three a b c) (Three d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Three a b c) (Four d e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits0 m1 (Four a b c d) (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Four a b c d) (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Four a b c d) (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits0 m1 (Four a b c d) (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree1 Empty a xs = a `consTree` xs appendTree1 xs a Empty = xs `snocTree` a appendTree1 (Single x) a xs = x `consTree` a `consTree` xs appendTree1 xs a (Single x) = xs `snocTree` a `snocTree` x appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits1 m1 (One a) b (One c) m2 = appendTree1 m1 (node3 a b c) m2 addDigits1 m1 (One a) b (Two c d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits1 m1 (One a) b (Three c d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (One a) b (Four c d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Two a b) c (One d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits1 m1 (Two a b) c (Two d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (Two a b) c (Three d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Two a b) c (Four d e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Three a b c) d (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (Three a b c) d (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Three a b c) d (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Three a b c) d (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits1 m1 (Four a b c d) e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Four a b c d) e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Four a b c d) e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree2 Empty a b xs = a `consTree` b `consTree` xs appendTree2 xs a b Empty = xs `snocTree` a `snocTree` b appendTree2 (Single x) a b xs = x `consTree` a `consTree` b `consTree` xs appendTree2 xs a b (Single x) = xs `snocTree` a `snocTree` b `snocTree` x appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits2 m1 (One a) b c (One d) m2 = appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits2 m1 (One a) b c (Two d e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits2 m1 (One a) b c (Three d e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (One a) b c (Four d e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Two a b) c d (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits2 m1 (Two a b) c d (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (Two a b) c d (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Two a b) c d (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Three a b c) d e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (Three a b c) d e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Three a b c) d e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits2 m1 (Four a b c d) e f (One g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Four a b c d) e f (Two g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree3 Empty a b c xs = a `consTree` b `consTree` c `consTree` xs appendTree3 xs a b c Empty = xs `snocTree` a `snocTree` b `snocTree` c appendTree3 (Single x) a b c xs = x `consTree` a `consTree` b `consTree` c `consTree` xs appendTree3 xs a b c (Single x) = xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2 addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits3 m1 (One a) b c d (One e) m2 = appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits3 m1 (One a) b c d (Two e f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits3 m1 (One a) b c d (Three e f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (One a) b c d (Four e f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Two a b) c d e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits3 m1 (Two a b) c d e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (Two a b) c d e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Three a b c) d e f (One g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (Three a b c) d e f (Two g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits3 m1 (Four a b c d) e f g (One h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) appendTree4 Empty a b c d xs = a `consTree` b `consTree` c `consTree` d `consTree` xs appendTree4 xs a b c d Empty = xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d appendTree4 (Single x) a b c d xs = x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs appendTree4 xs a b c d (Single x) = xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) = Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2 addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) addDigits4 m1 (One a) b c d e (One f) m2 = appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits4 m1 (One a) b c d e (Two f g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits4 m1 (One a) b c d e (Three f g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (One a) b c d e (Four f g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Two a b) c d e f (One g) m2 = appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits4 m1 (Two a b) c d e f (Two g h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Three a b c) d e f g (One h) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 addDigits4 m1 (Four a b c d) e f g h (One i) m2 = appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 = appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2 ------------------------------------------------------------------------ -- Deconstruction ------------------------------------------------------------------------ -- | /O(1)/. Is this the empty sequence? null :: Seq a -> Bool null (Seq Empty) = True null _ = False -- | /O(1)/. The number of elements in the sequence. length :: Seq a -> Int length (Seq xs) = size xs -- Views data Maybe2 a b = Nothing2 | Just2 a b -- | View of the left end of a sequence. data ViewL a = EmptyL -- ^ empty sequence | a :< Seq a -- ^ leftmost element and the rest of the sequence #ifndef __HADDOCK__ deriving (Eq, Show) #else instance Eq a => Eq (ViewL a) instance Show a => Show (ViewL a) #endif instance Functor ViewL where fmap _ EmptyL = EmptyL fmap f (x :< xs) = f x :< fmap f xs -- | /O(1)/. Analyse the left end of a sequence. viewl :: Seq a -> ViewL a viewl (Seq xs) = case viewLTree xs of Nothing2 -> EmptyL Just2 (Elem x) xs' -> x :< Seq xs' {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-} {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-} viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a) viewLTree Empty = Nothing2 viewLTree (Single a) = Just2 a Empty viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of Nothing2 -> digitToTree sf Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf) viewLTree (Deep s (Two a b) m sf) = Just2 a (Deep (s - size a) (One b) m sf) viewLTree (Deep s (Three a b c) m sf) = Just2 a (Deep (s - size a) (Two b c) m sf) viewLTree (Deep s (Four a b c d) m sf) = Just2 a (Deep (s - size a) (Three b c d) m sf) -- | View of the right end of a sequence. data ViewR a = EmptyR -- ^ empty sequence | Seq a :> a -- ^ the sequence minus the rightmost element, -- and the rightmost element #ifndef __HADDOCK__ deriving (Eq, Show) #else instance Eq a => Eq (ViewR a) instance Show a => Show (ViewR a) #endif instance Functor ViewR where fmap _ EmptyR = EmptyR fmap f (xs :> x) = fmap f xs :> f x -- | /O(1)/. Analyse the right end of a sequence. viewr :: Seq a -> ViewR a viewr (Seq xs) = case viewRTree xs of Nothing2 -> EmptyR Just2 xs' (Elem x) -> Seq xs' :> x {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-} {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-} viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a viewRTree Empty = Nothing2 viewRTree (Single z) = Just2 Empty z viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of Nothing2 -> digitToTree pr Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z viewRTree (Deep s pr m (Two y z)) = Just2 (Deep (s - size z) pr m (One y)) z viewRTree (Deep s pr m (Three x y z)) = Just2 (Deep (s - size z) pr m (Two x y)) z viewRTree (Deep s pr m (Four w x y z)) = Just2 (Deep (s - size z) pr m (Three w x y)) z -- Indexing -- | /O(log(min(i,n-i)))/. The element at the specified position index :: Seq a -> Int -> a index (Seq xs) i | 0 <= i && i < size xs = case lookupTree (-i) xs of Place _ (Elem x) -> x | otherwise = error "index out of bounds" data Place a = Place {-# UNPACK #-} !Int a #if TESTING deriving Show #endif {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-} {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-} lookupTree :: Sized a => Int -> FingerTree a -> Place a lookupTree i (Single x) = Place i x lookupTree i (Deep _ pr m sf) | vpr > 0 = lookupDigit i pr | vm > 0 = case lookupTree vpr m of Place i' xs -> lookupNode i' xs | otherwise = lookupDigit vm sf where vpr = i + size pr vm = vpr + size m {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-} {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-} lookupNode :: Sized a => Int -> Node a -> Place a lookupNode i (Node2 _ a b) | va > 0 = Place i a | otherwise = Place va b where va = i + size a lookupNode i (Node3 _ a b c) | va > 0 = Place i a | vab > 0 = Place va b | otherwise = Place vab c where va = i + size a vab = va + size b {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-} {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-} lookupDigit :: Sized a => Int -> Digit a -> Place a lookupDigit i (One a) = Place i a lookupDigit i (Two a b) | va > 0 = Place i a | otherwise = Place va b where va = i + size a lookupDigit i (Three a b c) | va > 0 = Place i a | vab > 0 = Place va b | otherwise = Place vab c where va = i + size a vab = va + size b lookupDigit i (Four a b c d) | va > 0 = Place i a | vab > 0 = Place va b | vabc > 0 = Place vab c | otherwise = Place vabc d where va = i + size a vab = va + size b vabc = vab + size c -- | /O(log(min(i,n-i)))/. Replace the element at the specified position update :: Int -> a -> Seq a -> Seq a update i x = adjust (const x) i -- | /O(log(min(i,n-i)))/. Update the element at the specified position adjust :: (a -> a) -> Int -> Seq a -> Seq a adjust f i (Seq xs) | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs) | otherwise = Seq xs {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-} adjustTree :: Sized a => (Int -> a -> a) -> Int -> FingerTree a -> FingerTree a adjustTree f i (Single x) = Single (f i x) adjustTree f i (Deep s pr m sf) | vpr > 0 = Deep s (adjustDigit f i pr) m sf | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf | otherwise = Deep s pr m (adjustDigit f vm sf) where vpr = i + size pr vm = vpr + size m {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-} {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-} adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a adjustNode f i (Node2 s a b) | va > 0 = Node2 s (f i a) b | otherwise = Node2 s a (f va b) where va = i + size a adjustNode f i (Node3 s a b c) | va > 0 = Node3 s (f i a) b c | vab > 0 = Node3 s a (f va b) c | otherwise = Node3 s a b (f vab c) where va = i + size a vab = va + size b {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-} {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-} adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a adjustDigit f i (One a) = One (f i a) adjustDigit f i (Two a b) | va > 0 = Two (f i a) b | otherwise = Two a (f va b) where va = i + size a adjustDigit f i (Three a b c) | va > 0 = Three (f i a) b c | vab > 0 = Three a (f va b) c | otherwise = Three a b (f vab c) where va = i + size a vab = va + size b adjustDigit f i (Four a b c d) | va > 0 = Four (f i a) b c d | vab > 0 = Four a (f va b) c d | vabc > 0 = Four a b (f vab c) d | otherwise = Four a b c (f vabc d) where va = i + size a vab = va + size b vabc = vab + size c -- Splitting -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence. take :: Int -> Seq a -> Seq a take i = fst . splitAt i -- | /O(log(min(i,n-i)))/. Elements of sequence after the first @i@. drop :: Int -> Seq a -> Seq a drop i = snd . splitAt i -- | /O(log(min(i,n-i)))/. Split a sequence at a given position. splitAt :: Int -> Seq a -> (Seq a, Seq a) splitAt i (Seq xs) = (Seq l, Seq r) where (l, r) = split i xs split :: Int -> FingerTree (Elem a) -> (FingerTree (Elem a), FingerTree (Elem a)) split i Empty = i `seq` (Empty, Empty) split i xs | size xs > i = (l, consTree x r) | otherwise = (xs, Empty) where Split l x r = splitTree (-i) xs data Split t a = Split t a t #if TESTING deriving Show #endif {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-} {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-} splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a splitTree i (Single x) = i `seq` Split Empty x Empty splitTree i (Deep _ pr m sf) | vpr > 0 = case splitDigit i pr of Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf) | vm > 0 = case splitTree vpr m of Split ml xs mr -> case splitNode (vpr + size ml) xs of Split l x r -> Split (deepR pr ml l) x (deepL r mr sf) | otherwise = case splitDigit vm sf of Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r) where vpr = i + size pr vm = vpr + size m {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a deepL Nothing m sf = case viewLTree m of Nothing2 -> digitToTree sf Just2 a m' -> deep (nodeToDigit a) m' sf deepL (Just pr) m sf = deep pr m sf {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-} {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-} deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a deepR pr m Nothing = case viewRTree m of Nothing2 -> digitToTree pr Just2 m' a -> deep pr m' (nodeToDigit a) deepR pr m (Just sf) = deep pr m sf {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-} {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-} splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a splitNode i (Node2 _ a b) | va > 0 = Split Nothing a (Just (One b)) | otherwise = Split (Just (One a)) b Nothing where va = i + size a splitNode i (Node3 _ a b c) | va > 0 = Split Nothing a (Just (Two b c)) | vab > 0 = Split (Just (One a)) b (Just (One c)) | otherwise = Split (Just (Two a b)) c Nothing where va = i + size a vab = va + size b {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-} {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-} splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a splitDigit i (One a) = i `seq` Split Nothing a Nothing splitDigit i (Two a b) | va > 0 = Split Nothing a (Just (One b)) | otherwise = Split (Just (One a)) b Nothing where va = i + size a splitDigit i (Three a b c) | va > 0 = Split Nothing a (Just (Two b c)) | vab > 0 = Split (Just (One a)) b (Just (One c)) | otherwise = Split (Just (Two a b)) c Nothing where va = i + size a vab = va + size b splitDigit i (Four a b c d) | va > 0 = Split Nothing a (Just (Three b c d)) | vab > 0 = Split (Just (One a)) b (Just (Two c d)) | vabc > 0 = Split (Just (Two a b)) c (Just (One d)) | otherwise = Split (Just (Three a b c)) d Nothing where va = i + size a vab = va + size b vabc = vab + size c ------------------------------------------------------------------------ -- Lists ------------------------------------------------------------------------ -- | /O(n)/. Create a sequence from a finite list of elements. fromList :: [a] -> Seq a fromList = Data.List.foldl' (|>) empty -- | /O(n)/. List of elements of the sequence. toList :: Seq a -> [a] toList = foldr (:) [] ------------------------------------------------------------------------ -- Folds ------------------------------------------------------------------------ -- | /O(n*t)/. Fold over the elements of a sequence, -- associating to the right. foldr :: (a -> b -> b) -> b -> Seq a -> b foldr f z (Seq xs) = foldrTree f' z xs where f' (Elem x) y = f x y foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b foldrTree _ z Empty = z foldrTree f z (Single x) = x `f` z foldrTree f z (Deep _ pr m sf) = foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr foldrDigit :: (a -> b -> b) -> b -> Digit a -> b foldrDigit f z (One a) = a `f` z foldrDigit f z (Two a b) = a `f` (b `f` z) foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z)) foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z))) foldrNode :: (a -> b -> b) -> b -> Node a -> b foldrNode f z (Node2 _ a b) = a `f` (b `f` z) foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z)) -- | /O(n*t)/. A variant of 'foldr' that has no base case, -- and thus may only be applied to non-empty sequences. foldr1 :: (a -> a -> a) -> Seq a -> a foldr1 f (Seq xs) = getElem (foldr1Tree f' xs) where f' (Elem x) (Elem y) = Elem (f x y) foldr1Tree :: (a -> a -> a) -> FingerTree a -> a foldr1Tree _ Empty = error "foldr1: empty sequence" foldr1Tree _ (Single x) = x foldr1Tree f (Deep _ pr m sf) = foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr foldr1Digit :: (a -> a -> a) -> Digit a -> a foldr1Digit f (One a) = a foldr1Digit f (Two a b) = a `f` b foldr1Digit f (Three a b c) = a `f` (b `f` c) foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d)) -- | /O(n*t)/. Fold over the elements of a sequence, -- associating to the left. foldl :: (a -> b -> a) -> a -> Seq b -> a foldl f z (Seq xs) = foldlTree f' z xs where f' x (Elem y) = f x y foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a foldlTree _ z Empty = z foldlTree f z (Single x) = z `f` x foldlTree f z (Deep _ pr m sf) = foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf foldlDigit :: (a -> b -> a) -> a -> Digit b -> a foldlDigit f z (One a) = z `f` a foldlDigit f z (Two a b) = (z `f` a) `f` b foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d foldlNode :: (a -> b -> a) -> a -> Node b -> a foldlNode f z (Node2 _ a b) = (z `f` a) `f` b foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c -- | /O(n*t)/. A variant of 'foldl' that has no base case, -- and thus may only be applied to non-empty sequences. foldl1 :: (a -> a -> a) -> Seq a -> a foldl1 f (Seq xs) = getElem (foldl1Tree f' xs) where f' (Elem x) (Elem y) = Elem (f x y) foldl1Tree :: (a -> a -> a) -> FingerTree a -> a foldl1Tree _ Empty = error "foldl1: empty sequence" foldl1Tree _ (Single x) = x foldl1Tree f (Deep _ pr m sf) = foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf foldl1Digit :: (a -> a -> a) -> Digit a -> a foldl1Digit f (One a) = a foldl1Digit f (Two a b) = a `f` b foldl1Digit f (Three a b c) = (a `f` b) `f` c foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d ------------------------------------------------------------------------ -- Derived folds ------------------------------------------------------------------------ -- | /O(n*t)/. Fold over the elements of a sequence, -- associating to the right, but strictly. foldr' :: (a -> b -> b) -> b -> Seq a -> b foldr' f z xs = foldl f' id xs z where f' k x z = k $! f x z -- | /O(n*t)/. Monadic fold over the elements of a sequence, -- associating to the right, i.e. from right to left. foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b foldrM f z xs = foldl f' return xs z where f' k x z = f x z >>= k -- | /O(n*t)/. Fold over the elements of a sequence, -- associating to the right, but strictly. foldl' :: (a -> b -> a) -> a -> Seq b -> a foldl' f z xs = foldr f' id xs z where f' x k z = k $! f z x -- | /O(n*t)/. Monadic fold over the elements of a sequence, -- associating to the left, i.e. from left to right. foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a foldlM f z xs = foldr f' return xs z where f' x k z = f z x >>= k ------------------------------------------------------------------------ -- Reverse ------------------------------------------------------------------------ -- | /O(n)/. The reverse of a sequence. reverse :: Seq a -> Seq a reverse (Seq xs) = Seq (reverseTree id xs) reverseTree :: (a -> a) -> FingerTree a -> FingerTree a reverseTree _ Empty = Empty reverseTree f (Single x) = Single (f x) reverseTree f (Deep s pr m sf) = Deep s (reverseDigit f sf) (reverseTree (reverseNode f) m) (reverseDigit f pr) reverseDigit :: (a -> a) -> Digit a -> Digit a reverseDigit f (One a) = One (f a) reverseDigit f (Two a b) = Two (f b) (f a) reverseDigit f (Three a b c) = Three (f c) (f b) (f a) reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a) reverseNode :: (a -> a) -> Node a -> Node a reverseNode f (Node2 s a b) = Node2 s (f b) (f a) reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a) #if TESTING ------------------------------------------------------------------------ -- QuickCheck ------------------------------------------------------------------------ instance Arbitrary a => Arbitrary (Seq a) where arbitrary = liftM Seq arbitrary coarbitrary (Seq x) = coarbitrary x instance Arbitrary a => Arbitrary (Elem a) where arbitrary = liftM Elem arbitrary coarbitrary (Elem x) = coarbitrary x instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where arbitrary = sized arb where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a) arb 0 = return Empty arb 1 = liftM Single arbitrary arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary coarbitrary Empty = variant 0 coarbitrary (Single x) = variant 1 . coarbitrary x coarbitrary (Deep _ pr m sf) = variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf instance (Arbitrary a, Sized a) => Arbitrary (Node a) where arbitrary = oneof [ liftM2 node2 arbitrary arbitrary, liftM3 node3 arbitrary arbitrary arbitrary] coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b coarbitrary (Node3 _ a b c) = variant 1 . coarbitrary a . coarbitrary b . coarbitrary c instance Arbitrary a => Arbitrary (Digit a) where arbitrary = oneof [ liftM One arbitrary, liftM2 Two arbitrary arbitrary, liftM3 Three arbitrary arbitrary arbitrary, liftM4 Four arbitrary arbitrary arbitrary arbitrary] coarbitrary (One a) = variant 0 . coarbitrary a coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b coarbitrary (Three a b c) = variant 2 . coarbitrary a . coarbitrary b . coarbitrary c coarbitrary (Four a b c d) = variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d ------------------------------------------------------------------------ -- Valid trees ------------------------------------------------------------------------ class Valid a where valid :: a -> Bool instance Valid (Elem a) where valid _ = True instance Valid (Seq a) where valid (Seq xs) = valid xs instance (Sized a, Valid a) => Valid (FingerTree a) where valid Empty = True valid (Single x) = valid x valid (Deep s pr m sf) = s == size pr + size m + size sf && valid pr && valid m && valid sf instance (Sized a, Valid a) => Valid (Node a) where valid (Node2 s a b) = s == size a + size b && valid a && valid b valid (Node3 s a b c) = s == size a + size b + size c && valid a && valid b && valid c instance Valid a => Valid (Digit a) where valid (One a) = valid a valid (Two a b) = valid a && valid b valid (Three a b c) = valid a && valid b && valid c valid (Four a b c d) = valid a && valid b && valid c && valid d #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeDrag.chs0000644000000000000000000001210507346545000017454 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface DragSource and DragDest -- -- Author : Axel Simon -- -- Created: 24 July 2007 -- -- Copyright (C) 2007 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) -- -- Interfaces for drag-and-drop support in 'Graphics.UI.Gtk.ModelView.TreeView'. -- module Graphics.UI.Gtk.ModelView.TreeDrag ( -- * Detail -- -- | 'Graphics.UI.Gtk.ModelView.TreeView's provide special support for -- Drag-and-Drop such as hover-to-open-rows or autoscrolling. This module -- implements two utility functions that set and get a path and a model in a -- 'Graphics.UI.Gtk.General.Selection.Selection' structure. These functions -- are thus useful to implement drag-and-drop functionality in a -- 'Graphics.UI.Gtk.ModelView.TreeModel'. In fact, they are used as part of -- the default drag-and-drop interfaces of -- 'Graphics.UI.Gtk.ModelView.ListStore' and -- 'Graphics.UI.Gtk.ModelView.TreeStore' that allows to permute rows and move -- them between hierarchy levels. -- * DND information for exchanging a model and a path. treeModelEqual, targetTreeModelRow, treeGetRowDragData, treeSetRowDragData, ) where -- I've decided not to bind the DragSource and DragDest interfaces. They seem -- to be useful if you (a) write your own 'TreeView' widget or (b) if you -- can't be bothered to implement a special variant of these interfaces in -- ListStore and TreeStore. In the latter case the interfaces are useful to -- "simulate" a drag-and-drop that looks like a row-permutation which is the -- interface that Gtk's ListStore and TreeStore support by default. Since -- overriding or augmenting the dnd interfaces for ListStore and TreeStore is -- so easy in Gtk2Hs, I think we can do without the cheat way. import System.Glib.FFI import System.Glib.UTFString import System.Glib.GObject {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.Types#} (TreePath, fromTreePath, withTreePath, NativeTreePath(..)) import Graphics.UI.Gtk.General.DNDTypes (SelectionDataM, TargetTag, atomNew) import Control.Monad (liftM) import Control.Monad.Trans (liftIO) import Control.Monad.Reader (ask) {# context lib="gtk" prefix="gtk" #} -- this function is not necessary anymore since the models can be compared -- using equality == treeModelEqual :: (TreeModelClass tm1, TreeModelClass tm2) => tm1 -> tm2 -> Bool treeModelEqual tm1 tm2 = unTreeModel (toTreeModel tm1) == unTreeModel (toTreeModel tm2) -- | The 'SelectionTag', 'TargetTag' and 'SelectionTypeTag' of the DND -- mechanism of 'Graphics.UI.Gtk.ModelView.ListStore' and -- 'Graphics.UI.Gtk.ModelView.TreeStore'. This tag is used by -- 'treeGetRowDragData' and 'treeSetRowDragData' to store a store and a -- 'TreePath' in a 'SelectionDataM'. This target should be added to a -- 'Graphics.UI.Gtk.General.Selection.TargetList' using -- 'Graphics.UI.Gtk.General.Seleciton.TargetSameWidget' flag and an -- 'Graphics.UI.Gtk.General.Selection.InfoId' of @0@. -- targetTreeModelRow :: TargetTag targetTreeModelRow = unsafePerformIO $ atomNew ("GTK_TREE_MODEL_ROW"::DefaultGlibString) -- %hash c:8dcb d:af3f -- | Obtains a 'TreeModel' and a path from 'SelectionDataM' whenever the target is -- 'targetTreeModelRow'. Normally called from a 'treeDragDestDragDataReceived' handler. -- treeGetRowDragData :: SelectionDataM (Maybe (TreeModel, TreePath)) treeGetRowDragData = ask >>= \selPtr -> liftIO $ alloca $ \tmPtrPtr -> alloca $ \pathPtrPtr -> do isValid <- liftM toBool $ {# call unsafe gtk_tree_get_row_drag_data #} selPtr (castPtr tmPtrPtr) (castPtr pathPtrPtr) if isValid then do tmPtr <- peek tmPtrPtr pathPtr <- peek pathPtrPtr tm <- makeNewGObject mkTreeModel (return tmPtr) path <- fromTreePath pathPtr return (Just (tm, path)) else return Nothing -- %hash c:e3e3 d:af3f -- | Sets selection data with the target 'targetTreeModelRow', consisting -- of a 'TreeModel' and a 'TreePath'. Normally used in a -- 'treeDragSourceDragDataGet' handler. -- -- * Returns @True@ if setting the data was successful. -- treeSetRowDragData :: TreeModelClass treeModel => treeModel -> TreePath -> SelectionDataM Bool treeSetRowDragData treeModel path = do selPtr <- ask liftM toBool $ liftIO $ withTreePath path $ \path -> {# call unsafe gtk_tree_set_row_drag_data #} selPtr (toTreeModel treeModel) path gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeModel.chs0000644000000000000000000005620307346545000017646 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) TreeModel -- -- Author : Axel Simon -- -- Created: 8 May 2001 -- -- Copyright (C) 1999-2007 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 tree interface used by 'TreeView'. -- module Graphics.UI.Gtk.ModelView.TreeModel ( -- * Detail -- -- | The 'TreeModel' interface defines a generic storage object for use by the -- 'TreeView' and similar widgets. Specifically, the functions in defined here -- are used by Gtk's widgets to access the stored data. Thus, rather than -- calling these functions, an application programmer has to implement them. -- While the module "Graphics.UI.Gtk.ModelView.CustomStore" provides the -- necessary functions to implement the 'TreeMode' interface, it is often -- sufficient to use the wo implementations that come with Gtk2Hs, namely are -- 'ListStore' and 'TreeStore'. -- -- The model is represented as a hierarchical tree of values. It is important -- to note that this interface only provides a way of examining a model and -- observing changes. The implementation of each individual model decides how -- and if changes are made. -- -- Two generic models are provided that implement the 'TreeModel' interface: -- the 'TreeStore' and the 'ListStore'. To use these, the developer simply -- inserts data into these models as necessary. These models provide the data -- structure as well as the 'TreeModel' interface. In fact, they implement -- other interfaces, making drag and drop and storing data trivial. -- -- A 'TreeModel' stores records of the same type. Each record is referred to -- as row, just like in a relational database. Defining how the information of -- a row is displayed can be done in two ways: If the widget displays data -- using 'Graphics.UI.Gtk.ModelView.CellRenderer.CellRenderer' or one of its -- derivatives, it is possible to state how a row is mapped to the attributes -- of a renderer using the -- 'Graphics.UI.Gtk.ModelView.CellLayout.cellLayoutSetAttributes' function. -- Some widgets do not use -- 'Graphics.UI.Gtk.ModelView.CellRenderer.CellRenderer's to display their -- data. In this case an extraction function can be defined that maps a row to -- one of a few basic types (like 'String's or 'Int's). This extraction -- function is associated with a 'ColumnId' using -- 'Graphics.UI.Gtk.ModelView.CustomStore.treeModelSetColumn'. The latter can -- be set in the widget for the property that should be set. The widget then -- uses the function 'treeModelGetValue' and the 'ColumnId' to extract the -- value from the model. As the name suggests, using 'ColumnId's creates a -- view of the data as if each row were divided into a well-defined set of -- columns, again, like a relational database. -- -- Models are accessed on a node level of granularity. There are two index -- types used to reference a particular node in a model. They are the -- 'TreePath' and the 'TreeIter'. Most of the interface consists of operations -- on a 'TreeIter'. -- -- A path is essentially a potential node. It is a location on a model that -- may or may not actually correspond to a node on a specific model. A -- 'TreePath' is in fact a synonym for a list of 'Int's and hence are easy to -- manipulate. Each number refers to the offset at that level. Thus, the path -- @[0]@ refers to the root node and the path @[2,4]@ refers to the fifth -- child of the third node. -- -- By contrast, a 'TreeIter' is a reference to a specific node on a specific -- model. It is an abstract data type filled in by the model. One can convert -- a path to an iterator by calling 'treeModelGetIter'. These iterators are -- the primary way of accessing a model and are similar to the iterators used -- by 'TextBuffer'. The model interface defines a set of operations using them -- for navigating the model. Iterators are expected to always be valid for as -- long as the model is unchanged (and doesn't emit a signal). -- -- * Class Hierarchy -- | -- @ -- | GInterface -- | +----TreeModel -- | +--------TypedTreeModel -- @ -- * Types TreeModel, TreeModelClass, castToTreeModel, gTypeTreeModel, toTreeModel, TypedTreeModel, TypedTreeModelClass, toTypedTreeModel, TreeIter(..), TreePath, ColumnId, -- * Constructors makeColumnIdInt, makeColumnIdBool, makeColumnIdString, makeColumnIdPixbuf, invalidColumnId, -- * Methods columnIdToNumber, stringToTreePath, treeModelGetFlags, treeModelGetIter, treeModelGetIterFromString, treeModelGetIterFirst, treeModelGetPath, treeModelGetValue, treeModelIterNext, treeModelIterChildren, treeModelIterHasChild, treeModelIterNChildren, treeModelIterNthChild, treeModelIterParent, treeModelForeach, #if GTK_CHECK_VERSION(2,2,0) treeModelGetStringFromIter, #endif treeModelRefNode, treeModelUnrefNode, treeModelRowChanged, treeModelRowInserted, treeModelRowHasChildToggled, treeModelRowDeleted, treeModelRowsReordered, -- * Signals rowChanged, rowInserted, rowHasChildToggled, rowDeleted, rowsReordered, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags (toFlags) import System.Glib.UTFString {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Types#} {#import System.Glib.GValue#} (GValue(GValue), allocaGValue) {#import Graphics.UI.Gtk.ModelView.CustomStore#} (TreeModelFlags(..)) {#import Graphics.UI.Gtk.ModelView.Types#} (TypedTreeModel, TypedTreeModelClass, toTypedTreeModel, TreeIter(..), receiveTreeIter, peekTreeIter, TreePath, NativeTreePath(..), withTreePath, fromTreePath, peekTreePath, stringToTreePath, ColumnId(..), ColumnAccess(..)) {#import System.Glib.GValueTypes#} ( valueGetInt, valueGetBool, valueGetString, valueGetGObject ) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a 'ColumnId' to extract an integer. makeColumnIdInt :: Int -> ColumnId row Int makeColumnIdInt = ColumnId valueGetInt CAInt -- | Create a 'ColumnId' to extract an Boolean. makeColumnIdBool :: Int -> ColumnId row Bool makeColumnIdBool = ColumnId valueGetBool CABool -- | Create a 'ColumnId' to extract an string. makeColumnIdString :: GlibString string => Int -> ColumnId row string makeColumnIdString = ColumnId valueGetString CAString -- | Create a 'ColumnId' to extract an 'Pixbuf'. makeColumnIdPixbuf :: Int -> ColumnId row Pixbuf makeColumnIdPixbuf = ColumnId valueGetGObject CAPixbuf -- | Convert a 'ColumnId' to a bare number. columnIdToNumber :: ColumnId row ty -> Int columnIdToNumber (ColumnId _ _ i) = i -- | The invalid 'ColumnId'. Widgets use this value if no column id has -- been set. invalidColumnId :: ColumnId row ty invalidColumnId = ColumnId (error "invalidColumnId: no GValue extractor") (error "invalidColumnId: no access type") (-1) instance Eq (ColumnId row ty) where (ColumnId _ _ i1) == (ColumnId _ _ i2) = i1==i2 instance Show (ColumnId row ty) where show (ColumnId _ _ i) = show i -------------------- -- Methods -- %hash d:35ea -- | Returns a set of flags supported by this interface. -- -- The flags supported should not -- change during the lifecycle of the tree_model. -- treeModelGetFlags :: TreeModelClass self => self -> IO [TreeModelFlags] treeModelGetFlags self = liftM (toFlags . fromIntegral) $ {# call gtk_tree_model_get_flags #} (toTreeModel self) -- %hash c:35a1 d:49a2 -- | Turn a 'String' into a 'TreeIter'. -- -- * Returns @Nothing@ if the string is not a colon separated list of numbers -- that references a valid node. -- treeModelGetIterFromString :: (TreeModelClass self, GlibString string) => self -> string -- ^ @pathString@ - A string representation of a 'TreePath'. -> IO (Maybe TreeIter) treeModelGetIterFromString self pathString = receiveTreeIter $ \iterPtr -> withUTFString pathString $ \pathStringPtr -> {# call tree_model_get_iter_from_string #} (toTreeModel self) iterPtr pathStringPtr -- %hash c:4cd2 d:ad96 -- | Turn a 'TreePath' into a 'TreeIter'. -- -- Returns @Nothing@ if the given 'TreePath' was invalid. The empty list -- is always invalid. The root node of a tree can be accessed by passing -- @[0]@ as @path@. -- treeModelGetIter :: TreeModelClass self => self -> TreePath -- ^ @path@ - The 'TreePath'. -> IO (Maybe TreeIter) treeModelGetIter _ [] = return Nothing treeModelGetIter self path = receiveTreeIter $ \iterPtr -> withTreePath path $ \path -> {# call tree_model_get_iter #} (toTreeModel self) iterPtr path -- %hash c:103f d:8041 -- | Retrieves an 'TreeIter' to the first entry. -- -- Returns @Nothing@ if the table is empty. -- treeModelGetIterFirst :: TreeModelClass self => self -> IO (Maybe TreeIter) treeModelGetIterFirst self = receiveTreeIter $ \iterPtr -> {# call tree_model_get_iter_first #} (toTreeModel self) iterPtr -- %hash c:ec20 d:d43e -- | Turn an abstract 'TreeIter' into a 'TreePath'. -- -- In case the given 'TreeIter' was invalid, an empty list is returned. -- treeModelGetPath :: TreeModelClass self => self -> TreeIter -> IO TreePath treeModelGetPath self iter = with iter $ \iterPtr -> {# call tree_model_get_path #} (toTreeModel self) iterPtr >>= fromTreePath -- | Read the value of at a specific column and 'TreeIter'. -- treeModelGetValue :: TreeModelClass self => self -> TreeIter -> ColumnId row ty -- ^ @column@ - The column to lookup the value at. -> IO ty treeModelGetValue self iter (ColumnId getter _ colId) = allocaGValue $ \gVal -> with iter $ \iterPtr -> do {# call tree_model_get_value #} (toTreeModel self) iterPtr (fromIntegral colId) gVal getter gVal -- %hash c:5c12 d:d7db -- | Retrieve an iterator to the node following it at the current level. If -- there is no next node, @Nothing@ is returned. -- treeModelIterNext :: TreeModelClass self => self -> TreeIter -> IO (Maybe TreeIter) treeModelIterNext self iter = receiveTreeIter $ \iterPtr -> do poke iterPtr iter {# call tree_model_iter_next #} (toTreeModel self) iterPtr -- %hash c:7eba d:27e8 -- | Retrieve an iterator to the first child of @parent@. If @parent@ has no -- children, @Nothing@. -- treeModelIterChildren :: TreeModelClass self => self -> TreeIter -- ^ @parent@ - a pointer to the parent -> IO (Maybe TreeIter) treeModelIterChildren self parent = receiveTreeIter $ \iterPtr -> with parent $ \parentPtr -> {# call tree_model_iter_children #} (toTreeModel self) iterPtr parentPtr -- %hash c:dcc3 -- | Returns @True@ if @iter@ has children, @False@ otherwise. -- treeModelIterHasChild :: TreeModelClass self => self -> TreeIter -- ^ @iter@ - The 'TreeIter' to test for children. -> IO Bool -- ^ returns @True@ if @iter@ has children. treeModelIterHasChild self iter = liftM toBool $ with iter $ \iterPtr -> {# call tree_model_iter_has_child #} (toTreeModel self) iterPtr -- %hash c:eed -- | Returns the number of children that @iter@ has. As a special case, if -- @iter@ is @Nothing@, then the number of toplevel nodes is returned. -- treeModelIterNChildren :: TreeModelClass self => self -> Maybe TreeIter -- ^ @iter@ - The 'TreeIter', or @Nothing@. -> IO Int -- ^ returns The number of children of @iter@. treeModelIterNChildren self iter = liftM fromIntegral $ maybeWith with iter $ \iterPtr -> {# call tree_model_iter_n_children #} (toTreeModel self) iterPtr -- %hash c:6950 d:6f4d -- | Retrieve the @n@th child of @parent@, counting from zero. If @n@ is too -- big or @parent@ has no children, @Nothing@ is returned. If @Nothing@ is -- specified for the @parent@ argument, the function will return the @n@th -- root node. -- treeModelIterNthChild :: TreeModelClass self => self -> Maybe TreeIter -- ^ @parent@ - The 'TreeIter' to get the child from, or -- @Nothing@. -> Int -- ^ @n@ - Then index of the desired child. -> IO (Maybe TreeIter) treeModelIterNthChild self parent n = receiveTreeIter $ \iterPtr -> maybeWith with parent $ \parentPtr -> {# call tree_model_iter_nth_child #} (toTreeModel self) iterPtr parentPtr (fromIntegral n) -- %hash c:8f01 d:70ff -- | Retrieve the parent of this iterator. -- treeModelIterParent :: TreeModelClass self => self -> TreeIter -> IO (Maybe TreeIter) treeModelIterParent self child = receiveTreeIter $ \iterPtr -> with child $ \childPtr -> {# call tree_model_iter_parent #} (toTreeModel self) iterPtr childPtr -- %hash c:154f d:a6d -- | Maps a function over each node in model in a depth-first fashion. If it -- returns @True@, then the tree ceases to be walked, and 'treeModelForeach' -- returns. -- treeModelForeach :: TreeModelClass self => self -> (TreeIter -> IO Bool) -> IO () treeModelForeach self fun = do fPtr <- mkTreeModelForeachFunc (\_ _ iterPtr _ -> do -- make a deep copy of the iterator. This makes it possible to store this -- iterator in Haskell land somewhere. The TreeModel parameter is not -- passed to the function due to performance reasons. But since it is -- a constant this does not matter. iter <- peek iterPtr liftM (fromIntegral.fromBool) $ fun iter ) {# call tree_model_foreach #} (toTreeModel self) fPtr nullPtr freeHaskellFunPtr fPtr {#pointer TreeModelForeachFunc#} foreign import ccall "wrapper" mkTreeModelForeachFunc :: (Ptr TreeModel -> Ptr NativeTreePath -> Ptr TreeIter -> Ptr () -> IO CInt) -> IO TreeModelForeachFunc #if GTK_CHECK_VERSION(2,2,0) -- %hash c:f04a d:94fd -- | Generates a string representation of the iter. This string is a \':\' -- separated list of numbers. For example, \"4:10:0:3\" would be an acceptable -- return value for this string. -- -- * Available since Gtk+ version 2.2 -- treeModelGetStringFromIter :: (TreeModelClass self, GlibString string) => self -> TreeIter -- ^ @iter@ - An 'TreeIter'. -> IO string -- ^ the returned string representation treeModelGetStringFromIter self iter = with iter $ \iter -> {# call gtk_tree_model_get_string_from_iter #} (toTreeModel self) iter >>= readUTFString #endif -- %hash c:228e d:304e -- | Lets the tree ref the node. This is an optional method for models to -- implement. To be more specific, models may ignore this call as it exists -- primarily for performance reasons. -- -- This function is primarily meant as a way for views to let caching model -- know when nodes are being displayed (and hence, whether or not to cache that -- node.) For example, a file-system based model would not want to keep the -- entire file-hierarchy in memory, just the sections that are currently being -- displayed by every current view. -- -- A model should be expected to be able to get an iter independent of its -- reffed state. -- treeModelRefNode :: TreeModelClass self => self -> TreeIter -- ^ @iter@ - The 'TreeIter'. -> IO () treeModelRefNode self iter = with iter $ \iter -> {# call gtk_tree_model_ref_node #} (toTreeModel self) iter -- %hash c:f5d7 d:22a6 -- | Lets the tree unref the node. This is an optional method for models to -- implement. To be more specific, models may ignore this call as it exists -- primarily for performance reasons. -- -- For more information on what this means, see 'treeModelRefNode'. Please -- note that nodes that are deleted are not unreffed. -- treeModelUnrefNode :: TreeModelClass self => self -> TreeIter -- ^ @iter@ - The 'TreeIter'. -> IO () treeModelUnrefNode self iter = with iter $ \iter -> {# call gtk_tree_model_unref_node #} (toTreeModel self) iter -- %hash c:8d25 d:a7c9 -- | Emits the 'rowChanged' signal on the model. -- -- * This function is only necessary to implement a custom tree model. When -- using 'Graphics.UI.Gtk.ModelView.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called -- automatically. -- treeModelRowChanged :: TreeModelClass self => self -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row -> IO () treeModelRowChanged self path iter = with iter $ \iter -> withTreePath path $ \path -> {# call gtk_tree_model_row_changed #} (toTreeModel self) path iter -- %hash c:f809 d:57af -- | Emits the 'rowInserted' signal on the model. -- -- * This function is only necessary to implement a custom tree model. When -- using 'Graphics.UI.Gtk.ModelView.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called -- automatically. -- treeModelRowInserted :: TreeModelClass self => self -> TreePath -- ^ @path@ - A 'TreePath' pointing to the inserted row -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the inserted row -> IO () treeModelRowInserted self path iter = with iter $ \iter -> withTreePath path $ \path -> {# call gtk_tree_model_row_inserted #} (toTreeModel self) path iter -- %hash c:e917 d:6534 -- | Emits the 'rowHasChildToggled' signal on the model. This should be -- called by models after the child state of a node changes. -- -- * This function is only necessary to implement a custom tree model. When -- using 'Graphics.UI.Gtk.ModelView.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called -- automatically. -- treeModelRowHasChildToggled :: TreeModelClass self => self -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row -> IO () treeModelRowHasChildToggled self path iter = with iter $ \iter -> withTreePath path $ \path -> {# call gtk_tree_model_row_has_child_toggled #} (toTreeModel self) path iter -- %hash c:c0a2 d:7ca6 -- | Emits the 'rowDeleted' signal on the model. This should be called by -- models after a row has been removed. The location pointed to by @path@ -- should be the location that the row previously was at. It may not be a -- valid location anymore. -- -- * This function is only necessary to implement a custom tree model. When -- using 'Graphics.UI.Gtk.ModelView.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called -- automatically. -- treeModelRowDeleted :: TreeModelClass self => self -> TreePath -- ^ @path@ - A 'TreePath' pointing to the previous location of -- the deleted row. -> IO () treeModelRowDeleted self path = withTreePath path $ \path -> {# call gtk_tree_model_row_deleted #} (toTreeModel self) path -- %hash c:f0f3 d:a8c5 -- | Emits the 'rowsReordered' signal on the model. This should be called by -- models when their rows have been reordered. The length of @newOrder@ must -- be equal to the value returned by @treeModelIterNChildren self iter@. -- -- * This function is only necessary to implement a custom tree model. When -- using 'Graphics.UI.Gtk.ModelView.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called -- automatically. -- treeModelRowsReordered :: TreeModelClass self => self -> TreePath -- ^ @path@ - A 'TreePath' pointing to the tree node whose -- children have been reordered -> Maybe TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the node whose -- children have been reordered, or @Nothing@ if -- @path@ is @[]@. -> [Int] -- ^ @newOrder@ - a list of integers giving the previous position -- of each node at this hierarchy level. -> IO () treeModelRowsReordered self path iter array = do n <- treeModelIterNChildren self iter let l = length array if n/=l then error ("treeModelRowsReordered: passed-in array is of size " ++show l++" but there are "++show n++ " children at path "++show path) else withTreePath path $ \path -> maybeWith with iter $ \iter -> withArray (map fromIntegral array) $ \newOrderPtr -> {# call gtk_tree_model_rows_reordered #} (toTreeModel self) path iter newOrderPtr -------------------- -- Signals -- %hash c:50c7 d:8da5 -- | This signal is emitted when a row in the model has changed. -- rowChanged :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) rowChanged = Signal (connect_BOXED_BOXED__NONE "row-changed" peekTreePath peekTreeIter) -- %hash c:f31a d:3c6b -- | This signal is emitted when a new row has been inserted in the model. -- -- rowInserted :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) rowInserted = Signal (connect_BOXED_BOXED__NONE "row-inserted" peekTreePath peekTreeIter) -- %hash c:7279 d:5ef -- | This signal is emitted when a row has gotten the first child row or lost -- its last child row. -- rowHasChildToggled :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) rowHasChildToggled = Signal (connect_BOXED_BOXED__NONE "row-has-child-toggled" peekTreePath peekTreeIter) -- %hash c:f669 d:367f -- | This signal is emitted when a row has been deleted. -- -- Note that no iterator is passed to the signal handler, since the row is -- already deleted. -- -- Implementations of 'TreeModel' must emit row-deleted /before/ removing the -- node from its internal data structures. This is because models and views -- which access and monitor this model might have references on the node which -- need to be released in the 'rowDeleted' handler. -- rowDeleted :: TreeModelClass self => Signal self (TreePath -> IO ()) rowDeleted = Signal (connect_BOXED__NONE "row-deleted" peekTreePath) -- %hash c:46dd d:b2e5 -- | This signal is emitted when the children of a node in the 'TreeModel' -- have been reordered. See 'treeModelRowsReordered' for more information -- about the parameters that this signal carries. -- -- Note that this signal is /not/ emitted when rows are reordered by DND, -- since this is implemented by removing and then reinserting the row. -- rowsReordered :: TreeModelClass self => Signal self (TreePath -> Maybe TreeIter -> [Int] -> IO ()) rowsReordered = Signal $ \after model user -> connect_BOXED_BOXED_PTR__NONE "rows-reordered" peekTreePath (maybePeek peekTreeIter) after model $ \path iter arrayPtr -> do n <- treeModelIterNChildren model iter -- hopefully the model is never buggy, otherwise this can segfault newOrder <- peekArray n arrayPtr user path iter (map fromIntegral (newOrder :: [{#type gint#}])) gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs0000644000000000000000000002405407346545000021013 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TreeModelFilter -- -- Author : Axel Simon -- -- Created: 14 January 2008 -- -- Copyright (C) 2008 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) -- -- A 'TreeModel' which hides parts of an underlying tree model -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ModelView.TreeModelFilter ( -- * Detail -- -- | A 'TreeModelFilter' is a tree model which wraps another tree model, and -- can do the following things: -- -- * Filter specific rows, based on a function that examines each row -- indicating whether the row should be shown or not, or -- based on the return value of a visibility function, which is passed -- the 'TreeIter' of the row and returns a Boolean indicating whether the row should -- be shown or not. -- -- * Set a different root node, also known as a \"virtual root\". You can -- pass in a 'TreePath' indicating the root node for the filter at construction -- time. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----TreeModelFilter -- | +----TypedTreeModelFilter -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types TreeModelFilter, TypedTreeModelFilter, TreeModelFilterClass, castToTreeModelFilter, gTypeTreeModelFilter, toTreeModelFilter, -- * Constructors treeModelFilterNew, -- * Methods treeModelFilterSetVisibleFunc, treeModelFilterSetVisibleColumn, treeModelFilterGetModel, treeModelFilterConvertChildIterToIter, treeModelFilterConvertIterToChildIter, treeModelFilterConvertChildPathToPath, treeModelFilterConvertPathToChildPath, treeModelFilterRefilter, treeModelFilterClearCache, -- * Attributes treeModelFilterChildModel, treeModelFilterVirtualRoot, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} {#import Graphics.UI.Gtk.ModelView.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Interfaces instance TreeModelClass (TypedTreeModelFilter a) instance TreeModelFilterClass (TypedTreeModelFilter a) instance GObjectClass (TypedTreeModelFilter a) where toGObject (TypedTreeModelFilter tm) = GObject (castForeignPtr tm) unsafeCastGObject = TypedTreeModelFilter . castForeignPtr . unGObject -------------------- -- Constructors -- %hash c:81e3 d:42cf -- | Creates a new 'TreeModel', with @childModel@ as the child model and -- @root@ as the virtual root. -- treeModelFilterNew :: (TreeModelClass (childModel row), TypedTreeModelClass childModel) => childModel row -- ^ @childModel@ - A 'TreeModel'. -> TreePath -- ^ @root@ - A 'TreePath' or @[]@. -> IO (TypedTreeModelFilter row) treeModelFilterNew childModel [] = liftM unsafeTreeModelFilterToGeneric $ wrapNewGObject mkTreeModelFilter $ liftM (castPtr :: Ptr TreeModel -> Ptr TreeModelFilter) $ {# call gtk_tree_model_filter_new #} (toTreeModel childModel) (NativeTreePath nullPtr) treeModelFilterNew childModel root = liftM unsafeTreeModelFilterToGeneric $ wrapNewGObject mkTreeModelFilter $ liftM (castPtr :: Ptr TreeModel -> Ptr TreeModelFilter) $ withTreePath root $ \root -> {# call gtk_tree_model_filter_new #} (toTreeModel childModel) root -------------------- -- Methods -- %hash c:2349 d:864a -- | Sets the visible function used when filtering the rows to be @func@. -- The function should return @True@ if the given row should be visible and -- @False@ otherwise. The passed-in iterator is an iterator of the child -- model, not of the 'TreeModelFilter' model that is passed in as the first -- argument to this function. -- -- If the condition calculated by the function changes over time (e.g. -- because it depends on some global parameters), you must call -- 'treeModelFilterRefilter' to keep the visibility information of the model -- up to date. -- treeModelFilterSetVisibleFunc :: TreeModelFilterClass self => self -> (TreeIter -> IO Bool) -- ^ @func@ - The visible function -> IO () treeModelFilterSetVisibleFunc self func = do funcPtr <- mkTreeModelFilterVisibleFunc $ \_ tiPtr _ -> do ti <- peekTreeIter tiPtr liftM fromBool $ func ti {# call gtk_tree_model_filter_set_visible_func #} (toTreeModelFilter self) funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr {#pointer TreeModelFilterVisibleFunc #} foreign import ccall "wrapper" mkTreeModelFilterVisibleFunc :: (Ptr TreeModel -> Ptr TreeIter -> Ptr () -> IO {#type gboolean#}) -> IO TreeModelFilterVisibleFunc -- %hash c:a56d d:b42e -- | Sets @column@ of the child model to be the column where the filter model -- should look for visibility information. A row containing @True@ means -- that this row should be shown. -- treeModelFilterSetVisibleColumn :: (TreeModelFilterClass (self row), TypedTreeModelClass self) => self row -> ColumnId row Bool -- ^ @column@ - A column of Booleans that determines -- if a row is visible -> IO () treeModelFilterSetVisibleColumn self col = {# call gtk_tree_model_filter_set_visible_column #} (toTreeModelFilter self) ((fromIntegral . columnIdToNumber) col) -- %hash c:85fb d:a36 -- | Returns a pointer to the child model of @filter@. -- treeModelFilterGetModel :: TreeModelFilterClass self => self -> IO (Maybe TreeModel) -- ^ returns a 'TreeModel'. treeModelFilterGetModel self = maybeNull (makeNewGObject mkTreeModel) $ {# call gtk_tree_model_filter_get_model #} (toTreeModelFilter self) -- %hash c:1b93 d:5689 -- | Return an iterator in the sorted model that points to the row pointed to -- by the given iter from the unfiltered model. -- treeModelFilterConvertChildIterToIter :: TreeModelFilterClass self => self -> TreeIter -> IO TreeIter treeModelFilterConvertChildIterToIter self childIter = with childIter $ \childIterPtr -> alloca $ \filterIterPtr -> do {# call tree_model_filter_convert_child_iter_to_iter #} (toTreeModelFilter self) filterIterPtr childIterPtr peek filterIterPtr -- %hash c:c754 d:c058 -- | Return an iterator in the unfiltered model that points to the row pointed to -- by the given iter from the filtered model. -- treeModelFilterConvertIterToChildIter :: TreeModelFilterClass self => self -> TreeIter -> IO TreeIter treeModelFilterConvertIterToChildIter self filteredIter = with filteredIter $ \filteredIterPtr -> alloca $ \childIterPtr -> do {# call tree_model_filter_convert_iter_to_child_iter #} (toTreeModelFilter self) childIterPtr filteredIterPtr peek childIterPtr -- %hash c:e4e3 d:57be -- | Converts the given path to a path relative to the given filtered model. -- -- * The given path points to a row in the child model. The returned path will -- point to the same row in the filtered model. -- treeModelFilterConvertChildPathToPath :: TreeModelFilterClass self => self -> TreePath -> IO TreePath treeModelFilterConvertChildPathToPath self [] = return [] treeModelFilterConvertChildPathToPath self childPath = withTreePath childPath $ \childPath -> {# call unsafe tree_model_filter_convert_child_path_to_path #} (toTreeModelFilter self) childPath >>= fromTreePath -- %hash c:446d d:db70 -- | Converts path in the filtered model to a path on the unfiltered model on which -- the given 'TreeModelFilter' is based. That is, the given path points to a -- location in the given 'TreeModelFilter'. The returned path will point to the -- same location in the underlying unfiltered model. -- treeModelFilterConvertPathToChildPath :: TreeModelFilterClass self => self -> TreePath -> IO TreePath treeModelFilterConvertPathToChildPath self [] = return [] treeModelFilterConvertPathToChildPath self filteredPath = withTreePath filteredPath $ \filteredPath -> {# call tree_model_filter_convert_path_to_child_path #} (toTreeModelFilter self) filteredPath >>= fromTreePath -- %hash c:ed0b d:1a19 -- | Emits 'rowChanged' for each row in the child model, which causes the -- filter to re-evaluate whether a row is visible or not. -- treeModelFilterRefilter :: TreeModelFilterClass self => self -> IO () treeModelFilterRefilter self = {# call gtk_tree_model_filter_refilter #} (toTreeModelFilter self) -- %hash c:ae64 d:a3b3 -- | This function should almost never be called. It clears the @filter@ of -- any cached iterators that haven't been reffed with 'treeModelRefNode'. This -- might be useful if the child model being filtered is static (and doesn't -- change often) and there has been a lot of unreffed access to nodes. As a -- side effect of this function, all unreffed iters will be invalid. -- treeModelFilterClearCache :: TreeModelFilterClass self => self -- ^ @filter@ - the filter model -> IO () treeModelFilterClearCache self = {# call gtk_tree_model_filter_clear_cache #} (toTreeModelFilter self) -------------------- -- Attributes -- %hash c:8630 d:81a7 -- | The model for the filtermodel to filter. -- treeModelFilterChildModel :: TreeModelFilterClass self => ReadAttr self TreeModel treeModelFilterChildModel = readAttrFromObjectProperty "child-model" {# call pure unsafe gtk_tree_model_get_type #} -- %hash c:263d d:2dd5 -- | The virtual root (relative to the child model) for this filtermodel. -- treeModelFilterVirtualRoot :: TreeModelFilterClass self => ReadAttr self TreePath treeModelFilterVirtualRoot = readAttrFromBoxedOpaqueProperty (peekTreePath . castPtr) "virtual-root" {#call pure unsafe gtk_tree_path_get_type#} #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeModelSort.chs0000644000000000000000000001603307346545000020513 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) TreeModelSort -- -- Author : Duncan Coutts -- -- Created: 4 August 2004 -- -- Copyright (C) 2004-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 (depends on GHC) -- -- A 'TreeModel' which makes an underlying tree model sortable -- module Graphics.UI.Gtk.ModelView.TreeModelSort ( -- * Detail -- -- | The 'TreeModelSort' is a model which implements the 'TreeSortable' -- interface. It does not hold any data itself, but rather is created with a -- child model and proxies its data. It has identical rows to its -- child model, and the changes in the child are propagated. The primary -- purpose of this model is to provide a way to sort a model without -- modifying it. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----TreeModelSort -- @ -- * Types TreeModelSort, TreeModelSortClass, castToTreeModelSort, gTypeTreeModelSort, toTreeModelSort, TypedTreeModelSort, -- * Constructors treeModelSortNewWithModel, -- * Methods treeModelSortGetModel, treeModelSortConvertChildPathToPath, treeModelSortConvertPathToChildPath, treeModelSortConvertChildIterToIter, treeModelSortConvertIterToChildIter, treeModelSortResetDefaultSortFunc, treeModelSortClearCache, #if GTK_CHECK_VERSION(2,2,0) treeModelSortIterIsValid, #endif ) where import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.TreeModel#} {#import Graphics.UI.Gtk.ModelView.Types#} {# context lib="gtk" prefix="gtk" #} instance TreeModelClass (TypedTreeModelSort a) instance TreeModelSortClass (TypedTreeModelSort a) instance GObjectClass (TypedTreeModelSort a) where toGObject (TypedTreeModelSort tm) = GObject (castForeignPtr tm) unsafeCastGObject = TypedTreeModelSort . castForeignPtr . unGObject instance TreeSortableClass TreeModelSort instance TreeSortableClass (TypedTreeModelSort row) -------------------- -- Constructors -- | Creates a new 'TreeModelSort', that will be a sorted view of the given -- model. -- treeModelSortNewWithModel :: (TreeModelClass (childModel row), TypedTreeModelClass childModel) => childModel row -> IO (TypedTreeModelSort row) treeModelSortNewWithModel childModel = liftM unsafeTreeModelSortToGeneric $ wrapNewGObject mkTreeModelSort $ liftM (castPtr :: Ptr TreeModel -> Ptr TreeModelSort) $ {# call tree_model_sort_new_with_model #} (toTreeModel childModel) -------------------- -- Methods -- | Returns the underlying model the 'TreeModelSort' is sorting. -- treeModelSortGetModel :: TreeModelSortClass self => self -> IO TreeModel treeModelSortGetModel self = makeNewGObject mkTreeModel $ {# call tree_model_sort_get_model #} (toTreeModelSort self) -- | Converts the given path to a path relative to the given sorted model. -- -- * The given path points to a row in the child model. The returned path will -- point to the same row in the sorted model. -- treeModelSortConvertChildPathToPath :: TreeModelSortClass self => self -> TreePath -> IO TreePath treeModelSortConvertChildPathToPath self [] = return [] treeModelSortConvertChildPathToPath self childPath = withTreePath childPath $ \childPath -> {# call tree_model_sort_convert_child_path_to_path #} (toTreeModelSort self) childPath >>= fromTreePath -- | Converts path in the sorted model to a path on the unsorted model on which -- the given 'TreeModelSort' is based. That is, the given path points to a -- location in the given 'TreeModelSort'. The returned path will point to the -- same location in the underlying unsorted model. -- treeModelSortConvertPathToChildPath :: TreeModelSortClass self => self -> TreePath -> IO TreePath treeModelSortConvertPathToChildPath self [] = return [] treeModelSortConvertPathToChildPath self sortedPath = withTreePath sortedPath $ \sortedPath -> {# call tree_model_sort_convert_path_to_child_path #} (toTreeModelSort self) sortedPath >>= fromTreePath -- | Return an iterator in the sorted model that points to the row pointed to -- by the given iter from the unsorted model. -- treeModelSortConvertChildIterToIter :: TreeModelSortClass self => self -> TreeIter -> IO TreeIter treeModelSortConvertChildIterToIter self childIter = with childIter $ \childIterPtr -> alloca $ \sortIterPtr -> do {# call tree_model_sort_convert_child_iter_to_iter #} (toTreeModelSort self) sortIterPtr childIterPtr peek sortIterPtr -- | Return an iterator in the unsorted model that points to the row pointed to -- by the given iter from the sorted model. -- treeModelSortConvertIterToChildIter :: TreeModelSortClass self => self -> TreeIter -> IO TreeIter treeModelSortConvertIterToChildIter self sortedIter = with sortedIter $ \sortedIterPtr -> alloca $ \childIterPtr -> do {# call tree_model_sort_convert_iter_to_child_iter #} (toTreeModelSort self) childIterPtr sortedIterPtr peek childIterPtr -- | This resets the default sort function. As a consequence, the order of -- this model will be the same order as that of the child model. -- treeModelSortResetDefaultSortFunc :: TreeModelSortClass self => self -> IO () treeModelSortResetDefaultSortFunc self = {# call tree_model_sort_reset_default_sort_func #} (toTreeModelSort self) -- | Clear the cache of unref'd iterators. -- -- * This function should almost never be called. It clears the -- 'TreeModelSort' of any cached iterators that haven't been reffed with -- 'treeModelRefNode'. This might be useful if the child model being sorted is -- static (and doesn't change often) and there has been a lot of unreffed -- access to nodes. As a side effect of this function, all unreffed iters will -- be invalid. -- treeModelSortClearCache :: TreeModelSortClass self => self -> IO () treeModelSortClearCache self = {# call gtk_tree_model_sort_clear_cache #} (toTreeModelSort self) #if GTK_CHECK_VERSION(2,2,0) -- | Checks if the given iter is a valid iter for this 'TreeModelSort'. -- -- * WARNING: This function is slow. Only use it for debugging and\/or testing -- purposes. -- -- * Available since Gtk+ version 2.2 -- treeModelSortIterIsValid :: TreeModelSortClass self => self -> TreeIter -- ^ @iter@ - A 'TreeIter'. -> IO Bool -- ^ returns @True@ if the iter is valid, @False@ if the iter is -- invalid. treeModelSortIterIsValid self iter = liftM toBool $ with iter $ \iterPtr -> {# call gtk_tree_model_sort_iter_is_valid #} (toTreeModelSort self) iterPtr #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeRowReference.chs0000644000000000000000000000574207346545000021176 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Class TreeRowReference -- -- Author : Duncan Coutts -- -- Created: 14 April 2005 -- -- Copyright (C) 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A persistent index into a tree model. -- module Graphics.UI.Gtk.ModelView.TreeRowReference ( -- * Detail -- -- | A 'RowReference' is an index into a -- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' that is persistent even if -- rows are inserted, deleted or reordered. -- -- * Types TreeRowReference, -- * Constructors treeRowReferenceNew, -- * Methods treeRowReferenceGetPath, treeRowReferenceValid, ) where import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.ModelView.Types#} {# context lib="gtk" prefix="gtk" #} -- | Tree Row Reference : like a 'TreePath' it points to a subtree or node, but -- it is persistent. It identifies the same node (so long as it exists) even -- when items are added, removed, or reordered. -- {#pointer * TreeRowReference foreign newtype#} -------------------- -- Constructors -- | Creates a row reference based on a path. This reference will keep pointing -- to the node pointed to by the given path, so long as it exists. Returns @Nothing@ if there is no node at the given path. -- treeRowReferenceNew :: TreeModelClass self => self -> TreePath -> IO (Maybe TreeRowReference) treeRowReferenceNew self path = withTreePath path $ \path -> do rowRefPtr <- {#call gtk_tree_row_reference_new#} (toTreeModel self) path if rowRefPtr==nullPtr then return Nothing else liftM (Just . TreeRowReference) $ newForeignPtr rowRefPtr tree_row_reference_free -------------------- -- Methods -- | Returns a path that the row reference currently points to. -- -- * The returned path may be the empty list if the reference was invalid. -- treeRowReferenceGetPath :: TreeRowReference -> IO TreePath treeRowReferenceGetPath ref = {# call unsafe tree_row_reference_get_path #} ref >>= fromTreePath -- path must be freed -- | Returns True if the reference refers to a current valid path. -- treeRowReferenceValid :: TreeRowReference -> IO Bool treeRowReferenceValid self = liftM toBool $ {# call unsafe tree_row_reference_valid #} self foreign import ccall unsafe ">k_tree_row_reference_free" tree_row_reference_free :: FinalizerPtr TreeRowReference gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeSelection.chs0000644000000000000000000003074407346545000020535 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TreeSelection -- -- Author : Axel Simon -- -- Created: 8 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The selection object for 'TreeView' -- module Graphics.UI.Gtk.ModelView.TreeSelection ( -- * Detail -- -- | The 'TreeSelection' object is a helper object to manage the selection for -- a 'TreeView' widget. The 'TreeSelection' object is automatically created -- when a new 'TreeView' widget is created, and cannot exist independentally of -- this widget. The primary reason the 'TreeSelection' objects exists is for -- cleanliness of code and API. That is, there is no conceptual reason all -- these functions could not be methods on the 'TreeView' widget instead of a -- separate function. -- -- The 'TreeSelection' object is gotten from a 'TreeView' by calling -- 'treeViewGetSelection'. It can be -- manipulated to check the selection status of the tree, as well as select -- and deselect individual rows. Selection is done completely on the -- 'TreeView' side. As a result, multiple views of the same model can -- have completely different selections. Additionally, you cannot change the -- selection of a row on the model that is not currently displayed by the view -- without expanding its parents first. -- -- One of the important things to remember when monitoring the selection of -- a view is that the \"changed\" signal is mostly a hint. That is, it may only -- emit one signal when a range of rows is selected. Additionally, it may on -- occasion emit a \"changed\" signal when nothing has happened (mostly as a -- result of programmers calling select_row on an already selected row). -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----TreeSelection -- @ -- * Types TreeSelection, TreeSelectionClass, castToTreeSelection, gTypeTreeSelection, toTreeSelection, SelectionMode(..), TreeSelectionCB, TreeSelectionForeachCB, -- * Methods treeSelectionSetMode, treeSelectionGetMode, treeSelectionSetSelectFunction, treeSelectionGetTreeView, treeSelectionGetSelected, treeSelectionSelectedForeach, #if GTK_CHECK_VERSION(2,2,0) treeSelectionGetSelectedRows, treeSelectionCountSelectedRows, #endif treeSelectionSelectPath, treeSelectionUnselectPath, treeSelectionPathIsSelected, treeSelectionSelectIter, treeSelectionUnselectIter, treeSelectionIterIsSelected, treeSelectionSelectAll, treeSelectionUnselectAll, treeSelectionSelectRange, #if GTK_CHECK_VERSION(2,2,0) treeSelectionUnselectRange, #endif -- * Attributes treeSelectionMode, -- * Signals treeSelectionSelectionChanged, #ifndef DISABLE_DEPRECATED -- * Deprecated onSelectionChanged, afterSelectionChanged #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.GList (fromGList) import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (SelectionMode(..)) {#import Graphics.UI.Gtk.ModelView.TreeModel#} {#import Graphics.UI.Gtk.ModelView.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | Set single or multiple choice. -- treeSelectionSetMode :: TreeSelectionClass self => self -> SelectionMode -> IO () treeSelectionSetMode self type_ = {# call tree_selection_set_mode #} (toTreeSelection self) ((fromIntegral . fromEnum) type_) -- | Gets the selection mode. -- treeSelectionGetMode :: TreeSelectionClass self => self -> IO SelectionMode treeSelectionGetMode self = liftM (toEnum . fromIntegral) $ {# call unsafe tree_selection_get_mode #} (toTreeSelection self) -- | Set a callback function if selection changes. -- -- * If set, this function is called before any -- node is selected or unselected, giving some control over which nodes are -- selected. The select function should return @True@ if the state of the node -- may be toggled, and @False@ if the state of the node should be left -- unchanged. treeSelectionSetSelectFunction :: TreeSelectionClass self => self -> TreeSelectionCB -> IO () treeSelectionSetSelectFunction ts fun = do fPtr <- mkTreeSelectionFunc (\_ _ tp _ _ -> do path <- peekTreePath (castPtr tp) liftM fromBool $ fun path ) {# call tree_selection_set_select_function #} (toTreeSelection ts) fPtr (castFunPtrToPtr fPtr) destroyFunPtr -- | Callback type for a function that is called every time the selection -- changes. This function is set with 'treeSelectionSetSelectFunction'. -- type TreeSelectionCB = TreePath -> IO Bool {#pointer TreeSelectionFunc#} foreign import ccall "wrapper" mkTreeSelectionFunc :: (Ptr TreeSelection -> Ptr TreeModel -> Ptr NativeTreePath -> {#type gint#} -> Ptr () -> IO CInt)-> IO TreeSelectionFunc -- | Retrieve the 'TreeView' widget that this 'TreeSelection' works on. -- treeSelectionGetTreeView :: TreeSelectionClass self => self -> IO TreeView treeSelectionGetTreeView self = makeNewObject mkTreeView $ {# call unsafe tree_selection_get_tree_view #} (toTreeSelection self) -- | Retrieves the selection of a single choice 'TreeSelection'. -- treeSelectionGetSelected :: TreeSelectionClass self => self -> IO (Maybe TreeIter) treeSelectionGetSelected self = receiveTreeIter $ \iterPtr -> {# call tree_selection_get_selected #} (toTreeSelection self) nullPtr iterPtr -- | Execute a function for each selected node. -- -- * Note that you cannot modify the tree or selection from within this -- function. Hence, 'treeSelectionGetSelectedRows' might be more useful. -- treeSelectionSelectedForeach :: TreeSelectionClass self => self -> TreeSelectionForeachCB -> IO () treeSelectionSelectedForeach self fun = do fPtr <- mkTreeSelectionForeachFunc (\_ _ iterPtr _ -> do -- make a deep copy of the iterator. This makes it possible to store this -- iterator in Haskell land somewhere. The TreeModel parameter is not -- passed to the function due to performance reasons. But since it is -- a constant member of Selection this does not matter. iter <- peek iterPtr fun iter ) {# call tree_selection_selected_foreach #} (toTreeSelection self) fPtr nullPtr freeHaskellFunPtr fPtr -- | Callback function type for 'treeSelectionSelectedForeach'. -- type TreeSelectionForeachCB = TreeIter -> IO () {#pointer TreeSelectionForeachFunc#} foreign import ccall "wrapper" mkTreeSelectionForeachFunc :: (Ptr TreeModel -> Ptr NativeTreePath -> Ptr TreeIter -> Ptr () -> IO ()) -> IO TreeSelectionForeachFunc #if GTK_CHECK_VERSION(2,2,0) -- | Creates a list of paths of all selected rows. -- -- * Additionally, if you are -- planning on modifying the model after calling this function, you may want to -- convert the returned list into a list of 'TreeRowReference's. To do this, -- you can use 'treeRowReferenceNew'. -- -- * Available since Gtk+ version 2.2 -- treeSelectionGetSelectedRows :: TreeSelectionClass self => self -> IO [TreePath] -- ^ returns a list containing a 'TreePath' for -- each selected row. treeSelectionGetSelectedRows self = {# call gtk_tree_selection_get_selected_rows #} (toTreeSelection self) nullPtr >>= fromGList >>= mapM fromTreePath -- | Returns the number of rows that are selected. -- -- * Available since Gtk+ version 2.2 -- treeSelectionCountSelectedRows :: TreeSelectionClass self => self -> IO Int -- ^ returns The number of rows selected. treeSelectionCountSelectedRows self = liftM fromIntegral $ {# call gtk_tree_selection_count_selected_rows #} (toTreeSelection self) #endif -- | Select a specific item by 'TreePath'. -- treeSelectionSelectPath :: TreeSelectionClass self => self -> TreePath -> IO () treeSelectionSelectPath self [] = return () treeSelectionSelectPath self path = withTreePath path $ \path -> {# call tree_selection_select_path #} (toTreeSelection self) path -- | Deselect a specific item by 'TreePath'. -- treeSelectionUnselectPath :: TreeSelectionClass self => self -> TreePath -> IO () treeSelectionUnselectPath self path = withTreePath path $ \path -> {# call tree_selection_unselect_path #} (toTreeSelection self) path -- | Returns True if the row at the given path is currently selected. -- treeSelectionPathIsSelected :: TreeSelectionClass self => self -> TreePath -> IO Bool treeSelectionPathIsSelected self path = liftM toBool $ withTreePath path $ \path -> {# call tree_selection_path_is_selected #} (toTreeSelection self) path -- | Select a specific item by 'TreeIter'. -- treeSelectionSelectIter :: TreeSelectionClass self => self -> TreeIter -> IO () treeSelectionSelectIter self iter = with iter $ \iterPtr -> {# call tree_selection_select_iter #} (toTreeSelection self) iterPtr -- | Deselect a specific item by 'TreeIter'. -- treeSelectionUnselectIter :: TreeSelectionClass self => self -> TreeIter -> IO () treeSelectionUnselectIter self iter = with iter $ \iterPtr -> {# call tree_selection_unselect_iter #} (toTreeSelection self) iterPtr -- | Returns True if the row at the given iter is currently selected. -- treeSelectionIterIsSelected :: TreeSelectionClass self => self -> TreeIter -> IO Bool treeSelectionIterIsSelected self iter = liftM toBool $ with iter $ \iterPtr -> {# call tree_selection_iter_is_selected #} (toTreeSelection self) iterPtr -- | Selects all the nodes. The tree selection must be set to -- 'SelectionMultiple' mode. -- treeSelectionSelectAll :: TreeSelectionClass self => self -> IO () treeSelectionSelectAll self = {# call tree_selection_select_all #} (toTreeSelection self) -- | Unselects all the nodes. -- treeSelectionUnselectAll :: TreeSelectionClass self => self -> IO () treeSelectionUnselectAll self = {# call tree_selection_unselect_all #} (toTreeSelection self) -- | Selects a range of nodes, determined by @startPath@ and @endPath@ -- inclusive. @selection@ must be set to 'SelectionMultiple' mode. -- treeSelectionSelectRange :: TreeSelectionClass self => self -> TreePath -- ^ @startPath@ - The initial node of the range. -> TreePath -- ^ @endPath@ - The final node of the range. -> IO () treeSelectionSelectRange self startPath endPath = withTreePath endPath $ \endPath -> withTreePath startPath $ \startPath -> {# call tree_selection_select_range #} (toTreeSelection self) startPath endPath #if GTK_CHECK_VERSION(2,2,0) -- | Unselects a range of nodes, determined by @startPath@ and @endPath@ -- inclusive. -- -- * Available since Gtk+ version 2.2 -- treeSelectionUnselectRange :: TreeSelectionClass self => self -> TreePath -- ^ @startPath@ - The initial node of the range. -> TreePath -- ^ @endPath@ - The initial node of the range. -> IO () treeSelectionUnselectRange self startPath endPath = withTreePath endPath $ \endPath -> withTreePath startPath $ \startPath -> {# call tree_selection_unselect_range #} (toTreeSelection self) startPath endPath #endif -------------------- -- Attributes -- | \'mode\' property. See 'treeSelectionGetMode' and 'treeSelectionSetMode' -- treeSelectionMode :: TreeSelectionClass self => Attr self SelectionMode treeSelectionMode = newAttr treeSelectionGetMode treeSelectionSetMode -------------------- -- Signals -- | Emitted whenever the selection has (possibly) changed. Please note that -- this signal is mostly a hint. It may only be emitted once when a range of -- rows are selected, and it may occasionally be emitted when nothing has -- happened. -- treeSelectionSelectionChanged :: TreeSelectionClass self => Signal self (IO ()) treeSelectionSelectionChanged = Signal (connect_NONE__NONE "changed") #ifndef DISABLE_DEPRECATED -------------------- -- Deprecated Signals onSelectionChanged, afterSelectionChanged :: TreeSelectionClass self => self -> IO () -> IO (ConnectId self) onSelectionChanged = connect_NONE__NONE "changed" False afterSelectionChanged = connect_NONE__NONE "changed" True #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeSortable.chs0000644000000000000000000002147707346545000020366 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface TreeSortable -- -- Author : Axel Simon -- -- Created: 8 Mar 2007 -- -- Copyright (C) 1999-2007 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. -- -- Note: there is a constant called GTK_TREE_SORTABLE_UNSORTED_SORT_COLUMN_ID -- which is only used in the C implementation of list store and tree store. -- The TreeModelSort proxy only uses the default column constant. Hence, we do -- not expose or tell the user about the UNSORTED constant since it can only -- be confusing. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The interface for sortable models used by 'TreeView' -- module Graphics.UI.Gtk.ModelView.TreeSortable ( -- * Detail -- -- | 'TreeSortable' is an interface to be implemented by tree models which -- support sorting. The 'TreeView' uses the methods provided by this interface -- to sort the model. As of now, only the -- 'Graphics.UI.Gtk.ModelView.TreeModelSort.TreeModelSort' proxy supports the -- sortable interface. Thus, in order to enable sortable columns in a -- 'TreeView', it is necessary to wrap a -- 'Graphics.UI.Gtk.ModelView.ListStore.ListStore' or -- 'Graphics.UI.Gtk.ModelView.TreeStore.TreeStore' model in a -- 'Graphics.UI.Gtk.ModelView.TreeModelSort.TreeModelSort'. -- -- A 'Graphics.UI.Gtk.ModelView.TreeViewColumn' can be sorted by the user -- though clicking into the column's header. The rows in the view will then be -- sorted by the sorting function set for that column. Specifically, a set of -- sorting functions must be set using the interface provided in this module. -- Each sorting function is associated with a 'SortColumnId', which is some -- positive number. A tree view column is then associated with the sorting -- function by passing the 'SortColumnId' to -- 'Graphics.UI.Gtk.ModelView.TreeViewColumn.treeViewColumnSetSortColumnId'. -- There exists one special 'SortColumnId', namely -- 'treeSortableDefaultSortColumnId' for which a default sorting function can -- be set. If no such function is set, the order of the rows is the order in -- which they are stored in the model. -- * Class Hierarchy -- -- | -- @ -- | 'GInterface' -- | +----TreeSortable -- @ -- * Types TreeSortable, TreeSortableClass, castToTreeSortable, gTypeTreeSortable, toTreeSortable, SortColumnId, -- * Constants treeSortableDefaultSortColumnId, -- * Methods treeSortableGetSortColumnId, treeSortableSetSortColumnId, treeSortableSetSortFunc, treeSortableSetDefaultSortFunc, treeSortableHasDefaultSortFunc, treeSortableSortColumnChanged, -- * Signals sortColumnChanged ) where import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.Enums#} (SortType(..)) {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.ModelView.Types#} import Graphics.UI.Gtk.General.Structs (SortColumnId, treeSortableDefaultSortColumnId ) {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- %hash c:a53 d:e0d2 -- | Query the sort column id that is currently in use. The return value may -- be the special constant 'treeSortableDefaultSortColumnId' in which case -- the returned Boolean flag is @False@. -- treeSortableGetSortColumnId :: TreeSortableClass self => self -> IO (SortType, Bool, SortColumnId) -- ^ @(type, columnSet, sortColumnId)@ -- returns @True@ in @columnSet@ if @sortColumnId@ is not -- 'treeSortableDefaultSortColumnId'. The @type@ value indicates increasing -- or decreasing ordering. treeSortableGetSortColumnId self = alloca $ \orderPtr -> alloca $ \sortColumnIdPtr -> do columnSet <- liftM toBool $ {# call unsafe tree_sortable_get_sort_column_id #} (toTreeSortable self) sortColumnIdPtr orderPtr order <- peek orderPtr sortColumnId <- peek sortColumnIdPtr return (toEnum (fromIntegral order), columnSet, fromIntegral sortColumnId) -- %hash c:8951 d:33ab -- | Sets the current sort column to be @sortColumnId@. The @sortable@ will -- resort itself to reflect this change, after emitting a 'sortColumnChanged' -- signal. If @sortColumnId@ is 'treeSortableDefaultSortColumnId', then the -- default sort function will be used, if it is set. Note that this function -- is mainly used by the view and that the user program should simply set the -- 'SortColumnId' of the 'TreeViewColumn's. -- treeSortableSetSortColumnId :: TreeSortableClass self => self -> SortColumnId -- ^ @sortColumnId@ - the sort column id to set -> SortType -- ^ @order@ - The sort order of the column -> IO () treeSortableSetSortColumnId self sortColumnId order = {# call tree_sortable_set_sort_column_id #} (toTreeSortable self) (fromIntegral sortColumnId) ((fromIntegral . fromEnum) order) -- %hash c:9048 d:c49d -- | Sets the comparison function used when sorting to be @sortFunc@. If the -- current sort column id of @self@ is the same as @sortColumnId@, then the -- model will sort using this function. -- treeSortableSetSortFunc :: TreeSortableClass self => self -> SortColumnId -- ^ @sortColumnId@ - the sort column id to set -- the function for -> (TreeIter -> TreeIter -> IO Ordering) -- ^ @sortFunc@ - The comparison function -> IO () treeSortableSetSortFunc self sortColumnId sortFunc = do fPtr <- mkTreeIterCompareFunc (\_ iter1Ptr iter2Ptr _ -> do iter1 <- peek iter1Ptr iter2 <- peek iter2Ptr liftM orderToGInt $ sortFunc iter1 iter2) {# call tree_sortable_set_sort_func #} (toTreeSortable self) (fromIntegral sortColumnId) fPtr (castFunPtrToPtr fPtr) destroyFunPtr orderToGInt :: Ordering -> {#type gint#} orderToGInt LT = -1 orderToGInt EQ = 0 orderToGInt GT = 1 {#pointer TreeIterCompareFunc#} foreign import ccall "wrapper" mkTreeIterCompareFunc :: (Ptr TreeModel -> Ptr TreeIter -> Ptr TreeIter -> Ptr () -> IO {#type gint#}) -> IO TreeIterCompareFunc -- %hash c:221e d:7c9 -- | Sets the default comparison function used when sorting to be @sortFunc@. -- If the current sort column id of @self@ is -- 'treeSortableDefaultSortColumnId' then the model will sort using -- this function. -- -- | If @sortFunc@ is 'Nothing', then there will be no default comparison function. -- This means that once the -- model has been sorted, it can't go back to the default state. In this case, when the current sort -- column id of sortable is 'TreeSortableDefaultSortColumnId', the model will be unsorted. treeSortableSetDefaultSortFunc :: TreeSortableClass self => self -> Maybe (TreeIter -> TreeIter -> IO Ordering) -- ^ @sortFunc@ - The comparison function -- or 'Nothing' to use default comparison function. -> IO () treeSortableSetDefaultSortFunc self Nothing = do {# call tree_sortable_set_default_sort_func #} (toTreeSortable self) nullFunPtr nullPtr nullFunPtr treeSortableSetDefaultSortFunc self (Just sortFunc) = do fPtr <- mkTreeIterCompareFunc (\_ iter1Ptr iter2Ptr _ -> do iter1 <- peek iter1Ptr iter2 <- peek iter2Ptr liftM orderToGInt $ sortFunc iter1 iter2) {# call tree_sortable_set_default_sort_func #} (toTreeSortable self) fPtr (castFunPtrToPtr fPtr) destroyFunPtr -- %hash c:78ec d:d949 -- | Emits a 'sortColumnChanged' signal on the model. -- treeSortableSortColumnChanged :: TreeSortableClass self => self -> IO () treeSortableSortColumnChanged self = {# call gtk_tree_sortable_sort_column_changed #} (toTreeSortable self) -- %hash c:4a10 d:f107 -- | Returns @True@ if the model has a default sort function. This is used -- primarily by 'Graphics.UI.Gtk.ModelView.TreeViewColumn's in order to -- determine if a model has a default ordering or if the entries are -- retrieved in the sequence in which they are stored in the model. -- treeSortableHasDefaultSortFunc :: TreeSortableClass self => self -> IO Bool -- ^ returns @True@, if the model has a default sort function treeSortableHasDefaultSortFunc self = liftM toBool $ {# call gtk_tree_sortable_has_default_sort_func #} (toTreeSortable self) -------------------- -- Signals -- %hash c:c461 d:af3f -- | -- sortColumnChanged :: TreeSortableClass self => Signal self (IO ()) sortColumnChanged = Signal (connect_NONE__NONE "sort-column-changed") gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeStore.hs0000644000000000000000000006377407346545000017552 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CustomStore TreeModel -- -- Author : Duncan Coutts, Axel Simon -- -- Created: 11 February 2006 -- -- Copyright (C) 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 (depends on GHC) -- -- Standard model to store hierarchical data. -- module Graphics.UI.Gtk.ModelView.TreeStore ( -- * Types TreeStore, -- * Constructors treeStoreNew, treeStoreNewDND, -- * Implementation of Interfaces treeStoreDefaultDragSourceIface, treeStoreDefaultDragDestIface, -- * Methods treeStoreGetValue, treeStoreGetTree, treeStoreLookup, treeStoreSetValue, treeStoreInsert, treeStoreInsertTree, treeStoreInsertForest, treeStoreRemove, treeStoreClear, treeStoreChange, treeStoreChangeM, ) where import Data.Bits import Data.Word (Word32) import Data.Maybe ( fromMaybe, isJust ) import Data.Tree import Control.Monad ( when ) import Control.Exception (assert) import Data.IORef import Graphics.UI.Gtk.ModelView.Types import Graphics.UI.Gtk.Types (GObjectClass(..)) import Graphics.UI.Gtk.ModelView.CustomStore import Graphics.UI.Gtk.ModelView.TreeModel import Graphics.UI.Gtk.ModelView.TreeDrag import Control.Monad.Trans ( liftIO ) -------------------------------------------- -- internal model data types -- -- | A store for hierarchical data. -- newtype TreeStore a = TreeStore (CustomStore (IORef (Store a)) a) instance TypedTreeModelClass TreeStore instance TreeModelClass (TreeStore a) instance GObjectClass (TreeStore a) where toGObject (TreeStore tm) = toGObject tm unsafeCastGObject = TreeStore . unsafeCastGObject -- | Maximum number of nodes on each level. -- -- * These numbers determine how many bits in a 'TreeIter' are devoted to -- each level. Hence, these numbers reflect log2 of the maximum number -- of nodes at a level, rounded up. -- type Depth = [Int] data Store a = Store { depth :: Depth, content :: Cache a } -- | Create a new list store. -- -- * The given rose tree determines the initial content and may be the empty -- list. Each 'Tree' in the forest corresponds to one top-level node. -- -- * The TreeStore maintains the initially given Forest and aligns the 'TreePath' -- bits to fit in 96-bit length 'TreeIter' storage. -- -- * Additionally, a cache is used to achieve higher performance if operating on -- recently used TreePaths. -- -- * __Note:__ due to the limited amount of bits available in TreeIter storage, only -- limited depth forests can be used with this implementation, the result of too deep -- Forests is an undefined behaviour while trying to retrieve the deeply nested nodes. -- For example: assuming the average requiement is 8 bits per tree level (max number of -- children at the level is 255), then we can only use 12 levels deep trees (96/8) - -- any further levels in a TreePath will not be encoded in the corresponding TreeIter -- storage. -- treeStoreNew :: Forest a -> IO (TreeStore a) treeStoreNew forest = treeStoreNewDND forest (Just treeStoreDefaultDragSourceIface) (Just treeStoreDefaultDragDestIface) -- | Create a new list store. -- -- * In addition to 'treeStoreNew', this function takes an two interfaces -- to implement user-defined drag-and-drop functionality. -- treeStoreNewDND :: Forest a -- ^ the initial tree stored in this model -> Maybe (DragSourceIface TreeStore a) -- ^ an optional interface for drags -> Maybe (DragDestIface TreeStore a) -- ^ an optional interface to handle drops -> IO (TreeStore a) treeStoreNewDND forest mDSource mDDest = do storeRef <- newIORef Store { depth = calcForestDepth forest, content = storeToCache forest } let withStore f = readIORef storeRef >>= return . f withStoreUpdateCache f = do store <- readIORef storeRef let (result, cache') = f store writeIORef storeRef store { content = cache' } return result customStoreNew storeRef TreeStore TreeModelIface { treeModelIfaceGetFlags = return [], treeModelIfaceGetIter = \path -> withStore $ \Store { depth = d } -> fromPath d path, treeModelIfaceGetPath = \iter -> withStore $ \Store { depth = d } -> toPath d iter, treeModelIfaceGetRow = \iter -> withStoreUpdateCache $ \Store { depth = d, content = cache } -> case checkSuccess d iter cache of (True, cache'@((_, (Node { rootLabel = val }:_)):_)) -> (val, cache') _ -> error "TreeStore.getRow: iter does not refer to a valid entry", treeModelIfaceIterNext = \iter -> withStoreUpdateCache $ \Store { depth = d, content = cache } -> iterNext d iter cache, treeModelIfaceIterChildren = \mIter -> withStoreUpdateCache $ \Store { depth = d, content = cache } -> let iter = fromMaybe invalidIter mIter in iterNthChild d 0 iter cache, treeModelIfaceIterHasChild = \iter -> withStoreUpdateCache $ \Store { depth = d, content = cache } -> let (mIter, cache') = iterNthChild d 0 iter cache in (isJust mIter, cache'), treeModelIfaceIterNChildren = \mIter -> withStoreUpdateCache $ \Store { depth = d, content = cache } -> let iter = fromMaybe invalidIter mIter in iterNChildren d iter cache, treeModelIfaceIterNthChild = \mIter idx -> withStoreUpdateCache $ \Store { depth = d, content = cache } -> let iter = fromMaybe invalidIter mIter in iterNthChild d idx iter cache, treeModelIfaceIterParent = \iter -> withStore $ \Store { depth = d } -> iterParent d iter, treeModelIfaceRefNode = \_ -> return (), treeModelIfaceUnrefNode = \_ -> return () } mDSource mDDest -- | Default drag functions for -- 'Graphics.UI.Gtk.ModelView.TreeStore'. These functions allow the rows of -- the model to serve as drag source. Any row is allowed to be dragged and the -- data set in the 'SelectionDataM' object is set with 'treeSetRowDragData', -- i.e. it contains the model and the 'TreePath' to the row. treeStoreDefaultDragSourceIface :: DragSourceIface TreeStore row treeStoreDefaultDragSourceIface = DragSourceIface { treeDragSourceRowDraggable = \_ _-> return True, treeDragSourceDragDataGet = treeSetRowDragData, treeDragSourceDragDataDelete = \model dest@(_:_) -> do liftIO $ treeStoreRemove model dest return True } -- | Default drop functions for 'Graphics.UI.Gtk.ModelView.TreeStore'. These -- functions accept a row and insert the row into the new location if it is -- dragged into a tree view -- that uses the same model. treeStoreDefaultDragDestIface :: DragDestIface TreeStore row treeStoreDefaultDragDestIface = DragDestIface { treeDragDestRowDropPossible = \model dest -> do mModelPath <- treeGetRowDragData case mModelPath of Nothing -> return False Just (model', source) -> return (toTreeModel model==toTreeModel model'), treeDragDestDragDataReceived = \model dest@(_:_) -> do mModelPath <- treeGetRowDragData case mModelPath of Nothing -> return False Just (model', source@(_:_)) -> if toTreeModel model/=toTreeModel model' then return False else liftIO $ do row <- treeStoreGetTree model source treeStoreInsertTree model (init dest) (last dest) row return True } -------------------------------------------- -- low level bit-twiddling utility functions -- bitsNeeded :: Word32 -> Int bitsNeeded n = bitsNeeded' 0 n where bitsNeeded' b 0 = b bitsNeeded' b n = bitsNeeded' (b+1) (n `shiftR` 1) getBitSlice :: TreeIter -> Int -> Int -> Word32 getBitSlice (TreeIter _ a b c) off count = getBitSliceWord a off count .|. getBitSliceWord b (off-32) count .|. getBitSliceWord c (off-64) count where getBitSliceWord :: Word32 -> Int -> Int -> Word32 getBitSliceWord word off count = word `shift` (-off) .&. (1 `shiftL` count - 1) setBitSlice :: TreeIter -> Int -> Int -> Word32 -> TreeIter setBitSlice (TreeIter stamp a b c) off count value = assert (value < 1 `shiftL` count) $ TreeIter stamp (setBitSliceWord a off count value) (setBitSliceWord b (off-32) count value) (setBitSliceWord c (off-64) count value) where setBitSliceWord :: Word32 -> Int -> Int -> Word32 -> Word32 setBitSliceWord word off count value = let mask = (1 `shiftL` count - 1) `shift` off in (word .&. complement mask) .|. (value `shift` off) --iterPrefixEqual :: TreeIter -> TreeIter -> Int -> Bool --iterPrefixEqual (TreeIter _ a1 b1 c1) (TreeIter _ a2 b2 c2) pos -- | pos>64 = let mask = 1 `shiftL` (pos-64) - 1 in -- a1==a2 && b1==b2 && (c1 .&. mask) == (c2 .&. mask) -- | pos>32 = let mask = 1 `shiftL` (pos-32) - 1 in -- a1==a2 && (b1 .&. mask) == (b2 .&. mask) -- | otherwise = let mask = 1 `shiftL` pos - 1 in -- (a1 .&. mask) == (a2 .&. mask) -- | The invalid tree iterator. -- invalidIter :: TreeIter invalidIter = TreeIter 0 0 0 0 --showIterBits (TreeIter _ a b c) = [showBits a, showBits b, showBits c] -- --showBits :: Bits a => a -> String --showBits a = [ if testBit a i then '1' else '0' | i <- [0..bitSize a - 1] ] -- | Calculate the maximum number of nodes on a per-level basis. -- calcForestDepth :: Forest a -> Depth calcForestDepth f = map bitsNeeded $ takeWhile (/=0) $ foldr calcTreeDepth (repeat 0) f where calcTreeDepth Node { subForest = f } (d:ds) = (d+1): zipWith max ds (foldr calcTreeDepth (repeat 0) f) -- | Convert an iterator into a path. -- toPath :: Depth -> TreeIter -> TreePath toPath d iter = gP 0 d where gP pos [] = [] gP pos (d:ds) = let idx = getBitSlice iter pos d in if idx==0 then [] else fromIntegral (idx-1) : gP (pos+d) ds -- | Try to convert a path into a 'TreeIter'. -- fromPath :: Depth -> TreePath -> Maybe TreeIter fromPath = fP 0 invalidIter where fP pos ti _ [] = Just ti -- the remaining bits are zero anyway fP pos ti [] _ = Nothing fP pos ti (d:ds) (p:ps) = let idx = fromIntegral (p+1) in if idx >= bit d then Nothing else fP (pos+d) (setBitSlice ti pos d idx) ds ps -- | The 'Cache' type synonym is only used iternally. What it represents -- the stack during a (fictional) lookup operations. -- The topmost frame is the node -- for which this lookup was started and the innermost frame (the last -- element of the list) contains the root of the tree. -- type Cache a = [(TreeIter, Forest a)] -- | Create a traversal structure that allows a pre-order traversal in linear -- time. -- -- * The returned structure points at the root of the first level which doesn't -- really exist, but serves to indicate that it is before the very first -- node. -- storeToCache :: Forest a -> Cache a storeToCache [] = [] storeToCache forest = [(invalidIter, [Node root forest])] where root = error "TreeStore.storeToCache: accessed non-exitent root of tree" -- | Extract the store from the cache data structure. cacheToStore :: Cache a -> Forest a cacheToStore [] = [] cacheToStore cache = case last cache of (_, [Node _ forest]) -> forest -- | Advance the traversal structure to the given 'TreeIter'. -- advanceCache :: Depth -> TreeIter -> Cache a -> Cache a advanceCache depth goal [] = [] advanceCache depth goal cache@((rootIter,_):_) = moveToSameLevel 0 depth where moveToSameLevel pos [] = cache moveToSameLevel pos (d:ds) = let goalIdx = getBitSlice goal pos d curIdx = getBitSlice rootIter pos d isNonZero pos d (ti,_) = getBitSlice ti pos d/=0 in if goalIdx==curIdx then moveToSameLevel (pos+d) ds else if goalIdx==0 then dropWhile (isNonZero pos d) cache else if curIdx==0 then moveToChild pos (d:ds) cache else if goalIdx cache (d':_) -> dropWhile (isNonZero (pos+d) d') cache -- Descend into the topmost forest to find the goal iterator. The position -- and the remainding depths specify the index in the cache that is zero. -- All indices in front of pos coincide with that of the goal iterator. moveToChild :: Int -> Depth -> Cache a -> Cache a moveToChild pos [] cache = cache -- we can't set more than the leaf moveToChild pos (d:ds) cache@((ti,forest):parents) | getBitSlice goal pos d == 0 = cache | otherwise = case forest of [] -> cache -- impossible request Node { subForest = children }:_ -> let childIdx :: Int childIdx = fromIntegral (getBitSlice goal pos d)-1 (dropped, remain) = splitAt childIdx children advanced = length dropped ti' = setBitSlice ti pos d (fromIntegral advanced+1) in if advanced TreeIter -> Cache a -> (Bool, Cache a) checkSuccess depth iter cache = case advanceCache depth iter cache of cache'@((cur,sibs):_) -> (cmp cur iter && not (null sibs), cache') [] -> (False, []) where cmp (TreeIter _ a1 b1 c1) (TreeIter _ a2 b2 c2) = a1==a2 && b1==b2 && c2==c2 -- | Get the leaf index of this iterator. -- -- * Due to the way we construct the 'TreeIter's, we can check which the last -- level of an iterator is: The bit sequence of level n is zero if n is -- greater or equal to the level that the iterator refers to. The returned -- triple is (pos, leaf, zero) such that pos..pos+leaf denotes the leaf -- index and pos+leaf..pos+leaf+zero denotes the bit field that is zero. -- getTreeIterLeaf :: Depth -> TreeIter -> (Int, Int, Int) getTreeIterLeaf ds ti = gTIL 0 0 ds where gTIL pos dCur (dNext:ds) | getBitSlice ti (pos+dCur) dNext==0 = (pos,dCur,dNext) | otherwise = gTIL (pos+dCur) dNext ds gTIL pos d [] = (pos, d, 0) -- | Move an iterator forwards on the same level. -- iterNext :: Depth -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a) iterNext depth iter cache = let (pos,leaf,_child) = getTreeIterLeaf depth iter curIdx = getBitSlice iter pos leaf nextIdx = curIdx+1 nextIter = setBitSlice iter pos leaf nextIdx in if nextIdx==bit leaf then (Nothing, cache) else case checkSuccess depth nextIter cache of (True, cache) -> (Just nextIter, cache) (False, cache) -> (Nothing, cache) -- | Move down to the child of the given iterator. -- iterNthChild :: Depth -> Int -> TreeIter -> Cache a -> (Maybe TreeIter, Cache a) iterNthChild depth childIdx_ iter cache = let (pos,leaf,child) = getTreeIterLeaf depth iter childIdx = fromIntegral childIdx_+1 nextIter = setBitSlice iter (pos+leaf) child childIdx in if childIdx>=bit child then (Nothing, cache) else case checkSuccess depth nextIter cache of (True, cache) -> (Just nextIter, cache) (False, cache) -> (Nothing, cache) -- | Descend to the first child. -- iterNChildren :: Depth -> TreeIter -> Cache a -> (Int, Cache a) iterNChildren depth iter cache = case checkSuccess depth iter cache of (True, cache@((_,Node { subForest = forest}:_):_)) -> (length forest, cache) (_, cache) -> (0, cache) -- | Ascend to parent. -- iterParent :: Depth -> TreeIter -> Maybe TreeIter iterParent depth iter = let (pos,leaf,_child) = getTreeIterLeaf depth iter in if pos==0 then Nothing else if getBitSlice iter pos leaf==0 then Nothing else Just (setBitSlice iter pos leaf 0) -- | Insert nodes into the store. -- -- * The given list of nodes is inserted into given parent at @pos@. -- If the parent existed, the function returns @Just path@ where @path@ -- is the position of the newly inserted elements. If @pos@ is negative -- or greater or equal to the number of children of the node at @path@, -- the new nodes are appended to the list. -- treeStoreInsertForest :: TreeStore a -- ^ the store -> TreePath -- ^ @path@ - the position of the parent -> Int -- ^ @pos@ - the index of the new tree -> Forest a -- ^ the list of trees to be inserted -> IO () treeStoreInsertForest (TreeStore model) path pos nodes = do customStoreInvalidateIters model (idx, toggle) <- atomicModifyIORef (customStoreGetPrivate model) $ \store@Store { depth = d, content = cache } -> case insertIntoForest (cacheToStore cache) nodes path pos of Nothing -> error ("treeStoreInsertForest: path does not exist " ++ show path) Just (newForest, idx, toggle) -> let depth = calcForestDepth newForest in (Store { depth = depth, content = storeToCache newForest }, (idx, toggle)) Store { depth = depth } <- readIORef (customStoreGetPrivate model) let rpath = reverse path stamp <- customStoreGetStamp model sequence_ [ let p' = reverse p Just iter = fromPath depth p' in treeModelRowInserted model p' (treeIterSetStamp iter stamp) | (i, node) <- zip [idx..] nodes , p <- paths (i : rpath) node ] let Just iter = fromPath depth path when toggle $ treeModelRowHasChildToggled model path (treeIterSetStamp iter stamp) where paths :: TreePath -> Tree a -> [TreePath] paths path Node { subForest = ts } = path : concat [ paths (n:path) t | (n, t) <- zip [0..] ts ] -- | Insert a node into the store. -- treeStoreInsertTree :: TreeStore a -- ^ the store -> TreePath -- ^ @path@ - the position of the parent -> Int -- ^ @pos@ - the index of the new tree -> Tree a -- ^ the value to be inserted -> IO () treeStoreInsertTree store path pos node = treeStoreInsertForest store path pos [node] -- | Insert a single node into the store. -- -- * This function inserts a single node without children into the tree. -- Its arguments are similar to those of 'treeStoreInsert'. -- treeStoreInsert :: TreeStore a -- ^ the store -> TreePath -- ^ @path@ - the position of the parent -> Int -- ^ @pos@ - the index of the new tree -> a -- ^ the value to be inserted -> IO () treeStoreInsert store path pos node = treeStoreInsertForest store path pos [Node node []] -- | Insert nodes into a forest. -- -- * If the parent was found, returns the new tree, the child number -- and a flag denoting if these new nodes were the first children -- of the parent. -- insertIntoForest :: Forest a -> Forest a -> TreePath -> Int -> Maybe (Forest a, Int, Bool) insertIntoForest forest nodes [] pos | pos<0 = Just (forest++nodes, length forest, null forest) | otherwise = Just (prev++nodes++next, length prev, null forest) where (prev, next) = splitAt pos forest insertIntoForest forest nodes (p:ps) pos = case splitAt p forest of (prev, []) -> Nothing (prev, Node { rootLabel = val, subForest = for}:next) -> case insertIntoForest for nodes ps pos of Nothing -> Nothing Just (for, pos, toggle) -> Just (prev++Node { rootLabel = val, subForest = for }:next, pos, toggle) -- | Remove a node from the store. -- -- * The node denoted by the path is removed, along with all its children. -- The function returns @True@ if the given node was found. -- treeStoreRemove :: TreeStore a -> TreePath -> IO Bool --TODO: eliminate this special case without segfaulting! treeStoreRemove (TreeStore model) [] = return False treeStoreRemove (TreeStore model) path = do customStoreInvalidateIters model (found, toggle) <- atomicModifyIORef (customStoreGetPrivate model) $ \store@Store { depth = d, content = cache } -> if null cache then (store, (False, False)) else case deleteFromForest (cacheToStore cache) path of Nothing -> (store, (False, False)) Just (newForest, toggle) -> (Store { depth = d, -- this might be a space leak content = storeToCache newForest }, (True, toggle)) when found $ do when (toggle && not (null path)) $ do Store { depth = depth } <- readIORef (customStoreGetPrivate model) let parent = init path Just iter = fromPath depth parent treeModelRowHasChildToggled model parent iter treeModelRowDeleted model path return found treeStoreClear :: TreeStore a -> IO () treeStoreClear (TreeStore model) = do customStoreInvalidateIters model Store { content = cache } <- readIORef (customStoreGetPrivate model) let forest = cacheToStore cache writeIORef (customStoreGetPrivate model) Store { depth = calcForestDepth [], content = storeToCache [] } let loop (-1) = return () loop n = treeModelRowDeleted model [n] >> loop (n-1) loop (length forest - 1) -- | Remove a node from a rose tree. -- -- * Returns the new tree if the node was found. The returned flag is -- @True@ if deleting the node left the parent without any children. -- deleteFromForest :: Forest a -> TreePath -> Maybe (Forest a, Bool) deleteFromForest forest [] = Just ([], False) deleteFromForest forest (p:ps) = case splitAt p forest of (prev, kill@Node { rootLabel = val, subForest = for}:next) -> if null ps then Just (prev++next, null prev && null next) else case deleteFromForest for ps of Nothing -> Nothing Just (for,toggle) -> Just (prev++Node {rootLabel = val, subForest = for }:next, toggle) (prev, []) -> Nothing -- | Set a node in the store. -- treeStoreSetValue :: TreeStore a -> TreePath -> a -> IO () treeStoreSetValue store path value = treeStoreChangeM store path (\_ -> return value) >> return () -- | Change a node in the store. -- -- * Returns @True@ if the node was found. For a monadic version, see -- 'treeStoreChangeM'. -- treeStoreChange :: TreeStore a -> TreePath -> (a -> a) -> IO Bool treeStoreChange store path func = treeStoreChangeM store path (return . func) -- | Change a node in the store. -- -- * Returns @True@ if the node was found. For a purely functional version, see -- 'treeStoreChange'. -- treeStoreChangeM :: TreeStore a -> TreePath -> (a -> IO a) -> IO Bool treeStoreChangeM (TreeStore model) path act = do customStoreInvalidateIters model store@Store { depth = d, content = cache } <- readIORef (customStoreGetPrivate model) (store'@Store { depth = d, content = cache }, found) <- do mRes <- changeForest (cacheToStore cache) act path return $ case mRes of Nothing -> (store, False) Just newForest -> (Store { depth = d, content = storeToCache newForest }, True) writeIORef (customStoreGetPrivate model) store' let Just iter = fromPath d path stamp <- customStoreGetStamp model when found $ treeModelRowChanged model path (treeIterSetStamp iter stamp) return found -- | Change a node in the forest. -- -- * Returns @True@ if the given node was found. -- changeForest :: Forest a -> (a -> IO a) -> TreePath -> IO (Maybe (Forest a)) changeForest forest act [] = return Nothing changeForest forest act (p:ps) = case splitAt p forest of (prev, []) -> return Nothing (prev, Node { rootLabel = val, subForest = for}:next) -> if null ps then do val' <- act val return (Just (prev++Node { rootLabel = val', subForest = for }:next)) else do mFor <- changeForest for act ps case mFor of Nothing -> return Nothing Just for -> return $ Just (prev++Node { rootLabel = val, subForest = for }:next) -- | Extract one node from the current model. Fails if the given -- 'TreePath' refers to a non-existent node. -- treeStoreGetValue :: TreeStore a -> TreePath -> IO a treeStoreGetValue model path = fmap rootLabel (treeStoreGetTree model path) -- | Extract a subtree from the current model. Fails if the given -- 'TreePath' refers to a non-existent node. -- treeStoreGetTree :: TreeStore a -> TreePath -> IO (Tree a) treeStoreGetTree (TreeStore model) path = do store@Store { depth = d, content = cache } <- readIORef (customStoreGetPrivate model) case fromPath d path of (Just iter) -> do let (res, cache') = checkSuccess d iter cache writeIORef (customStoreGetPrivate model) store { content = cache' } case cache' of ((_,node:_):_) | res -> return node _ -> fail ("treeStoreGetTree: path does not exist " ++ show path) _ -> fail ("treeStoreGetTree: path does not exist " ++ show path) -- | Extract a subtree from the current model. Like 'treeStoreGetTree' -- but returns @Nothing@ if the path refers to a non-existent node. -- treeStoreLookup :: TreeStore a -> TreePath -> IO (Maybe (Tree a)) treeStoreLookup (TreeStore model) path = do store@Store { depth = d, content = cache } <- readIORef (customStoreGetPrivate model) case fromPath d path of (Just iter) -> do let (res, cache') = checkSuccess d iter cache writeIORef (customStoreGetPrivate model) store { content = cache' } case cache' of ((_,node:_):_) | res -> return (Just node) _ -> return Nothing _ -> return Nothing gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeView.chs0000644000000000000000000020405507346545000017520 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TreeView -- -- Author : Axel Simon -- -- Created: 9 May 2001 -- -- Copyright (C) 2001-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. -- -- TODO -- -- gtk_tree_view_get_bin_window is to compare the GDK window from incoming -- events. We don't marshal that window parameter, so this function is not -- bound either. -- -- The following functions related to drag and drop: -- treeViewSetDragDestRow, treeViewGetDragDestRow, treeViewGetDestRowAtPos -- these seem to be useful only in cases when the user wants to implement -- drag and drop himself rather than use the widget's implementation. I -- think this would be a bad idea in the first place. -- -- get_search_equal_func is missing: proper memory management is impossible -- -- gtk_tree_view_set_destroy_count_func is not meant to be useful -- -- expand-collapse-cursor-row needs to be bound if it is useful to expand -- and collapse rows in a user-defined manner. Would only work on Gtk 2.2 -- and higher since the return parameter changed -- -- move_cursor, select_all, select_cursor_parent, select_cursor_row -- toggle_cursor_row, unselect_all are not bound. -- These functions are only useful to change the widgets -- behaviour for these actions. Everything else can be done with -- cursor_changed and columns_changed -- -- set_scroll_adjustment makes sense if the user monitors the scroll bars -- and the scroll bars can be replaced anytime (the latter is odd) -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A widget for displaying both trees and lists. -- module Graphics.UI.Gtk.ModelView.TreeView ( -- * Description -- -- | Widget that displays any object that implements the 'TreeModel' -- interface. -- -- The widget supports scrolling natively. This implies that pixel -- coordinates can be given in two formats: relative to the current view's -- upper left corner or relative to the whole list's coordinates. The former -- are called widget coordinates while the letter are called tree -- coordinates. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----TreeView -- @ -- * Types TreeView, TreeViewClass, castToTreeView, gTypeTreeView, toTreeView, Point, DragAction(..), #if GTK_CHECK_VERSION(2,10,0) TreeViewGridLines(..), #endif -- * Constructors treeViewNew, treeViewNewWithModel, -- * Methods treeViewGetModel, treeViewSetModel, treeViewGetSelection, treeViewGetHAdjustment, treeViewSetHAdjustment, treeViewGetVAdjustment, treeViewSetVAdjustment, treeViewGetHeadersVisible, treeViewSetHeadersVisible, treeViewColumnsAutosize, treeViewSetHeadersClickable, treeViewGetRulesHint, treeViewSetRulesHint, treeViewAppendColumn, treeViewRemoveColumn, treeViewInsertColumn, treeViewGetColumn, treeViewGetColumns, treeViewMoveColumnAfter, treeViewMoveColumnFirst, treeViewSetExpanderColumn, treeViewGetExpanderColumn, treeViewSetColumnDragFunction, treeViewScrollToPoint, treeViewScrollToCell, treeViewSetCursor, #if GTK_CHECK_VERSION(2,2,0) treeViewSetCursorOnCell, #endif treeViewGetCursor, treeViewRowActivated, treeViewExpandAll, treeViewCollapseAll, #if GTK_CHECK_VERSION(2,2,0) treeViewExpandToPath, #endif treeViewExpandRow, treeViewCollapseRow, treeViewMapExpandedRows, treeViewRowExpanded, treeViewGetReorderable, treeViewSetReorderable, treeViewGetPathAtPos, treeViewGetCellArea, treeViewGetBackgroundArea, treeViewGetVisibleRect, #if GTK_CHECK_VERSION(2,12,0) treeViewConvertBinWindowToTreeCoords, treeViewConvertBinWindowToWidgetCoords, treeViewConvertTreeToBinWindowCoords, treeViewConvertTreeToWidgetCoords, treeViewConvertWidgetToBinWindowCoords, treeViewConvertWidgetToTreeCoords, #endif #if GTK_MAJOR_VERSION < 3 treeViewCreateRowDragIcon, #endif treeViewGetEnableSearch, treeViewSetEnableSearch, treeViewGetSearchColumn, treeViewSetSearchColumn, treeViewSetSearchEqualFunc, #if GTK_CHECK_VERSION(2,6,0) treeViewGetFixedHeightMode, treeViewSetFixedHeightMode, treeViewGetHoverSelection, treeViewSetHoverSelection, treeViewGetHoverExpand, treeViewSetHoverExpand, #if GTK_CHECK_VERSION(2,10,0) treeViewGetHeadersClickable, #endif #endif #if GTK_CHECK_VERSION(2,8,0) treeViewGetVisibleRange, #endif #if GTK_CHECK_VERSION(2,10,0) treeViewEnableModelDragDest, treeViewEnableModelDragSource, treeViewUnsetRowsDragSource, treeViewUnsetRowsDragDest, treeViewGetSearchEntry, treeViewSetSearchEntry, #endif #if GTK_CHECK_VERSION(2,6,0) treeViewSetRowSeparatorFunc, #if GTK_CHECK_VERSION(2,10,0) treeViewGetRubberBanding, treeViewSetRubberBanding, treeViewGetEnableTreeLines, treeViewSetEnableTreeLines, treeViewGetGridLines, treeViewSetGridLines, #endif #endif #if GTK_CHECK_VERSION(2,12,0) treeViewSetTooltipRow, treeViewSetTooltipCell, treeViewGetTooltipContext, #endif -- * Attributes treeViewModel, treeViewHAdjustment, treeViewVAdjustment, treeViewHeadersVisible, treeViewHeadersClickable, treeViewExpanderColumn, treeViewReorderable, treeViewRulesHint, treeViewEnableSearch, treeViewSearchColumn, #if GTK_CHECK_VERSION(2,4,0) treeViewFixedHeightMode, #if GTK_CHECK_VERSION(2,6,0) treeViewHoverSelection, treeViewHoverExpand, #endif #endif treeViewShowExpanders, treeViewLevelIndentation, treeViewRubberBanding, #if GTK_CHECK_VERSION(2,10,0) treeViewEnableGridLines, #endif treeViewEnableTreeLines, #if GTK_CHECK_VERSION(2,10,0) treeViewGridLines, treeViewSearchEntry, #endif #if GTK_CHECK_VERSION(2,12,0) treeViewTooltipColumn, #endif -- * Signals columnsChanged, cursorChanged, rowCollapsed, rowExpanded, rowActivated, testCollapseRow, testExpandRow, -- * Deprecated #ifndef DISABLE_DEPRECATED #if GTK_MAJOR_VERSION < 3 treeViewWidgetToTreeCoords, treeViewTreeToWidgetCoords, #endif onColumnsChanged, afterColumnsChanged, onCursorChanged, afterCursorChanged, onRowActivated, afterRowActivated, onRowCollapsed, afterRowCollapsed, onRowExpanded, afterRowExpanded, onStartInteractiveSearch, afterStartInteractiveSearch, onTestCollapseRow, afterTestCollapseRow, onTestExpandRow, afterTestExpandRow #endif ) where import Control.Monad (liftM,) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList (fromGList) import System.Glib.Flags import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Gdk.Enums (DragAction(..)) import Graphics.UI.Gtk.Gdk.Events (Modifier(..)) import Graphics.UI.Gtk.General.Structs (Point, Rectangle) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.ModelView.TreeModel (columnIdToNumber, makeColumnIdString) {#import Graphics.UI.Gtk.ModelView.Types#} {#import Graphics.UI.Gtk.General.DNDTypes#} (TargetList(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'TreeView' widget. -- treeViewNew :: IO TreeView treeViewNew = makeNewObject mkTreeView $ liftM (castPtr :: Ptr Widget -> Ptr TreeView) $ {# call tree_view_new #} -- | Create a new 'TreeView' -- widget with @model@ as the storage model. -- treeViewNewWithModel :: TreeModelClass model => model -> IO TreeView treeViewNewWithModel model = makeNewObject mkTreeView $ liftM (castPtr :: Ptr Widget -> Ptr TreeView) $ {# call tree_view_new_with_model #} (toTreeModel model) -------------------- -- Methods -- | Returns the model that supplies the data for -- this 'TreeView'. Returns @Nothing@ if the model is unset. -- treeViewGetModel :: TreeViewClass self => self -> IO (Maybe TreeModel) treeViewGetModel self = maybeNull (makeNewGObject mkTreeModel) $ {# call unsafe tree_view_get_model #} (toTreeView self) -- | Set the 'TreeModel' for the current View. -- treeViewSetModel :: (TreeViewClass self, TreeModelClass model) => self -> Maybe model -> IO () treeViewSetModel self model = {# call tree_view_set_model #} (toTreeView self) (maybe (TreeModel nullForeignPtr) toTreeModel model) -- | Retrieve a 'TreeSelection' that -- holds the current selected nodes of the View. -- treeViewGetSelection :: TreeViewClass self => self -> IO TreeSelection treeViewGetSelection self = makeNewGObject mkTreeSelection $ {# call unsafe tree_view_get_selection #} (toTreeView self) -- | Gets the 'Adjustment' currently being used for the horizontal aspect. -- treeViewGetHAdjustment :: TreeViewClass self => self -> IO (Maybe Adjustment) treeViewGetHAdjustment self = maybeNull (makeNewObject mkAdjustment) $ {# call unsafe tree_view_get_hadjustment #} (toTreeView self) -- | Sets the 'Adjustment' for the current horizontal aspect. -- treeViewSetHAdjustment :: TreeViewClass self => self -> Maybe Adjustment -- ^ @adjustment@ - The 'Adjustment' to set, or @Nothing@ -> IO () treeViewSetHAdjustment self adjustment = {# call tree_view_set_hadjustment #} (toTreeView self) (fromMaybe (Adjustment nullForeignPtr) adjustment) -- | Gets the 'Adjustment' currently being used for the vertical aspect. -- treeViewGetVAdjustment :: TreeViewClass self => self -> IO (Maybe Adjustment) treeViewGetVAdjustment self = maybeNull (makeNewObject mkAdjustment) $ {# call unsafe tree_view_get_vadjustment #} (toTreeView self) -- | Sets the 'Adjustment' for the current vertical aspect. -- treeViewSetVAdjustment :: TreeViewClass self => self -> Maybe Adjustment -- ^ @adjustment@ - The 'Adjustment' to set, or @Nothing@ -> IO () treeViewSetVAdjustment self adjustment = {# call tree_view_set_vadjustment #} (toTreeView self) (fromMaybe (Adjustment nullForeignPtr) adjustment) -- | Query if the column headers are visible. -- treeViewGetHeadersVisible :: TreeViewClass self => self -> IO Bool treeViewGetHeadersVisible self = liftM toBool $ {# call unsafe tree_view_get_headers_visible #} (toTreeView self) -- | Set the visibility state of the column headers. -- treeViewSetHeadersVisible :: TreeViewClass self => self -> Bool -> IO () treeViewSetHeadersVisible self headersVisible = {# call tree_view_set_headers_visible #} (toTreeView self) (fromBool headersVisible) -- | Resize the columns to their optimal size. -- treeViewColumnsAutosize :: TreeViewClass self => self -> IO () treeViewColumnsAutosize self = {# call tree_view_columns_autosize #} (toTreeView self) -- | Set whether the columns headers are sensitive to mouse clicks. -- treeViewSetHeadersClickable :: TreeViewClass self => self -> Bool -> IO () treeViewSetHeadersClickable self setting = {# call tree_view_set_headers_clickable #} (toTreeView self) (fromBool setting) -- | Query if visual aid for wide columns is turned on. -- treeViewGetRulesHint :: TreeViewClass self => self -> IO Bool treeViewGetRulesHint self = liftM toBool $ {# call unsafe tree_view_get_rules_hint #} (toTreeView self) -- | This function tells Gtk+ that the user interface for your application -- requires users to read across tree rows and associate cells with one -- another. By default, Gtk+ will then render the tree with alternating row -- colors. Do /not/ use it just because you prefer the appearance of the ruled -- tree; that's a question for the theme. Some themes will draw tree rows in -- alternating colors even when rules are turned off, and users who prefer that -- appearance all the time can choose those themes. You should call this -- function only as a /semantic/ hint to the theme engine that your tree makes -- alternating colors useful from a functional standpoint (since it has lots of -- columns, generally). -- treeViewSetRulesHint :: TreeViewClass self => self -> Bool -> IO () treeViewSetRulesHint self setting = {# call tree_view_set_rules_hint #} (toTreeView self) (fromBool setting) -- | Append a new column to the 'TreeView'. Returns the new number of columns. -- treeViewAppendColumn :: TreeViewClass self => self -> TreeViewColumn -> IO Int treeViewAppendColumn self column = liftM fromIntegral $ {# call tree_view_append_column #} (toTreeView self) column -- | Remove column @tvc@ from the 'TreeView' -- widget. The number of remaining columns is returned. -- treeViewRemoveColumn :: TreeViewClass self => self -> TreeViewColumn -> IO Int treeViewRemoveColumn self column = liftM fromIntegral $ {# call tree_view_remove_column #} (toTreeView self) column -- | Inserts column @tvc@ into the -- 'TreeView' widget at the position @pos@. Returns the number of -- columns after insertion. Specify -1 for @pos@ to insert the column -- at the end. -- treeViewInsertColumn :: TreeViewClass self => self -> TreeViewColumn -> Int -> IO Int treeViewInsertColumn self column position = liftM fromIntegral $ {# call tree_view_insert_column #} (toTreeView self) column (fromIntegral position) -- | Retrieve a 'TreeViewColumn'. -- -- * Retrieve the @pos@ th columns of -- 'TreeView'. If the index is out of range Nothing is returned. -- treeViewGetColumn :: TreeViewClass self => self -> Int -> IO (Maybe TreeViewColumn) treeViewGetColumn self pos = do tvcPtr <- {# call unsafe tree_view_get_column #} (toTreeView self) (fromIntegral pos) if tvcPtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkTreeViewColumn (return tvcPtr) -- | Return all 'TreeViewColumn's in this 'TreeView'. -- treeViewGetColumns :: TreeViewClass self => self -> IO [TreeViewColumn] treeViewGetColumns self = do colsList <- {# call unsafe tree_view_get_columns #} (toTreeView self) colsPtr <- fromGList colsList mapM (makeNewObject mkTreeViewColumn) (map return colsPtr) -- | Move a specific column. -- -- * Use 'treeViewMoveColumnToFront' if you want to move the column -- to the left end of the 'TreeView'. -- treeViewMoveColumnAfter :: TreeViewClass self => self -> TreeViewColumn -> TreeViewColumn -> IO () treeViewMoveColumnAfter self column baseColumn = {# call tree_view_move_column_after #} (toTreeView self) column baseColumn -- | Move a specific column. -- -- * Use 'treeViewMoveColumnAfter' if you want to move the column -- somewhere else than to the leftmost position. -- treeViewMoveColumnFirst :: TreeViewClass self => self -> TreeViewColumn -> IO () treeViewMoveColumnFirst self which = {# call tree_view_move_column_after #} (toTreeView self) which (TreeViewColumn nullForeignPtr) -- | Set location of hierarchy controls. -- -- * Sets the column to draw the expander arrow at. If @col@ -- is @Nothing@, then the expander arrow is always at the first -- visible column. -- -- If you do not want expander arrow to appear in your tree, set the -- expander column to a hidden column. -- treeViewSetExpanderColumn :: TreeViewClass self => self -> Maybe TreeViewColumn -> IO () treeViewSetExpanderColumn self column = {# call unsafe tree_view_set_expander_column #} (toTreeView self) (fromMaybe (TreeViewColumn nullForeignPtr) column) -- | Get location of hierarchy controls. -- -- * Gets the column to draw the expander arrow at. If @col@ -- is @Nothing@, then the expander arrow is always at the first -- visible column. -- treeViewGetExpanderColumn :: TreeViewClass self => self -> IO TreeViewColumn treeViewGetExpanderColumn self = makeNewObject mkTreeViewColumn $ {# call unsafe tree_view_get_expander_column #} (toTreeView self) -- | Specify where a column may be dropped. -- -- * Sets a user function for determining where a column may be dropped when -- dragged. This function is called on every column pair in turn at the -- beginning of a column drag to determine where a drop can take place. -- -- * The callback function take the 'TreeViewColumn' to be moved, the -- second and third arguments are the columns on the left and right side -- of the new location. At most one of them might be @Nothing@ -- which indicates that the column is about to be dropped at the left or -- right end of the 'TreeView'. -- -- * The predicate @pred@ should return @True@ if it is ok -- to insert the column at this place. -- -- * Use @Nothing@ for the predicate if columns can be inserted -- anywhere. -- treeViewSetColumnDragFunction :: TreeViewClass self => self -> Maybe (TreeViewColumn -> Maybe TreeViewColumn -> Maybe TreeViewColumn -> IO Bool) -> IO () treeViewSetColumnDragFunction self Nothing = {# call tree_view_set_column_drag_function #} (toTreeView self) nullFunPtr nullPtr nullFunPtr treeViewSetColumnDragFunction self (Just pred) = do fPtr <- mkTreeViewColumnDropFunc $ \_ target prev next _ -> do target' <- makeNewObject mkTreeViewColumn (return target) prev' <- if prev==nullPtr then return Nothing else liftM Just $ makeNewObject mkTreeViewColumn (return prev) next' <- if next==nullPtr then return Nothing else liftM Just $ makeNewObject mkTreeViewColumn (return next) res <- pred target' prev' next' return (fromBool res) {# call tree_view_set_column_drag_function #} (toTreeView self) fPtr (castFunPtrToPtr fPtr) destroyFunPtr {#pointer TreeViewColumnDropFunc#} foreign import ccall "wrapper" mkTreeViewColumnDropFunc :: (Ptr TreeView -> Ptr TreeViewColumn -> Ptr TreeViewColumn -> Ptr TreeViewColumn -> Ptr () -> IO {#type gboolean#}) -> IO TreeViewColumnDropFunc -- | Scroll to a coordinate. -- -- * Scrolls the tree view such that the top-left corner of the -- visible area is @treeX@, @treeY@, where @treeX@ -- and @treeY@ are specified in tree window coordinates. -- The 'TreeView' must be realized before this function is -- called. If it isn't, you probably want to use -- 'treeViewScrollToCell'. -- treeViewScrollToPoint :: TreeViewClass self => self -> Int -> Int -> IO () treeViewScrollToPoint self treeX treeY = {# call tree_view_scroll_to_point #} (toTreeView self) (fromIntegral treeX) (fromIntegral treeY) -- | Scroll to a cell. -- -- Moves the alignments of tree_view to the position specified by mbColumn and mbPath. -- If mbColumn is Nothing, then no horizontal scrolling occurs. Likewise, if mbPath -- is Nothing no vertical scrolling occurs. At a minimum, one of mbColumn or mbPath -- need to be provided. @rowAlign@ determines where the row is placed, and -- @colAlign@ determines where column is placed. Both are expected to be between -- 0.0 and 1.0. 0.0 means left/top alignment, 1.0 means right/bottom alignment, -- 0.5 means center. -- -- If Nothing is passed instead of @rowAlign@ and @colAlign@, then the tree does -- the minimum amount of work to scroll the cell onto the screen. This means -- that the cell will be scrolled to the edge closest to its current position. -- If the cell is currently visible on the screen, nothing is done. -- -- This function only works if the model is set, and path is a valid row on -- the model. If the model changes before the tree_view is realized, the -- centered path will be modified to reflect this change. -- treeViewScrollToCell :: TreeViewClass self => self -> Maybe TreePath -> Maybe TreeViewColumn -> Maybe (Float, Float) -> IO () treeViewScrollToCell self mbPath mbColumn (Just (rowAlign, colAlign)) = maybeWithTreePath mbPath $ \path -> {# call tree_view_scroll_to_cell #} (toTreeView self) path (maybe (TreeViewColumn nullForeignPtr) toTreeViewColumn mbColumn) 1 (realToFrac rowAlign) (realToFrac colAlign) treeViewScrollToCell self mbPath mbColumn Nothing = maybeWithTreePath mbPath $ \path -> {# call tree_view_scroll_to_cell #} (toTreeView self) path (maybe (TreeViewColumn nullForeignPtr) toTreeViewColumn mbColumn) 0 0.0 0.0 -- | Selects a specific row. -- -- * Sets the current keyboard focus to be at @path@, and -- selects it. This is useful when you want to focus the user\'s -- attention on a particular row. If @focusColumn@ is given, -- then the input focus is given to the column specified by -- it. Additionally, if @focusColumn@ is specified, and -- @startEditing@ is @True@, -- then editing will be started in the -- specified cell. This function is often followed by a -- 'widgetGrabFocus' to the 'TreeView' in order -- to give keyboard focus to the widget. -- treeViewSetCursor :: TreeViewClass self => self -> TreePath -> (Maybe (TreeViewColumn, Bool)) -> IO () treeViewSetCursor self path Nothing = withTreePath path $ \path -> {# call tree_view_set_cursor #} (toTreeView self) path (TreeViewColumn nullForeignPtr) (fromBool False) treeViewSetCursor self path (Just (focusColumn, startEditing)) = withTreePath path $ \path -> {# call tree_view_set_cursor #} (toTreeView self) path focusColumn (fromBool startEditing) #if GTK_CHECK_VERSION(2,2,0) -- | Selects a cell in a specific row. -- -- * Similar to 'treeViewSetCursor' but allows a column to -- contain several 'CellRenderer's. -- -- * Only available in Gtk 2.2 and higher. -- treeViewSetCursorOnCell :: (TreeViewClass self, CellRendererClass focusCell) => self -> TreePath -> TreeViewColumn -> focusCell -> Bool -> IO () treeViewSetCursorOnCell self path focusColumn focusCell startEditing = withTreePath path $ \path -> {# call tree_view_set_cursor_on_cell #} (toTreeView self) path focusColumn (toCellRenderer focusCell) (fromBool startEditing) #endif -- | Retrieves the position of the focus. -- -- * Returns a pair @(path, column)@.If the cursor is not currently -- set, @path@ will be @[]@. If no column is currently -- selected, @column@ will be @Nothing@. -- treeViewGetCursor :: TreeViewClass self => self -> IO (TreePath, Maybe TreeViewColumn) treeViewGetCursor self = alloca $ \tpPtrPtr -> alloca $ \tvcPtrPtr -> do {# call unsafe tree_view_get_cursor #} (toTreeView self) (castPtr tpPtrPtr) (castPtr tvcPtrPtr) tpPtr <- peek tpPtrPtr tvcPtr <- peek tvcPtrPtr tp <- fromTreePath tpPtr tvc <- if tvcPtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkTreeViewColumn (return tvcPtr) return (tp,tvc) -- | Emit the activated signal on a cell. -- treeViewRowActivated :: TreeViewClass self => self -> TreePath -> TreeViewColumn -> IO () treeViewRowActivated self path column = withTreePath path $ \path -> {# call tree_view_row_activated #} (toTreeView self) path column -- | Recursively expands all nodes in the tree view. -- treeViewExpandAll :: TreeViewClass self => self -> IO () treeViewExpandAll self = {# call tree_view_expand_all #} (toTreeView self) -- | Recursively collapses all visible, expanded nodes in the tree view. -- treeViewCollapseAll :: TreeViewClass self => self -> IO () treeViewCollapseAll self = {# call tree_view_collapse_all #} (toTreeView self) #if GTK_CHECK_VERSION(2,2,0) -- | Make a certain path visible. -- -- * This will expand all parent rows of @tp@ as necessary. -- -- * Only available in Gtk 2.2 and higher. -- treeViewExpandToPath :: TreeViewClass self => self -> TreePath -> IO () treeViewExpandToPath self path = withTreePath path $ \path -> {# call tree_view_expand_to_path #} (toTreeView self) path #endif -- | Opens the row so its children are visible. -- treeViewExpandRow :: TreeViewClass self => self -> TreePath -- ^ @path@ - path to a row -> Bool -- ^ @openAll@ - whether to recursively expand, or just expand -- immediate children -> IO Bool -- ^ returns @True@ if the row existed and had children treeViewExpandRow self path openAll = liftM toBool $ withTreePath path $ \path -> {# call tree_view_expand_row #} (toTreeView self) path (fromBool openAll) -- | Collapses a row (hides its child rows, if they exist). -- treeViewCollapseRow :: TreeViewClass self => self -> TreePath -- ^ @path@ - path to a row in the tree view -> IO Bool -- ^ returns @True@ if the row was collapsed. treeViewCollapseRow self path = liftM toBool $ withTreePath path $ \path -> {# call tree_view_collapse_row #} (toTreeView self) path -- | Call function for every expanded row. -- treeViewMapExpandedRows :: TreeViewClass self => self -> (TreePath -> IO ()) -> IO () treeViewMapExpandedRows self func = do fPtr <- mkTreeViewMappingFunc $ \_ tpPtr _ -> fromTreePath tpPtr >>= func {# call tree_view_map_expanded_rows #} (toTreeView self) fPtr nullPtr freeHaskellFunPtr fPtr {#pointer TreeViewMappingFunc#} foreign import ccall "wrapper" mkTreeViewMappingFunc :: (Ptr TreeView -> Ptr NativeTreePath -> Ptr () -> IO ()) -> IO TreeViewMappingFunc -- | Check if row is expanded. -- treeViewRowExpanded :: TreeViewClass self => self -> TreePath -- ^ @path@ - A 'TreePath' to test expansion state. -> IO Bool -- ^ returns @True@ if @path@ is expanded. treeViewRowExpanded self path = liftM toBool $ withTreePath path $ \path -> {# call unsafe tree_view_row_expanded #} (toTreeView self) path -- | Query if rows can be moved around. -- -- * See 'treeViewSetReorderable'. -- treeViewGetReorderable :: TreeViewClass self => self -> IO Bool treeViewGetReorderable self = liftM toBool $ {# call unsafe tree_view_get_reorderable #} (toTreeView self) -- | Check if rows can be moved around. -- -- * Set whether the user can use drag and drop (DND) to reorder the rows in -- the store. This works on both 'TreeStore' and 'ListStore' models. If @ro@ -- is @True@, then the user can reorder the model by dragging and dropping -- rows. The developer can listen to these changes by connecting to the -- model's signals. If you need to control which rows may be dragged or -- where rows may be dropped, you can override the -- 'Graphics.UI.Gtk.ModelView.CustomStore.treeDragSourceRowDraggable' -- function in the default DND implementation of the model. -- treeViewSetReorderable :: TreeViewClass self => self -> Bool -> IO () treeViewSetReorderable self reorderable = {# call tree_view_set_reorderable #} (toTreeView self) (fromBool reorderable) -- | Map a pixel to the specific cell. -- -- * Finds the path at the 'Point' @(x, y)@. The -- coordinates @x@ and @y@ are relative to the top left -- corner of the 'TreeView' drawing window. As such, coordinates -- in a mouse click event can be used directly to determine the cell -- which the user clicked on. This function is useful to realize -- popup menus. -- -- * The returned point is the input point relative to the cell's upper -- left corner. The whole 'TreeView' is divided between all cells. -- The returned point is relative to the rectangle this cell occupies -- within the 'TreeView'. -- treeViewGetPathAtPos :: TreeViewClass self => self -> Point -> IO (Maybe (TreePath, TreeViewColumn, Point)) treeViewGetPathAtPos self (x,y) = alloca $ \tpPtrPtr -> alloca $ \tvcPtrPtr -> alloca $ \xPtr -> alloca $ \yPtr -> do res <- liftM toBool $ {# call unsafe tree_view_get_path_at_pos #} (toTreeView self) (fromIntegral x) (fromIntegral y) (castPtr tpPtrPtr) (castPtr tvcPtrPtr) xPtr yPtr tpPtr <- peek tpPtrPtr tvcPtr <- peek tvcPtrPtr xCell <- peek xPtr yCell <- peek yPtr if not res then return Nothing else do tp <- fromTreePath tpPtr tvc <- makeNewObject mkTreeViewColumn (return tvcPtr) return (Just (tp,tvc,(fromIntegral xCell, fromIntegral yCell))) -- | Retrieve the smallest bounding box of a cell. -- -- * Fills the bounding rectangle in tree window coordinates for the -- cell at the row specified by @tp@ and the column specified by -- @tvc@. -- If @path@ is @Nothing@ or points to a path not -- currently displayed, the @y@ and @height@ fields of -- the 'Rectangle' will be filled with @0@. The sum of -- all cell rectangles does not cover the entire tree; there are extra -- pixels in between rows, for example. -- treeViewGetCellArea :: TreeViewClass self => self -> Maybe TreePath -> TreeViewColumn -> IO Rectangle treeViewGetCellArea self Nothing tvc = alloca $ \rPtr -> {# call unsafe tree_view_get_cell_area #} (toTreeView self) (NativeTreePath nullPtr) tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr treeViewGetCellArea self (Just tp) tvc = withTreePath tp $ \tp -> alloca $ \rPtr -> do {# call unsafe tree_view_get_cell_area #} (toTreeView self) tp tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr -- | Retrieve the largest bounding box of a cell. -- -- * Fills the bounding rectangle in tree window coordinates for the -- cell at the row specified by @tp@ and the column specified by -- @tvc@. -- If @path@ is @Nothing@ or points to a path not -- currently displayed, the @y@ and @height@ fields of -- the 'Rectangle' will be filled with @0@. The background -- areas tile the widget's area to cover the entire tree window -- (except for the area used for header buttons). Contrast this with -- 'treeViewGetCellArea'. -- treeViewGetBackgroundArea :: TreeViewClass self => self -> Maybe TreePath -> TreeViewColumn -> IO Rectangle treeViewGetBackgroundArea self Nothing tvc = alloca $ \rPtr -> {# call unsafe tree_view_get_background_area #} (toTreeView self) (NativeTreePath nullPtr) tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr treeViewGetBackgroundArea self (Just tp) tvc = withTreePath tp $ \tp -> alloca $ \rPtr -> {# call unsafe tree_view_get_background_area #} (toTreeView self) tp tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr -- | Retrieve the currently visible area. -- -- * The returned rectangle gives the visible part of the tree in tree -- coordinates. -- treeViewGetVisibleRect :: TreeViewClass self => self -> IO Rectangle treeViewGetVisibleRect self = alloca $ \rPtr -> do {# call unsafe tree_view_get_visible_rect #} (toTreeView self) (castPtr (rPtr :: Ptr Rectangle)) peek rPtr #ifndef DISABLE_DEPRECATED #if GTK_MAJOR_VERSION < 3 -- | 'treeViewTreeToWidgetCoords' has been deprecated since version 2.12 and should not be used in -- newly-written code. Due to historical reasons the name of this function is incorrect. For converting -- bin window coordinates to coordinates relative to bin window, please see -- 'treeViewConvertBinWindowToWidgetCoords'. -- -- Converts tree coordinates (coordinates in full scrollable area of the tree) to bin window -- coordinates. -- -- Removed in Gtk3. treeViewTreeToWidgetCoords :: TreeViewClass self => self -> Point -- ^ @(tx, ty)@ - tree X and Y coordinates -> IO Point -- ^ @(wx, wy)@ returns widget X and Y coordinates treeViewTreeToWidgetCoords self (tx, ty) = alloca $ \wxPtr -> alloca $ \wyPtr -> do {# call unsafe tree_view_tree_to_widget_coords #} (toTreeView self) (fromIntegral tx) (fromIntegral ty) wxPtr wyPtr wx <- peek wxPtr wy <- peek wyPtr return (fromIntegral wx, fromIntegral wy) -- | 'treeViewWidgetToTreeCoords' has been deprecated since version 2.12 and should not be used in -- newly-written code. Due to historical reasons the name of this function is incorrect. For converting -- coordinates relative to the widget to bin window coordinates, please see -- 'treeViewConvertWidgetToBinWindowCoords'. -- -- Converts bin window coordinates to coordinates for the tree (the full scrollable area of the tree). -- -- Removed in Gtk3. treeViewWidgetToTreeCoords :: TreeViewClass self => self -> Point -- ^ @(wx, wy)@ - widget X and Y coordinates -> IO Point -- ^ @(tx, ty)@ returns tree X and Y coordinates treeViewWidgetToTreeCoords self (wx, wy) = alloca $ \txPtr -> alloca $ \tyPtr -> do {# call unsafe tree_view_widget_to_tree_coords #} (toTreeView self) (fromIntegral wx) (fromIntegral wy) txPtr tyPtr tx <- peek txPtr ty <- peek tyPtr return (fromIntegral tx, fromIntegral ty) #endif #endif #if GTK_CHECK_VERSION(2,12,0) -- | Converts bin window coordinates to coordinates for the tree (the full scrollable area of the tree). treeViewConvertBinWindowToTreeCoords :: TreeViewClass self => self -> Point -- ^ @(bx, by)@ - bin window X and Y coordinates -> IO Point -- ^ @(tx, ty)@ returns tree X and Y coordinates treeViewConvertBinWindowToTreeCoords self (bx, by) = alloca $ \txPtr -> alloca $ \tyPtr -> do {# call unsafe tree_view_convert_bin_window_to_tree_coords #} (toTreeView self) (fromIntegral bx) (fromIntegral by) txPtr tyPtr tx <- peek txPtr ty <- peek tyPtr return (fromIntegral tx, fromIntegral ty) -- | Converts bin window coordinates (see 'treeViewGetBinWindow' to widget relative coordinates. treeViewConvertBinWindowToWidgetCoords :: TreeViewClass self => self -> Point -- ^ @(bx, by)@ - bin window X and Y coordinates -> IO Point -- ^ @(wx, wy)@ returns widget X and Y coordinates treeViewConvertBinWindowToWidgetCoords self (bx, by) = alloca $ \wxPtr -> alloca $ \wyPtr -> do {# call unsafe tree_view_convert_bin_window_to_widget_coords #} (toTreeView self) (fromIntegral bx) (fromIntegral by) wxPtr wyPtr wx <- peek wxPtr wy <- peek wyPtr return (fromIntegral wx, fromIntegral wy) -- | Converts tree coordinates (coordinates in full scrollable area of the tree) to bin window -- coordinates. treeViewConvertTreeToBinWindowCoords :: TreeViewClass self => self -> Point -- ^ @(tx, ty)@ - tree X and Y coordinates -> IO Point -- ^ @(bx, by)@ returns bin window X and Y coordinates treeViewConvertTreeToBinWindowCoords self (tx, ty) = alloca $ \bxPtr -> alloca $ \byPtr -> do {# call unsafe tree_view_convert_tree_to_bin_window_coords #} (toTreeView self) (fromIntegral tx) (fromIntegral ty) bxPtr byPtr bx <- peek bxPtr by <- peek byPtr return (fromIntegral bx, fromIntegral by) -- | Converts tree coordinates (coordinates in full scrollable area of the tree) to widget coordinates. treeViewConvertTreeToWidgetCoords :: TreeViewClass self => self -> Point -- ^ @(tx, ty)@ - tree X and Y coordinates -> IO Point -- ^ @(wx, wy)@ returns widget X and Y coordinates treeViewConvertTreeToWidgetCoords self (wx, wy) = alloca $ \bxPtr -> alloca $ \byPtr -> do {# call unsafe tree_view_convert_tree_to_widget_coords #} (toTreeView self) (fromIntegral wx) (fromIntegral wy) bxPtr byPtr bx <- peek bxPtr by <- peek byPtr return (fromIntegral bx, fromIntegral by) -- | Converts widget coordinates to coordinates for the window (see 'treeViewGetBinWindow' ). treeViewConvertWidgetToBinWindowCoords :: TreeViewClass self => self -> Point -- ^ @(wx, wy)@ - widget X and Y coordinates -> IO Point -- ^ @(bx, by)@ returns bin window X and Y coordinates treeViewConvertWidgetToBinWindowCoords self (wx, wy) = alloca $ \bxPtr -> alloca $ \byPtr -> do {# call unsafe tree_view_convert_widget_to_bin_window_coords #} (toTreeView self) (fromIntegral wx) (fromIntegral wy) bxPtr byPtr bx <- peek bxPtr by <- peek byPtr return (fromIntegral bx, fromIntegral by) -- | Converts widget coordinates to coordinates for the tree (the full scrollable area of the tree). treeViewConvertWidgetToTreeCoords :: TreeViewClass self => self -> Point -- ^ @(wx, wy)@ - bin window X and Y coordinates -> IO Point -- ^ @(tx, ty)@ returns tree X and Y coordinates treeViewConvertWidgetToTreeCoords self (wx, wy) = alloca $ \txPtr -> alloca $ \tyPtr -> do {# call unsafe tree_view_convert_widget_to_tree_coords #} (toTreeView self) (fromIntegral wx) (fromIntegral wy) txPtr tyPtr tx <- peek txPtr ty <- peek tyPtr return (fromIntegral tx, fromIntegral ty) #endif #if GTK_MAJOR_VERSION < 3 -- | Creates a 'Pixmap' representation of the row at the given path. This image -- can be used for a drag icon. -- -- Removed in Gtk3. treeViewCreateRowDragIcon :: TreeViewClass self => self -> TreePath -> IO Pixmap treeViewCreateRowDragIcon self path = wrapNewGObject mkPixmap $ withTreePath path $ \path -> {# call unsafe tree_view_create_row_drag_icon #} (toTreeView self) path #endif -- | Returns whether or not the tree allows to start interactive searching by -- typing in text. -- -- * If enabled, the user can type in text which will set the cursor to -- the first matching entry. -- treeViewGetEnableSearch :: TreeViewClass self => self -> IO Bool treeViewGetEnableSearch self = liftM toBool $ {# call unsafe tree_view_get_enable_search #} (toTreeView self) -- | If this is set, then the user can type in text to search -- through the tree interactively (this is sometimes called \"typeahead -- find\"). -- -- Note that even if this is @False@, the user can still initiate a search -- using the \"start-interactive-search\" key binding. In any case, -- a predicate that compares a row of the model with the text the user -- has typed must be set using 'treeViewSetSearchEqualFunc'. -- treeViewSetEnableSearch :: TreeViewClass self => self -> Bool -> IO () treeViewSetEnableSearch self enableSearch = {# call tree_view_set_enable_search #} (toTreeView self) (fromBool enableSearch) -- %hash c:ecc5 d:bed6 -- | Gets the column searched on by the interactive search code. -- treeViewGetSearchColumn :: (TreeViewClass self, GlibString string) => self -> IO (ColumnId row string) -- ^ returns the column the interactive search code searches in. treeViewGetSearchColumn self = liftM (makeColumnIdString . fromIntegral) $ {# call unsafe tree_view_get_search_column #} (toTreeView self) -- %hash c:d0d0 -- | Sets @column@ as the column where the interactive search code should -- search in. -- -- If the sort column is set, users can use the \"start-interactive-search\" -- key binding to bring up search popup. The enable-search property controls -- whether simply typing text will also start an interactive search. -- -- Note that @column@ refers to a column of the model. Furthermore, the -- search column is not used if a comparison function is set, see -- 'treeViewSetSearchEqualFunc'. -- treeViewSetSearchColumn :: (TreeViewClass self, GlibString string) => self -> (ColumnId row string) -- ^ @column@ - the column of the model to search in, or -1 to disable -- searching -> IO () treeViewSetSearchColumn self column = {# call tree_view_set_search_column #} (toTreeView self) (fromIntegral (columnIdToNumber column)) -- | Set the predicate to test for equality. -- -- * The predicate must returns @True@ if the text entered by the user -- and the row of the model match. Calling this function will overwrite -- the 'treeViewSearchColumn' (which isn't used anyway when a comparison -- function is installed). -- treeViewSetSearchEqualFunc :: (TreeViewClass self, GlibString string) => self -> Maybe (string -> TreeIter -> IO Bool) -> IO () treeViewSetSearchEqualFunc self (Just pred) = do fPtr <- mkTreeViewSearchEqualFunc (\_ _ keyPtr iterPtr _ -> do key <- peekUTFString keyPtr iter <- peek iterPtr liftM (fromBool . not) $ pred key iter) {# call tree_view_set_search_equal_func #} (toTreeView self) fPtr (castFunPtrToPtr fPtr) destroyFunPtr {# call tree_view_set_search_column #} (toTreeView self) 0 treeViewSetSearchEqualFunc self Nothing = do {# call tree_view_set_search_equal_func #} (toTreeView self) nullFunPtr nullPtr nullFunPtr {# call tree_view_set_search_column #} (toTreeView self) (-1) {#pointer TreeViewSearchEqualFunc#} foreign import ccall "wrapper" mkTreeViewSearchEqualFunc :: (Ptr TreeModel -> {#type gint#} -> CString -> Ptr TreeIter -> Ptr () -> IO {#type gboolean#}) -> IO TreeViewSearchEqualFunc -- helper to marshal native tree paths to TreePaths readNTP :: Ptr TreePath -> IO TreePath readNTP ptr = peekTreePath (castPtr ptr) #if GTK_CHECK_VERSION(2,6,0) -- | Returns whether fixed height mode is turned on for the tree view. -- -- * Available since Gtk+ version 2.6 -- treeViewGetFixedHeightMode :: TreeViewClass self => self -> IO Bool -- ^ returns @True@ if the tree view is in fixed height mode treeViewGetFixedHeightMode self = liftM toBool $ {# call gtk_tree_view_get_fixed_height_mode #} (toTreeView self) -- | Enables or disables the fixed height mode of the tree view. Fixed height -- mode speeds up 'TreeView' by assuming that all rows have the same height. -- Only enable this option if all rows are the same height and all columns are -- of type 'TreeViewColumnFixed'. -- -- * Available since Gtk+ version 2.6 -- treeViewSetFixedHeightMode :: TreeViewClass self => self -> Bool -- ^ @enable@ - @True@ to enable fixed height mode -> IO () treeViewSetFixedHeightMode self enable = {# call gtk_tree_view_set_fixed_height_mode #} (toTreeView self) (fromBool enable) -- | Returns whether hover selection mode is turned on for @treeView@. -- -- * Available since Gtk+ version 2.6 -- treeViewGetHoverSelection :: TreeViewClass self => self -> IO Bool -- ^ returns @True@ if the tree view is in hover selection mode treeViewGetHoverSelection self = liftM toBool $ {# call gtk_tree_view_get_hover_selection #} (toTreeView self) -- | Enables of disables the hover selection mode of the tree view. Hover -- selection makes the selected row follow the pointer. Currently, this works -- only for the selection modes 'SelectionSingle' and 'SelectionBrowse'. -- -- * Available since Gtk+ version 2.6 -- treeViewSetHoverSelection :: TreeViewClass self => self -> Bool -- ^ @hover@ - @True@ to enable hover selection mode -> IO () treeViewSetHoverSelection self hover = {# call gtk_tree_view_set_hover_selection #} (toTreeView self) (fromBool hover) -- | Returns whether hover expansion mode is turned on for the tree view. -- -- * Available since Gtk+ version 2.6 -- treeViewGetHoverExpand :: TreeViewClass self => self -> IO Bool -- ^ returns @True@ if the tree view is in hover expansion mode treeViewGetHoverExpand self = liftM toBool $ {# call gtk_tree_view_get_hover_expand #} (toTreeView self) -- | Enables of disables the hover expansion mode of the tree view. Hover -- expansion makes rows expand or collapse if the pointer moves over them. -- -- * Available since Gtk+ version 2.6 -- treeViewSetHoverExpand :: TreeViewClass self => self -> Bool -- ^ @expand@ - @True@ to enable hover selection mode -> IO () treeViewSetHoverExpand self expand = {# call gtk_tree_view_set_hover_expand #} (toTreeView self) (fromBool expand) #endif #if GTK_CHECK_VERSION(2,10,0) -- %hash c:88cb d:65c9 -- | Returns whether all header columns are clickable. -- -- * Available since Gtk+ version 2.10 -- treeViewGetHeadersClickable :: TreeViewClass self => self -> IO Bool -- ^ returns @True@ if all header columns are clickable, otherwise -- @False@ treeViewGetHeadersClickable self = liftM toBool $ {# call gtk_tree_view_get_headers_clickable #} (toTreeView self) #endif #if GTK_CHECK_VERSION(2,8,0) -- %hash c:1d81 d:3587 -- | Return the first and last visible path. -- Note that there may be invisible paths in between. -- -- * Available since Gtk+ version 2.8 -- treeViewGetVisibleRange :: TreeViewClass self => self -> IO (TreePath, TreePath) -- ^ the first and the last node that is visible treeViewGetVisibleRange self = alloca $ \startPtr -> alloca $ \endPtr -> do valid <- liftM toBool $ {# call gtk_tree_view_get_visible_range #} (toTreeView self) (castPtr startPtr) (castPtr endPtr) if not valid then return ([],[]) else do startTPPtr <- peek startPtr endTPPtr <- peek endPtr startPath <- fromTreePath startTPPtr endPath <- fromTreePath endTPPtr return (startPath, endPath) #endif #if GTK_CHECK_VERSION(2,10,0) -- %hash c:61e1 d:3a0a -- | Turns @treeView@ into a drop destination for automatic DND. -- treeViewEnableModelDragDest :: TreeViewClass self => self -> TargetList -- ^ @targets@ - the list of targets that the -- the view will support -> [DragAction] -- ^ @actions@ - flags denoting the possible actions -- for a drop into this widget -> IO () treeViewEnableModelDragDest self targets actions = alloca $ \nTargetsPtr -> do tlPtr <- {#call unsafe gtk_target_table_new_from_list#} targets nTargetsPtr nTargets <- peek nTargetsPtr {# call gtk_tree_view_enable_model_drag_dest #} (toTreeView self) tlPtr nTargets ((fromIntegral . fromFlags) actions) {#call unsafe gtk_target_table_free#} tlPtr nTargets -- %hash c:1df9 d:622 -- | Turns @treeView@ into a drag source for automatic DND. -- treeViewEnableModelDragSource :: TreeViewClass self => self -> [Modifier] -- ^ @startButtonMask@ - Mask of allowed buttons -- to start drag -> TargetList -- ^ @targets@ - the list of targets that the -- the view will support -> [DragAction] -- ^ @actions@ - flags denoting the possible actions -- for a drag from this widget -> IO () treeViewEnableModelDragSource self startButtonMask targets actions = alloca $ \nTargetsPtr -> do tlPtr <- {#call unsafe gtk_target_table_new_from_list#} targets nTargetsPtr nTargets <- peek nTargetsPtr {# call gtk_tree_view_enable_model_drag_source #} (toTreeView self) ((fromIntegral . fromFlags) startButtonMask) tlPtr nTargets ((fromIntegral . fromFlags) actions) {#call unsafe gtk_target_table_free#} tlPtr nTargets -- %hash c:5201 d:f3be -- | Undoes the effect of 'treeViewEnableModelDragSource'. -- treeViewUnsetRowsDragSource :: TreeViewClass self => self -> IO () treeViewUnsetRowsDragSource self = {# call gtk_tree_view_unset_rows_drag_source #} (toTreeView self) -- %hash c:e31e d:323d -- | Undoes the effect of 'treeViewEnableModelDragDest'. -- treeViewUnsetRowsDragDest :: TreeViewClass self => self -> IO () treeViewUnsetRowsDragDest self = {# call gtk_tree_view_unset_rows_drag_dest #} (toTreeView self) -- %hash c:3355 d:3bbe -- | Returns the 'Entry' which is currently in use as interactive search entry -- for @treeView@. In case the built-in entry is being used, @Nothing@ will be -- returned. -- -- * Available since Gtk+ version 2.10 -- treeViewGetSearchEntry :: TreeViewClass self => self -> IO (Maybe Entry) -- ^ returns the entry currently in use as search entry. treeViewGetSearchEntry self = do ePtr <- {# call gtk_tree_view_get_search_entry #} (toTreeView self) if ePtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkEntry (return ePtr) -- %hash c:5e11 d:8ec5 -- | Sets the entry which the interactive search code will use for this -- @treeView@. This is useful when you want to provide a search entry in our -- interface at all time at a fixed position. Passing @Nothing@ for @entry@ -- will make the interactive search code use the built-in popup entry again. -- -- * Available since Gtk+ version 2.10 -- treeViewSetSearchEntry :: (TreeViewClass self, EntryClass entry) => self -> (Maybe entry) -- ^ @entry@ - the entry the interactive search code of @treeView@ -- should use or @Nothing@ -> IO () treeViewSetSearchEntry self (Just entry) = {# call gtk_tree_view_set_search_entry #} (toTreeView self) (toEntry entry) treeViewSetSearchEntry self Nothing = {# call gtk_tree_view_set_search_entry #} (toTreeView self) (Entry nullForeignPtr) #endif #if GTK_CHECK_VERSION(2,6,0) -- %hash c:6326 d:a050 -- | Sets the row separator function, which is used to determine whether a row -- should be drawn as a separator. If the row separator function is @Nothing@, -- no separators are drawn. This is the default value. -- -- * Available since Gtk+ version 2.6 -- treeViewSetRowSeparatorFunc :: TreeViewClass self => self -> Maybe (TreeIter -> IO Bool) -- ^ @func@ - a callback function that -- returns @True@ if the given row of -- the model should be drawn as separator -> IO () treeViewSetRowSeparatorFunc self Nothing = {# call gtk_tree_view_set_row_separator_func #} (toTreeView self) nullFunPtr nullPtr nullFunPtr treeViewSetRowSeparatorFunc self (Just func) = do funcPtr <- mkTreeViewRowSeparatorFunc $ \_ tiPtr _ -> do ti <- peekTreeIter tiPtr liftM fromBool $ func ti {# call gtk_tree_view_set_row_separator_func #} (toTreeView self) funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr {#pointer TreeViewRowSeparatorFunc #} foreign import ccall "wrapper" mkTreeViewRowSeparatorFunc :: (Ptr TreeModel -> Ptr TreeIter -> Ptr () -> IO {#type gboolean#}) -> IO TreeViewRowSeparatorFunc #if GTK_CHECK_VERSION(2,10,0) -- %hash c:778a d:eacd -- | Returns whether rubber banding is turned on for @treeView@. If the -- selection mode is 'SelectionMultiple', rubber banding will allow the user to -- select multiple rows by dragging the mouse. -- -- * Available since Gtk+ version 2.10 -- treeViewGetRubberBanding :: TreeViewClass self => self -> IO Bool -- ^ returns @True@ if rubber banding in @treeView@ is enabled. treeViewGetRubberBanding self = liftM toBool $ {# call gtk_tree_view_get_rubber_banding #} (toTreeView self) -- %hash c:4a69 d:93aa -- | Enables or disables rubber banding in @treeView@. If the selection mode -- is 'SelectionMultiple', rubber banding will allow the user to select -- multiple rows by dragging the mouse. -- -- * Available since Gtk+ version 2.10 -- treeViewSetRubberBanding :: TreeViewClass self => self -> Bool -- ^ @enable@ - @True@ to enable rubber banding -> IO () treeViewSetRubberBanding self enable = {# call gtk_tree_view_set_rubber_banding #} (toTreeView self) (fromBool enable) -- %hash c:c8f8 d:c47 -- | Returns whether or not tree lines are drawn in @treeView@. -- -- * Available since Gtk+ version 2.10 -- treeViewGetEnableTreeLines :: TreeViewClass self => self -> IO Bool -- ^ returns @True@ if tree lines are drawn in @treeView@, @False@ -- otherwise. treeViewGetEnableTreeLines self = liftM toBool $ {# call gtk_tree_view_get_enable_tree_lines #} (toTreeView self) -- %hash c:205d d:1df9 -- | Sets whether to draw lines interconnecting the expanders in @treeView@. -- This does not have any visible effects for lists. -- -- * Available since Gtk+ version 2.10 -- treeViewSetEnableTreeLines :: TreeViewClass self => self -> Bool -- ^ @enabled@ - @True@ to enable tree line drawing, @False@ -- otherwise. -> IO () treeViewSetEnableTreeLines self enabled = {# call gtk_tree_view_set_enable_tree_lines #} (toTreeView self) (fromBool enabled) -- | Grid lines. {#enum TreeViewGridLines {underscoreToCase}#} -- %hash c:cd40 d:fe96 -- | Returns which grid lines are enabled in @treeView@. -- -- * Available since Gtk+ version 2.10 -- treeViewGetGridLines :: TreeViewClass self => self -> IO TreeViewGridLines -- ^ returns a 'TreeViewGridLines' value indicating -- which grid lines are enabled. treeViewGetGridLines self = liftM (toEnum . fromIntegral) $ {# call gtk_tree_view_get_grid_lines #} (toTreeView self) -- %hash c:74b0 d:79f0 -- | Sets which grid lines to draw in @treeView@. -- -- * Available since Gtk+ version 2.10 -- treeViewSetGridLines :: TreeViewClass self => self -> TreeViewGridLines -- ^ @gridLines@ - a 'TreeViewGridLines' value -- indicating which grid lines to enable. -> IO () treeViewSetGridLines self gridLines = {# call gtk_tree_view_set_grid_lines #} (toTreeView self) ((fromIntegral . fromEnum) gridLines) #endif #endif #if GTK_CHECK_VERSION(2,12,0) -- | Sets the tip area of @tooltip@ to be the area covered by @path@. See also -- 'treeViewTooltipColumn' for a simpler alternative. See also -- 'tooltipSetTipArea'. treeViewSetTooltipRow :: TreeViewClass self => self -> Tooltip -- ^ the @tooltip@ -> TreePath -- ^ @path@ - the position of the @tooltip@ -> IO () treeViewSetTooltipRow self tip path = withTreePath path $ \path -> {#call gtk_tree_view_set_tooltip_row #} (toTreeView self) tip path -- | Sets the tip area of tooltip to the area path, column and cell have in -- common. For example if @path@ is @Nothing@ and @column@ is set, the tip area will be -- set to the full area covered by column. See also -- 'tooltipSetTipArea'. Note that if @path@ is not specified and @cell@ is -- set and part of a column containing the expander, the tooltip might not -- show and hide at the correct position. In such cases @path@ must be set to -- the current node under the mouse cursor for this function to operate -- correctly. See also 'treeViewTooltipColumn' for a simpler alternative. -- treeViewSetTooltipCell :: (TreeViewClass self, TreeViewColumnClass col, CellRendererClass renderer) => self -> Tooltip -- ^ the @tooltip@ -> Maybe TreePath -- ^ @path@ at which the tip should be shown -> Maybe col -- ^ @column@ at which the tip should be shown -> Maybe renderer -- ^ the @renderer@ for which to show the tip -> IO () treeViewSetTooltipCell self tip mPath mColumn mRenderer = (case mPath of Just path -> withTreePath path Nothing -> \f -> f (NativeTreePath nullPtr)) $ \path -> do {#call gtk_tree_view_set_tooltip_cell#} (toTreeView self) tip path (maybe (TreeViewColumn nullForeignPtr) toTreeViewColumn mColumn) (maybe (CellRenderer nullForeignPtr) toCellRenderer mRenderer) -- | This function is supposed to be used in a 'widgetQueryTooltip' signal handler -- for this 'TreeView'. The @point@ value which is received in the -- signal handler should be passed to this function without modification. A -- return value of @Just iter@ indicates that there is a tree view row at the given -- coordinates (if @Just (x,y)@ is passed in, denoting a mouse position), resp. -- the cursor row (if @Nothing@ is passed in, denoting a keyboard request). -- treeViewGetTooltipContext :: TreeViewClass self => self -> Maybe Point -- ^ @point@ - the coordinates of the mouse or @Nothing@ -- if a keyboard tooltip is to be generated -> IO (Maybe TreeIter) -- ^ @Just iter@ if a tooltip should be shown for that row treeViewGetTooltipContext self (Just (x,y)) = alloca $ \xPtr -> alloca $ \yPtr -> receiveTreeIter $ {#call gtk_tree_view_get_tooltip_context#} (toTreeView self) xPtr yPtr 0 nullPtr nullPtr treeViewGetTooltipContext self Nothing = receiveTreeIter $ {#call gtk_tree_view_get_tooltip_context#} (toTreeView self) nullPtr nullPtr 1 nullPtr nullPtr #endif -------------------- -- Attributes -- | The model for the tree view. -- treeViewModel :: TreeViewClass self => Attr self (Maybe TreeModel) treeViewModel = newAttr treeViewGetModel treeViewSetModel -- | Horizontal Adjustment for the widget. -- treeViewHAdjustment :: TreeViewClass self => Attr self (Maybe Adjustment) treeViewHAdjustment = newAttr treeViewGetHAdjustment treeViewSetHAdjustment -- | Vertical Adjustment for the widget. -- treeViewVAdjustment :: TreeViewClass self => Attr self (Maybe Adjustment) treeViewVAdjustment = newAttr treeViewGetVAdjustment treeViewSetVAdjustment -- | Show the column header buttons. -- -- Default value: @True@ -- treeViewHeadersVisible :: TreeViewClass self => Attr self Bool treeViewHeadersVisible = newAttr treeViewGetHeadersVisible treeViewSetHeadersVisible -- | Column headers respond to click events. -- -- Default value: @False@ -- treeViewHeadersClickable :: TreeViewClass self => Attr self Bool treeViewHeadersClickable = newAttrFromBoolProperty "headers-clickable" -- | Set the column for the expander column. -- treeViewExpanderColumn :: TreeViewClass self => ReadWriteAttr self TreeViewColumn (Maybe TreeViewColumn) treeViewExpanderColumn = newAttr treeViewGetExpanderColumn treeViewSetExpanderColumn -- | View is reorderable. -- -- Default value: @False@ -- treeViewReorderable :: TreeViewClass self => Attr self Bool treeViewReorderable = newAttr treeViewGetReorderable treeViewSetReorderable -- | Set a hint to the theme engine to draw rows in alternating colors. -- -- Default value: @False@ -- treeViewRulesHint :: TreeViewClass self => Attr self Bool treeViewRulesHint = newAttr treeViewGetRulesHint treeViewSetRulesHint -- | View allows user to search through columns interactively. -- -- Default value: @True@ -- treeViewEnableSearch :: TreeViewClass self => Attr self Bool treeViewEnableSearch = newAttr treeViewGetEnableSearch treeViewSetEnableSearch -- %hash c:e732 -- | Model column to search through when searching through code. -- -- Default value: 'invalidColumnId' -- treeViewSearchColumn :: (TreeViewClass self, GlibString string) => Attr self (ColumnId row string) treeViewSearchColumn = newAttr treeViewGetSearchColumn treeViewSetSearchColumn #if GTK_CHECK_VERSION(2,4,0) -- %hash c:c7ff d:24d1 -- | Setting the 'treeViewFixedHeightMode' property to @True@ speeds up 'TreeView' -- by assuming that all rows have the same height. Only enable this option if -- all rows are the same height. Please see 'treeViewSetFixedHeightMode' for -- more information on this option. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.4 -- treeViewFixedHeightMode :: TreeViewClass self => Attr self Bool treeViewFixedHeightMode = newAttrFromBoolProperty "fixed-height-mode" #if GTK_CHECK_VERSION(2,6,0) -- %hash c:2026 d:839a -- | Enables of disables the hover selection mode of @treeView@. Hover -- selection makes the selected row follow the pointer. Currently, this works -- only for the selection modes 'SelectionSingle' and 'SelectionBrowse'. -- -- This mode is primarily intended for 'TreeView's in popups, e.g. in -- 'ComboBox' or 'EntryCompletion'. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.6 -- treeViewHoverSelection :: TreeViewClass self => Attr self Bool treeViewHoverSelection = newAttrFromBoolProperty "hover-selection" -- %hash c:c694 d:3f15 -- | Enables of disables the hover expansion mode of @treeView@. Hover -- expansion makes rows expand or collapse if the pointer moves over them. -- -- This mode is primarily intended for 'TreeView's in popups, e.g. in -- 'ComboBox' or 'EntryCompletion'. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.6 -- treeViewHoverExpand :: TreeViewClass self => Attr self Bool treeViewHoverExpand = newAttrFromBoolProperty "hover-expand" #endif #endif -- %hash c:b409 d:2ed2 -- | View has expanders. -- -- Default value: @True@ -- treeViewShowExpanders :: TreeViewClass self => Attr self Bool treeViewShowExpanders = newAttrFromBoolProperty "show-expanders" -- %hash c:f0e5 d:9017 -- | Extra indentation for each level. -- -- Allowed values: >= 0 -- -- Default value: 0 -- treeViewLevelIndentation :: TreeViewClass self => Attr self Int treeViewLevelIndentation = newAttrFromIntProperty "level-indentation" -- %hash c:a647 d:9e53 -- | Whether to enable selection of multiple items by dragging the mouse -- pointer. -- -- Default value: @False@ -- treeViewRubberBanding :: TreeViewClass self => Attr self Bool treeViewRubberBanding = newAttrFromBoolProperty "rubber-banding" #if GTK_CHECK_VERSION(2,10,0) -- %hash c:e926 d:86a8 -- | Whether grid lines should be drawn in the tree view. -- -- Default value: 'TreeViewGridLinesNone' -- treeViewEnableGridLines :: TreeViewClass self => Attr self TreeViewGridLines treeViewEnableGridLines = newAttrFromEnumProperty "enable-grid-lines" {# call pure unsafe gtk_tree_view_grid_lines_get_type #} #endif -- %hash c:a7eb d:4c53 -- | Whether tree lines should be drawn in the tree view. -- -- Default value: @False@ -- treeViewEnableTreeLines :: TreeViewClass self => Attr self Bool treeViewEnableTreeLines = newAttrFromBoolProperty "enable-tree-lines" #if GTK_CHECK_VERSION(2,10,0) -- %hash c:688c d:cbcd -- | \'gridLines\' property. See 'treeViewGetGridLines' and -- 'treeViewSetGridLines' -- treeViewGridLines :: TreeViewClass self => Attr self TreeViewGridLines treeViewGridLines = newAttr treeViewGetGridLines treeViewSetGridLines -- %hash c:9cbe d:2962 -- | \'searchEntry\' property. See 'treeViewGetSearchEntry' and -- 'treeViewSetSearchEntry' -- treeViewSearchEntry :: (TreeViewClass self, EntryClass entry) => ReadWriteAttr self (Maybe Entry) (Maybe entry) treeViewSearchEntry = newAttr treeViewGetSearchEntry treeViewSetSearchEntry #endif #if GTK_CHECK_VERSION(2,12,0) -- | The column for which to show tooltips. -- -- If you only plan to have simple (text-only) tooltips on full rows, you can -- use this function to have 'TreeView' handle these automatically for you. -- @column@ should be set to a column in model containing the tooltip texts, -- or @-1@ to disable this feature. When enabled, 'widgetHasTooltip' will be -- set to @True@ and this view will connect to the 'widgetQueryTooltip' signal -- handler. -- -- Note that the signal handler sets the text as 'Markup', -- so \&, \<, etc have to be escaped in the text. -- -- Default value: 'invalidColumnId' -- treeViewTooltipColumn :: (TreeViewClass self, GlibString string) => Attr self (ColumnId row string) treeViewTooltipColumn = newAttr (\self -> liftM (makeColumnIdString . fromIntegral) $ {# call unsafe tree_view_get_tooltip_column #} (toTreeView self) ) (\self column -> {# call tree_view_set_tooltip_column #} (toTreeView self) (fromIntegral (columnIdToNumber column)) ) #endif -------------------- -- Signals -- %hash c:9fc5 d:3e66 -- | The given row is about to be expanded (show its children nodes). Use this -- signal if you need to control the expandability of individual rows. -- testExpandRow :: TreeViewClass self => Signal self (TreeIter -> TreePath -> IO Bool) testExpandRow = Signal (connect_BOXED_BOXED__BOOL "test-expand-row" peek readNTP) -- %hash c:20de d:96a3 -- | The given row is about to be collapsed (hide its children nodes). Use -- this signal if you need to control the collapsibility of individual rows. -- testCollapseRow :: TreeViewClass self => Signal self (TreeIter -> TreePath -> IO Bool) testCollapseRow = Signal (connect_BOXED_BOXED__BOOL "test-collapse-row" peek readNTP) -- %hash c:16dc d:b113 -- | The given row has been expanded (child nodes are shown). -- rowExpanded :: TreeViewClass self => Signal self (TreeIter -> TreePath -> IO ()) rowExpanded = Signal (connect_BOXED_BOXED__NONE "row-expanded" peek readNTP) -- | A row was activated. -- -- * Activation usually means the user has pressed return on a row. -- rowActivated :: TreeViewClass self => Signal self (TreePath -> TreeViewColumn -> IO ()) rowActivated = Signal (connect_BOXED_OBJECT__NONE "row-activated" readNTP) -- %hash c:9ee6 d:325e -- | The given row has been collapsed (child nodes are hidden). -- rowCollapsed :: TreeViewClass self => Signal self (TreeIter -> TreePath -> IO ()) rowCollapsed = Signal (connect_BOXED_BOXED__NONE "row-collapsed" peek readNTP) -- %hash c:4350 d:4f94 -- | The number of columns of the treeview has changed. -- columnsChanged :: TreeViewClass self => Signal self (IO ()) columnsChanged = Signal (connect_NONE__NONE "columns-changed") -- %hash c:6487 d:5b57 -- | The position of the cursor (focused cell) has changed. -- cursorChanged :: TreeViewClass self => Signal self (IO ()) cursorChanged = Signal (connect_NONE__NONE "cursor-changed") -------------------- -- Deprecated Signals #ifndef DISABLE_DEPRECATED -- | The user has dragged a column to another position. -- onColumnsChanged, afterColumnsChanged :: TreeViewClass self => self -> IO () -> IO (ConnectId self) onColumnsChanged = connect_NONE__NONE "columns_changed" False afterColumnsChanged = connect_NONE__NONE "columns_changed" True -- | The cursor in the tree has moved. -- onCursorChanged, afterCursorChanged :: TreeViewClass self => self -> IO () -> IO (ConnectId self) onCursorChanged = connect_NONE__NONE "cursor_changed" False afterCursorChanged = connect_NONE__NONE "cursor_changed" True -- | A row was activated. -- -- * Activation usually means the user has pressed return on a row. -- onRowActivated, afterRowActivated :: TreeViewClass self => self -> (TreePath -> TreeViewColumn -> IO ()) -> IO (ConnectId self) onRowActivated = connect_BOXED_OBJECT__NONE "row_activated" readNTP False afterRowActivated = connect_BOXED_OBJECT__NONE "row_activated" readNTP True -- | Children of this node were hidden. -- onRowCollapsed, afterRowCollapsed :: TreeViewClass self => self -> (TreeIter -> TreePath -> IO ()) -> IO (ConnectId self) onRowCollapsed = connect_BOXED_BOXED__NONE "row_collapsed" peek readNTP False afterRowCollapsed = connect_BOXED_BOXED__NONE "row_collapsed" peek readNTP True -- | Children of this node are made visible. -- onRowExpanded, afterRowExpanded :: TreeViewClass self => self -> (TreeIter -> TreePath -> IO ()) -> IO (ConnectId self) onRowExpanded = connect_BOXED_BOXED__NONE "row_expanded" peek readNTP False afterRowExpanded = connect_BOXED_BOXED__NONE "row_expanded" peek readNTP True -- | The user wants to search interactively. -- -- * Connect to this signal if you want to provide you own search facility. -- Note that you must handle all keyboard input yourself. -- onStartInteractiveSearch, afterStartInteractiveSearch :: TreeViewClass self => self -> IO () -> IO (ConnectId self) #if GTK_CHECK_VERSION(2,2,0) onStartInteractiveSearch self fun = connect_NONE__BOOL "start_interactive_search" False self (fun >> return True) afterStartInteractiveSearch self fun = connect_NONE__BOOL "start_interactive_search" True self (fun >> return True) #else onStartInteractiveSearch = connect_NONE__NONE "start_interactive_search" False afterStartInteractiveSearch = connect_NONE__NONE "start_interactive_search" True #endif -- | Determine if this row should be collapsed. -- -- * If the application connects to this function and returns @False@, -- the specific row will not be altered. -- onTestCollapseRow, afterTestCollapseRow :: TreeViewClass self => self -> (TreeIter -> TreePath -> IO Bool) -> IO (ConnectId self) onTestCollapseRow = connect_BOXED_BOXED__BOOL "test_collapse_row" peek readNTP False afterTestCollapseRow = connect_BOXED_BOXED__BOOL "test_collapse_row" peek readNTP True -- | Determine if this row should be expanded. -- -- * If the application connects to this function and returns @False@, -- the specific row will not be altered. -- onTestExpandRow, afterTestExpandRow :: TreeViewClass self => self -> (TreeIter -> TreePath -> IO Bool) -> IO (ConnectId self) onTestExpandRow = connect_BOXED_BOXED__BOOL "test_expand_row" peek readNTP False afterTestExpandRow = connect_BOXED_BOXED__BOOL "test_expand_row" peek readNTP True #endif gtk-0.15.9/Graphics/UI/Gtk/ModelView/TreeViewColumn.chs0000644000000000000000000005214207346545000020674 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) TreeViewColumn TreeView -- -- Author : Axel Simon -- -- Created: 9 May 2001 -- -- Copyright (C) 2001-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A visible column in a 'TreeView' widget -- module Graphics.UI.Gtk.ModelView.TreeViewColumn ( -- * Detail -- -- | The 'TreeViewColumn' object represents a visible column in a 'TreeView' -- widget. It allows to set properties of the column header, and functions as a -- holding pen for the cell renderers which determine how the data in the -- column is displayed. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----TreeViewColumn -- @ -- * Types TreeViewColumn, TreeViewColumnClass, castToTreeViewColumn, gTypeTreeViewColumn, toTreeViewColumn, -- * Constructors treeViewColumnNew, -- * Methods treeViewColumnPackStart, treeViewColumnPackEnd, treeViewColumnClear, #if GTK_MAJOR_VERSION < 3 treeViewColumnGetCellRenderers, #endif treeViewColumnSetSpacing, treeViewColumnGetSpacing, treeViewColumnSetVisible, treeViewColumnGetVisible, treeViewColumnSetResizable, treeViewColumnGetResizable, TreeViewColumnSizing(..), treeViewColumnSetSizing, treeViewColumnGetSizing, treeViewColumnGetWidth, treeViewColumnSetFixedWidth, treeViewColumnGetFixedWidth, treeViewColumnSetMinWidth, treeViewColumnGetMinWidth, treeViewColumnSetMaxWidth, treeViewColumnGetMaxWidth, treeViewColumnClicked, treeViewColumnSetTitle, treeViewColumnGetTitle, treeViewColumnSetClickable, treeViewColumnGetClickable, treeViewColumnSetWidget, treeViewColumnGetWidget, treeViewColumnSetAlignment, treeViewColumnGetAlignment, treeViewColumnSetReorderable, treeViewColumnGetReorderable, treeViewColumnSetSortColumnId, treeViewColumnGetSortColumnId, treeViewColumnSetSortIndicator, treeViewColumnGetSortIndicator, treeViewColumnSetSortOrder, treeViewColumnGetSortOrder, SortType(..), #if GTK_CHECK_VERSION(2,4,0) treeViewColumnSetExpand, treeViewColumnGetExpand, #endif treeViewColumnCellIsVisible, #if GTK_CHECK_VERSION(2,2,0) treeViewColumnFocusCell, #if GTK_CHECK_VERSION(2,8,0) treeViewColumnQueueResize, #endif #endif -- * Attributes treeViewColumnVisible, treeViewColumnResizable, treeViewColumnWidth, treeViewColumnSpacing, treeViewColumnSizing, treeViewColumnFixedWidth, treeViewColumnMinWidth, treeViewColumnMaxWidth, treeViewColumnTitle, treeViewColumnExpand, treeViewColumnClickable, treeViewColumnWidget, treeViewColumnAlignment, treeViewColumnReorderable, treeViewColumnSortIndicator, treeViewColumnSortOrder, treeViewColumnSortColumnId, -- * Signals onColClicked, afterColClicked ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString #if GTK_MAJOR_VERSION < 3 {#import System.Glib.GList#} (fromGList) #endif import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (TreeViewColumnSizing(..), SortType(..)) import Graphics.UI.Gtk.General.Structs (SortColumnId) {#import Graphics.UI.Gtk.ModelView.TreeModel#} () {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Generate a new TreeViewColumn widget. -- treeViewColumnNew :: IO TreeViewColumn treeViewColumnNew = makeNewObject mkTreeViewColumn {# call tree_view_column_new #} -------------------- -- Methods -- | Add a cell renderer at the beginning of a column. -- -- * Excess space is divided equally among all renderers which have -- @expand@ set to True. -- treeViewColumnPackStart :: CellRendererClass cell => TreeViewColumn -> cell -> Bool -> IO () treeViewColumnPackStart self cell expand = {# call unsafe tree_view_column_pack_start #} self (toCellRenderer cell) (fromBool expand) -- | Add a cell renderer at the end of a column. -- -- * Excess space is divided equally among all renderers which have -- @expand@ set to True. -- treeViewColumnPackEnd :: CellRendererClass cell => TreeViewColumn -> cell -> Bool -> IO () treeViewColumnPackEnd self cell expand = {# call unsafe tree_view_column_pack_end #} self (toCellRenderer cell) (fromBool expand) -- | Remove the associations of attributes to a store for all 'CellRenderer's. -- treeViewColumnClear :: TreeViewColumn -> IO () treeViewColumnClear self = {# call tree_view_column_clear #} self #if GTK_MAJOR_VERSION < 3 -- | Retrieve all 'CellRenderer's that are contained in this column. -- -- Removed in Gtk3. treeViewColumnGetCellRenderers :: TreeViewColumn -> IO [CellRenderer] treeViewColumnGetCellRenderers self = {# call unsafe tree_view_column_get_cell_renderers #} self >>= fromGList >>= mapM (makeNewObject mkCellRenderer . return) #endif -- | Set the number of pixels between two cell renderers. -- treeViewColumnSetSpacing :: TreeViewColumn -> Int -> IO () treeViewColumnSetSpacing self spacing = {# call tree_view_column_set_spacing #} self (fromIntegral spacing) -- | Get the number of pixels between two cell renderers. -- treeViewColumnGetSpacing :: TreeViewColumn -> IO Int treeViewColumnGetSpacing self = liftM fromIntegral $ {# call unsafe tree_view_column_get_spacing #} self -- | Set the visibility of a given column. -- treeViewColumnSetVisible :: TreeViewColumn -> Bool -> IO () treeViewColumnSetVisible self visible = {# call tree_view_column_set_visible #} self (fromBool visible) -- | Get the visibility of a given column. -- treeViewColumnGetVisible :: TreeViewColumn -> IO Bool treeViewColumnGetVisible self = liftM toBool $ {# call unsafe tree_view_column_get_visible #} self -- | Set if a given column is resizable by the user. -- treeViewColumnSetResizable :: TreeViewColumn -> Bool -> IO () treeViewColumnSetResizable self resizable = {# call tree_view_column_set_resizable #} self (fromBool resizable) -- | Get if a given column is resizable by the user. -- treeViewColumnGetResizable :: TreeViewColumn -> IO Bool treeViewColumnGetResizable self = liftM toBool $ {# call unsafe tree_view_column_get_resizable #} self -- | Set whether the column can be resized. -- treeViewColumnSetSizing :: TreeViewColumn -> TreeViewColumnSizing -> IO () treeViewColumnSetSizing self type_ = {# call tree_view_column_set_sizing #} self ((fromIntegral . fromEnum) type_) -- | Return the resizing type of the column. -- treeViewColumnGetSizing :: TreeViewColumn -> IO TreeViewColumnSizing treeViewColumnGetSizing self = liftM (toEnum . fromIntegral) $ {# call unsafe tree_view_column_get_sizing #} self -- | Query the current width of the column. -- treeViewColumnGetWidth :: TreeViewColumn -> IO Int treeViewColumnGetWidth self = liftM fromIntegral $ {# call unsafe tree_view_column_get_width #} self -- | Set the width of the column. -- -- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'. -- treeViewColumnSetFixedWidth :: TreeViewColumn -> Int -> IO () treeViewColumnSetFixedWidth self fixedWidth = {# call tree_view_column_set_fixed_width #} self (fromIntegral fixedWidth) -- | Gets the fixed width of the column. -- -- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'. -- -- * This value is only meaning may not be the actual width of the column on the -- screen, just what is requested. -- treeViewColumnGetFixedWidth :: TreeViewColumn -> IO Int treeViewColumnGetFixedWidth self = liftM fromIntegral $ {# call unsafe tree_view_column_get_fixed_width #} self -- | Set minimum width of the column. -- treeViewColumnSetMinWidth :: TreeViewColumn -> Int -> IO () treeViewColumnSetMinWidth self minWidth = {# call tree_view_column_set_min_width #} self (fromIntegral minWidth) -- | Get the minimum width of a column. Returns -1 if this width was not set. -- treeViewColumnGetMinWidth :: TreeViewColumn -> IO Int treeViewColumnGetMinWidth self = liftM fromIntegral $ {# call unsafe tree_view_column_get_min_width #} self -- | Set maximum width of the column. -- treeViewColumnSetMaxWidth :: TreeViewColumn -> Int -> IO () treeViewColumnSetMaxWidth self maxWidth = {# call tree_view_column_set_max_width #} self (fromIntegral maxWidth) -- | Get the maximum width of a column. Returns -1 if this width was not set. -- treeViewColumnGetMaxWidth :: TreeViewColumn -> IO Int treeViewColumnGetMaxWidth self = liftM fromIntegral $ {# call unsafe tree_view_column_get_max_width #} self -- | Emit the @clicked@ signal on the column. -- treeViewColumnClicked :: TreeViewColumn -> IO () treeViewColumnClicked self = {# call tree_view_column_clicked #} self -- | Set the widget's title if a custom widget has not been set. -- treeViewColumnSetTitle :: GlibString string => TreeViewColumn -> string -> IO () treeViewColumnSetTitle self title = withUTFString title $ \titlePtr -> {# call tree_view_column_set_title #} self titlePtr -- | Get the widget's title. -- treeViewColumnGetTitle :: GlibString string => TreeViewColumn -> IO (Maybe string) treeViewColumnGetTitle self = {# call unsafe tree_view_column_get_title #} self >>= maybePeek peekUTFString -- | Set if the column should be sensitive to mouse clicks. -- treeViewColumnSetClickable :: TreeViewColumn -> Bool -> IO () treeViewColumnSetClickable self clickable = {# call tree_view_column_set_clickable #} self (fromBool clickable) -- | Returns True if the user can click on the header for the column. -- treeViewColumnGetClickable :: TreeViewColumn -> IO Bool treeViewColumnGetClickable self = liftM toBool $ {# call tree_view_column_get_clickable #} self -- | Set the column's title to this widget. -- treeViewColumnSetWidget :: WidgetClass widget => TreeViewColumn -> Maybe widget -> IO () treeViewColumnSetWidget self widget = {# call tree_view_column_set_widget #} self (maybe (Widget nullForeignPtr) toWidget widget) -- | Retrieve the widget responsible for -- showing the column title. In case only a text title was set this will be a -- 'Alignment' widget with a 'Label' inside. -- treeViewColumnGetWidget :: TreeViewColumn -> IO (Maybe Widget) -- ^ returns the 'Widget' in the column header, or 'Nothing' treeViewColumnGetWidget self = do widgetPtr <- {# call unsafe tree_view_column_get_widget #} self if widgetPtr == nullPtr then return Nothing else liftM Just $ makeNewObject mkWidget (return widgetPtr) -- | Sets the alignment of the title or custom widget inside the column -- header. The alignment determines its location inside the button -- 0.0 for -- left, 0.5 for center, 1.0 for right. -- treeViewColumnSetAlignment :: TreeViewColumn -> Float -- ^ @xalign@ - The alignment, which is between [0.0 and -- 1.0] inclusive. -> IO () treeViewColumnSetAlignment self xalign = {# call tree_view_column_set_alignment #} self (realToFrac xalign) -- | Returns the current x alignment of the tree column. This value can range -- between 0.0 and 1.0. -- treeViewColumnGetAlignment :: TreeViewColumn -> IO Float treeViewColumnGetAlignment self = liftM realToFrac $ {# call unsafe tree_view_column_get_alignment #} self -- | Set if the column can be reordered by the end user dragging the header. -- treeViewColumnSetReorderable :: TreeViewColumn -> Bool -> IO () treeViewColumnSetReorderable self reorderable = {# call tree_view_column_set_reorderable #} self (fromBool reorderable) -- | Returns whether the column can be reordered by the user. -- treeViewColumnGetReorderable :: TreeViewColumn -> IO Bool treeViewColumnGetReorderable self = liftM toBool $ {# call unsafe tree_view_column_get_reorderable #} self -- | Set the column by which to sort. -- -- * Sets the logical @columnId@ that this column sorts on when -- this column is selected for sorting. The selected column's header -- will be clickable after this call. Logical refers to the -- 'Graphics.UI.Gtk.ModelView.TreeSortable.SortColumnId' for which -- a comparison function was set. -- treeViewColumnSetSortColumnId :: TreeViewColumn -> SortColumnId -> IO () treeViewColumnSetSortColumnId self sortColumnId = {# call tree_view_column_set_sort_column_id #} self (fromIntegral sortColumnId) -- | Get the column by which to sort. -- -- * Retrieves the logical @columnId@ that the model sorts on when this column -- is selected for sorting. -- -- * Returns -- 'Graphics.UI.Gtk.ModelView.TreeSortable.treeSortableDefaultSortColumnId' -- if this tree view column has no -- 'Graphics.UI.Gtk.ModelView.TreeSortable.SortColumnId' associated with it. -- treeViewColumnGetSortColumnId :: TreeViewColumn -> IO SortColumnId treeViewColumnGetSortColumnId self = liftM fromIntegral $ {# call unsafe tree_view_column_get_sort_column_id #} self -- | Set if a given column has sorting arrows in its heading. -- treeViewColumnSetSortIndicator :: TreeViewColumn -> Bool -> IO () treeViewColumnSetSortIndicator self setting = {# call tree_view_column_set_sort_indicator #} self (fromBool setting) -- | Query if a given column has sorting arrows in its heading. -- treeViewColumnGetSortIndicator :: TreeViewColumn -> IO Bool treeViewColumnGetSortIndicator self = liftM toBool $ {# call unsafe tree_view_column_get_sort_indicator #} self -- | Set if a given column is sorted in ascending or descending order. -- -- * In order for sorting to work, it is necessary to either use automatic -- sorting via 'treeViewColumnSetSortColumnId' or to use a -- user defined sorting on the elements in a 'TreeModel'. -- treeViewColumnSetSortOrder :: TreeViewColumn -> SortType -> IO () treeViewColumnSetSortOrder self order = {# call tree_view_column_set_sort_order #} self ((fromIntegral . fromEnum) order) -- | Query if a given column is sorted in ascending or descending order. -- treeViewColumnGetSortOrder :: TreeViewColumn -> IO SortType treeViewColumnGetSortOrder self = liftM (toEnum . fromIntegral) $ {# call unsafe tree_view_column_get_sort_order #} self #if GTK_CHECK_VERSION(2,4,0) -- %hash c:7808 d:942b -- | Sets the column to take available extra space. This space is shared -- equally amongst all columns that have the expand set to @True@. If no column -- has this option set, then the last column gets all extra space. By default, -- every column is created with this @False@. -- -- * Available since Gtk+ version 2.4 -- treeViewColumnSetExpand :: TreeViewColumn -> Bool -- ^ @expand@ - @True@ if the column should take available extra -- space, @False@ if not -> IO () treeViewColumnSetExpand self expand = {# call gtk_tree_view_column_set_expand #} self (fromBool expand) -- %hash c:ee41 d:f16b -- | Return @True@ if the column expands to take any available space. -- -- * Available since Gtk+ version 2.4 -- treeViewColumnGetExpand :: TreeViewColumn -> IO Bool -- ^ returns @True@, if the column expands treeViewColumnGetExpand self = liftM toBool $ {# call gtk_tree_view_column_get_expand #} self #endif -- %hash c:77e0 d:e1c7 -- | Returns @True@ if any of the cells packed into the @treeColumn@ are -- visible. For this to be meaningful, you must first initialize the cells with -- 'treeViewColumnCellSetCellData' -- treeViewColumnCellIsVisible :: TreeViewColumn -> IO Bool -- ^ returns @True@, if any of the cells packed into the -- @treeColumn@ are currently visible treeViewColumnCellIsVisible self = liftM toBool $ {# call gtk_tree_view_column_cell_is_visible #} self #if GTK_CHECK_VERSION(2,2,0) -- %hash c:a202 d:1401 -- | Sets the current keyboard focus to be at @cell@, if the column contains 2 -- or more editable and activatable cells. -- -- * Available since Gtk+ version 2.2 -- treeViewColumnFocusCell :: CellRendererClass cell => TreeViewColumn -> cell -- ^ @cell@ - A 'CellRenderer' -> IO () treeViewColumnFocusCell self cell = {# call gtk_tree_view_column_focus_cell #} self (toCellRenderer cell) #if GTK_CHECK_VERSION(2,8,0) -- %hash c:4420 d:bfde -- | Flags the column, and the cell renderers added to this column, to have -- their sizes renegotiated. -- -- * Available since Gtk+ version 2.8 -- treeViewColumnQueueResize :: TreeViewColumn -> IO () treeViewColumnQueueResize self = {# call gtk_tree_view_column_queue_resize #} self #endif #endif -------------------- -- Attributes -- | Whether to display the column. -- -- Default value: @True@ -- treeViewColumnVisible :: Attr TreeViewColumn Bool treeViewColumnVisible = newAttr treeViewColumnGetVisible treeViewColumnSetVisible -- | Column is user-resizable. -- -- Default value: @False@ -- treeViewColumnResizable :: Attr TreeViewColumn Bool treeViewColumnResizable = newAttr treeViewColumnGetResizable treeViewColumnSetResizable -- | Current width of the column. -- -- Allowed values: >= 0 -- -- Default value: 0 -- treeViewColumnWidth :: ReadAttr TreeViewColumn Int treeViewColumnWidth = readAttrFromIntProperty "width" -- | Space which is inserted between cells. -- -- Allowed values: >= 0 -- -- Default value: 0 -- treeViewColumnSpacing :: Attr TreeViewColumn Int treeViewColumnSpacing = newAttr treeViewColumnGetSpacing treeViewColumnSetSpacing -- | Resize mode of the column. -- -- Default value: 'TreeViewColumnGrowOnly' -- treeViewColumnSizing :: Attr TreeViewColumn TreeViewColumnSizing treeViewColumnSizing = newAttr treeViewColumnGetSizing treeViewColumnSetSizing -- | Current fixed width of the column. -- -- Allowed values: >= 1 -- -- Default value: 1 -- treeViewColumnFixedWidth :: Attr TreeViewColumn Int treeViewColumnFixedWidth = newAttr treeViewColumnGetFixedWidth treeViewColumnSetFixedWidth -- | Minimum allowed width of the column. -- -- Allowed values: >= -1 -- -- Default value: -1 -- treeViewColumnMinWidth :: Attr TreeViewColumn Int treeViewColumnMinWidth = newAttr treeViewColumnGetMinWidth treeViewColumnSetMinWidth -- | Maximum allowed width of the column. -- -- Allowed values: >= -1 -- -- Default value: -1 -- treeViewColumnMaxWidth :: Attr TreeViewColumn Int treeViewColumnMaxWidth = newAttr treeViewColumnGetMaxWidth treeViewColumnSetMaxWidth -- | Title to appear in column header. -- -- Default value: \"\" -- treeViewColumnTitle :: GlibString string => ReadWriteAttr TreeViewColumn (Maybe string) string treeViewColumnTitle = newAttr treeViewColumnGetTitle treeViewColumnSetTitle -- %hash c:800 d:eb1a -- | Column gets share of extra width allocated to the widget. -- -- Default value: @False@ -- treeViewColumnExpand :: Attr TreeViewColumn Bool treeViewColumnExpand = newAttrFromBoolProperty "expand" -- | Whether the header can be clicked. -- -- Default value: @False@ -- treeViewColumnClickable :: Attr TreeViewColumn Bool treeViewColumnClickable = newAttr treeViewColumnGetClickable treeViewColumnSetClickable -- | Widget to put in column header button instead of column title. -- treeViewColumnWidget :: WidgetClass widget => ReadWriteAttr TreeViewColumn (Maybe Widget) (Maybe widget) treeViewColumnWidget = newAttr treeViewColumnGetWidget treeViewColumnSetWidget -- | X Alignment of the column header text or widget. -- -- Allowed values: [0,1] -- -- Default value: 0 -- treeViewColumnAlignment :: Attr TreeViewColumn Float treeViewColumnAlignment = newAttr treeViewColumnGetAlignment treeViewColumnSetAlignment -- | Whether the column can be reordered around the headers. -- -- Default value: @False@ -- treeViewColumnReorderable :: Attr TreeViewColumn Bool treeViewColumnReorderable = newAttr treeViewColumnGetReorderable treeViewColumnSetReorderable -- | Whether to show a sort indicator. -- -- Default value: @False@ -- treeViewColumnSortIndicator :: Attr TreeViewColumn Bool treeViewColumnSortIndicator = newAttr treeViewColumnGetSortIndicator treeViewColumnSetSortIndicator -- | Sort direction the sort indicator should indicate. -- -- Default value: 'SortAscending' -- treeViewColumnSortOrder :: Attr TreeViewColumn SortType treeViewColumnSortOrder = newAttr treeViewColumnGetSortOrder treeViewColumnSetSortOrder -- | \'sortColumnId\' property. See 'treeViewColumnGetSortColumnId' and -- 'treeViewColumnSetSortColumnId' -- treeViewColumnSortColumnId :: Attr TreeViewColumn SortColumnId treeViewColumnSortColumnId = newAttr treeViewColumnGetSortColumnId treeViewColumnSetSortColumnId -------------------- -- Signals -- | Emitted when the header of this column has been clicked on. -- onColClicked, afterColClicked :: TreeViewColumnClass self => self -> IO () -> IO (ConnectId self) onColClicked = connect_NONE__NONE "clicked" False afterColClicked = connect_NONE__NONE "clicked" True gtk-0.15.9/Graphics/UI/Gtk/ModelView/Types.chs0000644000000000000000000002265607346545000017077 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) CustomStore TreeModel -- -- Author : Duncan Coutts -- -- Created: 31 March 2006 -- -- Copyright (C) 2006-2007 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. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Common types and classes for the ModelView modules. -- module Graphics.UI.Gtk.ModelView.Types ( TypedTreeModel(..), TypedTreeModelClass, toTypedTreeModel, unsafeTreeModelToGeneric, TypedTreeModelSort(..), unsafeTreeModelSortToGeneric, TypedTreeModelFilter(..), unsafeTreeModelFilterToGeneric, -- TreeIter TreeIter(..), receiveTreeIter, peekTreeIter, treeIterSetStamp, -- TreePath TreePath, NativeTreePath(..), newTreePath, withTreePath, maybeWithTreePath, peekTreePath, fromTreePath, stringToTreePath, -- Columns ColumnAccess(..), ColumnId(..), -- Storing the model in a ComboBox comboQuark, ) where import GHC.Exts (unsafeCoerce#) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GValue (GValue) import System.Glib.GObject (Quark, quarkFromString) {#import Graphics.UI.Gtk.Types#} (TreeModel, TreeModelSort, TreeModelFilter, Pixbuf) import Data.Char ( isDigit ) import Control.Monad ( liftM ) {# context lib="gtk" prefix="gtk" #} newtype TypedTreeModel row = TypedTreeModel (ForeignPtr (TypedTreeModel row)) class TypedTreeModelClass model where dummy :: model a -> a dummy _ = error "not used" -- this is to get the right kind for model :: * -> * -- TODO: when haddock is fixed we can use an explicit kind annotation toTypedTreeModel :: TypedTreeModelClass model => model row -> TypedTreeModel row toTypedTreeModel = unsafeCoerce# unsafeTreeModelToGeneric :: TreeModel -> model row unsafeTreeModelToGeneric = unsafeCoerce# instance TypedTreeModelClass TypedTreeModel newtype TypedTreeModelSort row = TypedTreeModelSort (ForeignPtr (TypedTreeModelSort row)) unsafeTreeModelSortToGeneric :: TreeModelSort -> TypedTreeModelSort row unsafeTreeModelSortToGeneric = unsafeCoerce# instance TypedTreeModelClass TypedTreeModelSort newtype TypedTreeModelFilter row = TypedTreeModelFilter (ForeignPtr (TypedTreeModelFilter row)) unsafeTreeModelFilterToGeneric :: TreeModelFilter -> TypedTreeModelFilter row unsafeTreeModelFilterToGeneric = unsafeCoerce# instance TypedTreeModelClass TypedTreeModelFilter -- | Tree Iterator: a pointer to an entry in a -- 'Graphics.UI.Gtk.ModelView.TreeModel'. The constructor of this structure is -- public for the sake of creating custom tree models. The first value is a -- time stamp that is handled by the functions that interface with Gtk. The -- time stamps are used to print warnings if programmers use an iter to a -- model that has changed meanwhile. The other three fields are used by the -- custom model implementation to implement an indexing scheme. The precise -- use of the three words is therefore implementation specific. See also -- 'TreePath'. -- data TreeIter = TreeIter {-# UNPACK #-} !CInt !Word32 !Word32 !Word32 deriving Show {#pointer *TreeIter as TreeIterPtr -> TreeIter #} instance Storable TreeIter where sizeOf _ = {# sizeof TreeIter #} alignment _ = alignment (undefined :: CInt) peek ptr = do stamp <- {# get TreeIter->stamp #} ptr user_data <- {# get TreeIter->user_data #} ptr user_data2 <- {# get TreeIter->user_data2 #} ptr user_data3 <- {# get TreeIter->user_data3 #} ptr return (TreeIter stamp (ptrToWord user_data) (ptrToWord user_data2) (ptrToWord user_data3)) where ptrToWord :: Ptr a -> Word32 ptrToWord ptr = fromIntegral (ptr `minusPtr` nullPtr) poke ptr (TreeIter stamp user_data user_data2 user_data3) = do {# set TreeIter->stamp #} ptr stamp {# set TreeIter->user_data #} ptr (wordToPtr user_data) {# set TreeIter->user_data2 #} ptr (wordToPtr user_data2) {# set TreeIter->user_data3 #} ptr (wordToPtr user_data3) where wordToPtr :: Word32 -> Ptr a wordToPtr word = nullPtr `plusPtr` fromIntegral word -- Pass a pointer to a structure large enough to hold a GtkTreeIter -- structure. If the function returns true, read the tree iter and -- return it. receiveTreeIter :: (Ptr TreeIter -> IO CInt) -> IO (Maybe TreeIter) receiveTreeIter body = alloca $ \iterPtr -> do result <- body iterPtr if toBool result then liftM Just (peek iterPtr) else return Nothing -- Note that this function does throw an error if the pointer is NULL rather -- than returning some random tree iterator. peekTreeIter :: Ptr TreeIter -> IO TreeIter peekTreeIter ptr | ptr==nullPtr = fail "peekTreeIter: ptr is NULL, tree iterator is invalid" | otherwise = peek ptr -- update the stamp of a tree iter treeIterSetStamp :: TreeIter -> CInt -> TreeIter treeIterSetStamp (TreeIter _ a b c) s = (TreeIter s a b c) -- | TreePath : a list of indices to specify a subtree or node in a -- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel'. The node that correspond -- to a given 'TreePath' might change if nodes are removed or added and a -- 'TreePath' may refer to a different or even non-existent node after a -- modification of the model. In contrast, a 'TreeIter' is a more compact -- representation of a 'TreePath' which becomes invalid after each -- modification of the underlying model. An intelligent index that is adjusted -- with each update of the model to point to the same node (whenever possible) -- is 'Graphics.UI.Gtk.ModelView.TreeRowReference.TreeRowReference'. -- type TreePath = [Int] {#pointer * TreePath as NativeTreePath newtype#} nativeTreePathFree :: NativeTreePath -> IO () nativeTreePathFree = {# call unsafe tree_path_free #} newTreePath :: TreePath -> IO NativeTreePath newTreePath path = do nativePath <- liftM NativeTreePath {# call unsafe tree_path_new #} mapM_ ({#call unsafe tree_path_append_index#} nativePath . fromIntegral) path return nativePath withTreePath :: TreePath -> (NativeTreePath -> IO a) -> IO a withTreePath tp act = do nativePath <- newTreePath tp res <- act nativePath nativeTreePathFree nativePath return res maybeWithTreePath :: Maybe TreePath -> (NativeTreePath -> IO a) -> IO a maybeWithTreePath mbTp act = maybe (act (NativeTreePath nullPtr)) (`withTreePath` act) mbTp nativeTreePathGetIndices :: NativeTreePath -> IO [Int] nativeTreePathGetIndices tp = do depth <- liftM fromIntegral $ {# call unsafe tree_path_get_depth #} tp arrayPtr <- {# call unsafe tree_path_get_indices #} tp if (depth==0 || arrayPtr==nullPtr) then return [] else liftM (map fromIntegral) $ peekArray depth arrayPtr -- | Convert the given pointer to a tree path. peekTreePath :: Ptr NativeTreePath -> IO TreePath peekTreePath tpPtr | tpPtr==nullPtr = return [] | otherwise = nativeTreePathGetIndices (NativeTreePath tpPtr) -- | Convert the given pointer to a tree path. Frees the pointer. fromTreePath :: Ptr NativeTreePath -> IO TreePath fromTreePath tpPtr | tpPtr==nullPtr = return [] | otherwise = do path <- nativeTreePathGetIndices (NativeTreePath tpPtr) nativeTreePathFree (NativeTreePath tpPtr) return path -- | Convert a comma or colon separated string into a 'TreePath'. Any -- non-digit characters are assumed to separate indices, thus, the function -- always is always successful. stringToTreePath :: DefaultGlibString -> TreePath stringToTreePath = stringToTreePath' . glibToString where stringToTreePath' "" = [] stringToTreePath' path = getNum 0 (dropWhile (not . isDigit) path) getNum acc ('0':xs) = getNum (10*acc) xs getNum acc ('1':xs) = getNum (10*acc+1) xs getNum acc ('2':xs) = getNum (10*acc+2) xs getNum acc ('3':xs) = getNum (10*acc+3) xs getNum acc ('4':xs) = getNum (10*acc+4) xs getNum acc ('5':xs) = getNum (10*acc+5) xs getNum acc ('6':xs) = getNum (10*acc+6) xs getNum acc ('7':xs) = getNum (10*acc+7) xs getNum acc ('8':xs) = getNum (10*acc+8) xs getNum acc ('9':xs) = getNum (10*acc+9) xs getNum acc xs = acc:stringToTreePath' (dropWhile (not . isDigit) xs) -- | Accessing a row for a specific value. Used for 'ColumnMap'. data ColumnAccess row where CAInvalid :: ColumnAccess row CAInt :: (row -> Int) -> ColumnAccess row CABool :: (row -> Bool) -> ColumnAccess row CAString :: GlibString string => (row -> string) -> ColumnAccess row CAPixbuf :: (row -> Pixbuf) -> ColumnAccess row -- | The type of a tree column. data ColumnId row ty = ColumnId (GValue -> IO ty) ((row -> ty) -> ColumnAccess row) Int -- it shouldn't matter if the following function is actually inlined {-# NOINLINE comboQuark #-} comboQuark :: Quark comboQuark = unsafePerformIO $ quarkFromString ("comboBoxHaskellStringModelQuark"::DefaultGlibString) gtk-0.15.9/Graphics/UI/Gtk/Multiline/0000755000000000000000000000000007346545000015330 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Multiline/TextBuffer.chs0000644000000000000000000014623007346545000020113 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) TextBuffer -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 February 2002 -- -- Copyright (C) 2001-2005 Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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. -- -- NOTES -- -- Below `variadic` functions can't support by FFI: -- gtk_text_buffer_insert_with_tags -- gtk_text_buffer_insert_with_tags_by_name -- gtk_text_buffer_create_tag -- But above functions is not essential, we can use other functions do same work. -- Example: -- -- gtk_text_buffer_insert_with_tags equivalent to calling textBufferInsert, -- then textBufferApplyTag on the inserted text. -- -- gtk_text_buffer_insert_with_tags_by_name same as gtk_text_buffer_insert_with_tags, -- just use textTagName handle tag name. -- -- gtk_text_buffer_create_tag Equivalent to calling textTagNew -- and then adding the tag to the buffer's tag table. -- -- The following functions do not make sense due to Haskell's wide character -- representation of Unicode: -- gtk_text_buffer_get_iter_at_line_index -- -- The function gtk_text_buffer_get_selection_bounds is only used to test -- if there is a selection (see 'textBufferHasSelection'). -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Stores attributed text for display in a 'TextView' -- module Graphics.UI.Gtk.Multiline.TextBuffer ( -- * Detail -- -- | You may wish to begin by reading the text widget conceptual overview -- which gives an overview of all the objects and data types related to the -- text widget and how they work together. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----TextBuffer -- @ -- * Types TextBuffer, TextBufferClass, castToTextBuffer, gTypeTextBuffer, toTextBuffer, -- * Constructors textBufferNew, -- * Methods textBufferGetLineCount, textBufferGetCharCount, textBufferGetTagTable, textBufferInsert, textBufferInsertByteString, textBufferInsertAtCursor, textBufferInsertByteStringAtCursor, textBufferInsertInteractive, textBufferInsertByteStringInteractive, textBufferInsertInteractiveAtCursor, textBufferInsertByteStringInteractiveAtCursor, textBufferInsertRange, textBufferInsertRangeInteractive, textBufferDelete, textBufferDeleteInteractive, textBufferSetByteString, textBufferGetByteString, textBufferGetByteStringSlice, textBufferSetText, textBufferGetText, textBufferGetSlice, textBufferInsertPixbuf, textBufferCreateMark, #if GTK_CHECK_VERSION(2,12,0) textBufferAddMark, #endif textBufferMoveMark, textBufferMoveMarkByName, textBufferDeleteMark, textBufferDeleteMarkByName, textBufferGetMark, textBufferGetInsert, textBufferGetSelectionBound, textBufferPlaceCursor, textBufferApplyTag, textBufferRemoveTag, textBufferApplyTagByName, textBufferRemoveTagByName, textBufferRemoveAllTags, textBufferGetIterAtLineOffset, textBufferGetIterAtOffset, textBufferGetIterAtLine, textBufferGetIterAtMark, textBufferGetStartIter, textBufferGetEndIter, textBufferGetModified, textBufferSetModified, textBufferDeleteSelection, textBufferHasSelection, textBufferGetSelectionBounds, #if GTK_CHECK_VERSION(2,4,0) textBufferSelectRange, #endif textBufferGetBounds, textBufferBeginUserAction, textBufferEndUserAction, #if GTK_CHECK_VERSION(2,6,0) textBufferBackspace, #endif textBufferInsertChildAnchor, textBufferCreateChildAnchor, textBufferGetIterAtChildAnchor, #if GTK_CHECK_VERSION(2,2,0) textBufferPasteClipboard, textBufferPasteClipboardAtCursor, textBufferCopyClipboard, textBufferCutClipboard, #endif textBufferAddSelectionClipboard, textBufferRemoveSelectionClipboard, -- * Attributes textBufferTagTable, #if GTK_CHECK_VERSION(2,8,0) textBufferText, #endif textBufferModified, -- * Signals applyTag, beginUserAction, bufferChanged, deleteRange, endUserAction, insertPixbuf, insertChildAnchor, bufferInsertText, markDeleted, markSet, modifiedChanged, pasteDone, removeTag, -- * Deprecated #ifndef DISABLE_DEPRECATED onApplyTag, afterApplyTag, onBeginUserAction, afterBeginUserAction, onBufferChanged, afterBufferChanged, onDeleteRange, afterDeleteRange, onEndUserAction, afterEndUserAction, onInsertPixbuf, afterInsertPixbuf, onBufferInsertText, afterBufferInsertText, onMarkDeleted, afterMarkDeleted, onMarkSet, afterMarkSet, onModifiedChanged, afterModifiedChanged, onRemoveTag, afterRemoveTag #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackCStringFinalizer) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Multiline.Types#} import Graphics.UI.Gtk.Multiline.TextMark (MarkName) import Graphics.UI.Gtk.Multiline.TextTag (TagName) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new text buffer. -- textBufferNew :: Maybe TextTagTable -- ^ @table@ - a tag table, or @Nothing@ to create a -- new one -> IO TextBuffer textBufferNew table = wrapNewGObject mkTextBuffer $ {# call unsafe text_buffer_new #} (maybe (TextTagTable nullForeignPtr) toTextTagTable table) -------------------- -- Methods -- | Obtains the number of lines in the buffer. This value is cached, so the -- function is very fast. -- textBufferGetLineCount :: TextBufferClass self => self -> IO Int textBufferGetLineCount self = liftM fromIntegral $ {# call unsafe text_buffer_get_line_count #} (toTextBuffer self) -- | Gets the number of characters in the buffer. The character count is -- cached, so this function is very fast. -- textBufferGetCharCount :: TextBufferClass self => self -> IO Int textBufferGetCharCount self = liftM fromIntegral $ {# call unsafe text_buffer_get_char_count #} (toTextBuffer self) -- | Get the 'TextTagTable' associated with this buffer. -- textBufferGetTagTable :: TextBufferClass self => self -> IO TextTagTable textBufferGetTagTable self = makeNewGObject mkTextTagTable $ {# call unsafe text_buffer_get_tag_table #} (toTextBuffer self) -- | Inserts @text@ at position @iter@. Emits the -- 'insertText' signal; insertion actually occurs in the default handler for -- the signal. @iter@ is invalidated when insertion occurs (because the buffer -- contents change). -- textBufferInsert :: (TextBufferClass self, GlibString string) => self -> TextIter -- ^ @iter@ - a position in the buffer -> string -- ^ @text@ - text to insert -> IO () textBufferInsert self iter text = withUTFStringLen text $ \(textPtr, len) -> {# call text_buffer_insert #} (toTextBuffer self) iter textPtr (fromIntegral len) -- | Inserts @text@ at position @iter@. Similar -- to 'textBufferInsert' but uses 'ByteString' buffers. -- -- * The passed-in buffer must contain a valid UTF-8 encoded string. -- textBufferInsertByteString :: TextBufferClass self => self -> TextIter -- ^ @iter@ - a position in the buffer -> ByteString -- ^ @text@ - text to insert -> IO () textBufferInsertByteString self iter text = unsafeUseAsCStringLen text $ \(textPtr, len) -> {# call text_buffer_insert #} (toTextBuffer self) iter textPtr (fromIntegral len) -- | Simply calls 'textBufferInsert', using the current cursor position as the -- insertion point. -- textBufferInsertAtCursor :: (TextBufferClass self, GlibString string) => self -> string -> IO () textBufferInsertAtCursor self text = withUTFStringLen text $ \(textPtr, len) -> {# call text_buffer_insert_at_cursor #} (toTextBuffer self) textPtr (fromIntegral len) -- | Simply calls 'textBufferInsert', using the current cursor position as the -- insertion point. Similar to 'textBufferInsertAtCursor' but uses 'ByteString' buffers. -- -- * The passed-in buffer must contain a valid UTF-8 encoded string. -- textBufferInsertByteStringAtCursor :: TextBufferClass self => self -> ByteString -> IO () textBufferInsertByteStringAtCursor self text = unsafeUseAsCStringLen text $ \(textPtr, len) -> {# call text_buffer_insert_at_cursor #} (toTextBuffer self) textPtr (fromIntegral len) -- | Like 'textBufferInsert', but the insertion will not occur if @iter@ is at -- a non-editable location in the buffer. Usually you want to prevent -- insertions at ineditable locations if the insertion results from a user -- action (is interactive). -- -- If no tag is at the specified position, use the default value @def@ to -- decide if the text should be inserted. This value could be set to the result -- of 'Graphics.UI.Gtk.Multiline.TextView.textViewGetEditable'. -- textBufferInsertInteractive :: (TextBufferClass self, GlibString string) => self -> TextIter -- ^ @iter@ - a position in @buffer@ -> string -- ^ @text@ - the text to insert -> Bool -- ^ @defaultEditable@ - default editability of buffer -> IO Bool -- ^ returns whether text was actually inserted textBufferInsertInteractive self iter text defaultEditable = liftM toBool $ withUTFStringLen text $ \(textPtr, len) -> {# call text_buffer_insert_interactive #} (toTextBuffer self) iter textPtr (fromIntegral len) (fromBool defaultEditable) -- | Similar to 'textBufferInsertInteractive' but uses 'ByteString' buffers. -- -- * The passed-in buffer must contain a valid UTF-8 encoded string. -- textBufferInsertByteStringInteractive :: TextBufferClass self => self -> TextIter -- ^ @iter@ - a position in @buffer@ -> ByteString -- ^ @text@ - the text to insert -> Bool -- ^ @defaultEditable@ - default editability of buffer -> IO Bool -- ^ returns whether text was actually inserted textBufferInsertByteStringInteractive self iter text defaultEditable = liftM toBool $ unsafeUseAsCStringLen text $ \(textPtr, len) -> {# call text_buffer_insert_interactive #} (toTextBuffer self) iter textPtr (fromIntegral len) (fromBool defaultEditable) -- | Calls 'textBufferInsertInteractive' at the cursor position. -- textBufferInsertInteractiveAtCursor :: (TextBufferClass self, GlibString string) => self -> string -- ^ @text@ - the text to insert -> Bool -- ^ @defaultEditable@ - default editability of buffer -> IO Bool -- ^ returns whether text was actually inserted textBufferInsertInteractiveAtCursor self text defaultEditable = liftM toBool $ withUTFStringLen text $ \(textPtr, len) -> {# call text_buffer_insert_interactive_at_cursor #} (toTextBuffer self) textPtr (fromIntegral len) (fromBool defaultEditable) -- | Similar to 'textBufferInsertInteractiveAtCursor' but uses 'ByteString' buffers. -- -- * The passed-in buffer must contain a valid UTF-8 encoded string. -- textBufferInsertByteStringInteractiveAtCursor :: TextBufferClass self => self -> ByteString -- ^ @text@ - the text to insert -> Bool -- ^ @defaultEditable@ - default editability of buffer -> IO Bool -- ^ returns whether text was actually inserted textBufferInsertByteStringInteractiveAtCursor self text defaultEditable = liftM toBool $ unsafeUseAsCStringLen text $ \(textPtr, len) -> {# call text_buffer_insert_interactive_at_cursor #} (toTextBuffer self) textPtr (fromIntegral len) (fromBool defaultEditable) -- | Copies text, tags, and pixbufs between @start@ and @end@ (the order of -- @start@ and @end@ doesn't matter) and inserts the copy at @iter@. Used -- instead of simply getting\/inserting text because it preserves images and -- tags. If @start@ and @end@ are in a different buffer from @buffer@, the two -- buffers must share the same tag table. -- -- Implemented via emissions of the insert-text and 'applyTag' signals, so -- expect those. -- textBufferInsertRange :: TextBufferClass self => self -> TextIter -- ^ @iter@ - a position in the buffer -> TextIter -- ^ @start@ - a position in a 'TextBuffer' -> TextIter -- ^ @end@ - another position in the same buffer as @start@ -> IO () textBufferInsertRange self iter start end = {# call text_buffer_insert_range #} (toTextBuffer self) iter start end -- | Same as 'textBufferInsertRange', but does nothing if the insertion point -- isn't editable. The @defaultEditable@ parameter indicates whether the text -- is editable at @iter@ if no tags enclosing @iter@ affect editability. -- Typically the result of -- 'Graphics.UI.Gtk.Multiline.TextView.textViewGetEditable' is appropriate here. -- textBufferInsertRangeInteractive :: TextBufferClass self => self -> TextIter -- ^ @iter@ - a position in the buffer -> TextIter -- ^ @start@ - a position in a 'TextBuffer' -> TextIter -- ^ @end@ - another position in the same buffer as @start@ -> Bool -- ^ @defaultEditable@ - default editability of the buffer -> IO Bool -- ^ returns whether an insertion was possible at @iter@ textBufferInsertRangeInteractive self iter start end defaultEditable = liftM toBool $ {# call text_buffer_insert_range_interactive #} (toTextBuffer self) iter start end (fromBool defaultEditable) -- | Deletes text between @start@ and @end@. The order of @start@ and @end@ is -- not actually relevant; 'textBufferDelete' will reorder them. This function -- actually emits the 'deleteRange' signal, and the default handler of that -- signal deletes the text. Because the buffer is modified, all outstanding -- iterators become invalid after calling this function; however, the @start@ -- and @end@ will be re-initialized to point to the location where text was -- deleted. -- textBufferDelete :: TextBufferClass self => self -> TextIter -- ^ @start@ - a position in @buffer@ -> TextIter -- ^ @end@ - another position in @buffer@ -> IO () textBufferDelete self start end = {# call text_buffer_delete #} (toTextBuffer self) start end -- | Deletes all /editable/ text in the given range. Calls 'textBufferDelete' -- for each editable sub-range of [@start@,@end@). @start@ and @end@ are -- revalidated to point to the location of the last deleted range, or left -- untouched if no text was deleted. -- textBufferDeleteInteractive :: TextBufferClass self => self -> TextIter -- ^ @startIter@ - start of range to delete -> TextIter -- ^ @endIter@ - end of range -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by -- default -> IO Bool -- ^ returns whether some text was actually deleted textBufferDeleteInteractive self startIter endIter defaultEditable = liftM toBool $ {# call text_buffer_delete_interactive #} (toTextBuffer self) startIter endIter (fromBool defaultEditable) -- | Deletes current contents of @buffer@, and inserts @text@ instead. -- textBufferSetText :: (TextBufferClass self, GlibString string) => self -> string -- ^ @text@ - text to insert -> IO () textBufferSetText self text = withUTFStringLen text $ \(textPtr, len) -> {# call text_buffer_set_text #} (toTextBuffer self) textPtr (fromIntegral len) -- | Returns the text in the range [@start@,@end@). Excludes undisplayed text -- (text marked with tags that set the invisibility attribute) if -- @includeHiddenChars@ is @False@. Does not include characters representing -- embedded images, so character indexes into the returned string do -- /not/ correspond to character indexes into the buffer. Contrast -- with 'textBufferGetSlice'. -- textBufferGetText :: (TextBufferClass self, GlibString string) => self -> TextIter -- ^ @start@ - start of a range -> TextIter -- ^ @end@ - end of a range -> Bool -- ^ @includeHiddenChars@ - whether to include invisible text -> IO string textBufferGetText self start end includeHiddenChars = {# call unsafe text_buffer_get_text #} (toTextBuffer self) start end (fromBool includeHiddenChars) >>= readUTFString -- | Returns the text in the range [@start@,@end@). Excludes undisplayed text -- (text marked with tags that set the invisibility attribute) if -- @includeHiddenChars@ is @False@. The returned string includes a -- @(chr 0xFFFC)@ character whenever the buffer contains embedded images, so -- character indexes into the returned string /do/ correspond to -- character indexes into the buffer. Contrast with 'textBufferGetText'. Note -- that @(chr 0xFFFC)@ can occur in normal text as well, so it is not a reliable -- indicator that a pixbuf or widget is in the buffer. -- textBufferGetSlice :: (TextBufferClass self, GlibString string) => self -> TextIter -- ^ @start@ - start of a range -> TextIter -- ^ @end@ - end of a range -> Bool -- ^ @includeHiddenChars@ - whether to include invisible text -> IO string textBufferGetSlice self start end includeHiddenChars = {# call unsafe text_buffer_get_slice #} (toTextBuffer self) start end (fromBool includeHiddenChars) >>= readUTFString -- | Deletes current contents of @buffer@, and inserts @text@ instead. Similar -- to 'textBufferSetText' but uses 'ByteString' buffers. -- -- * The passed-in buffer must contain a valid UTF-8 encoded string. -- textBufferSetByteString :: TextBufferClass self => self -> ByteString -- ^ @text@ - text to insert -> IO () textBufferSetByteString self text = unsafeUseAsCStringLen text $ \(textPtr, len) -> {# call text_buffer_set_text #} (toTextBuffer self) textPtr (fromIntegral len) -- | Returns the text in the range [@start@,@end@). Similar to -- `textBufferGetText` but uses 'ByteString' buffers. -- -- * The returned buffer is a UTF-8 encoded string. -- textBufferGetByteString :: TextBufferClass self => self -> TextIter -- ^ @start@ - start of a range -> TextIter -- ^ @end@ - end of a range -> Bool -- ^ @includeHiddenChars@ - whether to include invisible text -> IO ByteString textBufferGetByteString self start end includeHiddenChars = do sPtr <- {# call unsafe text_buffer_get_text #} (toTextBuffer self) start end (fromBool includeHiddenChars) sLen <- lengthArray0 0 sPtr unsafePackCStringFinalizer (castPtr sPtr) (fromIntegral sLen) ({#call unsafe g_free#} (castPtr sPtr)) -- | Returns the text in the range [@start@,@end@). Similar to -- `textBufferGetSlice` but uses 'ByteString' buffers. -- -- * The returned buffer is a UTF-8 encoded string. -- textBufferGetByteStringSlice :: TextBufferClass self => self -> TextIter -- ^ @start@ - start of a range -> TextIter -- ^ @end@ - end of a range -> Bool -- ^ @includeHiddenChars@ - whether to include invisible text -> IO ByteString textBufferGetByteStringSlice self start end includeHiddenChars = do sPtr <- {# call unsafe text_buffer_get_slice #} (toTextBuffer self) start end (fromBool includeHiddenChars) sLen <- lengthArray0 0 sPtr unsafePackCStringFinalizer (castPtr sPtr) (fromIntegral sLen) ({#call unsafe g_free#} (castPtr sPtr)) -- | Inserts an image into the text buffer at @iter@. The image will be -- counted as one character in character counts, and when obtaining the buffer -- contents as a string, will be represented by the Unicode \"object -- replacement character\" @(chr 0xFFFC)@. Note that the \"slice\" variants for -- obtaining portions of the buffer as a string include this character for -- pixbufs, but the \"text\" variants do not. e.g. see 'textBufferGetSlice' and -- 'textBufferGetText'. -- textBufferInsertPixbuf :: TextBufferClass self => self -> TextIter -- ^ @iter@ - location to insert the pixbuf -> Pixbuf -- ^ @pixbuf@ - a 'Pixbuf' -> IO () textBufferInsertPixbuf self iter pixbuf = {# call text_buffer_insert_pixbuf #} (toTextBuffer self) iter pixbuf -- | Creates a mark at position @where@. If @markName@ is @Nothing@, the mark -- is anonymous; otherwise, the mark can be retrieved by name using -- 'textBufferGetMark'. If a mark has left gravity, and text is inserted at the -- mark's current location, the mark will be moved to the left of the -- newly-inserted text. If the mark has right gravity (@leftGravity@ = -- @False@), the mark will end up on the right of newly-inserted text. The -- standard left-to-right cursor is a mark with right gravity (when you type, -- the cursor stays on the right side of the text you're typing). -- -- Emits the 'markSet' signal as notification of the mark's initial -- placement. -- textBufferCreateMark :: TextBufferClass self => self -> Maybe MarkName -- ^ @markName@ - name for mark, or @Nothing@ -> TextIter -- ^ @where@ - location to place mark -> Bool -- ^ @leftGravity@ - whether the mark has left gravity -> IO TextMark -- ^ returns the new 'TextMark' object textBufferCreateMark self markName where_ leftGravity = makeNewGObject mkTextMark $ maybeWith withUTFString markName $ \markNamePtr -> {# call text_buffer_create_mark #} (toTextBuffer self) markNamePtr where_ (fromBool leftGravity) #if GTK_CHECK_VERSION(2,12,0) -- | Adds the mark at position given by the 'TextIter'. -- The mark may not be added to any other buffer. -- -- Emits the 'markSet' signal as notification of the mark's initial placement. -- textBufferAddMark :: TextBufferClass self => self -> TextMark -- ^ @mark@ the mark to add -> TextIter -- ^ @iter@ location to place mark -> IO () textBufferAddMark self mark iter = {# call text_buffer_add_mark #} (toTextBuffer self) (toTextMark mark) iter #endif -- | Moves @mark@ to the new location @where@. Emits the 'markSet' signal -- as notification of the move. -- textBufferMoveMark :: (TextBufferClass self, TextMarkClass mark) => self -> mark -- ^ @mark@ - a 'TextMark' -> TextIter -- ^ @where@ - new location for @mark@ in the buffer -> IO () textBufferMoveMark self mark where_ = {# call text_buffer_move_mark #} (toTextBuffer self) (toTextMark mark) where_ -- | Moves the mark named @name@ (which must exist) to location @where@. See -- 'textBufferMoveMark' for details. -- textBufferMoveMarkByName :: TextBufferClass self => self -> MarkName -- ^ @name@ - name of a mark -> TextIter -- ^ @where@ - new location for mark -> IO () textBufferMoveMarkByName self name where_ = withUTFString name $ \namePtr -> {# call text_buffer_move_mark_by_name #} (toTextBuffer self) namePtr where_ -- | Deletes @mark@, so that it's no longer located anywhere in the buffer. -- Most operations on @mark@ become invalid. There is no way to undelete a -- mark. 'Graphics.UI.Gtk.Multiline.TextMark.textMarkGetDeleted' will -- return @True@ after this function has been -- called on a mark; 'Graphics.UI.Gtk.Multiline.TextMark.textMarkGetDeleted' -- indicates that a mark no longer -- belongs to a buffer. The 'markDeleted' signal will be emitted as -- notification after the mark is deleted. -- textBufferDeleteMark :: (TextBufferClass self, TextMarkClass mark) => self -> mark -- ^ @mark@ - a 'TextMark' in the buffer -> IO () textBufferDeleteMark self mark = {# call text_buffer_delete_mark #} (toTextBuffer self) (toTextMark mark) -- | Deletes the mark named @name@; the mark must exist. See -- 'textBufferDeleteMark' for details. -- textBufferDeleteMarkByName :: TextBufferClass self => self -> MarkName -- ^ @name@ - name of a mark in @buffer@ -> IO () textBufferDeleteMarkByName self name = withUTFString name $ \namePtr -> {# call text_buffer_delete_mark_by_name #} (toTextBuffer self) namePtr -- | Returns the mark named @name@ in the buffer, or @Nothing@ if no such -- mark exists in the buffer. -- textBufferGetMark :: TextBufferClass self => self -> MarkName -- ^ @name@ - a mark name -> IO (Maybe TextMark) -- ^ returns a 'TextMark', or @Nothing@ textBufferGetMark self name = maybeNull (makeNewGObject mkTextMark) $ withUTFString name $ \namePtr -> {# call unsafe text_buffer_get_mark #} (toTextBuffer self) namePtr -- | Returns the mark that represents the cursor (insertion point). Equivalent -- to calling @liftM fromJust $ textBufferGetMark \"insert\"@, but very -- slightly more efficient, and involves less typing. -- textBufferGetInsert :: TextBufferClass self => self -> IO TextMark textBufferGetInsert self = makeNewGObject mkTextMark $ {# call unsafe text_buffer_get_insert #} (toTextBuffer self) -- | Returns the mark that represents the selection bound. Equivalent to -- calling @liftM fromJust $ textBufferGetMark \"selection_bound\"@, but -- very slightly more efficient, and involves less typing. -- -- The currently-selected text in @buffer@ is the region between the -- \"selection_bound\" and \"insert\" marks. If \"selection_bound\" and -- \"insert\" are in the same place, then there is no current selection. -- 'textBufferGetSelectionBounds' is another convenient function for handling -- the selection, if you just want to know whether there's a selection and what -- its bounds are. -- textBufferGetSelectionBound :: TextBufferClass self => self -> IO TextMark textBufferGetSelectionBound self = makeNewGObject mkTextMark $ {# call unsafe text_buffer_get_selection_bound #} (toTextBuffer self) -- | This function moves the \"insert\" and \"selection_bound\" marks -- simultaneously. If you move them to the same place in two steps with -- 'textBufferMoveMark', you will temporarily select a region in between their -- old and new locations, which can be pretty inefficient since the -- temporarily-selected region will force stuff to be recalculated. This -- function moves them as a unit, which can be optimized. -- textBufferPlaceCursor :: TextBufferClass self => self -> TextIter -- ^ @where@ - where to put the cursor -> IO () textBufferPlaceCursor self where_ = {# call text_buffer_place_cursor #} (toTextBuffer self) where_ -- | Emits the 'applyTag' signal on the buffer. The default handler for the -- signal applies @tag@ to the given range. @start@ and @end@ do not have to be -- in order. -- textBufferApplyTag :: (TextBufferClass self, TextTagClass tag) => self -> tag -- ^ @tag@ - a 'TextTag' -> TextIter -- ^ @start@ - one bound of range to be tagged -> TextIter -- ^ @end@ - other bound of range to be tagged -> IO () textBufferApplyTag self tag start end = {# call text_buffer_apply_tag #} (toTextBuffer self) (toTextTag tag) start end -- | Emits the 'removeTag' signal. The default handler for the signal -- removes all occurrences of @tag@ from the given range. @start@ and @end@ -- don't have to be in order. -- textBufferRemoveTag :: (TextBufferClass self, TextTagClass tag) => self -> tag -- ^ @tag@ - a 'TextTag' -> TextIter -- ^ @start@ - one bound of range to be untagged -> TextIter -- ^ @end@ - other bound of range to be untagged -> IO () textBufferRemoveTag self tag start end = {# call text_buffer_remove_tag #} (toTextBuffer self) (toTextTag tag) start end -- | Calls 'Graphics.UI.Gtk.Multiline.TextTagTable.textTagTableLookup' on the -- buffer's tag table to get a 'TextTag', then calls 'textBufferApplyTag'. -- textBufferApplyTagByName :: TextBufferClass self => self -> TagName -- ^ @name@ - name of a named 'TextTag' -> TextIter -- ^ @start@ - one bound of range to be tagged -> TextIter -- ^ @end@ - other bound of range to be tagged -> IO () textBufferApplyTagByName self name start end = withUTFString name $ \namePtr -> {# call text_buffer_apply_tag_by_name #} (toTextBuffer self) namePtr start end -- | Calls 'Graphics.UI.Gtk.Multiline.TextTagTable.textTagTableLookup' on the -- buffer's tag table to get a 'TextTag', then calls 'textBufferRemoveTag'. -- textBufferRemoveTagByName :: TextBufferClass self => self -> TagName -- ^ @name@ - name of a 'TextTag' -> TextIter -- ^ @start@ - one bound of range to be untagged -> TextIter -- ^ @end@ - other bound of range to be untagged -> IO () textBufferRemoveTagByName self name start end = withUTFString name $ \namePtr -> {# call text_buffer_remove_tag_by_name #} (toTextBuffer self) namePtr start end -- | Removes all tags in the range between @start@ and @end@. Be careful with -- this function; it could remove tags added in code unrelated to the code -- you\'re currently writing. That is, using this function is probably a bad -- idea if you have two or more unrelated code sections that add tags. -- textBufferRemoveAllTags :: TextBufferClass self => self -> TextIter -- ^ @start@ - one bound of range to be untagged -> TextIter -- ^ @end@ - other bound of range to be untagged -> IO () textBufferRemoveAllTags self start end = {# call text_buffer_remove_all_tags #} (toTextBuffer self) start end -- | Obtains an iterator pointing to @charOffset@ within the given line. The -- @charOffset@ must exist, offsets off the end of the line are not allowed. -- textBufferGetIterAtLineOffset :: TextBufferClass self => self -> Int -- ^ @lineNumber@ - line number counting from 0 -> Int -- ^ @charOffset@ - char offset from start of line -> IO TextIter textBufferGetIterAtLineOffset self lineNumber charOffset = do iter <- makeEmptyTextIter {# call unsafe text_buffer_get_iter_at_line_offset #} (toTextBuffer self) iter (fromIntegral lineNumber) (fromIntegral charOffset) return iter -- | Creates an iterator pointing to a position @charOffset@ chars from the -- start of the entire buffer. If @charOffset@ is -1 or greater than the number -- of characters in the buffer, the end iterator is returned, that is the -- iterator one past the last valid character in the buffer. -- textBufferGetIterAtOffset :: TextBufferClass self => self -> Int -- ^ @charOffset@ - char offset from start of buffer (counting -- from 0) or -1 -> IO TextIter textBufferGetIterAtOffset self charOffset = do iter <- makeEmptyTextIter {# call unsafe text_buffer_get_iter_at_offset #} (toTextBuffer self) iter (fromIntegral charOffset) return iter -- | Create an iterator at a specific line. -- textBufferGetIterAtLine :: TextBufferClass self => self -> Int -- ^ @lineNumber@ - line number counting from 0 -> IO TextIter textBufferGetIterAtLine self lineNumber = do iter <- makeEmptyTextIter {# call unsafe text_buffer_get_iter_at_line #} (toTextBuffer self) iter (fromIntegral lineNumber) return iter -- | Create an iterator from a mark. -- textBufferGetIterAtMark :: (TextBufferClass self, TextMarkClass mark) => self -> mark -- ^ @mark@ - a 'TextMark' in the buffer -> IO TextIter textBufferGetIterAtMark self mark = do iter <- makeEmptyTextIter {# call unsafe text_buffer_get_iter_at_mark #} (toTextBuffer self) iter (toTextMark mark) return iter -- | Create an iterator at the first position in the text buffer. This is -- the same as using 'textBufferGetIterAtOffset' to get the iter at character -- offset 0. -- textBufferGetStartIter :: TextBufferClass self => self -> IO TextIter textBufferGetStartIter self = do iter <- makeEmptyTextIter {# call unsafe text_buffer_get_start_iter #} (toTextBuffer self) iter return iter -- | Returns the \"end iterator,\" one past the last valid -- character in the text buffer. If dereferenced with -- 'Graphics.UI.Gtk.Multiline.TextIter.textIterGetChar', the -- end iterator has a character value of 0. The entire buffer lies in the range -- from the first position in the buffer (call 'textBufferGetStartIter' to get -- character position 0) to the end iterator. -- textBufferGetEndIter :: TextBufferClass self => self -> IO TextIter textBufferGetEndIter self = do iter <- makeEmptyTextIter {# call unsafe text_buffer_get_end_iter #} (toTextBuffer self) iter return iter -- | Indicates whether the buffer has been modified since the last call to -- 'textBufferSetModified' set the modification flag to @False@. Used for -- example to enable a \"save\" function in a text editor. -- -- It is often more convenient to use 'onModifiedChanged'. -- textBufferGetModified :: TextBufferClass self => self -> IO Bool -- ^ returns @True@ if the buffer has been modified textBufferGetModified self = liftM toBool $ {# call unsafe text_buffer_get_modified #} (toTextBuffer self) -- | Used to keep track of whether the buffer has been modified since the last -- time it was saved. Whenever the buffer is saved to disk, call -- @'textBufferSetModified' buffer False@. When the buffer is -- modified, it will automatically toggled on the modified bit again. When the -- modified bit flips, the buffer emits a 'modifiedChanged' signal. -- textBufferSetModified :: TextBufferClass self => self -> Bool -> IO () textBufferSetModified self setting = {# call text_buffer_set_modified #} (toTextBuffer self) (fromBool setting) -- | Deletes the range between the \"insert\" and \"selection_bound\" marks, -- that is, the currently-selected text. If @interactive@ is @True@, the -- editability of the selection will be considered (users can't delete -- uneditable text). -- textBufferDeleteSelection :: TextBufferClass self => self -> Bool -- ^ @interactive@ - whether the deletion is caused by user -- interaction -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by default -> IO Bool -- ^ returns whether there was a non-empty selection to delete textBufferDeleteSelection self interactive defaultEditable = liftM toBool $ {# call text_buffer_delete_selection #} (toTextBuffer self) (fromBool interactive) (fromBool defaultEditable) -- | Check if a selection exists. -- textBufferHasSelection :: TextBufferClass self => self -> IO Bool textBufferHasSelection self = liftM toBool $ {# call unsafe text_buffer_get_selection_bounds #} (toTextBuffer self) (TextIter nullForeignPtr) (TextIter nullForeignPtr) -- | Returns the bounds of the selection (if the selection has length 0, then -- @start@ and @end@ will be the same). @start@ and @end@ will be in ascending -- order. -- textBufferGetSelectionBounds :: TextBufferClass self => self -> IO (TextIter, TextIter) -- ^ @(start, end)@ returns the selection start and -- end iterators textBufferGetSelectionBounds self = do start <- makeEmptyTextIter end <- makeEmptyTextIter {# call unsafe text_buffer_get_selection_bounds #} (toTextBuffer self) start end return (start, end) -- | Called to indicate that the buffer operations between here and a call to -- 'textBufferEndUserAction' are part of a single user-visible operation. The -- operations between 'textBufferBeginUserAction' and 'textBufferEndUserAction' -- can then be grouped when creating an undo stack. 'TextBuffer' maintains a -- count of calls to 'textBufferBeginUserAction' that have not been closed with -- a call to 'textBufferEndUserAction', and emits the 'beginUserAction' and -- 'endUserAction' signals only for the outermost pair of calls. This -- allows you to build user actions from other user actions. -- -- The \"interactive\" buffer mutation functions, such as -- 'textBufferInsertInteractive', automatically call begin\/end user action -- around the buffer operations they perform, so there's no need to add extra -- calls if you user action consists solely of a single call to one of those -- functions. -- textBufferBeginUserAction :: TextBufferClass self => self -> IO () textBufferBeginUserAction self = {# call text_buffer_begin_user_action #} (toTextBuffer self) -- | Should be paired with a call to 'textBufferBeginUserAction'. See that -- function for a full explanation. -- textBufferEndUserAction :: TextBufferClass self => self -> IO () textBufferEndUserAction self = {# call text_buffer_end_user_action #} (toTextBuffer self) #if GTK_CHECK_VERSION(2,6,0) -- | Performs the appropriate action as if the user hit the delete key with -- the cursor at the position specified by @iter@. In the normal case a single -- character will be deleted, but when combining accents are involved, more -- than one character can be deleted, and when precomposed character and accent -- combinations are involved, less than one character will be deleted. -- -- Because the buffer is modified, all outstanding iterators become invalid -- after calling this function; however, the @iter@ will be re-initialized to -- point to the location where text was deleted. -- -- * Available since Gtk+ version 2.6 -- textBufferBackspace :: TextBufferClass self => self -> TextIter -- ^ @iter@ - a position in @buffer@ -> Bool -- ^ @interactive@ - whether the deletion is caused by user -- interaction -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by -- default -> IO Bool -- ^ returns @True@ if the buffer was modified textBufferBackspace self iter interactive defaultEditable = liftM toBool $ {# call gtk_text_buffer_backspace #} (toTextBuffer self) iter (fromBool interactive) (fromBool defaultEditable) #endif -- | Inserts a child widget anchor into the text buffer at @iter@. The anchor -- will be counted as one character in character counts, and when obtaining the -- buffer contents as a string, will be represented by the Unicode \"object -- replacement character\" @(chr 0xFFFC)@. Note that the \"slice\" variants for -- obtaining portions of the buffer as a string include this character for -- child anchors, but the \"text\" variants do not. e.g. see -- 'textBufferGetSlice' and 'textBufferGetText'. Consider -- 'textBufferCreateChildAnchor' as a more convenient alternative to this -- function. -- textBufferInsertChildAnchor :: TextBufferClass self => self -> TextIter -- ^ @iter@ - location to insert the anchor -> TextChildAnchor -- ^ @anchor@ - a 'TextChildAnchor' -> IO () textBufferInsertChildAnchor self iter anchor = {# call gtk_text_buffer_insert_child_anchor #} (toTextBuffer self) iter anchor -- | This is a convenience function which simply creates a child anchor with -- 'Graphics.UI.Gtk.Multiline.TextView.textBufferChildAnchorNew' and inserts -- it into the buffer with 'textBufferInsertChildAnchor'. -- textBufferCreateChildAnchor :: TextBufferClass self => self -> TextIter -- ^ @iter@ - location in the buffer -> IO TextChildAnchor -- ^ returns the created child anchor textBufferCreateChildAnchor self iter = makeNewGObject mkTextChildAnchor $ {# call gtk_text_buffer_create_child_anchor #} (toTextBuffer self) iter #if GTK_CHECK_VERSION(2,4,0) -- | This function moves the \"insert\" and \"selection_bound\" marks -- simultaneously. If you move them in two steps with 'textBufferMoveMark', you -- will temporarily select a region in between their old and new locations, -- which can be pretty inefficient since the temporarily-selected region will -- force stuff to be recalculated. This function moves them as a unit, which -- can be optimized. -- -- * Available since Gtk+ version 2.4 -- textBufferSelectRange :: TextBufferClass self => self -> TextIter -- ^ @ins@ - where to put the \"insert\" mark -> TextIter -- ^ @bound@ - where to put the \"selection_bound\" mark -> IO () textBufferSelectRange self ins bound = {# call gtk_text_buffer_select_range #} (toTextBuffer self) ins bound #endif -- | Obtains the location of @anchor@ within @buffer@. -- textBufferGetIterAtChildAnchor :: TextBufferClass self => self -> TextIter -- ^ @iter@ - an iterator to be initialized -> TextChildAnchor -- ^ @anchor@ - a child anchor that appears in @buffer@ -> IO () textBufferGetIterAtChildAnchor self iter anchor = {# call gtk_text_buffer_get_iter_at_child_anchor #} (toTextBuffer self) iter anchor -- | Retrieves the first and last iterators in the buffer, i.e. the entire -- buffer lies within the range @[start,end)@. -- textBufferGetBounds :: TextBufferClass self => self -> IO (TextIter, TextIter) -- ^ return the first and last iterators in the buffer textBufferGetBounds self = do start <- makeEmptyTextIter end <- makeEmptyTextIter {#call unsafe text_buffer_get_bounds #} (toTextBuffer self) start end return (start, end) #if GTK_CHECK_VERSION(2,2,0) -- | Pastes the contents of a clipboard at the given @location@. -- (Note: pasting is asynchronous, that is, -- we'll ask for the paste data and return, and at some point later -- after the main loop runs, the paste data will be inserted.) textBufferPasteClipboard :: TextBufferClass self => self -> Clipboard -- ^ @clipboard@ - the GtkClipboard to paste from -> TextIter -- ^ @location@ - location to insert pasted text -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by default -> IO () textBufferPasteClipboard self clipboard overrideLocation defaultEditable = {# call gtk_text_buffer_paste_clipboard #} (toTextBuffer self) clipboard overrideLocation (fromBool defaultEditable) -- | Pastes the contents of a clipboard at the insertion point. -- (Note: pasting is asynchronous, that is, -- we'll ask for the paste data and return, and at some point later -- after the main loop runs, the paste data will be inserted.) textBufferPasteClipboardAtCursor :: TextBufferClass self => self -> Clipboard -- ^ @clipboard@ - the GtkClipboard to paste from -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by default -> IO () textBufferPasteClipboardAtCursor self clipboard defaultEditable = {# call gtk_text_buffer_paste_clipboard #} (toTextBuffer self) clipboard (TextIter nullForeignPtr) (fromBool defaultEditable) -- | Copies the currently-selected text to a clipboard. textBufferCopyClipboard :: TextBufferClass self => self -> Clipboard -- ^ @clipboard@ - the GtkClipboard object to copy to -> IO () textBufferCopyClipboard self clipboard = {# call gtk_text_buffer_copy_clipboard #} (toTextBuffer self) clipboard -- | Copies the currently-selected text to a clipboard, -- then deletes said text if it's editable. textBufferCutClipboard :: TextBufferClass self => self -> Clipboard -- ^ @clipboard@ - the GtkClipboard object to cut to -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by default -> IO () textBufferCutClipboard self clipboard defaultEditable = {# call gtk_text_buffer_cut_clipboard #} (toTextBuffer self) clipboard (fromBool defaultEditable) #endif -- | Adds clipboard to the list of clipboards in which the selection contents of @self@ are available. -- In most cases, @clipboard@ will be the 'Clipboard' of type 'selectionPrimary' for a view of @self@. -- textBufferAddSelectionClipboard :: TextBufferClass self => self -> Clipboard -- ^ @clipboard@ - the 'Clipboard' object to add -> IO () textBufferAddSelectionClipboard self clipboard = {# call text_buffer_add_selection_clipboard #} (toTextBuffer self) clipboard -- | Removes a 'Clipboard' added with 'textBufferAddSelectionClipboard'. -- textBufferRemoveSelectionClipboard :: TextBufferClass self => self -> Clipboard -- ^ @clipboard@ - the 'Clipboard' object to remove -> IO () textBufferRemoveSelectionClipboard self clipboard = {# call text_buffer_remove_selection_clipboard #} (toTextBuffer self) clipboard -------------------- -- Attributes -- | Text Tag Table. -- textBufferTagTable :: (TextBufferClass self, TextTagTableClass textTagTable) => ReadWriteAttr self TextTagTable textTagTable textBufferTagTable = newAttrFromObjectProperty "tag-table" {# call pure unsafe gtk_text_tag_table_get_type #} #if GTK_CHECK_VERSION(2,8,0) -- | The text content of the buffer. Without child widgets and images, see -- 'textBufferGetText' for more information. -- -- Default value: \"\" -- textBufferText :: (TextBufferClass self, GlibString string) => Attr self string textBufferText = newAttrFromStringProperty "text" #endif -- | The \'modified\' property. See 'textBufferGetModified' and -- 'textBufferSetModified' -- textBufferModified :: TextBufferClass self => Attr self Bool textBufferModified = newAttr textBufferGetModified textBufferSetModified -------------------- -- Signals -- | A 'TextTag' was applied to a region of text. -- applyTag :: TextBufferClass self => Signal self (TextTag -> TextIter -> TextIter -> IO ()) applyTag = Signal (connect_OBJECT_BOXED_BOXED__NONE "apply-tag" mkTextIterCopy mkTextIterCopy) -- | A new atomic user action is started. -- -- * Together with 'endUserAction' these signals can be -- used to build an undo stack. -- beginUserAction :: TextBufferClass self => Signal self (IO ()) beginUserAction = Signal (connect_NONE__NONE "begin-user-action") -- | Emitted when the contents of the buffer change. -- bufferChanged :: TextBufferClass self => Signal self (IO ()) bufferChanged = Signal (connect_NONE__NONE "changed") -- | A range of text is about to be deleted. -- deleteRange :: TextBufferClass self => Signal self (TextIter -> TextIter -> IO ()) deleteRange = Signal (connect_BOXED_BOXED__NONE "delete-range" mkTextIterCopy mkTextIterCopy) -- | An atomic action has ended. -- -- * see 'beginUserAction' -- endUserAction :: TextBufferClass self => Signal self (IO ()) endUserAction = Signal (connect_NONE__NONE "end-user-action") -- | A 'Pixbuf' is inserted into the buffer. -- -- * See note in 'bufferInsertText'. -- insertPixbuf :: TextBufferClass self => Signal self (TextIter -> Pixbuf -> IO ()) insertPixbuf = Signal (connect_BOXED_OBJECT__NONE "insert-pixbuf" mkTextIterCopy) -- | The 'insertChildAnchor' signal is emitted to insert a 'TextChildAnchor' in a 'TextBuffer'. -- Insertion actually occurs in the default handler. -- -- * See note in 'bufferInsertText'. -- insertChildAnchor :: TextBufferClass self => Signal self (TextIter -> TextChildAnchor -> IO ()) insertChildAnchor = Signal (connect_BOXED_OBJECT__NONE "insert-child-anchor" mkTextIterCopy) -- | Some text is inserted. Insertion actually occurs in the default handler. -- -- * The function connected to this handler may not modify the buffer since -- this would invalidate the iterator. If this function replaces the -- default handler, it needs to stop the emission of this signal in order -- to prevent the default handler from running. If additional text should -- be inserted, this can be done using the 'after' function to connect. -- bufferInsertText :: (TextBufferClass self, GlibString string) => Signal self (TextIter -> string -> IO ()) bufferInsertText = Signal $ \after obj handler -> connect_BOXED_PTR_INT__NONE "insert-text" mkTextIterCopy after obj (\iter strPtr strLen -> peekUTFStringLen (strPtr, strLen) >>= handler iter) -- | A 'TextMark' within the buffer was deleted. -- markDeleted :: TextBufferClass self => Signal self (TextMark -> IO ()) markDeleted = Signal (connect_OBJECT__NONE "mark-deleted") -- | A 'TextMark' was inserted into the buffer. -- markSet :: TextBufferClass self => Signal self (TextIter -> TextMark -> IO ()) markSet = Signal (connect_BOXED_OBJECT__NONE "mark-set" mkTextIterCopy) modifiedChanged :: TextBufferClass self => Signal self (IO ()) modifiedChanged = Signal (connect_NONE__NONE "modified-changed") -- | The 'pasteDone' signal is emitted after paste operation has been completed. -- This is useful to properly scroll the view to the end of the pasted text. -- See 'textBufferPasteClipboard' for more details. pasteDone :: TextBufferClass self => Signal self (Clipboard -> IO ()) pasteDone = Signal (connect_OBJECT__NONE "paste-done") -- | The textbuffer has changed. -- removeTag :: TextBufferClass self => Signal self (TextTag -> TextIter -> TextIter -> IO ()) removeTag = Signal (connect_OBJECT_BOXED_BOXED__NONE "remove-tag" mkTextIterCopy mkTextIterCopy) -------------------- -- Deprecated Signals and Events #ifndef DISABLE_DEPRECATED -- | A 'TextTag' was applied to a region of text. -- onApplyTag, afterApplyTag :: TextBufferClass self => self -> (TextTag -> TextIter -> TextIter -> IO ()) -> IO (ConnectId self) onApplyTag = connect_OBJECT_BOXED_BOXED__NONE "apply-tag" mkTextIterCopy mkTextIterCopy False afterApplyTag = connect_OBJECT_BOXED_BOXED__NONE "apply-tag" mkTextIterCopy mkTextIterCopy True -- | A new atomic user action is started. -- -- * Together with 'onEndUserAction' these signals can be -- used to build an undo stack. -- onBeginUserAction, afterBeginUserAction :: TextBufferClass self => self -> IO () -> IO (ConnectId self) onBeginUserAction = connect_NONE__NONE "begin-user-action" False afterBeginUserAction = connect_NONE__NONE "begin-user-action" True --- renamed from Changed to BufferChanged, since the former conflicts with TreeSelection -- | Emitted when the contents of the buffer change. -- onBufferChanged, afterBufferChanged :: TextBufferClass self => self -> IO () -> IO (ConnectId self) onBufferChanged = connect_NONE__NONE "changed" False afterBufferChanged = connect_NONE__NONE "changed" True -- | A range of text is about to be deleted. -- onDeleteRange, afterDeleteRange :: TextBufferClass self => self -> (TextIter -> TextIter -> IO ()) -> IO (ConnectId self) onDeleteRange = connect_BOXED_BOXED__NONE "delete-range" mkTextIterCopy mkTextIterCopy False afterDeleteRange = connect_BOXED_BOXED__NONE "delete-range" mkTextIterCopy mkTextIterCopy True -- | An atomic action has ended. -- -- * see 'onBeginUserAction' -- onEndUserAction, afterEndUserAction :: TextBufferClass self => self -> IO () -> IO (ConnectId self) onEndUserAction = connect_NONE__NONE "end-user-action" False afterEndUserAction = connect_NONE__NONE "end-user-action" True -- | A 'Pixbuf' is inserted into the -- buffer. -- onInsertPixbuf, afterInsertPixbuf :: TextBufferClass self => self -> (TextIter -> Pixbuf -> IO ()) -> IO (ConnectId self) onInsertPixbuf = connect_BOXED_OBJECT__NONE "insert-pixbuf" mkTextIterCopy False afterInsertPixbuf = connect_BOXED_OBJECT__NONE "insert-pixbuf" mkTextIterCopy True -- | Some text was inserted. -- onBufferInsertText, afterBufferInsertText :: (TextBufferClass self, GlibString string) => self -> (TextIter -> string -> IO ()) -> IO (ConnectId self) onBufferInsertText self user = connect_BOXED_PTR_INT__NONE "insert-text" mkTextIterCopy False self $ \iter strP strLen -> do str <- peekUTFStringLen (strP,strLen) user iter str afterBufferInsertText self user = connect_BOXED_PTR_INT__NONE "insert-text" mkTextIterCopy True self $ \iter strP strLen -> do str <- peekUTFStringLen (strP,strLen) user iter str -- | A 'TextMark' within the buffer was deleted. -- onMarkDeleted, afterMarkDeleted :: TextBufferClass self => self -> (TextMark -> IO ()) -> IO (ConnectId self) onMarkDeleted = connect_OBJECT__NONE "mark-deleted" False afterMarkDeleted = connect_OBJECT__NONE "mark-deleted" True -- | A 'TextMark' was inserted into the buffer. -- onMarkSet, afterMarkSet :: TextBufferClass self => self -> (TextIter -> TextMark -> IO ()) -> IO (ConnectId self) onMarkSet = connect_BOXED_OBJECT__NONE "mark-set" mkTextIterCopy False afterMarkSet = connect_BOXED_OBJECT__NONE "mark-set" mkTextIterCopy True -- | The textbuffer has changed. -- onModifiedChanged, afterModifiedChanged :: TextBufferClass self => self -> IO () -> IO (ConnectId self) onModifiedChanged = connect_NONE__NONE "modified-changed" False afterModifiedChanged = connect_NONE__NONE "modified-changed" True -- | A 'TextTag' was removed. -- onRemoveTag, afterRemoveTag :: TextBufferClass self => self -> (TextTag -> TextIter -> TextIter -> IO ()) -> IO (ConnectId self) onRemoveTag = connect_OBJECT_BOXED_BOXED__NONE "remove-tag" mkTextIterCopy mkTextIterCopy False afterRemoveTag = connect_OBJECT_BOXED_BOXED__NONE "remove-tag" mkTextIterCopy mkTextIterCopy True #endif gtk-0.15.9/Graphics/UI/Gtk/Multiline/TextIter.chs0000644000000000000000000011516307346545000017606 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) TextIter TextBuffer -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 February 2002 -- -- Copyright (C) 2002-2005 Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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. -- -- The following functions do not make sense due to Haskell's wide character -- representation of Unicode: -- gtk_text_iter_get_line_index -- gtk_text_iter_get_visible_line_index -- gtk_text_iter_get_bytes_in_line -- gtk_text_iter_set_line_index -- gtk_text_iter_set_visible_line_index -- -- All offsets are counted from 0. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- An iterator is an abstract datatype representing a pointer into a -- 'TextBuffer'. -- module Graphics.UI.Gtk.Multiline.TextIter ( -- * Types TextIter, TextSearchFlags(..), -- * Methods textIterCopy, textIterGetBuffer, textIterGetOffset, textIterGetLine, textIterGetLineOffset, textIterGetVisibleLineOffset, textIterGetChar, textIterGetSlice, textIterGetText, textIterGetVisibleSlice, textIterGetVisibleText, textIterGetPixbuf, textIterGetChildAnchor, textIterGetMarks, textIterGetToggledTags, textIterBeginsTag, textIterEndsTag, textIterTogglesTag, textIterHasTag, textIterGetTags, textIterEditable, textIterCanInsert, textIterStartsWord, textIterEndsWord, textIterInsideWord, textIterStartsLine, textIterEndsLine, textIterStartsSentence, textIterEndsSentence, textIterInsideSentence, textIterIsCursorPosition, textIterGetCharsInLine, textIterGetAttributes, textIterGetLanguage, textIterIsEnd, textIterIsStart, textIterForwardChar, textIterBackwardChar, textIterForwardChars, textIterBackwardChars, textIterForwardLine, textIterBackwardLine, textIterForwardLines, textIterBackwardLines, textIterForwardWordEnds, textIterBackwardWordStarts, textIterForwardWordEnd, textIterBackwardWordStart, textIterForwardCursorPosition, textIterBackwardCursorPosition, textIterForwardCursorPositions, textIterBackwardCursorPositions, textIterForwardSentenceEnds, textIterBackwardSentenceStarts, textIterForwardSentenceEnd, textIterBackwardSentenceStart, textIterSetOffset, textIterSetLine, textIterSetLineOffset, textIterSetVisibleLineOffset, textIterForwardToEnd, textIterForwardToLineEnd, textIterForwardToTagToggle, textIterBackwardToTagToggle, textIterForwardFindChar, textIterBackwardFindChar, textIterForwardSearch, textIterBackwardSearch, textIterEqual, textIterCompare, textIterInRange, textIterOrder, #if GTK_CHECK_VERSION(2,8,0) textIterForwardVisibleLine, textIterBackwardVisibleLine, textIterForwardVisibleLines, textIterBackwardVisibleLines, #endif textIterForwardVisibleWordEnds, textIterBackwardVisibleWordStarts, textIterForwardVisibleWordEnd, textIterBackwardVisibleWordStart, textIterForwardVisibleCursorPosition, textIterBackwardVisibleCursorPosition, textIterForwardVisibleCursorPositions, textIterBackwardVisibleCursorPositions, -- * Attributes textIterVisibleLineOffset, textIterOffset, textIterLineOffset, textIterLine, ) where import Control.Monad (liftM) import Data.Maybe (fromMaybe) import Data.Char (chr) import System.Glib.FFI import System.Glib.Flags (fromFlags) import System.Glib.UTFString import System.Glib.Attributes import System.Glib.GList {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (TextSearchFlags(..)) {#import Graphics.UI.Gtk.Multiline.Types#} {#import Graphics.UI.Gtk.Multiline.TextTag#} {#import Graphics.Rendering.Pango.BasicTypes#} {# context lib="gtk" prefix="gtk" #} -- methods -- | Return the 'TextBuffer' this iterator -- is associated with. -- textIterGetBuffer :: TextIter -> IO TextBuffer textIterGetBuffer ti = makeNewGObject mkTextBuffer $ {#call unsafe text_iter_get_buffer#} ti -- | Returns the character offset of an iterator. Each character in a -- 'TextBuffer' has an offset, starting with 0 for the first character in the -- buffer. Use 'Graphics.UI.Gtk.Multiline.TextBuffer.textBufferGetIterAtOffset' -- to convert an offset back into an iterator. -- textIterGetOffset :: TextIter -> IO Int textIterGetOffset ti = liftM fromIntegral $ {#call unsafe text_iter_get_offset#} ti -- | Returns the line number containing the iterator. Lines in a 'TextBuffer' -- are numbered beginning with 0 for the first line in the buffer. -- textIterGetLine :: TextIter -> IO Int textIterGetLine ti = liftM fromIntegral $ {#call unsafe text_iter_get_line#} ti -- | Returns the character offset of the iterator, counting from the start of -- a newline-terminated line. The first character on the line has offset 0. -- textIterGetLineOffset :: TextIter -> IO Int textIterGetLineOffset ti = liftM fromIntegral $ {#call unsafe text_iter_get_line_offset#} ti -- | Returns the offset in characters from the start of the line to the given -- @iter@, not counting characters that are invisible due to tags with the -- \"invisible\" flag toggled on. -- textIterGetVisibleLineOffset :: TextIter -> IO Int textIterGetVisibleLineOffset ti = liftM fromIntegral $ {#call unsafe text_iter_get_visible_line_offset#} ti -- | Returns the Unicode character at this iterator. -- If the element at this iterator is a non-character -- element, such as an image embedded in the buffer, the Unicode \"unknown\" -- character 0xFFFC is returned. If invoked on the end iterator, -- @Nothing@ is returned. -- textIterGetChar :: TextIter -> IO (Maybe Char) textIterGetChar ti = do res <- liftM fromIntegral $ {#call unsafe text_iter_get_char#} ti return $ if res==0 then Nothing else Just (chr res) -- | Returns the text in the given range. A \"slice\" is a list of -- characters, including the Unicode \"unknown\" -- character 0xFFFC for iterable non-character elements in the buffer, such as -- images. Because images are encoded in the slice, offsets -- in the returned array will correspond to offsets in the text buffer. -- Note that 0xFFFC can occur in normal text as well, so it is not a reliable -- indicator that a pixbuf or widget is in the buffer. -- textIterGetSlice :: GlibString string => TextIter -> TextIter -> IO string textIterGetSlice end start = do cStr <- {#call text_iter_get_slice#} start end str <- peekUTFString cStr {#call unsafe g_free#} (castPtr cStr) return str -- | Return the text in a given range. -- -- * Pictures (and other objects) are stripped form the output. Thus, this -- function does not preserve offsets. -- textIterGetText :: GlibString string => TextIter -> TextIter -> IO string textIterGetText start end = do cStr <- {#call text_iter_get_text#} start end str <- peekUTFString cStr {#call unsafe g_free#} (castPtr cStr) return str -- | Like 'textIterGetSlice', but invisible text is not included. Invisible -- text is usually invisible because a 'TextTag' with the \"invisible\" -- attribute turned on has been applied to it. -- textIterGetVisibleSlice :: GlibString string => TextIter -> TextIter -> IO string textIterGetVisibleSlice start end = do cStr <- {#call text_iter_get_visible_slice#} start end str <- peekUTFString cStr {#call unsafe g_free#} (castPtr cStr) return str -- | Like 'textIterGetText', but invisible text is not included. Invisible -- text is usually invisible because a 'TextTag' with the \"invisible\" -- attribute turned on has been applied to it. -- textIterGetVisibleText :: GlibString string => TextIter -> TextIter -> IO string textIterGetVisibleText start end = do cStr <- {#call text_iter_get_visible_text#} start end str <- peekUTFString cStr {#call unsafe g_free#} (castPtr cStr) return str -- | Get the 'Pixbuf' under the iterator. -- textIterGetPixbuf :: TextIter -> IO (Maybe Pixbuf) textIterGetPixbuf it = do pbPtr <- {#call unsafe text_iter_get_pixbuf#} it if pbPtr==nullPtr then return Nothing else liftM Just $ makeNewGObject mkPixbuf (return pbPtr) -- | If the location at @iter@ contains a child anchor, -- the anchor is returned (with no new reference count added). -- Otherwise, @Nothing@ is returned. -- textIterGetChildAnchor :: TextIter -> IO (Maybe TextChildAnchor) textIterGetChildAnchor it = do tcaPtr <- {#call unsafe text_iter_get_child_anchor#} it if tcaPtr == nullPtr then return Nothing else liftM Just $ makeNewGObject mkTextChildAnchor (return tcaPtr) -- | Returns a list of all 'TextMark' at this location. Because marks are not -- iterable (they don't take up any \"space\" in the buffer, they are just -- marks in between iterable locations), multiple marks can exist in the same -- place. The returned list is not in any meaningful order. -- textIterGetMarks :: TextIter -> IO [TextMark] -- ^ returns list of 'TextMark' textIterGetMarks self = {# call gtk_text_iter_get_marks #} self >>= fromGSList >>= mapM (\tm -> makeNewGObject mkTextMark (return tm)) -- | Returns a list of 'TextTag' that are toggled on or off at this point. (If -- @toggledOn@ is @True@, the list contains tags that are toggled on.) If a tag -- is toggled on at @iter@, then some non-empty range of characters following -- @iter@ has that tag applied to it. If a tag is toggled off, then some -- non-empty range following @iter@ does /not/ have the tag applied to it. -- textIterGetToggledTags :: TextIter -> Bool -- ^ @toggledOn@ - @True@ to get toggled-on tags -> IO [TextTag] -- ^ returns tags toggled at this point textIterGetToggledTags self toggledOn = {# call gtk_text_iter_get_toggled_tags #} self (fromBool toggledOn) >>= fromGSList >>= mapM (\tt -> makeNewGObject mkTextTag (return tt)) -- | Returns @True@ if @tag@ is toggled on at exactly this point. If @tag@ is -- @Nothing@, -- returns @True@ if any tag is toggled on at this point. Note that the -- 'textIterBeginsTag' returns @True@ if @iter@ is the /start/ of the tagged -- range; 'textIterHasTag' tells you whether an iterator is /within/ a tagged -- range. -- textIterBeginsTag :: TextIter -> Maybe TextTag -> IO Bool textIterBeginsTag ti (Just tt) = liftM toBool $ {#call unsafe text_iter_begins_tag#} ti tt textIterBeginsTag ti Nothing = liftM toBool $ {#call unsafe text_iter_begins_tag#} ti (TextTag nullForeignPtr) -- | Returns @True@ if @tag@ is toggled off at exactly this point. If @tag@ is -- @Notihng@, -- returns @True@ if any tag is toggled off at this point. Note that the -- 'textIterEndsTag' returns @True@ if @iter@ is the /end/ of the tagged range; -- 'textIterHasTag' tells you whether an iterator is /within/ a tagged range. -- textIterEndsTag :: TextIter -> Maybe TextTag -> IO Bool textIterEndsTag ti (Just tt) = liftM toBool $ {#call unsafe text_iter_ends_tag#} ti tt textIterEndsTag ti Nothing = liftM toBool $ {#call unsafe text_iter_ends_tag#} ti (TextTag nullForeignPtr) -- | Query if the 'TextIter' is at the -- beginning or the end of a 'TextTag'. This is equivalent to -- ('textIterBeginsTag' || 'textIterEndsTag'), i.e. it -- tells you whether a range with @tag@ applied to it begins /or/ ends at -- @iter@. -- textIterTogglesTag :: TextIter -> Maybe TextTag -> IO Bool textIterTogglesTag ti (Just tt) = liftM toBool $ {#call unsafe text_iter_toggles_tag#} ti tt textIterTogglesTag ti Nothing = liftM toBool $ {#call unsafe text_iter_toggles_tag#} ti (TextTag nullForeignPtr) -- | Check if 'TextIter' is within a range -- tagged with tag. -- textIterHasTag :: TextIter -> Maybe TextTag -> IO Bool textIterHasTag ti (Just tt) = liftM toBool $ {#call unsafe text_iter_has_tag#} ti tt textIterHasTag ti Nothing = liftM toBool $ {#call unsafe text_iter_has_tag#} ti (TextTag nullForeignPtr) -- | Returns a list of tags that apply to @iter@, in ascending order of -- priority (highest-priority tags are last). -- textIterGetTags :: TextIter -> IO [TextTag] -- ^ returns list of 'TextTag' textIterGetTags self = {# call gtk_text_iter_get_tags #} self >>= fromGSList >>= mapM (\tt -> makeNewGObject mkTextTag (return tt)) -- | Returns whether the character at @iter@ is within an editable region of -- text. Non-editable text is \"locked\" and can't be changed by the user via -- 'TextView'. This function is simply a convenience wrapper around -- 'textIterGetAttributes'. If no tags applied to this text affect editability, -- @defaultSetting@ will be returned. -- -- You don't want to use this function to decide whether text can be -- inserted at @iter@, because for insertion you don't want to know whether the -- char at @iter@ is inside an editable range, you want to know whether a new -- character inserted at @iter@ would be inside an editable range. Use -- 'textIterCanInsert' to handle this case. -- textIterEditable :: TextIter -> Bool -> IO Bool textIterEditable ti def = liftM toBool $ {#call unsafe text_iter_editable#} ti (fromBool def) -- | Check if new text can be inserted at 'TextIter'. -- -- * Considering the default editability of the buffer, and tags that affect -- editability, determines whether text inserted at @iter@ would be editable. -- If text inserted at @iter@ would be editable then the user should be allowed -- to insert text at @iter@. -- 'Graphics.UI.Gtk.Multiline.TextBuffer.textBufferInsertInteractive' -- uses this function -- to decide whether insertions are allowed at a given position. -- -- * Use 'Graphics.UI.Gtk.Multiline.TextBuffer.textBufferInsertInteractive' -- if you want to insert text depending on the current editable status. -- textIterCanInsert :: TextIter -> Bool -> IO Bool textIterCanInsert ti def = liftM toBool $ {#call unsafe text_iter_can_insert#} ti (fromBool def) -- | Determine if 'TextIter' begins a new -- natural-language word. -- textIterStartsWord :: TextIter -> IO Bool textIterStartsWord ti = liftM toBool $ {#call unsafe text_iter_starts_word#} ti -- | Determine if 'TextIter' ends a new -- natural-language word. -- textIterEndsWord :: TextIter -> IO Bool textIterEndsWord ti = liftM toBool $ {#call unsafe text_iter_ends_word#} ti -- | Determine if 'TextIter' is inside a -- word. -- textIterInsideWord :: TextIter -> IO Bool textIterInsideWord ti = liftM toBool $ {#call unsafe text_iter_inside_word#} ti -- | Determine if 'TextIter' begins a new -- line. -- textIterStartsLine :: TextIter -> IO Bool textIterStartsLine ti = liftM toBool $ {#call unsafe text_iter_starts_line#} ti -- | Returns @True@ if @iter@ points to the start of the paragraph delimiter -- characters for a line (delimiters will be either a newline, a carriage -- return, a carriage return followed by a newline, or a Unicode paragraph -- separator character). Note that an iterator pointing to the \n of a \r\n -- pair will not be counted as the end of a line, the line ends before the \r. -- The end iterator is considered to be at the end of a line, even though there -- are no paragraph delimiter chars there. -- textIterEndsLine :: TextIter -> IO Bool textIterEndsLine ti = liftM toBool $ {#call unsafe text_iter_ends_line#} ti -- | Determine if 'TextIter' starts a -- sentence. -- textIterStartsSentence :: TextIter -> IO Bool textIterStartsSentence ti = liftM toBool $ {#call unsafe text_iter_starts_sentence#} ti -- | Determine if 'TextIter' ends a -- sentence. -- textIterEndsSentence :: TextIter -> IO Bool textIterEndsSentence ti = liftM toBool $ {#call unsafe text_iter_ends_sentence#} ti -- | Determine if 'TextIter' is inside -- a sentence. -- textIterInsideSentence :: TextIter -> IO Bool textIterInsideSentence ti = liftM toBool $ {#call unsafe text_iter_inside_sentence#} ti -- | Determine if 'TextIter' is at a -- cursor position. -- textIterIsCursorPosition :: TextIter -> IO Bool textIterIsCursorPosition ti = liftM toBool $ {#call unsafe text_iter_is_cursor_position#} ti -- | Return number of characters in this line. -- -- * The return value includes delimiters. -- textIterGetCharsInLine :: TextIter -> IO Int textIterGetCharsInLine ti = liftM fromIntegral $ {#call unsafe text_iter_get_chars_in_line#} ti -- | Computes the effect of any tags applied to this spot in the text. -- The values parameter should be initialized to the default settings you wish to use if no tags are in effect. -- You'd typically obtain the defaults from 'textViewGetDefaultAttributes'. -- 'textIterGetAttributes' will modify values, applying the effects of any tags present at iter. -- If any tags affected values, the function returns @True@. -- textIterGetAttributes :: TextIter -> TextAttributes -> IO Bool textIterGetAttributes ti ta = liftM toBool $ {#call unsafe text_iter_get_attributes#} ti ta -- | A convenience wrapper around 'textIterGetAttributes', which returns the language in effect at iter. -- If no tags affecting language apply to iter, the return value is identical to that of 'getDefaultLanguage'. -- textIterGetLanguage :: TextIter -> IO Language textIterGetLanguage ti = liftM Language $ {#call unsafe text_iter_get_language#} ti -- | Determine if 'TextIter' is at the end of -- the buffer. -- textIterIsEnd :: TextIter -> IO Bool textIterIsEnd ti = liftM toBool $ {#call unsafe text_iter_is_end#} ti -- | Determine if 'TextIter' is at the -- beginning of the buffer. -- textIterIsStart :: TextIter -> IO Bool textIterIsStart ti = liftM toBool $ {#call unsafe text_iter_is_start#} ti -- | Move 'TextIter' forwards. -- -- * Returns True if the iterator is pointing to a character. -- textIterForwardChar :: TextIter -> IO Bool textIterForwardChar ti = liftM toBool $ {#call unsafe text_iter_forward_char#} ti -- | Move 'TextIter' backwards. -- -- * Returns True if the movement was possible. -- textIterBackwardChar :: TextIter -> IO Bool textIterBackwardChar ti = liftM toBool $ {#call unsafe text_iter_backward_char#} ti -- | Move 'TextIter' forwards by -- @n@ characters. -- -- * Returns @True@ if the iterator is pointing to a new character (and @False@ if -- the iterator points to a picture or has not moved). -- -- * Note that images embedded -- in the buffer occupy 1 character slot, so 'textIterForwardChar' may actually -- move onto an image instead of a character. -- textIterForwardChars :: TextIter -> Int -> IO Bool textIterForwardChars ti n = liftM toBool $ {#call unsafe text_iter_forward_chars#} ti (fromIntegral n) -- | Move 'TextIter' backwards by -- @n@ characters. -- -- * Returns @True@ if the iterator is pointing to a new character (and @False@ if -- the iterator points to a picture or has not moved). -- textIterBackwardChars :: TextIter -> Int -> IO Bool textIterBackwardChars ti n = liftM toBool $ {#call unsafe text_iter_backward_chars#} ti (fromIntegral n) -- | Move 'TextIter' forwards. -- -- * Returns True if the iterator is pointing to a new line (and False if the -- iterator points to a picture or has not moved). -- -- * If 'TextIter' is on the first line, it will be moved to the -- beginning of the buffer. -- textIterForwardLine :: TextIter -> IO Bool textIterForwardLine ti = liftM toBool $ {#call unsafe text_iter_forward_line#} ti -- | Move 'TextIter' backwards. -- -- * Returns True if the iterator is pointing to a new line (and False if the -- iterator points to a picture or has not moved). -- -- * If 'TextIter' is on the first line, it will be moved to the end -- of the buffer. -- textIterBackwardLine :: TextIter -> IO Bool textIterBackwardLine ti = liftM toBool $ {#call unsafe text_iter_backward_line#} ti -- | Move 'TextIter' forwards by -- @n@ lines. -- -- * Returns True if the iterator is pointing to a new line (and False if the -- iterator points to a picture or has not moved). -- -- * If 'TextIter' is on the first line, it will be moved to the -- beginning of the buffer. -- -- * @n@ can be negative. -- textIterForwardLines :: TextIter -> Int -> IO Bool textIterForwardLines ti n = liftM toBool $ {#call unsafe text_iter_forward_lines#} ti (fromIntegral n) -- | Move 'TextIter' backwards by -- @n@ lines. -- -- * Returns True if the iterator is pointing to a new line (and False if the -- iterator points to a picture or has not moved). -- -- * If 'TextIter' is on the first line, it will be moved to the end -- of the buffer. -- -- * @n@ can be negative. -- textIterBackwardLines :: TextIter -> Int -> IO Bool textIterBackwardLines ti n = liftM toBool $ {#call unsafe text_iter_backward_lines#} ti (fromIntegral n) -- | Move 'TextIter' forwards by -- @n@ word ends. -- -- * Returns True if the iterator is pointing to a new word end. -- textIterForwardWordEnds :: TextIter -> Int -> IO Bool textIterForwardWordEnds ti n = liftM toBool $ {#call unsafe text_iter_forward_word_ends#} ti (fromIntegral n) -- | Move 'TextIter' backwards by -- @n@ word beginnings. -- -- * Returns True if the iterator is pointing to a new word start. -- textIterBackwardWordStarts :: TextIter -> Int -> IO Bool textIterBackwardWordStarts ti n = liftM toBool $ {#call unsafe text_iter_backward_word_starts#} ti (fromIntegral n) -- | Move 'TextIter' forwards to the -- next word end. -- -- * Returns True if the iterator has moved to a new word end. -- textIterForwardWordEnd :: TextIter -> IO Bool textIterForwardWordEnd ti = liftM toBool $ {#call unsafe text_iter_forward_word_end#} ti -- | Move 'TextIter' backwards to -- the next word beginning. -- -- * Returns True if the iterator has moved to a new word beginning. -- textIterBackwardWordStart :: TextIter -> IO Bool textIterBackwardWordStart ti = liftM toBool $ {#call unsafe text_iter_backward_word_start#} ti -- | Move 'TextIter' forwards to -- the next cursor position. -- -- * Some characters are composed of two Unicode codes. This function ensures -- that 'TextIter' does not point in between such double characters. -- -- * Returns True if 'TextIter' moved and points to a character (not -- to an object). -- textIterForwardCursorPosition :: TextIter -> IO Bool textIterForwardCursorPosition ti = liftM toBool $ {#call unsafe text_iter_forward_cursor_position#} ti -- | Move 'TextIter' backwards -- to the next cursor position. -- -- * Some characters are composed of two Unicode codes. This function ensures -- that 'TextIter' does not point in between such double characters. -- -- * Returns True if 'TextIter' moved and points to a character (not -- to an object). -- textIterBackwardCursorPosition :: TextIter -> IO Bool textIterBackwardCursorPosition ti = liftM toBool $ {#call unsafe text_iter_backward_cursor_position#} ti -- | Move 'TextIter' forwards -- by @n@ cursor positions. -- -- * Returns True if 'TextIter' moved and points to a character (not -- to an object). -- textIterForwardCursorPositions :: TextIter -> Int -> IO Bool textIterForwardCursorPositions ti n = liftM toBool $ {#call unsafe text_iter_forward_cursor_positions#} ti (fromIntegral n) -- | Move 'TextIter' backwards -- by @n@ cursor positions. -- -- * Returns True if 'TextIter' moved and points to a character (not -- to an object). -- textIterBackwardCursorPositions :: TextIter -> Int -> IO Bool textIterBackwardCursorPositions ti n = liftM toBool $ {#call unsafe text_iter_backward_cursor_positions#} ti (fromIntegral n) -- | Move 'TextIter' forwards by -- @n@ sentence ends. -- -- * Returns True if the iterator is pointing to a new sentence end. -- textIterForwardSentenceEnds :: TextIter -> Int -> IO Bool textIterForwardSentenceEnds ti n = liftM toBool $ {#call unsafe text_iter_forward_sentence_ends#} ti (fromIntegral n) -- | Move 'TextIter' backwards -- by @n@ sentence beginnings. -- -- * Returns True if the iterator is pointing to a new sentence start. -- textIterBackwardSentenceStarts :: TextIter -> Int -> IO Bool textIterBackwardSentenceStarts ti n = liftM toBool $ {#call unsafe text_iter_backward_sentence_starts#} ti (fromIntegral n) -- | Move 'TextIter' forwards to -- the next sentence end. -- -- * Returns True if the iterator has moved to a new sentence end. -- textIterForwardSentenceEnd :: TextIter -> IO Bool textIterForwardSentenceEnd ti = liftM toBool $ {#call unsafe text_iter_forward_sentence_end#} ti -- | Move 'TextIter' backwards -- to the next sentence beginning. -- -- * Returns True if the iterator has moved to a new sentence beginning. -- textIterBackwardSentenceStart :: TextIter -> IO Bool textIterBackwardSentenceStart ti = liftM toBool $ {#call unsafe text_iter_backward_sentence_start#} ti -- | Set 'TextIter' to an offset within the -- buffer. -- textIterSetOffset :: TextIter -> Int -> IO () textIterSetOffset ti n = {#call unsafe text_iter_set_offset#} ti (fromIntegral n) -- | Set 'TextIter' to a line within the -- buffer. -- -- * If number is negative or larger than the number of lines in the buffer, -- moves @iter@ to the start of the last line in the buffer. -- textIterSetLine :: TextIter -> Int -> IO () textIterSetLine ti n = {#call unsafe text_iter_set_line#} ti (fromIntegral n) -- | Set 'TextIter' to an offset within the line. -- -- * The -- given character offset must be less than or equal to the number of -- characters in the line; if equal, the iterator moves to the start of the -- next line. -- textIterSetLineOffset :: TextIter -> Int -> IO () textIterSetLineOffset ti n = {#call unsafe text_iter_set_line_offset#} ti (fromIntegral n) -- | Like 'textIterSetLineOffset', but the offset is in visible characters, -- i.e. text with a tag making it invisible is not counted in the offset. -- textIterSetVisibleLineOffset :: TextIter -> Int -> IO () textIterSetVisibleLineOffset ti n = {#call unsafe text_iter_set_visible_line_offset#} ti (fromIntegral n) -- | Moves @iter@ forward to the \"end iterator,\" which points one past the -- last valid character in the buffer. -- textIterForwardToEnd :: TextIter -> IO () textIterForwardToEnd ti = {#call unsafe text_iter_forward_to_end#} ti -- | Moves the iterator to point to the paragraph delimiter characters, which -- will be either a newline, a carriage return, a carriage return\/newline in -- sequence, or the Unicode paragraph separator character. If the iterator is -- already at the paragraph delimiter characters, moves to the paragraph -- delimiter characters for the next line. If @iter@ is on the last line in the -- buffer, which does not end in paragraph delimiters, moves to the end -- iterator (end of the last line), and returns @False@. -- textIterForwardToLineEnd :: TextIter -> IO Bool textIterForwardToLineEnd ti = liftM toBool $ {#call unsafe text_iter_forward_to_line_end#} ti -- | Moves 'TextIter' forward to -- the next change of a 'TextTag'. -- -- * If Nothing is supplied, any 'TextTag' will be matched. -- -- * Returns @True@ if there was a tag toggle after 'TextIter'. -- textIterForwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool textIterForwardToTagToggle ti tt = liftM toBool $ {#call unsafe text_iter_forward_to_tag_toggle#} ti (fromMaybe (TextTag nullForeignPtr) tt) -- | Moves 'TextIter' backward to -- the next change of a 'TextTag'. -- -- * If @Nothing@ is supplied, any 'TextTag' will be matched. -- -- * Returns @True@ if there was a tag toggle before 'TextIter'. -- textIterBackwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool textIterBackwardToTagToggle ti tt = liftM toBool $ {#call unsafe text_iter_backward_to_tag_toggle#} ti (fromMaybe (TextTag nullForeignPtr) tt) {#pointer TextCharPredicate#} foreign import ccall "wrapper" mkTextCharPredicate :: ({#type gunichar#} -> Ptr () -> IO {#type gboolean#}) -> IO TextCharPredicate -- | Move 'TextIter' forward until a -- predicate function returns True. -- -- * If @pred@ returns True before @limit@ is reached, the -- search is stopped and the return value is True. -- -- * If @limit@ is Nothing, the search stops at the end of the buffer. -- textIterForwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter -> IO Bool textIterForwardFindChar ti pred limit = do fPtr <- mkTextCharPredicate (\c _ -> return $ fromBool $ pred (chr (fromIntegral c))) res <- liftM toBool $ {#call text_iter_forward_find_char#} ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit) freeHaskellFunPtr fPtr return res -- | Move 'TextIter' backward until a -- predicate function returns True. -- -- * If @pred@ returns True before @limit@ is reached, the -- search is stopped and the return value is True. -- -- * If @limit@ is Nothing, the search stops at the end of the buffer. -- textIterBackwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter -> IO Bool textIterBackwardFindChar ti pred limit = do fPtr <- mkTextCharPredicate (\c _ -> return $ fromBool $ pred (chr (fromIntegral c))) res <- liftM toBool $ {#call text_iter_backward_find_char#} ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit) freeHaskellFunPtr fPtr return res -- | Search forward for a specific string. -- -- * If specified, the last character which is tested against that start of -- the search pattern will be @limit@. -- -- * 'TextSearchFlags' may be empty. -- -- * Returns the start and end position of the string found. -- textIterForwardSearch :: GlibString string => TextIter -> string -> [TextSearchFlags] -> Maybe TextIter -> IO (Maybe (TextIter, TextIter)) textIterForwardSearch ti str flags limit = do start <- makeEmptyTextIter end <- makeEmptyTextIter found <- liftM toBool $ withUTFString str $ \cStr -> {#call unsafe text_iter_forward_search#} ti cStr ((fromIntegral.fromFlags) flags) start end (fromMaybe (TextIter nullForeignPtr) limit) return $ if found then Just (start,end) else Nothing -- | Search backward for a specific string. -- -- * If specified, the last character which is tested against that start of -- the search pattern will be @limit@. -- -- * 'TextSearchFlags' my be empty. -- -- * Returns the start and end position of the string found. -- textIterBackwardSearch :: GlibString string => TextIter -> string -> [TextSearchFlags] -> Maybe TextIter -> IO (Maybe (TextIter, TextIter)) textIterBackwardSearch ti str flags limit = do start <- makeEmptyTextIter end <- makeEmptyTextIter found <- liftM toBool $ withUTFString str $ \cStr -> {#call unsafe text_iter_backward_search#} ti cStr ((fromIntegral.fromFlags) flags) start end (fromMaybe (TextIter nullForeignPtr) limit) return $ if found then Just (start,end) else Nothing #if GTK_CHECK_VERSION(2,8,0) -- | Moves @iter@ to the start of the next visible line. Returns @True@ if -- there was a next line to move to, and @False@ if @iter@ was simply moved to -- the end of the buffer and is now not dereferenceable, or if @iter@ was -- already at the end of the buffer. -- -- * Available since Gtk+ version 2.8 -- textIterForwardVisibleLine :: TextIter -> IO Bool -- ^ returns whether @iter@ can be dereferenced textIterForwardVisibleLine self = liftM toBool $ {# call gtk_text_iter_forward_visible_line #} self -- | Moves @iter@ to the start of the previous visible line. Returns @True@ if -- @iter@ could be moved; i.e. if @iter@ was at character offset 0, this -- function returns @False@. Therefore if @iter@ was already on line 0, but not -- at the start of the line, @iter@ is snapped to the start of the line and the -- function returns @True@. (Note that this implies that in a loop calling this -- function, the line number may not change on every iteration, if your first -- iteration is on line 0.) -- -- * Available since Gtk+ version 2.8 -- textIterBackwardVisibleLine :: TextIter -> IO Bool -- ^ returns whether @iter@ moved textIterBackwardVisibleLine self = liftM toBool $ {# call gtk_text_iter_backward_visible_line #} self -- | Moves @count@ visible lines forward, if possible (if @count@ would move -- past the start or end of the buffer, moves to the start or end of the -- buffer). The return value indicates whether the iterator moved onto a -- dereferenceable position; if the iterator didn't move, or moved onto the end -- iterator, then @False@ is returned. If @count@ is 0, the function does -- nothing and returns @False@. If @count@ is negative, moves backward by 0 - -- @count@ lines. -- -- * Available since Gtk+ version 2.8 -- textIterForwardVisibleLines :: TextIter -> Int -- ^ @count@ - number of lines to move forward -> IO Bool -- ^ returns whether @iter@ moved and is dereferenceable textIterForwardVisibleLines self count = liftM toBool $ {# call gtk_text_iter_forward_visible_lines #} self (fromIntegral count) -- | Moves @count@ visible lines backward, if possible (if @count@ would move -- past the start or end of the buffer, moves to the start or end of the -- buffer). The return value indicates whether the iterator moved onto a -- dereferenceable position; if the iterator didn't move, or moved onto the end -- iterator, then @False@ is returned. If @count@ is 0, the function does -- nothing and returns @False@. If @count@ is negative, moves forward by 0 - -- @count@ lines. -- -- * Available since Gtk+ version 2.8 -- textIterBackwardVisibleLines :: TextIter -> Int -- ^ @count@ - number of lines to move backward -> IO Bool -- ^ returns whether @iter@ moved and is dereferenceable textIterBackwardVisibleLines self count = liftM toBool $ {# call gtk_text_iter_backward_visible_lines #} self (fromIntegral count) #endif -- | Calls 'textIterForwardVisibleWordEnd' up to count times. -- textIterForwardVisibleWordEnds :: TextIter -> Int -- ^ @counter@ - number of times to move -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterForwardVisibleWordEnds self count = liftM toBool $ {# call text_iter_forward_visible_word_ends #} self (fromIntegral count) -- | Calls 'textIterBackwardVisibleWordStart' up to count times. -- textIterBackwardVisibleWordStarts :: TextIter -> Int -- ^ @counter@ - number of times to move -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterBackwardVisibleWordStarts self count = liftM toBool $ {# call text_iter_backward_visible_word_starts #} self (fromIntegral count) -- | Moves forward to the next visible word end. -- (If iter is currently on a word end, moves forward to the next one after that.) -- Word breaks are determined by Pango and should be correct for nearly any language -- (if not, the correct fix would be to the Pango word break algorithms). -- textIterForwardVisibleWordEnd :: TextIter -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterForwardVisibleWordEnd self = liftM toBool $ {# call text_iter_forward_visible_word_end #} self -- | Moves backward to the previous visible word start. -- (If iter is currently on a word start, moves backward to the next one after that.) -- Word breaks are determined by Pango and should be correct for nearly any language -- (if not, the correct fix would be to the Pango word break algorithms). -- textIterBackwardVisibleWordStart :: TextIter -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterBackwardVisibleWordStart self = liftM toBool $ {# call text_iter_backward_visible_word_start #} self -- | Moves iter forward to the next visible cursor position. -- See 'textIterForwardCursorPosition' for details. -- textIterForwardVisibleCursorPosition :: TextIter -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterForwardVisibleCursorPosition self = liftM toBool $ {# call text_iter_forward_visible_cursor_position #} self -- | Moves iter forward to the previous visible cursor position. -- See 'textIterBackwardCursorPosition' for details. -- textIterBackwardVisibleCursorPosition :: TextIter -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterBackwardVisibleCursorPosition self = liftM toBool $ {# call text_iter_backward_visible_cursor_position #} self -- | Moves up to count visible cursor positions. -- See 'textIterForwardCursorPosition' for details. textIterForwardVisibleCursorPositions :: TextIter -> Int -- ^ @counter@ - number of times to move -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterForwardVisibleCursorPositions self count = liftM toBool $ {# call text_iter_forward_visible_cursor_positions #} self (fromIntegral count) -- | Moves up to count visible cursor positions. -- See 'textIterBackwardCursorPosition' for details. -- textIterBackwardVisibleCursorPositions :: TextIter -> Int -- ^ @counter@ - number of times to move -> IO Bool -- ^ return @True@ if iter moved and is not the end iterator textIterBackwardVisibleCursorPositions self count = liftM toBool $ {# call text_iter_backward_visible_cursor_positions #} self (fromIntegral count) -- | Compare two 'TextIter' for equality. -- textIterEqual :: TextIter -> TextIter -> IO Bool textIterEqual ti2 ti1 = liftM toBool $ {#call unsafe text_iter_equal#} ti1 ti2 -- | Compare two 'TextIter'. -- textIterCompare :: TextIter -> TextIter -> IO Ordering textIterCompare ti2 ti1 = do res <- {#call unsafe text_iter_compare#} ti1 ti2 return $ case res of (-1) -> LT 0 -> EQ 1 -> GT -- | Checks whether iter falls in the range [start, end). -- start and end must be in ascending order. -- textIterInRange :: TextIter -> TextIter -- ^ @start@ start of range -> TextIter -- ^ @end@ end of range -> IO Bool -- ^ @True@ if iter is in the range textIterInRange ti start end = liftM toBool $ {# call unsafe text_iter_in_range #} ti start end -- | Swaps the value of first and second if second comes before first in the buffer. -- That is, ensures that first and second are in sequence. -- Most text buffer functions that take a range call this automatically on your behalf, so there's no real reason to call it yourself in those cases. -- There are some exceptions, such as 'textIterInRange', that expect a pre-sorted range. -- textIterOrder :: TextIter -> TextIter -> IO () textIterOrder first second = {# call text_iter_order #} first second -------------------- -- Attributes -- | \'visibleLineOffset\' property. See 'textIterGetVisibleLineOffset' and -- 'textIterSetVisibleLineOffset' -- textIterVisibleLineOffset :: Attr TextIter Int textIterVisibleLineOffset = newAttr textIterGetVisibleLineOffset textIterSetVisibleLineOffset -- | \'offset\' property. See 'textIterGetOffset' and 'textIterSetOffset' -- textIterOffset :: Attr TextIter Int textIterOffset = newAttr textIterGetOffset textIterSetOffset -- | \'lineOffset\' property. See 'textIterGetLineOffset' and -- 'textIterSetLineOffset' -- textIterLineOffset :: Attr TextIter Int textIterLineOffset = newAttr textIterGetLineOffset textIterSetLineOffset -- | \'line\' property. See 'textIterGetLine' and 'textIterSetLine' -- textIterLine :: Attr TextIter Int textIterLine = newAttr textIterGetLine textIterSetLine gtk-0.15.9/Graphics/UI/Gtk/Multiline/TextMark.chs0000644000000000000000000001466407346545000017601 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) TextMark TextBuffer -- -- Author : Axel Simon -- -- Created: 23 February 2002 -- -- Copyright (C) 2002-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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A position in the buffer preserved across buffer modifications -- module Graphics.UI.Gtk.Multiline.TextMark ( -- * Detail -- -- | You may wish to begin by reading the text widget conceptual overview -- which gives an overview of all the objects and data types related to the -- text widget and how they work together. -- -- A 'TextMark' is like a bookmark in a text buffer; it preserves a position -- in the text. You can convert the mark to an iterator using -- 'textBufferGetIterAtMark'. Unlike -- iterators, marks remain valid across buffer mutations, because their -- behavior is defined when text is inserted or deleted. When text containing -- a mark is deleted, the mark remains in the position originally occupied by -- the deleted text. When text is inserted at a mark, a mark with left -- gravity will be moved to the beginning of the newly-inserted text, and a -- mark with right gravity will be moved to the end. -- -- Marks can be deleted from the buffer at any time with -- 'textBufferDeleteMark'. Once deleted -- from the buffer, a mark is essentially useless. -- -- Marks optionally have names; these can be convenient to avoid passing the -- 'TextMark' object around. -- -- Marks are typically created using the -- 'textBufferCreateMark' function. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----TextMark -- @ -- * Types TextMark, TextMarkClass, castToTextMark, gTypeTextMark, toTextMark, MarkName, -- * Constructors #if GTK_CHECK_VERSION(2,12,0) textMarkNew, #endif -- * Methods textMarkSetVisible, textMarkGetVisible, textMarkGetDeleted, textMarkGetName, textMarkGetBuffer, textMarkGetLeftGravity, -- * Attributes textMarkName, textMarkVisible, textMarkLeftGravity ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -- | The name of a mark. type MarkName = DefaultGlibString -------------------- -- Constructors #if GTK_CHECK_VERSION(2,12,0) -- | Creates a text mark. Add it to a buffer using 'textBufferAddMark'. If -- @name@ is @Nothing@, the mark is anonymous; otherwise, the mark can be retrieved by -- this name -- using 'textBufferGetMark'. If a mark has left gravity, and text is inserted -- at the mark's current location, the mark will be moved to the left of the -- newly-inserted text. If the mark has right gravity (@leftGravity@ = -- @False@), the mark will end up on the right of newly-inserted text. The -- standard left-to-right cursor is a mark with right gravity (when you type, -- the cursor stays on the right side of the text you\'re typing). -- -- * Available since Gtk+ version 2.12 -- textMarkNew :: Maybe MarkName -- ^ @markName@ - name for mark, or @Nothing@ -> Bool -- ^ @leftGravity@ - whether the mark has left gravity -> IO TextMark textMarkNew markName leftGravity = wrapNewGObject mkTextMark $ maybeWith withUTFString markName $ \markNamePtr -> {# call text_mark_new #} markNamePtr (fromBool leftGravity) #endif -------------------- -- Methods -- | Sets the visibility of @mark@; the insertion point is normally visible, -- i.e. you can see it as a vertical bar. Also, the text widget uses a visible -- mark to indicate where a drop will occur when dragging-and-dropping text. -- Most other marks are not visible. Marks are not visible by default. -- textMarkSetVisible :: TextMarkClass self => self -> Bool -> IO () textMarkSetVisible self setting = {# call unsafe text_mark_set_visible #} (toTextMark self) (fromBool setting) -- | Returns @True@ if the mark is visible (i.e. a cursor is displayed for it) -- textMarkGetVisible :: TextMarkClass self => self -> IO Bool textMarkGetVisible self = liftM toBool $ {# call unsafe text_mark_get_visible #} (toTextMark self) -- | Returns @True@ if the mark has been removed from its buffer with -- 'textBufferDeleteMark'. Marks can't -- be used once deleted. -- textMarkGetDeleted :: TextMarkClass self => self -> IO Bool textMarkGetDeleted self = liftM toBool $ {# call unsafe text_mark_get_deleted #} (toTextMark self) -- | Returns the mark name; returns @Nothing@ for anonymous marks. -- textMarkGetName :: TextMarkClass self => self -> IO (Maybe MarkName) textMarkGetName self = {# call unsafe text_mark_get_name #} (toTextMark self) >>= maybePeek peekUTFString -- | Gets the buffer this mark is located inside, or @Nothing@ if the mark is -- deleted. -- textMarkGetBuffer :: TextMarkClass self => self -> IO (Maybe TextBuffer) textMarkGetBuffer self = maybeNull (makeNewGObject mkTextBuffer) $ {# call unsafe text_mark_get_buffer #} (toTextMark self) -- | Determines whether the mark has left gravity. -- -- The name is misleading as Arabic, Hebrew and some other languages have the -- beginning of a line towards the right. -- textMarkGetLeftGravity :: TextMarkClass self => self -> IO Bool textMarkGetLeftGravity self = liftM toBool $ {# call unsafe text_mark_get_left_gravity #} (toTextMark self) -------------------- -- Attributes -- | Retrieves the name of a mark. -- textMarkName :: TextMarkClass self => ReadAttr self (Maybe MarkName) textMarkName = readAttrFromMaybeStringProperty "name" -- | The \'visible\' property. See 'textMarkGetVisible' and 'textMarkSetVisible' -- textMarkVisible :: TextMarkClass self => Attr self Bool textMarkVisible = newAttr textMarkGetVisible textMarkSetVisible -- | Determines whether the mark keeps to the left when text is inserted at its position. -- textMarkLeftGravity :: TextMarkClass self => ReadAttr self Bool textMarkLeftGravity = readAttrFromBoolProperty "left-gravity" gtk-0.15.9/Graphics/UI/Gtk/Multiline/TextTag.chs0000644000000000000000000005650107346545000017416 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TextTag -- -- Author : Duncan Coutts -- -- Created: 4 August 2004 -- -- Copyright (C) 2004-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. -- -- TODO -- -- Didn't bind `textTagTabs` properties, we need to bind PangoTab first (in `pango-tabs.c`) -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A tag that can be applied to text in a 'TextBuffer' -- module Graphics.UI.Gtk.Multiline.TextTag ( -- * Detail -- -- | You may wish to begin by reading the text widget conceptual overview -- which gives an overview of all the objects and data types related to the -- text widget and how they work together. -- -- Tags should be in the 'TextTagTable' for a given -- 'Graphics.UI.Gtk.Multiline.TextBuffer.TextBuffer' before -- using them with that buffer. -- -- 'Graphics.UI.Gtk.Multiline.TextBuffer.textBufferCreateTag' is the best way -- to create tags. -- -- The 'textTagInvisible' property was not implemented for Gtk+ 2.0; it's planned -- to be implemented in future releases. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----TextTag -- @ -- * Types TextTag, TextTagClass, castToTextTag, gTypeTextTag, toTextTag, TagName, -- * Constructors textTagNew, -- * Methods textTagSetPriority, textTagGetPriority, TextAttributes(..), textAttributesNew, textAttributesCopy, textAttributesCopyValues, makeNewTextAttributes, -- internal -- * Attributes textTagName, textTagBackground, textTagBackgroundSet, textTagBackgroundFullHeight, textTagBackgroundFullHeightSet, textTagBackgroundGdk, #if GTK_MAJOR_VERSION < 3 textTagBackgroundStipple, textTagBackgroundStippleSet, #endif textTagForeground, textTagForegroundSet, textTagForegroundGdk, #if GTK_MAJOR_VERSION < 3 textTagForegroundStipple, textTagForegroundStippleSet, #endif textTagDirection, textTagEditable, textTagEditableSet, textTagFont, textTagFontDesc, textTagFamily, textTagFamilySet, textTagStyle, textTagStyleSet, -- textTagTabs, textTagTabsSet, textTagVariant, textTagVariantSet, textTagWeight, textTagWeightSet, textTagStretch, textTagStretchSet, textTagSize, textTagSizeSet, textTagScale, textTagScaleSet, textTagSizePoints, textTagJustification, textTagJustificationSet, textTagLanguage, textTagLanguageSet, textTagLeftMargin, textTagLeftMarginSet, textTagRightMargin, textTagRightMarginSet, textTagIndent, textTagIndentSet, textTagRise, textTagRiseSet, textTagPixelsAboveLines, textTagPixelsAboveLinesSet, textTagPixelsBelowLines, textTagPixelsBelowLinesSet, textTagPixelsInsideWrap, textTagPixelsInsideWrapSet, textTagStrikethrough, textTagStrikethroughSet, textTagUnderline, textTagUnderlineSet, textTagWrapMode, textTagWrapModeSet, #if GTK_CHECK_VERSION(2,8,0) textTagInvisible, textTagInvisibleSet, textTagParagraphBackground, textTagParagraphBackgroundSet, textTagParagraphBackgroundGdk, #endif textTagPriority, -- * Signals textTagEvent, -- * Deprecated #ifndef DISABLE_DEPRECATED onTextTagEvent #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.Rendering.Pango.Font import Graphics.Rendering.Pango.BasicTypes (FontDescription (..), makeNewFontDescription) import Graphics.Rendering.Pango.Enums (FontStyle(..), Variant(..), Stretch(..), Underline(..)) import Graphics.UI.Gtk.General.Enums (TextDirection(..), Justification(..), WrapMode(..)) import Graphics.UI.Gtk.General.Structs (Color(..)) import Graphics.UI.Gtk.Multiline.Types ( TextIter, mkTextIterCopy ) #ifndef DISABLE_DEPRECATED import Graphics.UI.Gtk.Gdk.Events (Event, marshalEvent) #endif import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny) import Control.Monad.Reader ( runReaderT ) {# context lib="gtk" prefix="gtk" #} type TagName = DefaultGlibString -------------------- -- Constructors -- | Creates a 'TextTag'. -- -- * Supplying @Nothing@ as tag name results in an anonymous tag. -- textTagNew :: Maybe TagName -> IO TextTag textTagNew (Just name) = wrapNewGObject mkTextTag $ withUTFString name $ \namePtr -> {# call unsafe text_tag_new #} namePtr textTagNew Nothing = wrapNewGObject mkTextTag $ {# call unsafe text_tag_new #} nullPtr -------------------- -- Methods -- | Get the tag priority. -- textTagGetPriority :: TextTagClass self => self -> IO Int textTagGetPriority self = liftM fromIntegral $ {# call unsafe text_tag_get_priority #} (toTextTag self) -- | Sets the priority of a 'TextTag'. Valid priorities are start at 0 and go -- to one less than -- 'Graphics.UI.Gtk.Multiline.TextTagTable.textTagTableGetSize'. -- Each tag in a table has a unique -- priority; setting the priority of one tag shifts the priorities of all the -- other tags in the table to maintain a unique priority for each tag. Higher -- priority tags \"win\" if two tags both set the same text attribute. When -- adding a tag to a tag table, it will be assigned the highest priority in the -- table by default; so normally the precedence of a set of tags is the order -- in which they were added to the table, or created with -- 'Graphics.UI.Gtk.Multiline.TextBuffer.textBufferCreateTag', which adds the tag to the buffer's table -- automatically. -- textTagSetPriority :: TextTagClass self => self -> Int -> IO () textTagSetPriority self priority = {# call text_tag_set_priority #} (toTextTag self) (fromIntegral priority) -- TextAttributes methods {#pointer * TextAttributes foreign newtype#} -- | Creates a 'TextAttributes', which describes a set of properties on some -- text. -- textAttributesNew :: IO TextAttributes textAttributesNew = {#call unsafe text_attributes_new#} >>= makeNewTextAttributes -- | Copies src and returns a new 'TextAttributes'. -- textAttributesCopy :: TextAttributes -- ^ @src@ - a 'TextAttributes' to be copied -> IO TextAttributes textAttributesCopy src = {#call text_attributes_copy#} src >>= makeNewTextAttributes -- | Copies the values from src to dest so that dest has the same values as src. -- textAttributesCopyValues :: TextAttributes -> TextAttributes -> IO () textAttributesCopyValues src dest = {# call text_attributes_copy_values #} src dest -- | This function is use internal for transform TextAttributes. -- Don't export this function. makeNewTextAttributes :: Ptr TextAttributes -> IO TextAttributes makeNewTextAttributes ptr = liftM TextAttributes $ newForeignPtr ptr text_attributes_unref foreign import ccall unsafe ">k_text_attributes_unref" text_attributes_unref :: FinalizerPtr TextAttributes -------------------- -- Attributes -- | Name used to refer to the text tag. @Nothing@ for anonymous tags. -- -- Default value: @Nothing@ -- textTagName :: (TextTagClass self, GlibString string) => Attr self (Maybe string) textTagName = newAttrFromMaybeStringProperty "name" -- | Background color as a string. -- -- Default value: \"\" -- textTagBackground :: (TextTagClass self, GlibString string) => WriteAttr self string textTagBackground = writeAttrFromStringProperty "background" -- | Whether this tag affects the background color. -- -- Default value: @False@ -- textTagBackgroundSet :: TextTagClass self => Attr self Bool textTagBackgroundSet = newAttrFromBoolProperty "background-set" -- | Whether the background color fills the entire line height or only the -- height of the tagged characters. -- -- Default value: @False@ -- textTagBackgroundFullHeight :: TextTagClass self => Attr self Bool textTagBackgroundFullHeight = newAttrFromBoolProperty "background-full-height" -- | Whether this tag affects background height. -- -- Default value: @False@ -- textTagBackgroundFullHeightSet :: TextTagClass self => Attr self Bool textTagBackgroundFullHeightSet = newAttrFromBoolProperty "background-full-height-set" -- | Background color as a (possibly unallocated) GdkColor. -- textTagBackgroundGdk :: TextTagClass self => Attr self Color textTagBackgroundGdk = newAttrFromBoxedStorableProperty "background-gdk" {#call pure unsafe gdk_color_get_type#} #if GTK_MAJOR_VERSION < 3 -- | Bitmap to use as a mask when drawing the text background. -- -- Removed in Gtk3. textTagBackgroundStipple :: (TextTagClass self, PixmapClass pixmap) => ReadWriteAttr self Pixmap pixmap textTagBackgroundStipple = newAttrFromObjectProperty "background-stipple" {# call pure unsafe gdk_pixmap_get_type #} -- | Whether this tag affects the background stipple. -- -- Default value: @False@ -- -- Removed in Gtk3. textTagBackgroundStippleSet :: TextTagClass self => Attr self Bool textTagBackgroundStippleSet = newAttrFromBoolProperty "background-stipple-set" #endif -- | Foreground color as a string. -- -- Default value: \"\" -- textTagForeground :: (TextTagClass self, GlibString string) => WriteAttr self string textTagForeground = writeAttrFromStringProperty "foreground" -- | Whether this tag affects the foreground color. -- -- Default value: @False@ -- textTagForegroundSet :: TextTagClass self => Attr self Bool textTagForegroundSet = newAttrFromBoolProperty "foreground-set" -- | Foreground color as a (possibly unallocated) GdkColor. -- textTagForegroundGdk :: TextTagClass self => Attr self Color textTagForegroundGdk = newAttrFromBoxedStorableProperty "foreground-gdk" {# call pure unsafe gdk_color_get_type #} #if GTK_MAJOR_VERSION < 3 -- | Bitmap to use as a mask when drawing the text foreground. -- -- Removed in Gtk3. textTagForegroundStipple :: (TextTagClass self, PixmapClass pixmap) => ReadWriteAttr self Pixmap pixmap textTagForegroundStipple = newAttrFromObjectProperty "foreground-stipple" {# call pure unsafe gdk_pixmap_get_type #} -- | Whether this tag affects the foreground stipple. -- -- Default value: @False@ -- -- Removed in Gtk3. textTagForegroundStippleSet :: TextTagClass self => Attr self Bool textTagForegroundStippleSet = newAttrFromBoolProperty "foreground-stipple-set" #endif -- | Text direction, e.g. right-to-left or left-to-right. -- -- Default value: 'TextDirLtr' -- textTagDirection :: TextTagClass self => Attr self TextDirection textTagDirection = newAttrFromEnumProperty "direction" {# call pure unsafe gtk_text_direction_get_type #} -- | Whether the text can be modified by the user. -- -- Default value: @True@ -- textTagEditable :: TextTagClass self => Attr self Bool textTagEditable = newAttrFromBoolProperty "editable" -- | Whether this tag affects text editability. -- -- Default value: @False@ -- textTagEditableSet :: TextTagClass self => Attr self Bool textTagEditableSet = newAttrFromBoolProperty "editable-set" -- | Font description as a string, e.g. \"Sans Italic 12\". -- -- Default value: \"\" -- textTagFont :: (TextTagClass self, GlibString string) => Attr self string textTagFont = newAttrFromStringProperty "font" -- | Font description as a 'FontDescription' struct. -- textTagFontDesc :: TextTagClass self => Attr self FontDescription textTagFontDesc = newAttrFromBoxedOpaqueProperty makeNewFontDescription (\(FontDescription fd) act -> withForeignPtr fd act) "font-desc" {# call pure unsafe pango_font_description_get_type #} -- | Name of the font family, e.g. Sans, Helvetica, Times, Monospace. -- -- Default value: \"\" -- textTagFamily :: (TextTagClass self, GlibString string) => Attr self string textTagFamily = newAttrFromStringProperty "family" -- | Whether this tag affects the font family. -- -- Default value: @False@ -- textTagFamilySet :: TextTagClass self => Attr self Bool textTagFamilySet = newAttrFromBoolProperty "family-set" -- | Font style as a 'Style', e.g. 'StyleItalic'. -- -- Default value: 'StyleNormal' -- textTagStyle :: TextTagClass self => Attr self FontStyle textTagStyle = newAttrFromEnumProperty "style" {# call pure unsafe pango_style_get_type #} -- | Whether this tag affects the font style. -- -- Default value: @False@ -- textTagStyleSet :: TextTagClass self => Attr self Bool textTagStyleSet = newAttrFromBoolProperty "style-set" -- | Custom tabs for this text. -- textTagTabs :: TextTagClass self => Attr self TabArray -- | Whether this tag affects tabs. -- -- Default value: @False@ -- textTagTabsSet :: TextTagClass self => Attr self Bool textTagTabsSet = newAttrFromBoolProperty "tabs-set" -- | Font variant as a 'Variant', e.g. 'VariantSmallCaps'. -- -- Default value: 'VariantNormal' -- textTagVariant :: TextTagClass self => Attr self Variant textTagVariant = newAttrFromEnumProperty "variant" {# call pure unsafe pango_variant_get_type #} -- | Whether this tag affects the font variant. -- -- Default value: @False@ -- textTagVariantSet :: TextTagClass self => Attr self Bool textTagVariantSet = newAttrFromBoolProperty "variant-set" -- | Font weight as an integer, see predefined values in 'Graphics.Rendering.Pango.Enums.Weight'; for -- example, 'Graphics.Rendering.Pango.Enums.WeightBold'. -- -- Allowed values: >= 0 -- -- Default value: 400 -- textTagWeight :: TextTagClass self => Attr self Int textTagWeight = newAttrFromIntProperty "weight" -- | Whether this tag affects the font weight. -- -- Default value: @False@ -- textTagWeightSet :: TextTagClass self => Attr self Bool textTagWeightSet = newAttrFromBoolProperty "weight-set" -- | Font stretch as a 'Stretch', e.g. 'StretchCondensed'. -- -- Default value: 'StretchNormal' -- textTagStretch :: TextTagClass self => Attr self Stretch textTagStretch = newAttrFromEnumProperty "stretch" {# call pure unsafe pango_stretch_get_type #} -- | Whether this tag affects the font stretch. textTagStretchSet :: TextTagClass self => Attr self Bool textTagStretchSet = newAttrFromBoolProperty "stretch-set" -- | Font size in Pango units. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagSize :: TextTagClass self => Attr self Int textTagSize = newAttrFromIntProperty "size" -- | Whether this tag affects the font size. -- -- Default value: @False@ -- textTagSizeSet :: TextTagClass self => Attr self Bool textTagSizeSet = newAttrFromBoolProperty "size-set" -- | Font size as a scale factor relative to the default font size. This -- properly adapts to theme changes etc. so is recommended. -- -- Allowed values: >= 0 -- -- Default value: 1 -- textTagScale :: TextTagClass self => Attr self Double textTagScale = newAttrFromDoubleProperty "scale" -- | Whether this tag scales the font size by a factor. -- -- Default value: @False@ -- textTagScaleSet :: TextTagClass self => Attr self Bool textTagScaleSet = newAttrFromBoolProperty "scale-set" -- | Font size in points. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagSizePoints :: TextTagClass self => Attr self Double textTagSizePoints = newAttrFromDoubleProperty "size-points" -- | Left, right, or center justification. -- -- Default value: 'JustifyLeft' -- textTagJustification :: TextTagClass self => Attr self Justification textTagJustification = newAttrFromEnumProperty "justification" {# call pure unsafe gtk_justification_get_type #} -- | Whether this tag affects paragraph justification. -- -- Default value: @False@ -- textTagJustificationSet :: TextTagClass self => Attr self Bool textTagJustificationSet = newAttrFromBoolProperty "justification-set" -- | The language this text is in, as an ISO code. Pango can use this as a -- hint when rendering the text. If not set, an appropriate default will be -- used. -- -- Default value: \"\" -- textTagLanguage :: (TextTagClass self, GlibString string) => Attr self string textTagLanguage = newAttrFromStringProperty "language" -- | Whether this tag affects the language the text is rendered as. -- -- Default value: @False@ -- textTagLanguageSet :: TextTagClass self => Attr self Bool textTagLanguageSet = newAttrFromBoolProperty "language-set" -- | Width of the left margin in pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagLeftMargin :: TextTagClass self => Attr self Int textTagLeftMargin = newAttrFromIntProperty "left-margin" -- | Whether this tag affects the left margin. -- -- Default value: @False@ -- textTagLeftMarginSet :: TextTagClass self => Attr self Bool textTagLeftMarginSet = newAttrFromBoolProperty "left-margin-set" -- | Width of the right margin in pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagRightMargin :: TextTagClass self => Attr self Int textTagRightMargin = newAttrFromIntProperty "right-margin" -- | Whether this tag affects the right margin. -- -- Default value: @False@ -- textTagRightMarginSet :: TextTagClass self => Attr self Bool textTagRightMarginSet = newAttrFromBoolProperty "right-margin-set" -- | Amount to indent the paragraph, in pixels. -- -- Default value: 0 -- textTagIndent :: TextTagClass self => Attr self Int textTagIndent = newAttrFromIntProperty "indent" -- | Whether this tag affects indentation. -- -- Default value: @False@ -- textTagIndentSet :: TextTagClass self => Attr self Bool textTagIndentSet = newAttrFromBoolProperty "indent-set" -- | Offset of text above the baseline (below the baseline if rise is -- negative) in pixels. -- -- Default value: 0 -- textTagRise :: TextTagClass self => Attr self Int textTagRise = newAttrFromIntProperty "rise" -- | Whether this tag affects the rise. textTagRiseSet :: TextTagClass self => Attr self Bool textTagRiseSet = newAttrFromBoolProperty "rise-set" -- | Pixels of blank space above paragraphs. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagPixelsAboveLines :: TextTagClass self => Attr self Int textTagPixelsAboveLines = newAttrFromIntProperty "pixels-above-lines" -- | Whether this tag affects the number of pixels above lines. -- -- Default value: @False@ -- textTagPixelsAboveLinesSet :: TextTagClass self => Attr self Bool textTagPixelsAboveLinesSet = newAttrFromBoolProperty "pixels-above-lines-set" -- | Pixels of blank space below paragraphs. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagPixelsBelowLines :: TextTagClass self => Attr self Int textTagPixelsBelowLines = newAttrFromIntProperty "pixels-below-lines" -- | Whether this tag affects the number of pixels below lines. -- -- Default value: @False@ -- textTagPixelsBelowLinesSet :: TextTagClass self => Attr self Bool textTagPixelsBelowLinesSet = newAttrFromBoolProperty "pixels-below-lines-set" -- | Pixels of blank space between wrapped lines in a paragraph. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textTagPixelsInsideWrap :: TextTagClass self => Attr self Int textTagPixelsInsideWrap = newAttrFromIntProperty "pixels-inside-wrap" -- | Whether this tag affects the number of pixels between wrapped lines. -- -- Default value: @False@ -- textTagPixelsInsideWrapSet :: TextTagClass self => Attr self Bool textTagPixelsInsideWrapSet = newAttrFromBoolProperty "pixels-inside-wrap-set" -- | Whether to strike through the text. -- -- Default value: @False@ -- textTagStrikethrough :: TextTagClass self => Attr self Bool textTagStrikethrough = newAttrFromBoolProperty "strikethrough" -- | Whether this tag affects strikethrough. -- -- Default value: @False@ -- textTagStrikethroughSet :: TextTagClass self => Attr self Bool textTagStrikethroughSet = newAttrFromBoolProperty "strikethrough-set" -- | Style of underline for this text. -- -- Default value: 'UnderlineNone' -- textTagUnderline :: TextTagClass self => Attr self Underline textTagUnderline = newAttrFromEnumProperty "underline" {# call pure unsafe pango_underline_get_type #} -- | Whether this tag affects underlining. -- -- Default value: @False@ -- textTagUnderlineSet :: TextTagClass self => Attr self Bool textTagUnderlineSet = newAttrFromBoolProperty "underline-set" -- | Whether to wrap lines never, at word boundaries, or at character -- boundaries. -- -- Default value: 'WrapNone' -- textTagWrapMode :: TextTagClass self => Attr self WrapMode textTagWrapMode = newAttrFromEnumProperty "wrap-mode" {# call pure unsafe gtk_wrap_mode_get_type #} -- | Whether this tag affects line wrap mode. -- -- Default value: @False@ -- textTagWrapModeSet :: TextTagClass self => Attr self Bool textTagWrapModeSet = newAttrFromBoolProperty "wrap-mode-set" #if GTK_CHECK_VERSION(2,8,0) -- | Whether this text is hidden. -- -- Note that there may still be problems with the support for invisible -- text, in particular when navigating programmatically inside a buffer -- containing invisible segments. -- -- Default value: @False@ -- textTagInvisible :: TextTagClass self => Attr self Bool textTagInvisible = newAttrFromBoolProperty "invisible" -- | Whether this tag affects text visibility. -- -- Default value: @False@ -- textTagInvisibleSet :: TextTagClass self => Attr self Bool textTagInvisibleSet = newAttrFromBoolProperty "invisible-set" -- | The paragraph background color as a string. -- -- Default value: \"\" -- textTagParagraphBackground :: (TextTagClass self, GlibString string) => WriteAttr self string textTagParagraphBackground = writeAttrFromStringProperty "paragraph-background" -- | Whether this tag affects the paragraph background color. -- -- Default value: @False@ -- textTagParagraphBackgroundSet :: TextTagClass self => Attr self Bool textTagParagraphBackgroundSet = newAttrFromBoolProperty "paragraph-background-set" -- | The paragraph background color as a as a (possibly unallocated) 'Color'. -- textTagParagraphBackgroundGdk :: TextTagClass self => Attr self Color textTagParagraphBackgroundGdk = newAttrFromBoxedStorableProperty "paragraph-background-gdk" {# call pure unsafe gdk_color_get_type #} #endif -- | \'priority\' property. See 'textTagGetPriority' and 'textTagSetPriority' -- textTagPriority :: TextTagClass self => Attr self Int textTagPriority = newAttr textTagGetPriority textTagSetPriority -------------------- -- Signals -- the following signal only really makes sense if the EventM module provides dynamic upcast -- functions since the user must test what kind of event has been delivered. -- | An event has occurred that affects the given tag. -- -- * Adding an event handler to the tag makes it possible to react on -- e.g. mouse clicks to implement hyperlinking. -- -- * The first argument is the object the event was fired from (typically a 'TextView'). -- The second argument is the iterator indicating where the event happened. -- textTagEvent :: TextTagClass self => Signal self (GObject -> TextIter -> EventM EAny Bool) textTagEvent = Signal (\after obj fun -> connect_OBJECT_PTR_BOXED__BOOL "event" mkTextIterCopy after obj (\tv eventPtr iter -> runReaderT (fun tv iter) eventPtr) ) -------------------- -- Deprecated Signals and Events #ifndef DISABLE_DEPRECATED -- | An event has occurred that affects the given tag. -- -- * Adding an event handler to the tag makes it possible to react on -- e.g. mouse clicks to implement hyperlinking. -- onTextTagEvent :: TextTagClass t => t -> (Event -> TextIter -> IO ()) -> IO (ConnectId t) onTextTagEvent tt act = connect_PTR_BOXED_BOXED__BOOL "event" marshalEvent mkTextIterCopy False tt (\_ event iter -> act event iter >> return False) #endif gtk-0.15.9/Graphics/UI/Gtk/Multiline/TextTagTable.chs0000644000000000000000000000746507346545000020373 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TextTagTable -- -- Author : Duncan Coutts -- -- Created: 4 August 2004 -- -- Copyright (C) 2004-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) -- -- Collection of tags that can be used together -- module Graphics.UI.Gtk.Multiline.TextTagTable ( -- * Detail -- -- | You may wish to begin by reading the text widget conceptual overview -- which gives an overview of all the objects and data types related to the -- text widget and how they work together. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----TextTagTable -- @ -- * Types TextTagTable, TextTagTableClass, castToTextTagTable, gTypeTextTagTable, toTextTagTable, -- * Constructors textTagTableNew, -- * Methods textTagTableAdd, textTagTableRemove, textTagTableLookup, textTagTableForeach, textTagTableGetSize ) where import Control.Monad (liftM, void) import System.Glib.FFI (withForeignPtr, nullPtr, Ptr(..), CInt(..), CChar(..), FunPtr(..), maybeNull) import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'TextTagTable'. The table contains no tags by default. -- textTagTableNew :: IO TextTagTable textTagTableNew = wrapNewGObject mkTextTagTable $ {# call unsafe text_tag_table_new #} -------------------- -- Methods -- | Add a tag to the table. The tag is assigned the highest priority in the -- table. -- -- The tag must not be in a tag table already, and may not have the same name as -- an already-added tag. -- textTagTableAdd :: (TextTagTableClass self, TextTagClass tag) => self -> tag -> IO () textTagTableAdd self tag = void $ {# call text_tag_table_add #} (toTextTagTable self) (toTextTag tag) -- | Remove a tag from the table. -- textTagTableRemove :: (TextTagTableClass self, TextTagClass tag) => self -> tag -> IO () textTagTableRemove self tag = {# call text_tag_table_remove #} (toTextTagTable self) (toTextTag tag) -- | Look up a named tag. -- textTagTableLookup :: (TextTagTableClass self, GlibString string) => self -> string -- ^ @name@ - name of a tag -> IO (Maybe TextTag) -- ^ returns The tag, or @Nothing@ if none by that name -- is in the table. textTagTableLookup self name = maybeNull (makeNewGObject mkTextTag) $ withUTFString name $ \namePtr -> {# call unsafe text_tag_table_lookup #} (toTextTagTable self) namePtr -- | Maps over each tag in the table. -- textTagTableForeach :: TextTagTableClass self => self -> (TextTag -> IO ()) -> IO () textTagTableForeach self func = do funcPtr <- mkTextTagTableForeach (\tagPtr _ -> do tag <- makeNewGObject mkTextTag (return tagPtr) func tag) {# call text_tag_table_foreach #} (toTextTagTable self) funcPtr nullPtr {#pointer TextTagTableForeach#} foreign import ccall "wrapper" mkTextTagTableForeach :: (Ptr TextTag -> Ptr () -> IO ()) -> IO TextTagTableForeach -- | Returns the size of the table (the number of tags). -- textTagTableGetSize :: TextTagTableClass self => self -> IO Int textTagTableGetSize self = liftM fromIntegral $ {# call unsafe text_tag_table_get_size #} (toTextTagTable self) gtk-0.15.9/Graphics/UI/Gtk/Multiline/TextView.chs0000644000000000000000000013701407346545000017614 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TextView -- -- Author : Axel Simon -- -- Created: 23 February 2002 -- -- Copyright (C) 2002-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. -- -- TODO -- -- If PangoTabArray is bound: -- Functions: textViewSetTabs and textViewGetTabs -- Properties: textViewTabs -- -- All on... and after... signals had incorrect names (underscore instead of hyphens). Thus -- they could not have been used in applications and removing them can't break anything. -- Thus, I've removed them. Also, all key-binding signals are now removed as there is -- no way to add additional key bindings programmatically in a type-safe way, let alone -- use these signals. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Widget that displays a 'TextBuffer' -- module Graphics.UI.Gtk.Multiline.TextView ( -- * Detail -- -- | You may wish to begin by reading the text widget conceptual overview -- which gives an overview of all the objects and data types related to the -- text widget and how they work together. -- -- Throughout we distinguish between buffer coordinates which are pixels with -- the origin at the upper left corner of the first character on the first -- line. Window coordinates are relative to the top left pixel which is visible -- in the current 'TextView'. Coordinates from Events are in the latter -- relation. The conversion can be done with 'textViewWindowToBufferCoords'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----TextView -- | -- | -- | 'GObject' -- | +----TextChildAnchor -- @ -- * Types TextView, TextViewClass, TextChildAnchor, TextChildAnchorClass, castToTextView, gTypeTextView, toTextView, DeleteType(..), DirectionType(..), Justification(..), MovementStep(..), TextWindowType(..), WrapMode(..), -- * Constructors textViewNew, textViewNewWithBuffer, -- * Methods textViewSetBuffer, textViewGetBuffer, textViewScrollToMark, textViewScrollToIter, textViewScrollMarkOnscreen, textViewMoveMarkOnscreen, textViewPlaceCursorOnscreen, textViewGetLineAtY, textViewGetLineYrange, textViewGetIterAtLocation, textViewBufferToWindowCoords, textViewWindowToBufferCoords, textViewGetWindow, textViewGetWindowType, textViewSetBorderWindowSize, textViewGetBorderWindowSize, textViewForwardDisplayLine, textViewBackwardDisplayLine, textViewForwardDisplayLineEnd, textViewBackwardDisplayLineStart, textViewStartsDisplayLine, textViewMoveVisually, textViewAddChildAtAnchor, textChildAnchorNew, textChildAnchorGetWidgets, textChildAnchorGetDeleted, textViewAddChildInWindow, textViewMoveChild, textViewSetWrapMode, textViewGetWrapMode, textViewSetEditable, textViewGetEditable, textViewSetCursorVisible, textViewGetCursorVisible, textViewSetPixelsAboveLines, textViewGetPixelsAboveLines, textViewSetPixelsBelowLines, textViewGetPixelsBelowLines, textViewSetPixelsInsideWrap, textViewGetPixelsInsideWrap, textViewSetJustification, textViewGetJustification, textViewSetLeftMargin, textViewGetLeftMargin, textViewSetRightMargin, textViewGetRightMargin, textViewSetIndent, textViewGetIndent, textViewGetDefaultAttributes, textViewGetVisibleRect, textViewGetIterLocation, #if GTK_CHECK_VERSION(2,6,0) textViewGetIterAtPosition, #endif #if GTK_CHECK_VERSION(2,4,0) textViewSetOverwrite, textViewGetOverwrite, textViewSetAcceptsTab, textViewGetAcceptsTab, #endif #if GTK_CHECK_VERSION(2,22,0) textViewGetHadjustment, textViewGetVadjustment, textViewImContextFilterKeypress, textViewResetImContext, #endif -- * Attributes textViewPixelsAboveLines, textViewPixelsBelowLines, textViewPixelsInsideWrap, textViewEditable, textViewImModule, textViewWrapMode, textViewJustification, textViewLeftMargin, textViewRightMargin, textViewIndent, textViewCursorVisible, textViewBuffer, #if GTK_CHECK_VERSION(2,4,0) textViewOverwrite, textViewAcceptsTab, #endif -- * Signals backspace, copyClipboard, cutClipboard, deleteFromCursor, insertAtCursor, moveCursor, moveViewport, moveFocus, pageHorizontally, pasteClipboard, populatePopup, selectAll, setAnchor, setTextViewScrollAdjustments, toggleCursorVisible, toggleOverwrite, textViewPreeditChanged ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties (newAttrFromStringProperty) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey) import Control.Monad.Reader ( ask ) import Control.Monad.Trans ( liftIO ) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Multiline.Types#} {#import Graphics.UI.Gtk.Multiline.TextTag#} import Graphics.UI.Gtk.General.Enums (TextWindowType(..), DeleteType(..), DirectionType(..), Justification(..), MovementStep(..), WrapMode(..), ScrollStep (..)) import System.Glib.GList (fromGList) import Graphics.UI.Gtk.General.Structs (Rectangle(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'TextView'. If you don't call 'textViewSetBuffer' before -- using the text view, an empty default buffer will be created for you. Get -- the buffer with 'textViewGetBuffer'. If you want to specify your own buffer, -- consider 'textViewNewWithBuffer'. -- textViewNew :: IO TextView textViewNew = makeNewObject mkTextView $ liftM (castPtr :: Ptr Widget -> Ptr TextView) $ {# call unsafe text_view_new #} -- | Creates a new 'TextView' widget displaying the buffer @buffer@. One -- buffer can be shared among many widgets. -- textViewNewWithBuffer :: TextBufferClass buffer => buffer -> IO TextView textViewNewWithBuffer buffer = makeNewObject mkTextView $ liftM (castPtr :: Ptr Widget -> Ptr TextView) $ {# call text_view_new_with_buffer #} (toTextBuffer buffer) -------------------- -- Methods -- | Sets the given buffer as the buffer being displayed by the text view. -- textViewSetBuffer :: (TextViewClass self, TextBufferClass buffer) => self -> buffer -> IO () textViewSetBuffer self buffer = {# call text_view_set_buffer #} (toTextView self) (toTextBuffer buffer) -- | Returns the 'TextBuffer' being displayed by this text view. -- textViewGetBuffer :: TextViewClass self => self -> IO TextBuffer textViewGetBuffer self = makeNewGObject mkTextBuffer $ {# call unsafe text_view_get_buffer #} (toTextView self) -- | Scrolls the text view so that @mark@ is on the screen in the position -- indicated by @xalign@ and @yalign@. An alignment of 0.0 indicates left or -- top, 1.0 indicates right or bottom, 0.5 means center. If the alignment is -- @Nothing@, the text scrolls the minimal distance to get the mark onscreen, -- possibly not scrolling at all. The effective screen for purposes of this -- function is reduced by a margin of size @withinMargin@. -- textViewScrollToMark :: (TextViewClass self, TextMarkClass mark) => self -> mark -- ^ @mark@ - a 'TextMark' -> Double -- ^ @withinMargin@ - margin as a [0.0,0.5) fraction of screen size -- and imposes an extra margin at all four sides of the window -- within which @xalign@ and @yalign@ are evaluated. -> Maybe (Double, Double) -- ^ @Just (xalign, yalign)@ - horizontal and -- vertical alignment of mark within visible area (if @Nothing@, -- scroll just enough to get the mark onscreen) -> IO () textViewScrollToMark self mark withinMargin align = let (useAlign, xalign, yalign) = case align of Nothing -> (False, 0, 0) Just (xalign, yalign) -> (True, xalign, yalign) in {# call text_view_scroll_to_mark #} (toTextView self) (toTextMark mark) (realToFrac withinMargin) (fromBool useAlign) (realToFrac xalign) (realToFrac yalign) -- | Scrolls the text view so that @iter@ is on the screen in the position -- indicated by @xalign@ and @yalign@. An alignment of 0.0 indicates left or -- top, 1.0 indicates right or bottom, 0.5 means center. If the alignment is -- @Nothing@, the text scrolls the minimal distance to get the mark onscreen, -- possibly not scrolling at all. The effective screen for purposes of this -- function is reduced by a margin of size @withinMargin@. -- -- * This function -- uses the currently-computed height of the lines in the text buffer. Note -- that line heights are computed in an idle handler; so this function may -- not -- have the desired effect if it's called before the height computations. To -- avoid oddness, consider using 'textViewScrollToMark' which saves a point -- to be scrolled to after line validation. This is particularly important -- if you add new text to the buffer and immediately ask the view to scroll -- to it (which it can't since it is not updated until the main loop runs). -- textViewScrollToIter :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> Double -- ^ @withinMargin@ - margin as a [0.0,0.5) fraction of screen -- size -> Maybe (Double, Double) -- ^ @Just (xalign, yalign)@ - horizontal and -- vertical alignment of mark within visible area (if @Nothing@, -- scroll just enough to get the iterator onscreen) -> IO Bool -- ^ returns @True@ if scrolling occurred textViewScrollToIter self iter withinMargin align = let (useAlign, xalign, yalign) = case align of Nothing -> (False, 0, 0) Just (xalign, yalign) -> (True, xalign, yalign) in liftM toBool $ {# call text_view_scroll_to_iter #} (toTextView self) iter (realToFrac withinMargin) (fromBool useAlign) (realToFrac xalign) (realToFrac yalign) -- | Scrolls the text view the minimum distance such that @mark@ is contained -- within the visible area of the widget. -- textViewScrollMarkOnscreen :: (TextViewClass self, TextMarkClass mark) => self -> mark -- ^ @mark@ - a mark in the buffer for the text view -> IO () textViewScrollMarkOnscreen self mark = {# call text_view_scroll_mark_onscreen #} (toTextView self) (toTextMark mark) -- | Moves a mark within the buffer so that it's located within the -- currently-visible text area. -- textViewMoveMarkOnscreen :: (TextViewClass self, TextMarkClass mark) => self -> mark -- ^ @mark@ - a 'TextMark' -> IO Bool -- ^ returns @True@ if the mark moved (wasn't already onscreen) textViewMoveMarkOnscreen self mark = liftM toBool $ {# call text_view_move_mark_onscreen #} (toTextView self) (toTextMark mark) -- | Moves the cursor to the currently visible region of the buffer, it it -- isn't there already. -- textViewPlaceCursorOnscreen :: TextViewClass self => self -> IO Bool -- ^ returns @True@ if the cursor had to be moved. textViewPlaceCursorOnscreen self = liftM toBool $ {# call text_view_place_cursor_onscreen #} (toTextView self) -- | Returns the currently-visible region of the buffer, in -- buffer coordinates. Convert to window coordinates with -- 'textViewBufferToWindowCoords'. -- textViewGetVisibleRect :: TextViewClass self => self -> IO Rectangle textViewGetVisibleRect self = alloca $ \rectPtr -> do {# call unsafe text_view_get_visible_rect #} (toTextView self) (castPtr rectPtr) peek rectPtr -- | Gets a rectangle which roughly contains the character at @iter@. The -- rectangle position is in buffer coordinates; use -- 'textViewBufferToWindowCoords' to convert these coordinates to coordinates -- for one of the windows in the text view. -- textViewGetIterLocation :: TextViewClass self => self -> TextIter -> IO Rectangle textViewGetIterLocation self iter = alloca $ \rectPtr -> do {# call unsafe text_view_get_iter_location #} (toTextView self) iter (castPtr rectPtr) peek rectPtr -- | Gets the 'TextIter' at the start of the line containing the coordinate -- @y@. @y@ is in buffer coordinates, convert from window coordinates with -- 'textViewWindowToBufferCoords'. Also returns @lineTop@ the -- coordinate of the top edge of the line. -- textViewGetLineAtY :: TextViewClass self => self -> Int -- ^ @y@ - a y coordinate -> IO (TextIter, Int) -- ^ @(targetIter, lineTop)@ - returns the iter and the -- top coordinate of the line textViewGetLineAtY self y = makeEmptyTextIter >>= \targetIter -> alloca $ \lineTopPtr -> do {# call unsafe text_view_get_line_at_y #} (toTextView self) targetIter (fromIntegral y) lineTopPtr lineTop <- peek lineTopPtr return (targetIter, fromIntegral lineTop) -- | Gets the y coordinate of the top of the line containing @iter@, and the -- height of the line. The coordinate is a buffer coordinate; convert to window -- coordinates with 'textViewBufferToWindowCoords'. -- textViewGetLineYrange :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> IO (Int, Int) -- ^ @(y, height)@ - y coordinate and height of the line textViewGetLineYrange self iter = alloca $ \yPtr -> alloca $ \heightPtr -> do {# call unsafe text_view_get_line_yrange #} (toTextView self) iter yPtr heightPtr y <- peek yPtr height <- peek heightPtr return (fromIntegral y, fromIntegral height) -- | Retrieves the iterator at buffer coordinates @x@ and @y@. Buffer -- coordinates are coordinates for the entire buffer, not just the -- currently-displayed portion. If you have coordinates from an event, you have -- to convert those to buffer coordinates with 'textViewWindowToBufferCoords'. -- textViewGetIterAtLocation :: TextViewClass self => self -> Int -- ^ @x@ - x position, in buffer coordinates -> Int -- ^ @y@ - y position, in buffer coordinates -> IO TextIter textViewGetIterAtLocation self x y = do iter <- makeEmptyTextIter {# call unsafe text_view_get_iter_at_location #} (toTextView self) iter (fromIntegral x) (fromIntegral y) return iter -- | Converts coordinate @(bufferX, bufferY)@ to coordinates for the window -- @win@ -- -- Note that you can't convert coordinates for a nonexisting window (see -- 'textViewSetBorderWindowSize'). -- textViewBufferToWindowCoords :: TextViewClass self => self -> TextWindowType -- ^ @win@ - a 'TextWindowType' except 'TextWindowPrivate' -> (Int, Int) -- ^ @(bufferX, bufferY)@ - buffer x and y coordinates -> IO (Int, Int) -- ^ returns window x and y coordinates textViewBufferToWindowCoords self win (bufferX, bufferY) = alloca $ \windowXPtr -> alloca $ \windowYPtr -> do {# call unsafe text_view_buffer_to_window_coords #} (toTextView self) ((fromIntegral . fromEnum) win) (fromIntegral bufferX) (fromIntegral bufferY) windowXPtr windowYPtr windowX <- peek windowXPtr windowY <- peek windowYPtr return (fromIntegral windowX, fromIntegral windowY) -- | Converts coordinates on the window identified by @win@ to buffer -- coordinates. -- -- Note that you can't convert coordinates for a nonexisting window (see -- 'textViewSetBorderWindowSize'). -- textViewWindowToBufferCoords :: TextViewClass self => self -> TextWindowType -- ^ @win@ - a 'TextWindowType' except 'TextWindowPrivate' -> (Int, Int) -- ^ @(windowX, windowY)@ - window x and y coordinates -> IO (Int, Int) -- ^ returns buffer x and y coordinates textViewWindowToBufferCoords self win (windowX, windowY) = alloca $ \bufferXPtr -> alloca $ \bufferYPtr -> do {# call unsafe text_view_window_to_buffer_coords #} (toTextView self) ((fromIntegral . fromEnum) win) (fromIntegral windowX) (fromIntegral windowY) bufferXPtr bufferYPtr bufferX <- peek bufferXPtr bufferY <- peek bufferYPtr return (fromIntegral bufferX, fromIntegral bufferY) -- | Retrieves the 'DrawWindow' corresponding to an area of the text view; -- possible windows include the overall widget window, child windows on the -- left, right, top, bottom, and the window that displays the text buffer. -- Windows are @Nothing@ and nonexistent if their width or height is 0, and are -- nonexistent before the widget has been realized. -- textViewGetWindow :: TextViewClass self => self -> TextWindowType -- ^ @win@ - window to get -> IO (Maybe DrawWindow) -- ^ returns a 'DrawWindow', or @Nothing@ textViewGetWindow self win = maybeNull (makeNewGObject mkDrawWindow) $ {# call unsafe text_view_get_window #} (toTextView self) ((fromIntegral . fromEnum) win) -- | Retrieve the type of window the 'TextView' widget contains. -- -- Usually used to find out which window an event corresponds to. An emission -- of an event signal of 'TextView' yields a 'DrawWindow'. This function can be -- used to see if the event actually belongs to the main text window. -- textViewGetWindowType :: TextViewClass self => self -> DrawWindow -> IO TextWindowType textViewGetWindowType self window = liftM (toEnum . fromIntegral) $ {# call unsafe text_view_get_window_type #} (toTextView self) window -- | Sets the width of 'TextWindowLeft' or 'TextWindowRight', or the height of -- 'TextWindowTop' or 'TextWindowBottom'. Automatically destroys the -- corresponding window if the size is set to 0, and creates the window if the -- size is set to non-zero. This function can only be used for the \"border -- windows\", it doesn't work with 'TextWindowWidget', 'TextWindowText', or -- 'TextWindowPrivate'. -- textViewSetBorderWindowSize :: TextViewClass self => self -> TextWindowType -- ^ @type@ - window to affect -> Int -- ^ @size@ - width or height of the window -> IO () textViewSetBorderWindowSize self type_ size = {# call text_view_set_border_window_size #} (toTextView self) ((fromIntegral . fromEnum) type_) (fromIntegral size) -- | Gets the width of the specified border window. See -- 'textViewSetBorderWindowSize'. -- textViewGetBorderWindowSize :: TextViewClass self => self -> TextWindowType -- ^ @type@ - window to return size from -> IO Int -- ^ returns width of window textViewGetBorderWindowSize self type_ = liftM fromIntegral $ {# call unsafe text_view_get_border_window_size #} (toTextView self) ((fromIntegral . fromEnum) type_) -- | Moves the given @iter@ forward by one display (wrapped) line. A display -- line is different from a paragraph. Paragraphs are separated by newlines or -- other paragraph separator characters. Display lines are created by -- line-wrapping a paragraph. If wrapping is turned off, display lines and -- paragraphs will be the same. Display lines are divided differently for each -- view, since they depend on the view's width; paragraphs are the same in all -- views, since they depend on the contents of the 'TextBuffer'. -- textViewForwardDisplayLine :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> IO Bool -- ^ returns @True@ if @iter@ was moved and is not on the end -- iterator textViewForwardDisplayLine self iter = liftM toBool $ {# call unsafe text_view_forward_display_line #} (toTextView self) iter -- | Moves the given @iter@ backward by one display (wrapped) line. A display -- line is different from a paragraph. Paragraphs are separated by newlines or -- other paragraph separator characters. Display lines are created by -- line-wrapping a paragraph. If wrapping is turned off, display lines and -- paragraphs will be the same. Display lines are divided differently for each -- view, since they depend on the view's width; paragraphs are the same in all -- views, since they depend on the contents of the 'TextBuffer'. -- textViewBackwardDisplayLine :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> IO Bool -- ^ returns @True@ if @iter@ was moved and is not on the end -- iterator textViewBackwardDisplayLine self iter = liftM toBool $ {# call unsafe text_view_backward_display_line #} (toTextView self) iter -- | Moves the given @iter@ forward to the next display line end. A display -- line is different from a paragraph. Paragraphs are separated by newlines or -- other paragraph separator characters. Display lines are created by -- line-wrapping a paragraph. If wrapping is turned off, display lines and -- paragraphs will be the same. Display lines are divided differently for each -- view, since they depend on the view's width; paragraphs are the same in all -- views, since they depend on the contents of the 'TextBuffer'. -- textViewForwardDisplayLineEnd :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> IO Bool -- ^ returns @True@ if @iter@ was moved and is not on the end -- iterator textViewForwardDisplayLineEnd self iter = liftM toBool $ {# call unsafe text_view_forward_display_line_end #} (toTextView self) iter -- | Moves the given @iter@ backward to the next display line start. A display -- line is different from a paragraph. Paragraphs are separated by newlines or -- other paragraph separator characters. Display lines are created by -- line-wrapping a paragraph. If wrapping is turned off, display lines and -- paragraphs will be the same. Display lines are divided differently for each -- view, since they depend on the view's width; paragraphs are the same in all -- views, since they depend on the contents of the 'TextBuffer'. -- textViewBackwardDisplayLineStart :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> IO Bool -- ^ returns @True@ if @iter@ was moved and is not on the end -- iterator textViewBackwardDisplayLineStart self iter = liftM toBool $ {# call unsafe text_view_backward_display_line_start #} (toTextView self) iter -- | Determines whether @iter@ is at the start of a display line. See -- 'textViewForwardDisplayLine' for an explanation of display lines vs. -- paragraphs. -- textViewStartsDisplayLine :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> IO Bool -- ^ returns @True@ if @iter@ begins a wrapped line textViewStartsDisplayLine self iter = liftM toBool $ {# call unsafe text_view_starts_display_line #} (toTextView self) iter -- | Move the iterator a given number of characters visually, treating it as -- the strong cursor position. If @count@ is positive, then the new strong -- cursor position will be @count@ positions to the right of the old cursor -- position. If @count@ is negative then the new strong cursor position will be -- @count@ positions to the left of the old cursor position. -- -- In the presence of bidirection text, the correspondence between logical -- and visual order will depend on the direction of the current run, and there -- may be jumps when the cursor is moved off of the end of a run. -- textViewMoveVisually :: TextViewClass self => self -> TextIter -- ^ @iter@ - a 'TextIter' -> Int -- ^ @count@ - number of characters to move (negative moves left, -- positive moves right) -> IO Bool -- ^ returns @True@ if @iter@ moved and is not on the end -- iterator textViewMoveVisually self iter count = liftM toBool $ {# call unsafe text_view_move_visually #} (toTextView self) iter (fromIntegral count) -- | Adds a child widget in the text buffer, at the given @anchor@. -- textViewAddChildAtAnchor :: (TextViewClass self, WidgetClass child) => self -> child -- ^ @child@ - a 'Widget' -> TextChildAnchor -- ^ @anchor@ - a 'TextChildAnchor' in the 'TextBuffer' -- for the text view -> IO () textViewAddChildAtAnchor self child anchor = {# call text_view_add_child_at_anchor #} (toTextView self) (toWidget child) anchor -- | Create a new 'TextChildAnchor'. -- -- * Using 'textBufferCreateChildAnchor' is usually simpler then -- executing this function and 'textBufferInsertChildAnchor'. -- textChildAnchorNew :: IO TextChildAnchor textChildAnchorNew = wrapNewGObject mkTextChildAnchor {# call unsafe text_child_anchor_new #} -- | Retrieve all 'Widget's at this -- 'TextChildAnchor'. -- -- * The widgets in the returned list need to be upcasted to what they were. -- textChildAnchorGetWidgets :: TextChildAnchor -> IO [Widget] textChildAnchorGetWidgets tca = do gList <- {# call text_child_anchor_get_widgets #} tca wList <- fromGList gList mapM (makeNewObject mkWidget) (map return wList) -- | Query if an anchor was deleted. -- textChildAnchorGetDeleted :: TextChildAnchor -> IO Bool textChildAnchorGetDeleted tca = liftM toBool $ {# call unsafe text_child_anchor_get_deleted #} tca -- | Adds a child at fixed coordinates in one of the text widget's windows. -- The window must have nonzero size (see 'textViewSetBorderWindowSize'). Note -- that the child coordinates are given relative to the 'DrawWindow' in -- question, and that these coordinates have no sane relationship to scrolling. -- When placing a child in 'TextWindowWidget', scrolling is irrelevant, the -- child floats above all scrollable areas. If you want the widget to move when -- the text view scrolls, use 'textViewAddChildAtAnchor' instead. -- textViewAddChildInWindow :: (TextViewClass self, WidgetClass child) => self -> child -- ^ @child@ - a 'Widget' -> TextWindowType -- ^ @whichWindow@ - which window the child should appear -- in -> Int -- ^ @xpos@ - X position of child in window coordinates -> Int -- ^ @ypos@ - Y position of child in window coordinates -> IO () textViewAddChildInWindow self child whichWindow xpos ypos = {# call text_view_add_child_in_window #} (toTextView self) (toWidget child) ((fromIntegral . fromEnum) whichWindow) (fromIntegral xpos) (fromIntegral ypos) -- | Move a child widget within the 'TextView'. This is really only appropriate -- for \"floating\" child widgets added using 'textViewAddChildInWindow'. -- textViewMoveChild :: (TextViewClass self, WidgetClass child) => self -> child -- ^ @child@ - child widget already added to the text view -> Int -- ^ @xpos@ - new X position in window coordinates -> Int -- ^ @ypos@ - new Y position in window coordinates -> IO () textViewMoveChild self child xpos ypos = {# call text_view_move_child #} (toTextView self) (toWidget child) (fromIntegral xpos) (fromIntegral ypos) -- | Sets the line wrapping for the view. -- textViewSetWrapMode :: TextViewClass self => self -> WrapMode -> IO () textViewSetWrapMode self wrapMode = {# call text_view_set_wrap_mode #} (toTextView self) ((fromIntegral . fromEnum) wrapMode) -- | Gets the line wrapping for the view. -- textViewGetWrapMode :: TextViewClass self => self -> IO WrapMode textViewGetWrapMode self = liftM (toEnum . fromIntegral) $ {# call unsafe text_view_get_wrap_mode #} (toTextView self) -- | Sets the default editability of the 'TextView'. You can override this -- default setting with tags in the buffer, using the \"editable\" attribute of -- tags. -- textViewSetEditable :: TextViewClass self => self -> Bool -> IO () textViewSetEditable self setting = {# call text_view_set_editable #} (toTextView self) (fromBool setting) -- | Returns the default editability of the 'TextView'. Tags in the buffer may -- override this setting for some ranges of text. -- textViewGetEditable :: TextViewClass self => self -> IO Bool textViewGetEditable self = liftM toBool $ {# call unsafe text_view_get_editable #} (toTextView self) -- | Toggles whether the insertion point is displayed. A buffer with no -- editable text probably shouldn't have a visible cursor, so you may want to -- turn the cursor off. -- textViewSetCursorVisible :: TextViewClass self => self -> Bool -> IO () textViewSetCursorVisible self setting = {# call text_view_set_cursor_visible #} (toTextView self) (fromBool setting) -- | Find out whether the cursor is being displayed. -- textViewGetCursorVisible :: TextViewClass self => self -> IO Bool textViewGetCursorVisible self = liftM toBool $ {# call unsafe text_view_get_cursor_visible #} (toTextView self) -- | Sets the default number of blank pixels above paragraphs in the text view. -- Tags in the buffer for the text view may override the defaults. -- -- * Tags in the buffer may override this default. -- textViewSetPixelsAboveLines :: TextViewClass self => self -> Int -> IO () textViewSetPixelsAboveLines self pixelsAboveLines = {# call text_view_set_pixels_above_lines #} (toTextView self) (fromIntegral pixelsAboveLines) -- | Gets the default number of pixels to put above paragraphs. -- textViewGetPixelsAboveLines :: TextViewClass self => self -> IO Int textViewGetPixelsAboveLines self = liftM fromIntegral $ {# call unsafe text_view_get_pixels_above_lines #} (toTextView self) -- | Sets the default number of pixels of blank space to put below paragraphs -- in the text view. May be overridden by tags applied to the text view's -- buffer. -- textViewSetPixelsBelowLines :: TextViewClass self => self -> Int -> IO () textViewSetPixelsBelowLines self pixelsBelowLines = {# call text_view_set_pixels_below_lines #} (toTextView self) (fromIntegral pixelsBelowLines) -- | Gets the default number of blank pixels below each paragraph. -- textViewGetPixelsBelowLines :: TextViewClass self => self -> IO Int textViewGetPixelsBelowLines self = liftM fromIntegral $ {# call unsafe text_view_get_pixels_below_lines #} (toTextView self) -- | Sets the default number of pixels of blank space to leave between -- display\/wrapped lines within a paragraph. May be overridden by tags in -- the text view's buffer. -- textViewSetPixelsInsideWrap :: TextViewClass self => self -> Int -> IO () textViewSetPixelsInsideWrap self pixelsInsideWrap = {# call text_view_set_pixels_inside_wrap #} (toTextView self) (fromIntegral pixelsInsideWrap) -- | Gets the default number of pixels of blank space between lines in a -- wrapped paragraph. -- textViewGetPixelsInsideWrap :: TextViewClass self => self -> IO Int textViewGetPixelsInsideWrap self = liftM fromIntegral $ {# call unsafe text_view_get_pixels_inside_wrap #} (toTextView self) -- | Sets the default justification of text in the text view. Tags in the -- view's buffer may override the default. -- textViewSetJustification :: TextViewClass self => self -> Justification -> IO () textViewSetJustification self justification = {# call text_view_set_justification #} (toTextView self) ((fromIntegral . fromEnum) justification) -- | Gets the default justification of paragraphs in the text view. Tags in the -- buffer may override the default. -- textViewGetJustification :: TextViewClass self => self -> IO Justification textViewGetJustification self = liftM (toEnum . fromIntegral) $ {# call unsafe text_view_get_justification #} (toTextView self) -- | Sets the default left margin for text in the text view. Tags in the buffer -- may override the default. -- textViewSetLeftMargin :: TextViewClass self => self -> Int -- ^ @leftMargin@ - left margin in pixels -> IO () textViewSetLeftMargin self leftMargin = {# call text_view_set_left_margin #} (toTextView self) (fromIntegral leftMargin) -- | Gets the default left margin size of paragraphs in the text view. Tags -- in the buffer may override the default. -- textViewGetLeftMargin :: TextViewClass self => self -> IO Int -- ^ returns left margin in pixels textViewGetLeftMargin self = liftM fromIntegral $ {# call unsafe text_view_get_left_margin #} (toTextView self) -- | Sets the default right margin for text in the text view. Tags in the -- buffer may override the default. -- textViewSetRightMargin :: TextViewClass self => self -> Int -- ^ @rightMargin@ - right margin in pixels -> IO () textViewSetRightMargin self rightMargin = {# call text_view_set_right_margin #} (toTextView self) (fromIntegral rightMargin) -- | Gets the default right margin for text in the text view. Tags in the -- buffer may override the default. -- textViewGetRightMargin :: TextViewClass self => self -> IO Int -- ^ returns right margin in pixels textViewGetRightMargin self = liftM fromIntegral $ {# call unsafe text_view_get_right_margin #} (toTextView self) -- | Sets the default indentation for paragraphs in the text view. Tags in the -- buffer may override the default. -- textViewSetIndent :: TextViewClass self => self -> Int -- ^ @indent@ - indentation in pixels (may be negative) -> IO () textViewSetIndent self indent = {# call text_view_set_indent #} (toTextView self) (fromIntegral indent) -- | Gets the default indentation of paragraphs in the text view. Tags in the -- view's buffer may override the default. The indentation may be negative. -- textViewGetIndent :: TextViewClass self => self -> IO Int -- ^ returns number of pixels of indentation textViewGetIndent self = liftM fromIntegral $ {# call unsafe text_view_get_indent #} (toTextView self) -- | Obtains a copy of the default text attributes. These are the attributes -- used for text unless a tag overrides them. You'd typically pass the default -- attributes in to 'textIterGetAttributes' in order to get the attributes in -- effect at a given text position. -- textViewGetDefaultAttributes :: TextViewClass self => self -> IO TextAttributes textViewGetDefaultAttributes self = {# call gtk_text_view_get_default_attributes #} (toTextView self) >>= makeNewTextAttributes #if GTK_CHECK_VERSION(2,6,0) -- | Retrieves the iterator pointing to the character at buffer coordinates -- @x@ and @y@. Buffer coordinates are coordinates for the entire buffer, not -- just the currently-displayed portion. If you have coordinates from an event, -- you have to convert those to buffer coordinates with -- 'textViewWindowToBufferCoords'. -- -- Note that this is different from 'textViewGetIterAtLocation', which -- returns cursor locations, i.e. positions /between/ characters. -- -- * Available since Gtk+ version 2.6 -- textViewGetIterAtPosition :: TextViewClass self => self -> Int -- ^ @x@ - x position, in buffer coordinates -> Int -- ^ @y@ - y position, in buffer coordinates -> IO (TextIter, Int) -- ^ @(iter, trailing)@ - returns the iterator and -- an integer indicating where in the grapheme the -- user clicked. It will either be zero, or the -- number of characters in the grapheme. 0 represents -- the trailing edge of the grapheme. textViewGetIterAtPosition self x y = alloca $ \trailingPtr -> do iter <- makeEmptyTextIter {# call gtk_text_view_get_iter_at_position #} (toTextView self) iter trailingPtr (fromIntegral x) (fromIntegral y) trailing <- peek trailingPtr return (iter, fromIntegral trailing) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Changes the 'TextView' overwrite mode. -- -- * Available since Gtk+ version 2.4 -- textViewSetOverwrite :: TextViewClass self => self -> Bool -- ^ @overwrite@ - @True@ to turn on overwrite mode, @False@ to turn -- it off -> IO () textViewSetOverwrite self overwrite = {# call gtk_text_view_set_overwrite #} (toTextView self) (fromBool overwrite) -- | Returns whether the 'TextView' is in overwrite mode or not. -- -- * Available since Gtk+ version 2.4 -- textViewGetOverwrite :: TextViewClass self => self -> IO Bool textViewGetOverwrite self = liftM toBool $ {# call gtk_text_view_get_overwrite #} (toTextView self) -- | Sets the behavior of the text widget when the Tab key is pressed. If -- @acceptsTab@ is @True@ a tab character is inserted. If @acceptsTab@ is -- @False@ the keyboard focus is moved to the next widget in the focus chain. -- -- * Available since Gtk+ version 2.4 -- textViewSetAcceptsTab :: TextViewClass self => self -> Bool -- ^ @acceptsTab@ - @True@ if pressing the Tab key should insert a -- tab character, @False@, if pressing the Tab key should move the -- keyboard focus. -> IO () textViewSetAcceptsTab self acceptsTab = {# call gtk_text_view_set_accepts_tab #} (toTextView self) (fromBool acceptsTab) -- | Returns whether pressing the Tab key inserts a tab characters. -- 'textViewSetAcceptsTab'. -- -- * Available since Gtk+ version 2.4 -- textViewGetAcceptsTab :: TextViewClass self => self -> IO Bool -- ^ returns @True@ if pressing the Tab key inserts a tab -- character, @False@ if pressing the Tab key moves the keyboard -- focus. textViewGetAcceptsTab self = liftM toBool $ {# call gtk_text_view_get_accepts_tab #} (toTextView self) #endif #if GTK_CHECK_VERSION(2,22,0) -- | Gets the horizontal-scrolling 'Adjustment'. -- -- * Available since Gtk+ version 2.22 -- textViewGetHadjustment :: TextViewClass self => self -> IO Adjustment textViewGetHadjustment self = makeNewObject mkAdjustment $ {#call gtk_text_view_get_hadjustment #} (toTextView self) -- | Gets the vertical-scrolling 'Adjustment'. -- -- * Available since Gtk+ version 2.22 -- textViewGetVadjustment :: TextViewClass self => self -> IO Adjustment textViewGetVadjustment self = makeNewObject mkAdjustment $ {#call gtk_text_view_get_vadjustment #} (toTextView self) -- | Allow the 'TextView' input method to internally handle key press and release events. If this -- function returns 'True', then no further processing should be done for this key event. See -- 'imContextFilterKeypress'. -- -- Note that you are expected to call this function from your handler when overriding key event -- handling. This is needed in the case when you need to insert your own key handling between the input -- method and the default key event handling of the 'TextView'. -- -- * Available since Gtk+ version 2.22 -- textViewImContextFilterKeypress :: TextViewClass self => self -> EventM EKey Bool textViewImContextFilterKeypress self = do ptr <- ask liftIO $ liftM toBool $ {# call gtk_text_view_im_context_filter_keypress #} (toTextView self) (castPtr ptr) -- | Reset the input method context of the text view if needed. -- -- This can be necessary in the case where modifying the buffer would confuse on-going input method -- behavior. -- -- * Available since Gtk+ version 2.22 -- textViewResetImContext :: TextViewClass self => self -> IO () textViewResetImContext self = {#call gtk_text_view_reset_im_context #} (toTextView self) #endif -------------------- -- Attributes -- | Pixels of blank space above paragraphs. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textViewPixelsAboveLines :: TextViewClass self => Attr self Int textViewPixelsAboveLines = newAttr textViewGetPixelsAboveLines textViewSetPixelsAboveLines -- | Pixels of blank space below paragraphs. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textViewPixelsBelowLines :: TextViewClass self => Attr self Int textViewPixelsBelowLines = newAttr textViewGetPixelsBelowLines textViewSetPixelsBelowLines -- | Pixels of blank space between wrapped lines in a paragraph. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textViewPixelsInsideWrap :: TextViewClass self => Attr self Int textViewPixelsInsideWrap = newAttr textViewGetPixelsInsideWrap textViewSetPixelsInsideWrap -- | Whether the text can be modified by the user. -- -- Default value: @True@ -- textViewEditable :: TextViewClass self => Attr self Bool textViewEditable = newAttr textViewGetEditable textViewSetEditable -- | Which IM (input method) module should be used for this entry. See GtkIMContext. -- Setting this to a non-empty value overrides the system-wide IM module setting. -- See the GtkSettings "gtk-im-module" property. -- -- Default value: \"\" -- textViewImModule :: TextViewClass self => Attr self DefaultGlibString textViewImModule = newAttrFromStringProperty "im-module" -- | Whether to wrap lines never, at word boundaries, or at character -- boundaries. -- -- Default value: 'WrapNone' -- textViewWrapMode :: TextViewClass self => Attr self WrapMode textViewWrapMode = newAttr textViewGetWrapMode textViewSetWrapMode -- | Left, right, or center justification. -- -- Default value: 'JustifyLeft' -- textViewJustification :: TextViewClass self => Attr self Justification textViewJustification = newAttr textViewGetJustification textViewSetJustification -- | Width of the left margin in pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textViewLeftMargin :: TextViewClass self => Attr self Int textViewLeftMargin = newAttr textViewGetLeftMargin textViewSetLeftMargin -- | Width of the right margin in pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textViewRightMargin :: TextViewClass self => Attr self Int textViewRightMargin = newAttr textViewGetRightMargin textViewSetRightMargin -- | Amount to indent the paragraph, in pixels. -- -- Allowed values: >= 0 -- -- Default value: 0 -- textViewIndent :: TextViewClass self => Attr self Int textViewIndent = newAttr textViewGetIndent textViewSetIndent -- | If the insertion cursor is shown. -- -- Default value: @True@ -- textViewCursorVisible :: TextViewClass self => Attr self Bool textViewCursorVisible = newAttr textViewGetCursorVisible textViewSetCursorVisible -- | The buffer which is displayed. -- textViewBuffer :: TextViewClass self => Attr self TextBuffer textViewBuffer = newAttr textViewGetBuffer textViewSetBuffer #if GTK_CHECK_VERSION(2,4,0) -- | Whether entered text overwrites existing contents. -- -- Default value: @False@ -- textViewOverwrite :: TextViewClass self => Attr self Bool textViewOverwrite = newAttr textViewGetOverwrite textViewSetOverwrite -- | Whether Tab will result in a tab character being entered. -- -- Default value: @True@ -- textViewAcceptsTab :: TextViewClass self => Attr self Bool textViewAcceptsTab = newAttr textViewGetAcceptsTab textViewSetAcceptsTab #endif -------------------- -- Signals -- | The 'backspace' signal is a keybinding signal which gets emitted when the user asks for it. -- -- The default bindings for this signal are Backspace and Shift-Backspace. -- backspace :: TextViewClass self => Signal self (IO ()) backspace = Signal (connect_NONE__NONE "on-backspace") -- | Copying to the clipboard. -- -- * This signal is emitted when a selection is copied to the clipboard. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- copyClipboard :: TextViewClass self => Signal self (IO ()) copyClipboard = Signal (connect_NONE__NONE "copy-clipboard") -- | Cutting to the clipboard. -- -- * This signal is emitted when a selection is cut out and copied to the -- clipboard. The action itself happens when the textview processed this -- request. -- cutClipboard :: TextViewClass self => Signal self (IO ()) cutClipboard = Signal (connect_NONE__NONE "cut-clipboard") -- | Deleting text. -- -- * The widget will remove the specified number of units in the text where -- the meaning of units depends on the kind of deletion. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- deleteFromCursor :: TextViewClass self => Signal self (DeleteType -> Int -> IO ()) deleteFromCursor = Signal (connect_ENUM_INT__NONE "delete-from-cursor") -- | Inserting text. -- -- * The widget will insert the string into the text where the meaning -- of units depends on the kind of deletion. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- insertAtCursor :: (TextViewClass self, GlibString string) => Signal self (string -> IO ()) insertAtCursor = Signal (connect_GLIBSTRING__NONE "insert-at-cursor") -- | Moving the cursor. -- -- * The signal specifies what kind and how many steps the cursor will do. -- The flag is set to @True@ if this movement extends a selection. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- moveCursor :: TextViewClass self => Signal self (MovementStep -> Int -> Bool -> IO ()) moveCursor = Signal (connect_ENUM_INT_BOOL__NONE "move-cursor") -- | The 'moveViewport' signal is a keybinding signal which can be bound to key combinations -- to allow the user to move the viewport, i.e. -- change what part of the text view is visible in a containing scrolled window. -- There are no default bindings for this signal. -- moveViewport :: TextViewClass self => Signal self (ScrollStep -> Int -> IO ()) moveViewport = Signal (connect_ENUM_INT__NONE "move-viewport") -- | Moving the focus. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- moveFocus :: TextViewClass self => Signal self (DirectionType -> IO ()) moveFocus = Signal (connect_ENUM__NONE "move-focus") -- | Page change signals. -- -- * The signal specifies how many pages the view should move up or down. -- The flag is set to @True@ if this movement extends a selection. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- -- * Figure out why this signal is called horizontally, not vertically. -- pageHorizontally :: TextViewClass self => Signal self (Int -> Bool -> IO ()) pageHorizontally = Signal (connect_INT_BOOL__NONE "page-horizontally") -- | Pasting from the clipboard. -- -- * This signal is emitted when something is pasted from the clipboard. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- pasteClipboard :: TextViewClass self => Signal self (IO ()) pasteClipboard = Signal (connect_NONE__NONE "paste-clipboard") -- | Add menu entries to context menus. -- -- * This signal is emitted if a context menu within the 'TextView' -- is opened. This signal can be used to add application specific menu -- items to this popup. -- populatePopup :: TextViewClass self => Signal self (Menu -> IO ()) populatePopup = Signal (connect_OBJECT__NONE "populate-popup") -- | Inserting an anchor. -- -- * This signal is emitted when anchor is inserted into the text. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- selectAll :: TextViewClass self => Signal self (Bool -> IO ()) selectAll = Signal (connect_BOOL__NONE "select-all") -- | The scroll-bars changed. -- setAnchor :: TextViewClass self => Signal self (IO ()) setAnchor = Signal (connect_NONE__NONE "set-anchor") -- | The 'setTextViewScrollAdjustments' signal is a keybinding signal which -- gets emitted to toggle the visibility of the cursor. -- The default binding for this signal is F7. -- setTextViewScrollAdjustments :: TextViewClass self => Signal self (Adjustment -> Adjustment -> IO ()) setTextViewScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set-scroll-adjustments") -- | The 'toggleCursorVisible' signal is a keybinding signal -- which gets emitted to toggle the visibility of the cursor. -- The default binding for this signal is F7. -- toggleCursorVisible :: TextViewClass self => Signal self (IO ()) toggleCursorVisible = Signal (connect_NONE__NONE "toggle-cursor-visible") -- | Insert Overwrite mode has changed. -- -- * This signal is emitted when the 'TextView' changes from -- inserting mode to overwriting mode and vice versa. -- -- * The action itself happens when the 'TextView' processes this -- signal. -- toggleOverwrite :: TextViewClass self => Signal self (IO ()) toggleOverwrite = Signal (connect_NONE__NONE "toggle-overwrite") -- | If an input method is used, the typed text will not immediately be committed to the buffer. So if -- you are interested in the text, connect to this signal. -- -- This signal is only emitted if the text at the given position is actually editable. textViewPreeditChanged :: (TextViewClass self, GlibString string) => Signal self (string -> IO ()) textViewPreeditChanged = Signal (connect_GLIBSTRING__NONE "preedit-changed") gtk-0.15.9/Graphics/UI/Gtk/Multiline/Types.chs0000644000000000000000000000342607346545000017140 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Multiline internal types -- -- Author : Axel Simon -- -- Created: 2 March 2006 -- -- Copyright (C) 2002-2006 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 module Graphics.UI.Gtk.Multiline.Types ( -- * Types TextIter(TextIter), -- * Methods textIterCopy, mkTextIterCopy, makeEmptyTextIter ) where import System.Glib.FFI import Graphics.UI.Gtk.General.Structs (textIterSize) {# context lib="gtk" prefix="gtk" #} -- methods {#pointer *TextIter foreign newtype #} -- | Copy the iterator. -- textIterCopy :: TextIter -> IO TextIter textIterCopy (TextIter iter) = do iter' <- mallocForeignPtrBytes textIterSize withForeignPtr iter' $ \iterPtr' -> withForeignPtr iter $ \iterPtr -> copyBytes iterPtr' iterPtr textIterSize return (TextIter iter') -- | Internal marshaling util -- mkTextIterCopy :: Ptr TextIter -> IO TextIter mkTextIterCopy iterPtr = do iter' <- mallocForeignPtrBytes textIterSize withForeignPtr iter' $ \iterPtr' -> copyBytes iterPtr' iterPtr textIterSize return (TextIter iter') -- | Allocate memory to be filled with a TextIter. -- makeEmptyTextIter :: IO TextIter makeEmptyTextIter = do iter <- mallocForeignPtrBytes textIterSize return (TextIter iter) gtk-0.15.9/Graphics/UI/Gtk/Ornaments/0000755000000000000000000000000007346545000015334 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Ornaments/Frame.chs0000644000000000000000000001513007346545000017065 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Frame -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A bin with a decorative frame and optional label -- module Graphics.UI.Gtk.Ornaments.Frame ( -- * Detail -- -- | The frame widget is a Bin that surrounds its child with a decorative -- frame and an optional label. If present, the label is drawn in a gap in the -- top side of the frame. The position of the label can be controlled with -- 'frameSetLabelAlign'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Frame -- | +----'AspectFrame' -- @ -- * Types Frame, FrameClass, castToFrame, gTypeFrame, toFrame, -- * Constructors frameNew, -- * Methods frameSetLabel, frameGetLabel, frameSetLabelWidget, frameGetLabelWidget, frameSetLabelAlign, frameGetLabelAlign, ShadowType(..), frameSetShadowType, frameGetShadowType, -- * Attributes frameLabel, frameLabelXAlign, frameLabelYAlign, frameShadowType, frameLabelWidget, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (ShadowType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Frame' without a label. -- -- * A label can later be set by calling 'frameSetLabel'. -- frameNew :: IO Frame frameNew = makeNewObject mkFrame $ liftM (castPtr :: Ptr Widget -> Ptr Frame) $ {# call unsafe frame_new #} nullPtr -------------------- -- Methods -- | Sets the text of the label. -- frameSetLabel :: (FrameClass self, GlibString string) => self -> string -- ^ @label@ - the text to use as the label of the frame -> IO () frameSetLabel self label = withUTFString label $ \labelPtr -> {# call frame_set_label #} (toFrame self) labelPtr -- | Sets the label widget for the frame. This is the widget that will appear -- embedded in the top edge of the frame as a title. -- frameSetLabelWidget :: (FrameClass self, WidgetClass labelWidget) => self -> labelWidget -> IO () frameSetLabelWidget self labelWidget = {# call frame_set_label_widget #} (toFrame self) (toWidget labelWidget) -- | Retrieves the label widget for the frame. See 'frameSetLabelWidget'. -- frameGetLabelWidget :: FrameClass self => self -> IO (Maybe Widget) -- ^ returns the label widget, or @Nothing@ if there is -- none. frameGetLabelWidget self = maybeNull (makeNewObject mkWidget) $ {# call frame_get_label_widget #} (toFrame self) -- | Sets the alignment of the frame widget's label. The default values for a -- newly created frame are 0.0 and 0.5. -- frameSetLabelAlign :: FrameClass self => self -> Float -- ^ @xalign@ - The position of the label along the top edge of the -- widget. A value of 0.0 represents left alignment; 1.0 represents -- right alignment. -> Float -- ^ @yalign@ - The y alignment of the label. A value of 0.0 aligns -- under the frame; 1.0 aligns above the frame. -> IO () frameSetLabelAlign self xalign yalign = {# call frame_set_label_align #} (toFrame self) (realToFrac xalign) (realToFrac yalign) -- | Retrieves the X and Y alignment of the frame's label. See -- 'frameSetLabelAlign'. -- frameGetLabelAlign :: FrameClass self => self -> IO (Float, Float) -- ^ @(xalign, yalign)@ frameGetLabelAlign self = alloca $ \xalignPtr -> alloca $ \yalignPtr -> do {# call unsafe frame_get_label_align #} (toFrame self) xalignPtr yalignPtr xalign <- peek xalignPtr yalign <- peek yalignPtr return (realToFrac xalign, realToFrac yalign) -- | Sets the shadow type of the frame. -- frameSetShadowType :: FrameClass self => self -> ShadowType -> IO () frameSetShadowType self type_ = {# call frame_set_shadow_type #} (toFrame self) ((fromIntegral . fromEnum) type_) -- | Retrieves the shadow type of the frame. See 'frameSetShadowType'. -- frameGetShadowType :: FrameClass self => self -> IO ShadowType frameGetShadowType self = liftM (toEnum . fromIntegral) $ {# call unsafe frame_get_shadow_type #} (toFrame self) -- | If the frame's label widget is a 'Label', returns the text in the label -- widget. -- frameGetLabel :: (FrameClass self, GlibString string) => self -> IO string -- ^ returns the text in the label, or if there was no label -- widget or the label widget was not a 'Label' then an -- exception is thrown frameGetLabel self = throwIfNull "frameGetLabel: the title of the frame was not a Label widget." ({# call unsafe frame_get_label #} (toFrame self)) >>= peekUTFString -------------------- -- Attributes -- | Text of the frame's label. -- frameLabel :: (FrameClass self, GlibString string) => Attr self string frameLabel = newAttr frameGetLabel frameSetLabel -- | The horizontal alignment of the label. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- frameLabelXAlign :: FrameClass self => Attr self Float frameLabelXAlign = newAttrFromFloatProperty "label-xalign" -- | The vertical alignment of the label. -- -- Allowed values: [0,1] -- -- Default value: 0.5 -- frameLabelYAlign :: FrameClass self => Attr self Float frameLabelYAlign = newAttrFromFloatProperty "label-yalign" -- | Appearance of the frame border. -- -- Default value: 'ShadowEtchedIn' -- frameShadowType :: FrameClass self => Attr self ShadowType frameShadowType = newAttr frameGetShadowType frameSetShadowType -- | A widget to display in place of the usual frame label. -- frameLabelWidget :: (FrameClass self, WidgetClass labelWidget) => ReadWriteAttr self (Maybe Widget) labelWidget frameLabelWidget = newAttr frameGetLabelWidget frameSetLabelWidget gtk-0.15.9/Graphics/UI/Gtk/Ornaments/HSeparator.chs0000644000000000000000000000351507346545000020107 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HSeparator -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A horizontal separator -- module Graphics.UI.Gtk.Ornaments.HSeparator ( -- * Detail -- -- | The 'HSeparator' widget is a horizontal separator, used to group the -- widgets within a window. It displays a horizontal line with a shadow to make -- it appear sunken into the interface. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Separator' -- | +----HSeparator -- @ -- * Types HSeparator, HSeparatorClass, castToHSeparator, gTypeHSeparator, toHSeparator, -- * Constructors hSeparatorNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'HSeparator'. -- hSeparatorNew :: IO HSeparator hSeparatorNew = makeNewObject mkHSeparator $ liftM (castPtr :: Ptr Widget -> Ptr HSeparator) $ {# call unsafe hseparator_new #} gtk-0.15.9/Graphics/UI/Gtk/Ornaments/VSeparator.chs0000644000000000000000000000350707346545000020126 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VSeparator -- -- Author : Axel Simon -- -- Created: 15 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A vertical separator -- module Graphics.UI.Gtk.Ornaments.VSeparator ( -- * Detail -- -- | The 'VSeparator' widget is a vertical separator, used to group the -- widgets within a window. It displays a vertical line with a shadow to make -- it appear sunken into the interface. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Separator' -- | +----VSeparator -- @ -- * Types VSeparator, VSeparatorClass, castToVSeparator, gTypeVSeparator, toVSeparator, -- * Constructors vSeparatorNew, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'VSeparator'. -- vSeparatorNew :: IO VSeparator vSeparatorNew = makeNewObject mkVSeparator $ liftM (castPtr :: Ptr Widget -> Ptr VSeparator) $ {# call unsafe vseparator_new #} gtk-0.15.9/Graphics/UI/Gtk/Printing/0000755000000000000000000000000007346545000015160 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Printing/PageSetup.chs0000644000000000000000000002757207346545000017571 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget PageSetup -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Stores page setup information -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Printing.PageSetup ( -- * Detail -- -- | A 'PageSetup' object stores the page size, orientation and margins. The -- idea is that you can get one of these from the page setup dialog and then -- pass it to the 'PrintOperation' when printing. The benefit of splitting this -- out of the 'PrintSettings' is that these affect the actual layout of the -- page, and thus need to be set long before user prints. -- -- The margins specified in this object are the \"print margins\", i.e. the -- parts of the page that the printer cannot print on. These are different from -- the layout margins that a word processor uses; they are typically used to -- determine the /minimal/ size for the layout margins. -- -- To obtain a 'PageSetup' use 'pageSetupNew' to get the defaults, or use -- 'printRunPageSetupDialog' to show the page setup dialog and receive the -- resulting page setup. -- -- Printing support was added in Gtk+ 2.10. -- -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----PageSetup -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types PageSetup, PageSetupClass, castToPageSetup, toPageSetup, -- * Constructors pageSetupNew, #if GTK_CHECK_VERSION(2,12,0) pageSetupNewFromFile, #endif -- * Methods pageSetupCopy, pageSetupGetTopMargin, pageSetupSetTopMargin, pageSetupGetBottomMargin, pageSetupSetBottomMargin, pageSetupGetLeftMargin, pageSetupSetLeftMargin, pageSetupGetRightMargin, pageSetupSetRightMargin, pageSetupSetPaperSizeAndDefaultMargins, pageSetupGetPaperWidth, pageSetupGetPaperHeight, pageSetupGetPageWidth, pageSetupGetPageHeight, #if GTK_CHECK_VERSION(2,14,0) pageSetupLoadFile, #endif #if GTK_CHECK_VERSION(2,12,0) pageSetupToFile, #endif -- * Attributes pageSetupOrientation, pageSetupPaperSize, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.GError import System.Glib.Attributes import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Printing.PaperSize#} (PaperSize(..), mkPaperSize, Unit(..)) {#import Graphics.UI.Gtk.Printing.PrintSettings#} (PageOrientation (..)) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Constructors -- | Creates a new 'PageSetup'. -- pageSetupNew :: IO PageSetup pageSetupNew = wrapNewGObject mkPageSetup $ {# call gtk_page_setup_new #} #if GTK_CHECK_VERSION(2,12,0) -- | Reads the page setup from the file @fileName@. Returns a new 'PageSetup' -- object with the restored page setup. -- -- * Available since Gtk+ version 2.12 -- pageSetupNewFromFile :: GlibString string => string -- ^ @fileName@ - the filename to read the page setup from -> IO PageSetup pageSetupNewFromFile fileName = propagateGError $ \errorPtr -> withUTFString fileName $ \fileNamePtr -> do setupPtr <- {# call gtk_page_setup_new_from_file #} fileNamePtr errorPtr wrapNewGObject mkPageSetup (return setupPtr) #endif -------------------- -- Methods -- | Copies a 'PageSetup'. -- pageSetupCopy :: PageSetupClass self => self -> IO PageSetup -- ^ returns a copy of @other@ pageSetupCopy self = wrapNewGObject mkPageSetup $ {# call gtk_page_setup_copy #} (toPageSetup self) -- | Gets the page orientation of the 'PageSetup'. pageSetupGetOrientation :: PageSetupClass self => self -> IO PageOrientation -- ^ returns the page orientation pageSetupGetOrientation self = liftM (toEnum . fromIntegral) $ {# call gtk_page_setup_get_orientation #} (toPageSetup self) -- | Sets the page orientation of the 'PageSetup'. pageSetupSetOrientation :: PageSetupClass self => self -> PageOrientation -- ^ @orientation@ - a 'PageOrientation' value -> IO () pageSetupSetOrientation self orientation = {# call gtk_page_setup_set_orientation #} (toPageSetup self) ((fromIntegral . fromEnum) orientation) -- | Gets the paper size of the 'PageSetup'. pageSetupGetPaperSize :: PageSetupClass self => self -> IO PaperSize -- ^ returns the paper size pageSetupGetPaperSize self = {# call gtk_page_setup_get_paper_size #} (toPageSetup self) >>= mkPaperSize . castPtr pageSetupSetPaperSize :: PageSetupClass self => self -> PaperSize -- ^ @size@ - a 'PaperSize' -> IO () pageSetupSetPaperSize self size = {# call gtk_page_setup_set_paper_size #} (toPageSetup self) size -- | Gets the top margin in units of @unit@. -- pageSetupGetTopMargin :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the top margin pageSetupGetTopMargin self unit = liftM realToFrac $ {# call gtk_page_setup_get_top_margin #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Sets the top margin of the 'PageSetup'. -- pageSetupSetTopMargin :: PageSetupClass self => self -> Double -- ^ @margin@ - the new top margin in units of @unit@ -> Unit -- ^ @unit@ - the units for @margin@ -> IO () pageSetupSetTopMargin self margin unit = {# call gtk_page_setup_set_top_margin #} (toPageSetup self) (realToFrac margin) ((fromIntegral . fromEnum) unit) -- | Gets the bottom margin in units of @unit@. -- pageSetupGetBottomMargin :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the bottom margin pageSetupGetBottomMargin self unit = liftM realToFrac $ {# call gtk_page_setup_get_bottom_margin #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Sets the bottom margin of the 'PageSetup'. -- pageSetupSetBottomMargin :: PageSetupClass self => self -> Double -- ^ @margin@ - the new bottom margin in units of @unit@ -> Unit -- ^ @unit@ - the units for @margin@ -> IO () pageSetupSetBottomMargin self margin unit = {# call gtk_page_setup_set_bottom_margin #} (toPageSetup self) (realToFrac margin) ((fromIntegral . fromEnum) unit) -- | Gets the left margin in units of @unit@. -- pageSetupGetLeftMargin :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the left margin pageSetupGetLeftMargin self unit = liftM realToFrac $ {# call gtk_page_setup_get_left_margin #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Sets the left margin of the 'PageSetup'. -- pageSetupSetLeftMargin :: PageSetupClass self => self -> Double -- ^ @margin@ - the new left margin in units of @unit@ -> Unit -- ^ @unit@ - the units for @margin@ -> IO () pageSetupSetLeftMargin self margin unit = {# call gtk_page_setup_set_left_margin #} (toPageSetup self) (realToFrac margin) ((fromIntegral . fromEnum) unit) -- | Gets the right margin in units of @unit@. -- pageSetupGetRightMargin :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the right margin pageSetupGetRightMargin self unit = liftM realToFrac $ {# call gtk_page_setup_get_right_margin #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Sets the right margin of the 'PageSetup'. -- pageSetupSetRightMargin :: PageSetupClass self => self -> Double -- ^ @margin@ - the new right margin in units of @unit@ -> Unit -- ^ @unit@ - the units for @margin@ -> IO () pageSetupSetRightMargin self margin unit = {# call gtk_page_setup_set_right_margin #} (toPageSetup self) (realToFrac margin) ((fromIntegral . fromEnum) unit) -- | Sets the paper size of the 'PageSetup' and modifies the margins according -- to the new paper size. -- pageSetupSetPaperSizeAndDefaultMargins :: PageSetupClass self => self -> PaperSize -- ^ @size@ - a 'PaperSize' -> IO () pageSetupSetPaperSizeAndDefaultMargins self size = {# call gtk_page_setup_set_paper_size_and_default_margins #} (toPageSetup self) size -- | Returns the paper width in units of @unit@. -- -- Note that this function takes orientation, but not margins into -- consideration. See 'pageSetupGetPageWidth'. -- pageSetupGetPaperWidth :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the paper width. pageSetupGetPaperWidth self unit = liftM realToFrac $ {# call gtk_page_setup_get_paper_width #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Returns the paper height in units of @unit@. -- -- Note that this function takes orientation, but not margins into -- consideration. See 'pageSetupGetPageHeight'. -- pageSetupGetPaperHeight :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the paper height. pageSetupGetPaperHeight self unit = liftM realToFrac $ {# call gtk_page_setup_get_paper_height #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Returns the page width in units of @unit@. -- -- Note that this function takes orientation and margins into consideration. -- See 'pageSetupGetPaperWidth'. -- pageSetupGetPageWidth :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the page width. pageSetupGetPageWidth self unit = liftM realToFrac $ {# call gtk_page_setup_get_page_width #} (toPageSetup self) ((fromIntegral . fromEnum) unit) -- | Returns the page height in units of @unit@. -- -- Note that this function takes orientation and margins into consideration. -- See 'pageSetupGetPaperHeight'. -- pageSetupGetPageHeight :: PageSetupClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the page height. pageSetupGetPageHeight self unit = liftM realToFrac $ {# call gtk_page_setup_get_page_height #} (toPageSetup self) ((fromIntegral . fromEnum) unit) #if GTK_CHECK_VERSION(2,14,0) -- | Reads the page setup from the file @fileName@. See 'pageSetupToFile'. -- -- * Available since Gtk+ version 2.14 -- pageSetupLoadFile :: (PageSetupClass self, GlibString string) => self -> string -- ^ @fileName@ - the filename to read the page setup from -> IO Bool -- ^ returns @True@ on success pageSetupLoadFile self fileName = liftM toBool $ propagateGError $ \errorPtr -> withUTFString fileName $ \fileNamePtr -> {# call gtk_page_setup_load_file #} (toPageSetup self) fileNamePtr errorPtr #endif #if GTK_CHECK_VERSION(2,12,0) -- | This function saves the information from @setup@ to @fileName@. -- -- * Available since Gtk+ version 2.12 -- pageSetupToFile :: (PageSetupClass self, GlibString string) => self -> string -- ^ @fileName@ - the file to save to -> IO Bool -- ^ returns @True@ on success pageSetupToFile self fileName = liftM toBool $ propagateGError $ \errorPtr -> withUTFString fileName $ \fileNamePtr -> {# call gtk_page_setup_to_file #} (toPageSetup self) fileNamePtr errorPtr #endif -- | The page orientation of the 'PageSetup'. pageSetupOrientation :: PageSetupClass self => Attr self PageOrientation pageSetupOrientation = newAttr pageSetupGetOrientation pageSetupSetOrientation -- | The paper size of the 'PageSetup'. pageSetupPaperSize :: PageSetupClass self => Attr self PaperSize pageSetupPaperSize = newAttr pageSetupGetPaperSize pageSetupSetPaperSize #endif gtk-0.15.9/Graphics/UI/Gtk/Printing/PaperSize.chs0000644000000000000000000002415707346545000017572 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget PaperSize -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Support for named paper sizes -- module Graphics.UI.Gtk.Printing.PaperSize ( -- * Detail -- -- | 'PaperSize' handles paper sizes. It uses the -- standard called \"PWG 5101.1-2002 PWG: Standard for Media Standardized -- Names\" to name the paper sizes (and to get the data for the page sizes). In -- addition to standard paper sizes, 'PaperSize' allows -- to construct custom paper sizes with arbitrary dimensions. -- -- The 'PaperSize' object stores not only the -- dimensions (width and height) of a paper size and its name, it also provides -- default print margins. -- -- Printing support has been added in Gtk+ 2.10. #if GTK_CHECK_VERSION(2,10,0) -- * Types PaperSize(..), mkPaperSize, -- * Enums Unit(..), -- * Constructors paperSizeNew, paperSizeNewFromPpd, paperSizeNewCustom, -- * Methods paperSizeCopy, paperSizeIsEqual, paperSizeGetName, paperSizeGetDisplayName, paperSizeGetPpdName, paperSizeGetWidth, paperSizeGetHeight, paperSizeIsCustom, paperSizeSetSize, paperSizeGetDefaultTopMargin, paperSizeGetDefaultBottomMargin, paperSizeGetDefaultLeftMargin, paperSizeGetDefaultRightMargin, paperSizeGetDefault, #endif #if GTK_CHECK_VERSION(2,12,0) paperSizeGetPaperSizes, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList {# context lib="gtk" prefix="gtk" #} -------------------- -- Types {#pointer *PaperSize foreign newtype#} -------------------- -- Enums {#enum Unit {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Constructors mkPaperSize :: Ptr PaperSize -> IO PaperSize mkPaperSize pPtr = do size <- newForeignPtr pPtr paper_size_free return (PaperSize size) foreign import ccall unsafe ">k_paper_size_free" paper_size_free :: FinalizerPtr PaperSize #if GTK_CHECK_VERSION(2,10,0) -- | Creates a new 'PaperSize' object by parsing a PWG -- 5101.1-2002 paper name. -- -- If @name@ is Nothing, the default paper size is returned, see 'paperSizeGetDefault'. -- -- * Available since Gtk+ version 2.10 -- paperSizeNew :: GlibString string => Maybe string -- ^ @name@ - a paper size name, or 'Nothing' -> IO PaperSize paperSizeNew name = maybeWith withUTFString name $ \namePtr -> {# call gtk_paper_size_new #} namePtr >>= mkPaperSize -- | Creates a new 'PaperSize' object by using PPD -- information. -- -- If @ppdName@ is not a recognized PPD paper name, @ppdDisplayName@, -- @width@ and @height@ are used to construct a custom 'PaperSize' object. -- -- * Available since Gtk+ version 2.10 -- paperSizeNewFromPpd :: GlibString string => string -- ^ @ppdName@ - a PPD paper name -> string -- ^ @ppdDisplayName@ - the corresponding human-readable name -> Double -- ^ @width@ - the paper width, in points -> Double -- ^ @height@ - the paper height in points -> IO PaperSize paperSizeNewFromPpd ppdName ppdDisplayName width height = withUTFString ppdDisplayName $ \ppdDisplayNamePtr -> withUTFString ppdName $ \ppdNamePtr -> {# call gtk_paper_size_new_from_ppd #} ppdNamePtr ppdDisplayNamePtr (realToFrac width) (realToFrac height) >>= mkPaperSize -- | Creates a new 'PaperSize' object with the given -- parameters. -- -- * Available since Gtk+ version 2.10 -- paperSizeNewCustom :: GlibString string => string -- ^ @name@ - the paper name -> string -- ^ @displayName@ - the human-readable name -> Double -- ^ @width@ - the paper width, in units of @unit@ -> Double -- ^ @height@ - the paper height, in units of @unit@ -> Unit -- ^ @unit@ - the unit for @width@ and @height@ -> IO PaperSize paperSizeNewCustom name displayName width height unit = withUTFString displayName $ \displayNamePtr -> withUTFString name $ \namePtr -> {# call gtk_paper_size_new_custom #} namePtr displayNamePtr (realToFrac width) (realToFrac height) ((fromIntegral . fromEnum) unit) >>= mkPaperSize -------------------- -- Methods -- | Copies an existing 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeCopy :: PaperSize -> IO PaperSize -- ^ returns a copy of @other@ paperSizeCopy self = {# call gtk_paper_size_copy #} self >>= mkPaperSize -- | Compares two 'PaperSize' objects. -- -- * Available since Gtk+ version 2.10 -- paperSizeIsEqual :: PaperSize -> PaperSize -- ^ @size2@ - another 'PaperSize' object -> IO Bool -- ^ returns @True@, if @size1@ and @size2@ represent -- the same paper size paperSizeIsEqual self size2 = liftM toBool $ {# call gtk_paper_size_is_equal #} self size2 -- | Gets the name of the 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetName :: GlibString string => PaperSize -> IO string -- ^ returns the name of @size@ paperSizeGetName self = {# call gtk_paper_size_get_name #} self >>= peekUTFString -- | Gets the human-readable name of the 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetDisplayName :: GlibString string => PaperSize -> IO string -- ^ returns the human-readable name of @size@ paperSizeGetDisplayName self = {# call gtk_paper_size_get_display_name #} self >>= peekUTFString -- | Gets the PPD name of the 'PaperSize', which may be -- -- * Available since Gtk+ version 2.10 -- paperSizeGetPpdName :: GlibString string => PaperSize -> IO (Maybe string) -- ^ returns the PPD name of @size@, or 'Nothing' paperSizeGetPpdName self = {# call gtk_paper_size_get_ppd_name #} self >>= maybePeekUTFString -- | Gets the paper width of the 'PaperSize', in units -- of @unit@. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetWidth :: PaperSize -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the paper width paperSizeGetWidth self unit = liftM realToFrac $ {# call gtk_paper_size_get_width #} self ((fromIntegral . fromEnum) unit) -- | Gets the paper height of the 'PaperSize', in units -- of @unit@. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetHeight :: PaperSize -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the paper height paperSizeGetHeight self unit = liftM realToFrac $ {# call gtk_paper_size_get_height #} self ((fromIntegral . fromEnum) unit) -- | Returns @True@ if @size@ is not a standard paper size. -- paperSizeIsCustom :: PaperSize -> IO Bool -- ^ returns whether @size@ is a custom paper size. paperSizeIsCustom self = liftM toBool $ {# call gtk_paper_size_is_custom #} self -- | Changes the dimensions of a @size@ to @width@ x @height@. -- -- * Available since Gtk+ version 2.10 -- paperSizeSetSize :: PaperSize -> Double -- ^ @width@ - the new width in units of @unit@ -> Double -- ^ @height@ - the new height in units of @unit@ -> Unit -- ^ @unit@ - the unit for @width@ and @height@ -> IO () paperSizeSetSize self width height unit = {# call gtk_paper_size_set_size #} self (realToFrac width) (realToFrac height) ((fromIntegral . fromEnum) unit) -- | Gets the default top margin for the 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetDefaultTopMargin :: PaperSize -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the default top margin paperSizeGetDefaultTopMargin self unit = liftM realToFrac $ {# call gtk_paper_size_get_default_top_margin #} self ((fromIntegral . fromEnum) unit) -- | Gets the default bottom margin for the 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetDefaultBottomMargin :: PaperSize -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the default bottom margin paperSizeGetDefaultBottomMargin self unit = liftM realToFrac $ {# call gtk_paper_size_get_default_bottom_margin #} self ((fromIntegral . fromEnum) unit) -- | Gets the default left margin for the 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetDefaultLeftMargin :: PaperSize -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the default left margin paperSizeGetDefaultLeftMargin self unit = liftM realToFrac $ {# call gtk_paper_size_get_default_left_margin #} self ((fromIntegral . fromEnum) unit) -- | Gets the default right margin for the 'PaperSize'. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetDefaultRightMargin :: PaperSize -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the default right margin paperSizeGetDefaultRightMargin self unit = liftM realToFrac $ {# call gtk_paper_size_get_default_right_margin #} self ((fromIntegral . fromEnum) unit) -- | Returns the name of the default paper size, which depends on the current -- locale. -- -- * Available since Gtk+ version 2.10 -- paperSizeGetDefault :: GlibString string => IO string -- ^ returns the name of the default paper size. paperSizeGetDefault = {# call gtk_paper_size_get_default #} >>= peekUTFString #endif #if GTK_CHECK_VERSION(2,12,0) -- | Creates a list of known paper sizes. -- -- * Available since Gtk+ version 2.12 -- paperSizeGetPaperSizes :: Bool -- ^ @includeCustom@ - whether to include custom -- paper sizes as defined in the page setup dialog -> IO [PaperSize] paperSizeGetPaperSizes includeCustom = do glist <- {# call gtk_paper_size_get_paper_sizes #} (fromBool includeCustom) list <- fromGList glist mapM mkPaperSize list #endif gtk-0.15.9/Graphics/UI/Gtk/Printing/PrintContext.chs0000644000000000000000000001631007346545000020321 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget PrintContext -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Encapsulates context for drawing pages -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Printing.PrintContext ( -- * Detail -- -- | A 'PrintContext' encapsulates context information that is required when -- drawing pages for printing, such as the cairo context and important -- parameters like page size and resolution. It also lets you easily create -- 'PangoLayout' and 'Context' objects that match the font metrics of the cairo -- surface. -- -- 'PrintContext' objects gets passed to the 'beginPrint', 'endPrint', -- 'requestPageSetup' and 'drawPage' signals on the 'PrintOperation'. -- -- Printing support was added in Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----PrintContext -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types PrintContext, PrintContextClass, castToPrintContext, toPrintContext, -- * Methods printContextGetCairoContext, printContextSetCairoContext, printContextGetPageSetup, printContextGetWidth, printContextGetHeight, printContextGetDpiX, printContextGetDpiY, printContextGetPangoFontmap, printContextCreatePangoContext, printContextCreatePangoLayout, #if GTK_CHECK_VERSION(2,20,0) printContextGetHardMargins, #endif #endif ) where import Control.Monad (liftM) import Data.IORef (newIORef) import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {#import Graphics.Rendering.Pango.Types#} {#import Graphics.Rendering.Pango.BasicTypes#} {#import Graphics.Rendering.Cairo.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Methods -- | Obtains the cairo context that is associated with the 'PrintContext'. -- printContextGetCairoContext :: PrintContextClass self => self -> IO Cairo -- ^ returns the cairo context of @context@ printContextGetCairoContext self = liftM Cairo $ {# call gtk_print_context_get_cairo_context #} (toPrintContext self) -- | Sets a new cairo context on a print context. -- -- This function is intended to be used when implementing an internal print -- preview, it is not needed for printing, since Gtk+ itself creates a suitable -- cairo context in that case. -- printContextSetCairoContext :: PrintContextClass self => self -> Cairo -- ^ @cr@ - the cairo context -> Double -- ^ @dpiX@ - the horizontal resolution to use with @cr@ -> Double -- ^ @dpiY@ - the vertical resolution to use with @cr@ -> IO () printContextSetCairoContext self cr dpiX dpiY = {# call gtk_print_context_set_cairo_context #} (toPrintContext self) cr (realToFrac dpiX) (realToFrac dpiY) -- | Obtains the 'PageSetup' that determines the page dimensions of the -- 'PrintContext'. -- printContextGetPageSetup :: PrintContextClass self => self -> IO PageSetup -- ^ returns the page setup of @context@ printContextGetPageSetup self = makeNewGObject mkPageSetup $ {# call gtk_print_context_get_page_setup #} (toPrintContext self) -- | Obtains the width of the 'PrintContext', in pixels. -- printContextGetWidth :: PrintContextClass self => self -> IO Double -- ^ returns the width of @context@ printContextGetWidth self = liftM realToFrac $ {# call gtk_print_context_get_width #} (toPrintContext self) -- | Obtains the height of the 'PrintContext', in pixels. -- printContextGetHeight :: PrintContextClass self => self -> IO Double -- ^ returns the height of @context@ printContextGetHeight self = liftM realToFrac $ {# call gtk_print_context_get_height #} (toPrintContext self) -- | Obtains the horizontal resolution of the 'PrintContext', in dots per -- inch. -- printContextGetDpiX :: PrintContextClass self => self -> IO Double -- ^ returns the horizontal resolution of @context@ printContextGetDpiX self = liftM realToFrac $ {# call gtk_print_context_get_dpi_x #} (toPrintContext self) -- | Obtains the vertical resolution of the 'PrintContext', in dots per inch. -- printContextGetDpiY :: PrintContextClass self => self -> IO Double -- ^ returns the vertical resolution of @context@ printContextGetDpiY self = liftM realToFrac $ {# call gtk_print_context_get_dpi_y #} (toPrintContext self) -- | Returns a 'FontMap' that is suitable for use with the 'PrintContext'. -- printContextGetPangoFontmap :: PrintContextClass self => self -> IO FontMap -- ^ returns the font map of @context@ printContextGetPangoFontmap self = makeNewGObject mkFontMap $ {# call gtk_print_context_get_pango_fontmap #} (toPrintContext self) -- | Creates a new 'Context' that can be used with the 'PrintContext'. -- printContextCreatePangoContext :: PrintContextClass self => self -> IO PangoContext -- ^ returns a new Pango context for @context@ printContextCreatePangoContext self = wrapNewGObject mkPangoContext $ {# call gtk_print_context_create_pango_context #} (toPrintContext self) -- | Creates a new 'PangoLayout' that is suitable for use with the -- 'PrintContext'. -- printContextCreatePangoLayout :: PrintContextClass self => self -> IO PangoLayout -- ^ returns a new Pango layout for @context@ printContextCreatePangoLayout self = do pl <- wrapNewGObject mkPangoLayoutRaw $ {# call gtk_print_context_create_pango_layout #} (toPrintContext self) ps <- makeNewPangoString (""::DefaultGlibString) psRef <- newIORef ps return (PangoLayout psRef pl) #if GTK_CHECK_VERSION(2,20,0) printContextGetHardMargins :: PrintContextClass self => self -> IO (Maybe (Double, Double, Double, Double)) -- ^ returns @(top, bottom, left, right)@ -- @top@ top hardware printer margin -- @bottom@ bottom hardware printer margin -- @left@ left hardware printer margin -- @right@ right hardware printer margin printContextGetHardMargins self = alloca $ \ topPtr -> alloca $ \ bottomPtr -> alloca $ \ leftPtr -> alloca $ \ rightPtr -> do success <- liftM toBool $ {#call gtk_print_context_get_hard_margins #} (toPrintContext self) topPtr bottomPtr leftPtr rightPtr if success then do top <- liftM realToFrac $ peek topPtr bottom <- liftM realToFrac $ peek bottomPtr left <- liftM realToFrac $ peek leftPtr right <- liftM realToFrac $ peek rightPtr return $ Just (top, bottom, left, right) else return Nothing #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Printing/PrintOperation.chs0000644000000000000000000011151207346545000020635 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget PrintOperation -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- High-level Printing API -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Printing.PrintOperation ( -- * Detail -- -- | 'PrintOperation' is the high-level, portable printing API. It looks a bit -- different than other Gtk+ dialogs such as the 'FileChooser', since some -- platforms don't expose enough infrastructure to implement a good print -- dialog. On such platforms, 'PrintOperation' uses the native print dialog. On -- platforms which do not provide a native print dialog, Gtk+ uses its own, see -- 'PrintUnixDialog'. -- -- The typical way to use the high-level printing API is to create a -- 'PrintOperation' object with 'printOperationNew' when the user selects to -- print. Then you set some properties on it, e.g. the page size, any -- 'PrintSettings' from previous print operations, the number of pages, the -- current page, etc. -- -- Then you start the print operation by calling 'printOperationRun'. It -- will then show a dialog, let the user select a printer and options. When the -- user finished the dialog various signals will be emitted on the -- 'PrintOperation', the main one being 'draw-page' signal, which you are supposed to -- catch and render the page on the provided 'PrintContext' using Cairo. -- -- By default 'PrintOperation' uses an external application to do print -- preview. To implement a custom print preview, an application must connect to -- the preview signal. The functions 'printOperationPrintPreviewRenderPage', -- 'printOperationPreviewEndPreview' and 'printOperationPreviewIsSelected' are -- useful when implementing a print preview. -- -- Printing support was added in Gtk+ 2.10. -- -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----PrintOperation -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types PrintOperation, PrintOperationClass, castToPrintOperation, toPrintOperation, PrintOperationPreview, PrintOperationPreviewClass, castToPrintOperationPreview, toPrintOperationPreview, -- * Enums PrintStatus(..), PrintOperationAction(..), PrintOperationResult(..), PrintError(..), -- * Constructors printOperationNew, -- * Methods printOperationSetAllowAsync, printOperationGetError, printOperationSetJobName, printOperationSetNPages, #if GTK_CHECK_VERSION(2,18,0) printOperationGetNPagesToPrint, #endif printOperationSetCurrentPage, printOperationSetUseFullPage, printOperationSetUnit, printOperationSetExportFilename, printOperationSetShowProgress, printOperationSetTrackPrintStatus, printOperationSetCustomTabLabel, printOperationRun, printOperationCancel, #if GTK_CHECK_VERSION(2,16,0) printOperationDrawPageFinish, printOperationSetDeferDrawing, #endif printOperationGetStatus, printOperationGetStatusString, printOperationIsFinished, printRunPageSetupDialog, printRunPageSetupDialogAsync, printOperationPreviewEndPreview, printOperationPreviewIsSelected, printOperationPreviewRenderPage, -- * Attributes printOperationDefaultPageSetup, printOperationPrintSettings, printOperationJobName, printOperationNPages, printOperationCurrentPage, printOperationUseFullPage, printOperationTrackPrintStatus, printOperationUnit, printOperationShowProgress, printOperationAllowAsync, printOperationExportFilename, printOperationStatus, printOperationStatusString, printOperationCustomTabLabel, #if GTK_CHECK_VERSION(2,18,0) printOperationSupportSelection, printOperationHasSelection, printOperationEmbedPageSetup, printOperationNPagesToPrint, #endif -- * Signals printOptDone, printOptBeginPrint, printOptPaginate, printOptRequestPageSetup, printOptDrawPage, printOptEndPrint, printOptStatusChanged, printOptCreateCustomWidget, #if GTK_CHECK_VERSION(2,18,0) printOptUpdateCustomWidget, #endif printOptCustomWidgetApply, printOptPreview, printOptReady, printOptGotPageSize, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import System.Glib.UTFString import System.Glib.GError {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.Printing.PaperSize (Unit(..)) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Interfaces instance PrintOperationPreviewClass PrintOperation -------------------- -- Enums -- | The status gives a rough indication of the completion of a running print operation. {#enum PrintStatus {underscoreToCase} deriving (Bounded,Eq,Show)#} -- | The action parameter to 'printOperationRun' determines what action the print operation should -- perform. {#enum PrintOperationAction {underscoreToCase} deriving (Bounded,Eq,Show)#} -- | A value of this type is returned by 'printOperationRun'. {#enum PrintOperationResult {underscoreToCase} deriving (Bounded,Eq,Show)#} -- | Error codes that identify various errors that can occur while using the GTK+ printing support. {#enum PrintError {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Constructors -- | Creates a new 'PrintOperation'. -- printOperationNew :: IO PrintOperation printOperationNew = wrapNewGObject mkPrintOperation $ {# call gtk_print_operation_new #} -------------------- -- Methods -- | Sets whether the 'printOperationRun' may return before the print -- operation is completed. Note that some platforms may not allow asynchronous -- operation. -- printOperationSetAllowAsync :: PrintOperationClass self => self -> Bool -- ^ @allowAsync@ - @True@ to allow asynchronous operation -> IO () printOperationSetAllowAsync self allowAsync = {# call gtk_print_operation_set_allow_async #} (toPrintOperation self) (fromBool allowAsync) -- | Call this when the result of a print operation is -- 'PrintOperationResultError', either as returned by 'printOperationRun', or -- in the 'done' signal handler. The returned -- 'GError' will contain more details on what went wrong. -- printOperationGetError :: PrintOperationClass self => self -> IO () printOperationGetError self = propagateGError $ \errorPtr -> {# call gtk_print_operation_get_error #} (toPrintOperation self) errorPtr -- | Sets the name of the print job. The name is used to identify the job -- (e.g. in monitoring applications like eggcups). -- -- If you don't set a job name, Gtk+ picks a default one by numbering -- successive print jobs. -- printOperationSetJobName :: (PrintOperationClass self, GlibString string) => self -> string -- ^ @jobName@ - a string that identifies the print job -> IO () printOperationSetJobName self jobName = withUTFString jobName $ \jobNamePtr -> {# call gtk_print_operation_set_job_name #} (toPrintOperation self) jobNamePtr -- | Sets the number of pages in the document. -- -- This /must/ be set to a positive number before the rendering starts. It -- may be set in a 'beginPrint' signal handler. -- -- Note that the page numbers passed to the 'requestPageSetup' -- and 'drawPage' signals -- are 0-based, i.e. if the user chooses to print all pages, the last -- 'draw-page' signal will be for page @nPages@ - 1. -- printOperationSetNPages :: PrintOperationClass self => self -> Int -- ^ @nPages@ - the number of pages -> IO () printOperationSetNPages self nPages = {# call gtk_print_operation_set_n_pages #} (toPrintOperation self) (fromIntegral nPages) #if GTK_CHECK_VERSION(2,18,0) -- | Returns the number of pages that will be printed. -- -- Note that this value is set during print preparation phase -- ('PrintStatusPreparing'), so this function should never be called before the -- data generation phase ('PrintStatusGeneratingData'). You can connect to the -- 'statusChanged' signal and call -- 'printOperationGetNPagesToPrint' when print status is -- 'PrintStatusGeneratingData'. This is typically used to track the progress of -- print operation. -- -- * Available since Gtk+ version 2.18 -- printOperationGetNPagesToPrint :: PrintOperationClass self => self -> IO Int -- ^ returns the number of pages that will be printed printOperationGetNPagesToPrint self = liftM fromIntegral $ {# call gtk_print_operation_get_n_pages_to_print #} (toPrintOperation self) #endif -- | Sets the current page. -- -- If this is called before 'printOperationRun', the user will be able to -- select to print only the current page. -- -- Note that this only makes sense for pre-paginated documents. -- printOperationSetCurrentPage :: PrintOperationClass self => self -> Int -- ^ @currentPage@ - the current page, 0-based -> IO () printOperationSetCurrentPage self currentPage = {# call gtk_print_operation_set_current_page #} (toPrintOperation self) (fromIntegral currentPage) -- | If @fullPage@ is @True@, the transformation for the cairo context -- obtained from 'PrintContext' puts the origin at the top left corner of the -- page (which may not be the top left corner of the sheet, depending on page -- orientation and the number of pages per sheet). Otherwise, the origin is at -- the top left corner of the imageable area (i.e. inside the margins). -- printOperationSetUseFullPage :: PrintOperationClass self => self -> Bool -- ^ @fullPage@ - @True@ to set up the 'PrintContext' for the full -- page -> IO () printOperationSetUseFullPage self fullPage = {# call gtk_print_operation_set_use_full_page #} (toPrintOperation self) (fromBool fullPage) -- | Sets up the transformation for the cairo context obtained from -- 'PrintContext' in such a way that distances are measured in units of @unit@. -- printOperationSetUnit :: PrintOperationClass self => self -> Unit -- ^ @unit@ - the unit to use -> IO () printOperationSetUnit self unit = {# call gtk_print_operation_set_unit #} (toPrintOperation self) ((fromIntegral . fromEnum) unit) -- | Sets up the 'PrintOperation' to generate a file instead of showing the -- print dialog. The intended use of this function is for implementing \"Export -- to PDF\" actions. Currently, PDF is the only supported format. -- -- \"Print to PDF\" support is independent of this and is done by letting -- the user pick the \"Print to PDF\" item from the list of printers in the -- print dialog. -- printOperationSetExportFilename :: (PrintOperationClass self, GlibString string) => self -> string -- ^ @filename@ - the filename for the exported file -> IO () printOperationSetExportFilename self filename = withUTFString filename $ \filenamePtr -> {# call gtk_print_operation_set_export_filename #} (toPrintOperation self) filenamePtr -- | If @showProgress@ is @True@, the print operation will show a progress -- dialog during the print operation. -- printOperationSetShowProgress :: PrintOperationClass self => self -> Bool -- ^ @showProgress@ - @True@ to show a progress dialog -> IO () printOperationSetShowProgress self showProgress = {# call gtk_print_operation_set_show_progress #} (toPrintOperation self) (fromBool showProgress) -- | If track_status is @True@, the print operation will try to continue -- report on the status of the print job in the printer queues and printer. -- This can allow your application to show things like \"out of paper\" issues, -- and when the print job actually reaches the printer. -- -- This function is often implemented using some form of polling, so it -- should not be enabled unless needed. -- printOperationSetTrackPrintStatus :: PrintOperationClass self => self -> Bool -- ^ @trackStatus@ - @True@ to track status after printing -> IO () printOperationSetTrackPrintStatus self trackStatus = {# call gtk_print_operation_set_track_print_status #} (toPrintOperation self) (fromBool trackStatus) -- | Sets the label for the tab holding custom widgets. -- printOperationSetCustomTabLabel :: (PrintOperationClass self, GlibString string) => self -> string -- ^ @label@ - the label to use, or empty to use the default -- label -> IO () printOperationSetCustomTabLabel self label = withUTFString label $ \labelPtr -> {# call gtk_print_operation_set_custom_tab_label #} (toPrintOperation self) labelPtr -- | Runs the print operation, by first letting the user modify print settings -- in the print dialog, and then print the document. -- -- Normally that this function does not return until the rendering of all -- pages is complete. You can connect to the 'statusChanged' signal on @op@ to obtain some information about the -- progress of the print operation. Furthermore, it may use a recursive -- mainloop to show the print dialog. -- -- If you call 'printOperationSetAllowAsync' or set the 'allowAsync' -- property the operation will run asynchronously -- if this is supported on the platform. The 'done' signal will be emitted with the result of the operation when -- the it is done (i.e. when the dialog is canceled, or when the print succeeds -- or fails). -- printOperationRun :: (PrintOperationClass self, WindowClass parent) => self -> PrintOperationAction -- ^ @action@ - the action to start -> parent -- ^ @parent@ - Transient parent of the dialog -> IO PrintOperationResult -- ^ returns the result of the print operation. A -- return value of 'PrintOperationResultApply' -- indicates that the printing was completed -- successfully. In this case, it is a good idea to -- obtain the used print settings with -- 'printOperationGetPrintSettings' and store them -- for reuse with the next print operation. A value -- of 'PrintOperationResultInProgress' means the -- operation is running asynchronously, and will -- emit the 'done' signal when done. printOperationRun self action parent = liftM (toEnum . fromIntegral) $ propagateGError $ \errorPtr -> {# call gtk_print_operation_run #} (toPrintOperation self) ((fromIntegral . fromEnum) action) (toWindow parent) errorPtr -- | Cancels a running print operation. This function may be called from a -- 'beginPrint', 'paginate' or 'drawPage' signal handler -- to stop the currently running print operation. -- printOperationCancel :: PrintOperationClass self => self -> IO () printOperationCancel self = {# call gtk_print_operation_cancel #} (toPrintOperation self) #if GTK_CHECK_VERSION(2,16,0) -- | Signalize that drawing of particular page is complete. -- -- It is called after completion of page drawing (e.g. drawing in another -- thread). If 'printOperationSetDeferDrawing' was called before, then this -- function has to be called by application. In another case it is called by -- the library itself. -- -- * Available since Gtk+ version 2.16 -- printOperationDrawPageFinish :: PrintOperationClass self => self -> IO () printOperationDrawPageFinish self = {# call gtk_print_operation_draw_page_finish #} (toPrintOperation self) -- | Sets up the 'PrintOperation' to wait for calling of -- 'printOperationDrawPageFinish' from application. It can be used for drawing -- page in another thread. -- -- This function must be called in the callback of \"draw-page\" signal. -- -- * Available since Gtk+ version 2.16 -- printOperationSetDeferDrawing :: PrintOperationClass self => self -> IO () printOperationSetDeferDrawing self = {# call gtk_print_operation_set_defer_drawing #} (toPrintOperation self) #endif -- | Returns the status of the print operation. Also see -- 'printOperationGetStatusString'. -- printOperationGetStatus :: PrintOperationClass self => self -> IO PrintStatus -- ^ returns the status of the print operation printOperationGetStatus self = liftM (toEnum . fromIntegral) $ {# call gtk_print_operation_get_status #} (toPrintOperation self) -- | Returns a string representation of the status of the print operation. The -- string is translated and suitable for displaying the print status e.g. in a -- 'Statusbar'. -- -- Use 'printOperationGetStatus' to obtain a status value that is suitable -- for programmatic use. -- printOperationGetStatusString :: (PrintOperationClass self, GlibString string) => self -> IO string -- ^ returns a string representation of the status of the print -- operation printOperationGetStatusString self = {# call gtk_print_operation_get_status_string #} (toPrintOperation self) >>= peekUTFString -- | A convenience function to find out if the print operation is finished, -- either successfully ('PrintStatusFinished') or unsuccessfully -- ('PrintStatusFinishedAborted'). -- -- Note: when you enable print status tracking the print operation can be in -- a non-finished state even after done has been called, as the operation -- status then tracks the print job status on the printer. -- printOperationIsFinished :: PrintOperationClass self => self -> IO Bool -- ^ returns @True@, if the print operation is finished. printOperationIsFinished self = liftM toBool $ {# call gtk_print_operation_is_finished #} (toPrintOperation self) -- | Runs a page setup dialog, letting the user modify the values from @pageSetup@. If the user cancels -- the dialog, the returned 'PageSetup' is identical to the passed in @pageSetup@, otherwise it -- contains the modifications done in the dialog. -- -- Note that this function may use a recursive mainloop to show the page setup dialog. See -- 'printRunPageSetupDialogAsync' if this is a problem. printRunPageSetupDialog :: (WindowClass window, PageSetupClass pageSetup, PrintSettingsClass setting) => window -- ^ @parent@ transient parent. -> pageSetup -- ^ @pageSetup@ an existing 'PageSetup'. -> setting -- ^ @settings@ a 'PrintSettings' -> IO PageSetup -- ^ returns a new 'PageSetup' printRunPageSetupDialog window pageSetup setting = wrapNewGObject mkPageSetup $ {#call gtk_print_run_page_setup_dialog #} (toWindow window) (toPageSetup pageSetup) (toPrintSettings setting) {#pointer PageSetupDoneFunc#} foreign import ccall "wrapper" mkGtkPageSetupDoneFunc :: (Ptr PageSetup -> Ptr () -> IO ()) -> IO PageSetupDoneFunc -- | Runs a page setup dialog, letting the user modify the values from @pageSetup@. -- -- In contrast to 'printRunPageSetupDialog', this function returns after showing the page setup -- dialog on platforms that support this, and calls @doneCb@ from a signal handler for the 'response' -- signal of the dialog. printRunPageSetupDialogAsync :: (WindowClass window, PageSetupClass pageSetup, PrintSettingsClass setting) => window -- ^ @parent@ transient parent. -> pageSetup -- ^ @pageSetup@ an existing 'PageSetup'. -> setting -- ^ @settings@ a 'PrintSettings' -> (PageSetup -> IO ()) -- ^ @doneCb@ a function to call when the user saves the modified page setup -> IO () printRunPageSetupDialogAsync window pageSetup setting doneCb = do funcPtr <- mkGtkPageSetupDoneFunc $ \setupPtr _ -> do setup <- makeNewGObject mkPageSetup (return setupPtr) doneCb setup {#call gtk_print_run_page_setup_dialog_async #} (toWindow window) (toPageSetup pageSetup) (toPrintSettings setting) funcPtr nullPtr -- | Ends a preview. -- -- This function must be called to finish a custom print preview. printOperationPreviewEndPreview :: PrintOperationPreviewClass self => self -> IO () printOperationPreviewEndPreview self = {# call gtk_print_operation_preview_end_preview #} (toPrintOperationPreview self) -- | Returns whether the given page is included in the set of pages that have been selected for printing. printOperationPreviewIsSelected :: PrintOperationPreviewClass self => self -- ^ @preview@ a 'PrintOperationPreview' -> Int -- ^ @pageNr@ a page number -> IO Bool -- ^ returns 'True' if the page has been selected for printing printOperationPreviewIsSelected self pageNr = liftM toBool $ {# call gtk_print_operation_preview_is_selected #} (toPrintOperationPreview self) (fromIntegral pageNr) -- | Renders a page to the preview, using the print context that was passed to the "preview" handler -- together with preview. -- -- A custom iprint preview should use this function in its 'expose' handler to render the currently -- selected page. -- -- Note that this function requires a suitable cairo context to be associated with the print context. printOperationPreviewRenderPage :: PrintOperationPreviewClass self => self -- ^ @preview@ a 'PrintOperationPreview' -> Int -- ^ @pageNr@ the page to render -> IO () printOperationPreviewRenderPage self pageNr = {# call gtk_print_operation_preview_render_page #} (toPrintOperationPreview self) (fromIntegral pageNr) -------------------- -- Attributes -- | The 'PageSetup' used by default. -- -- This page setup will be used by 'printOperationRun', but it can be overridden on a per-page -- basis by connecting to the 'requestPageSetup' signal. -- -- Since 2.10 printOperationDefaultPageSetup :: (PrintOperationClass self, PageSetupClass pageSetup) => ReadWriteAttr self PageSetup pageSetup printOperationDefaultPageSetup = newAttrFromObjectProperty "default-page-setup" {# call pure unsafe gtk_page_setup_get_type #} -- | The 'PrintSettings' used for initializing the dialog. -- -- Setting this property is typically used to re-establish print settings from a previous print -- operation, see 'printOperationRun'. -- -- Since 2.10 printOperationPrintSettings :: (PrintOperationClass self, PrintSettingsClass printSettings) => ReadWriteAttr self PrintSettings printSettings printOperationPrintSettings = newAttrFromObjectProperty "print-settings" {# call pure unsafe gtk_print_settings_get_type #} -- | A string used to identify the job (e.g. in monitoring applications like eggcups). -- -- If you don't set a job name, GTK+ picks a default one by numbering successive print jobs. -- -- Default value: \"\" -- -- Since 2.10 printOperationJobName :: (PrintOperationClass self, GlibString string) => Attr self string printOperationJobName = newAttrFromStringProperty "job-name" -- | The number of pages in the document. -- -- This must be set to a positive number before the rendering starts. It may be set in a 'beginPrint' -- signal handler. -- -- Note that the page numbers passed to the 'requestPageSetup' and 'drawPage' signals are 0-based, -- i.e. if the user chooses to print all pages, the last 'drawPage' signal will be for page @nPages@ - -- 1. -- -- Allowed values: >= 'GMaxulong' -- -- Default value: -1 -- -- Since 2.10 printOperationNPages :: PrintOperationClass self => Attr self Int printOperationNPages = newAttrFromIntProperty "n-pages" -- | The current page in the document. -- -- If this is set before 'printOperationRun', the user will be able to select to print only the -- current page. -- -- Note that this only makes sense for pre-paginated documents. -- -- Allowed values: >= 'GMaxulong' -- -- Default value: -1 -- -- Since 2.10 printOperationCurrentPage :: PrintOperationClass self => Attr self Int printOperationCurrentPage = newAttrFromIntProperty "current-page" -- | If 'True', the transformation for the cairo context obtained from 'PrintContext' puts the origin at -- the top left corner of the page (which may not be the top left corner of the sheet, depending on -- page orientation and the number of pages per sheet). Otherwise, the origin is at the top left corner -- of the imageable area (i.e. inside the margins). -- -- Default value: 'False' -- -- Since 2.10 printOperationUseFullPage :: PrintOperationClass self => Attr self Bool printOperationUseFullPage = newAttrFromBoolProperty "use-full-page" -- | If 'True', the print operation will try to continue report on the status of the print job in the -- printer queues and printer. This can allow your application to show things like "out of paper" -- issues, and when the print job actually reaches the printer. However, this is often implemented -- using polling, and should not be enabled unless needed. -- -- Default value: 'False' -- -- Since 2.10 printOperationTrackPrintStatus :: PrintOperationClass self => Attr self Bool printOperationTrackPrintStatus = newAttrFromBoolProperty "track-print-status" -- | The transformation for the cairo context obtained from 'PrintContext' is set up in such a way that -- distances are measured in units of unit. -- -- Default value: ''UnitPixel'' -- -- Since 2.10 -- printOperationUnit :: PrintOperationClass self => Attr self Unit printOperationUnit = newAttrFromEnumProperty "unit" {# call pure unsafe gtk_unit_get_type #} -- | Determines whether to show a progress dialog during the print operation. -- -- Default value: 'False' -- -- Since 2.10 printOperationShowProgress :: PrintOperationClass self => Attr self Bool printOperationShowProgress = newAttrFromBoolProperty "show-progress" -- | Determines whether the print operation may run asynchronously or not. -- -- Some systems don't support asynchronous printing, but those that do will return -- ''PrintOperationResultInProgress'' as the status, and emit the "done" signal when the operation -- is actually done. -- -- The Windows port does not support asynchronous operation at all (this is unlikely to change). On -- other platforms, all actions except for ''PrintOperationActionExport'' support asynchronous -- operation. -- -- Default value: 'False' -- -- Since 2.10 printOperationAllowAsync :: PrintOperationClass self => Attr self Bool printOperationAllowAsync = newAttrFromBoolProperty "allow-async" -- | The name of a file to generate instead of showing the print dialog. Currently, PDF is the only -- supported format. -- -- The intended use of this property is for implementing "Export to PDF" actions. -- -- "Print to PDF" support is independent of this and is done by letting the user pick the "Print to -- PDF" item from the list of printers in the print dialog. -- -- Default value: 'Nothing' -- -- Since 2.10 printOperationExportFilename :: (PrintOperationClass self, GlibString string) => Attr self string printOperationExportFilename = newAttrFromStringProperty "export-filename" -- | The status of the print operation. -- -- Default value: ''PrintStatusInitial'' -- -- Since 2.10 printOperationStatus :: PrintOperationClass self => ReadAttr self PrintStatus printOperationStatus = readAttrFromEnumProperty "status" {# call pure unsafe gtk_print_status_get_type #} -- | A string representation of the status of the print operation. The string is translated and suitable -- for displaying the print status e.g. in a 'Statusbar'. -- -- See the 'printOperationStatus' property for a status value that is suitable for programmatic use. -- -- Default value: \"\" -- -- Since 2.10 printOperationStatusString :: (PrintOperationClass self, GlibString string) => ReadAttr self string printOperationStatusString = readAttrFromStringProperty "status-string" -- | Used as the label of the tab containing custom widgets. Note that this property may be ignored on -- some platforms. -- -- If this is 'Nothing', GTK+ uses a default label. -- -- Default value: 'Nothing' -- -- Since 2.10 printOperationCustomTabLabel :: (PrintOperationClass self, GlibString string) => Attr self string printOperationCustomTabLabel = newAttrFromStringProperty "custom-tab-label" #if GTK_CHECK_VERSION(2,18,0) -- | If 'True', the print operation will support print of selection. This allows the print dialog to show a -- "Selection" button. -- -- Default value: 'False' -- -- Since 2.18 printOperationSupportSelection :: PrintOperationClass self => Attr self Bool printOperationSupportSelection = newAttrFromBoolProperty "support-selection" -- | Determines whether there is a selection in your application. This can allow your application to -- print the selection. This is typically used to make a "Selection" button sensitive. -- -- Default value: 'False' -- -- Since 2.18 printOperationHasSelection :: PrintOperationClass self => Attr self Bool printOperationHasSelection = newAttrFromBoolProperty "has-selection" -- | If 'True', page size combo box and orientation combo box are embedded into page setup page. -- -- Default value: 'False' -- -- Since 2.18 printOperationEmbedPageSetup :: PrintOperationClass self => Attr self Bool printOperationEmbedPageSetup = newAttrFromBoolProperty "embed-page-setup" -- | The number of pages that will be printed. -- -- Note that this value is set during print preparation phase (''PrintStatusPreparing''), so this -- value should never be get before the data generation phase (''PrintStatusGeneratingData''). You -- can connect to the 'statusChanged' signal and call 'printOperationGetNPagesToPrint' when -- print status is ''PrintStatusGeneratingData''. This is typically used to track the progress of -- print operation. -- -- Allowed values: >= 'GMaxulong' -- -- Default value: -1 -- -- Since 2.18 printOperationNPagesToPrint :: PrintOperationClass self => ReadAttr self Int printOperationNPagesToPrint = readAttrFromIntProperty "n-pages-to-print" #endif -------------------- -- Signals -- | Emitted when the print operation run has finished doing everything -- required for printing. -- -- @result@ gives you information about what happened during the run. If -- @result@ is 'PrintOperationResultError' then you can call -- 'printOperationGetError' for more information. -- -- If you enabled print status tracking then 'printOperationIsFinished' may -- still return @False@ after 'done' was -- emitted. -- printOptDone :: PrintOperationClass self => Signal self (PrintOperationResult -> IO ()) printOptDone = Signal (connect_ENUM__NONE "done") -- | Emitted after the user has finished changing print settings in the -- dialog, before the actual rendering starts. -- -- A typical use for 'begin-print' is to use the parameters from the -- 'PrintContext' and paginate the document accordingly, and then set the -- number of pages with 'printOperationSetNPages'. -- printOptBeginPrint :: PrintOperationClass self => Signal self (PrintContext -> IO ()) printOptBeginPrint = Signal (connect_OBJECT__NONE "begin_print") -- | Emitted after the 'beginPrint' signal, -- but before the actual rendering starts. It keeps getting emitted until a -- connected signal handler returns @True@. -- -- The 'paginate' signal is intended to be used for paginating a document in -- small chunks, to avoid blocking the user interface for a long time. The -- signal handler should update the number of pages using -- 'printOperationSetNPages', and return @True@ if the document has been -- completely paginated. -- -- If you don't need to do pagination in chunks, you can simply do it all in -- the 'begin-print handler', and set the number of pages from there. -- printOptPaginate :: PrintOperationClass self => Signal self (PrintContext -> IO Bool) printOptPaginate = Signal (connect_OBJECT__BOOL "paginate") -- | Emitted once for every page that is printed, to give the application a -- chance to modify the page setup. Any changes done to @setup@ will be in -- force only for printing this page. -- printOptRequestPageSetup :: PrintOperationClass self => Signal self (PrintContext -> Int -> PageSetup -> IO ()) printOptRequestPageSetup = Signal (connect_OBJECT_INT_OBJECT__NONE "request_page_setup") -- | Emitted for every page that is printed. The signal handler must render -- the @pageNr@'s page onto the cairo context obtained from @context@ using -- 'printContextGetCairoContext'. -- -- Use 'printOperationSetUseFullPage' and 'printOperationSetUnit' before -- starting the print operation to set up the transformation of the cairo -- context according to your needs. -- printOptDrawPage :: PrintOperationClass self => Signal self (PrintContext -> Int -> IO ()) printOptDrawPage = Signal (connect_OBJECT_INT__NONE "draw_page") -- | Emitted after all pages have been rendered. A handler for this signal can -- clean up any resources that have been allocated in the 'beginPrint' handler. -- printOptEndPrint :: PrintOperationClass self => Signal self (PrintContext -> IO ()) printOptEndPrint = Signal (connect_OBJECT__NONE "end_print") -- | Emitted at between the various phases of the print operation. See -- 'PrintStatus' for the phases that are being discriminated. Use -- 'printOperationGetStatus' to find out the current status. -- printOptStatusChanged :: PrintOperationClass self => Signal self (IO ()) printOptStatusChanged = Signal (connect_NONE__NONE "status_changed") -- | Emitted when displaying the print dialog. If you return a widget in a -- handler for this signal it will be added to a custom tab in the print -- dialog. You typically return a container widget with multiple widgets in it. -- -- The print dialog owns the returned widget, and its lifetime is not -- controlled by the application. However, the widget is guaranteed to stay -- around until the 'customWidgetApply' -- signal is emitted on the operation. Then you can read out any information -- you need from the widgets. -- printOptCreateCustomWidget :: PrintOperationClass self => Signal self (IO Widget) printOptCreateCustomWidget = Signal (connect_NONE__OBJECTPTR "create_custom_widget") -- | Signal helper functions. connect_NONE__OBJECTPTR :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (IO Widget) -> IO (ConnectId obj) connect_NONE__OBJECTPTR signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> IO (Ptr Widget) action _ = failOnGError $ do x <- user return $ unsafeForeignPtrToPtr (unWidget (toWidget x)) #if GTK_CHECK_VERSION(2,18,0) -- | Emitted after change of selected printer. The actual page setup and print -- settings are passed to the custom widget, which can actualize itself -- according to this change. -- -- * Available since Gtk+ version 2.18 -- printOptUpdateCustomWidget :: PrintOperationClass self => Signal self (Widget -> PageSetup -> PrintSettings -> IO ()) printOptUpdateCustomWidget = Signal (connect_OBJECT_OBJECT_OBJECT__NONE "update_custom_widget") #endif -- | Emitted right before 'beginPrint' if you -- added a custom widget in the 'createCustomWidtet' handler. When you get this signal you should read the -- information from the custom widgets, as the widgets are not guaraneed to be -- around at a later time. -- printOptCustomWidgetApply :: PrintOperationClass self => Signal self (Widget -> IO ()) printOptCustomWidgetApply = Signal (connect_OBJECT__NONE "custom_widget_apply") -- | Gets emitted when a preview is requested from the native dialog. -- -- The default handler for this signal uses an external viewer application -- to preview. -- -- To implement a custom print preview, an application must return @True@ -- from its handler for this signal. In order to use the provided @context@ for -- the preview implementation, it must be given a suitable cairo context with -- 'printContextSetCairoContext'. -- -- The custom preview implementation can use -- 'printOperationPreviewIsSelected' and 'printOperationPreviewRenderPage' to -- find pages which are selected for print and render them. The preview must be -- finished by calling 'printOperationPreviewEndPreview' (typically in response -- to the user clicking a close button). -- printOptPreview :: PrintOperationClass self => Signal self (PrintOperationPreview -> PrintContext -> Window -> IO Bool) printOptPreview = Signal (connect_OBJECT_OBJECT_OBJECT__BOOL "preview") -- | The 'ready' signal gets emitted once per preview operation, before the first page is rendered. -- -- A handler for this signal can be used for setup tasks. printOptReady :: PrintOperationPreviewClass self => Signal self (PrintContext -> IO ()) printOptReady = Signal (connect_OBJECT__NONE "ready") -- | The 'gotPageSize' signal is emitted once for each page that gets rendered to the preview. -- -- A handler for this signal should update the context according to @pageSetup@ and set up a suitable -- cairo context, using 'printContextSetCairoContext'. printOptGotPageSize :: PrintOperationPreviewClass self => Signal self (PrintContext -> PageSetup -> IO ()) printOptGotPageSize = Signal (connect_OBJECT_OBJECT__NONE "got_page_size") #endif gtk-0.15.9/Graphics/UI/Gtk/Printing/PrintSettings.chs0000644000000000000000000010605407346545000020502 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget PrintSettings -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Stores print settings -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Printing.PrintSettings ( -- * Detail -- -- | A 'PrintSettings' object represents the settings of a print dialog in a -- system-independent way. The main use for this object is that once you\'ve -- printed you can get a settings object that represents the settings the user -- chose, and the next time you print you can pass that object in so that the -- user doesn't have to re-set all his settings. -- -- Its also possible to enumerate the settings so that you can easily save -- the settings for the next time your app runs, or even store them in a -- document. The predefined keys try to use shared values as much as possible -- so that moving such a document between systems still works. -- -- Printing support was added in Gtk+ 2.10. -- -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----PrintSettings -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types PrintSettings, PrintSettingsClass, castToPrintSettings, toPrintSettings, -- PageRange, -- * Enums PageOrientation(..), #if GTK_CHECK_VERSION(2,14,0) NumberUpLayout(..), #endif PrintQuality(..), PrintDuplex(..), PrintPages(..), PageSet(..), -- * Constructors printSettingsNew, #if GTK_CHECK_VERSION(2,12,0) printSettingsNewFromFile, #endif -- * Methods printSettingsCopy, printSettingsHasKey, printSettingsGet, printSettingsSet, printSettingsUnset, printSettingsForeach, printSettingsGetBool, printSettingsSetBool, printSettingsGetDouble, printSettingsGetDoubleWithDefault, printSettingsSetDouble, printSettingsGetLength, printSettingsSetLength, printSettingsGetInt, printSettingsGetIntWithDefault, printSettingsSetInt, printSettingsGetPaperWidth, printSettingsSetPaperWidth, printSettingsGetPaperHeight, printSettingsSetPaperHeight, #if GTK_CHECK_VERSION(2,16,0) printSettingsSetResolutionXy, printSettingsGetResolutionX, printSettingsGetResolutionY, #endif -- printSettingsGetPageRanges, -- printSettingsSetPageRanges, #if GTK_CHECK_VERSION(2,14,0) printSettingsLoadFile, #endif #if GTK_CHECK_VERSION(2,12,0) printSettingsToFile, #endif -- * Attributes printSettingsPrinter, printSettingsOrientation, printSettingsPaperSize, printSettingsUseColor, printSettingsCollate, printSettingsReverse, printSettingsDuplex, printSettingsQuality, printSettingsNCopies, printSettingsNumberUp, printSettingsResolution, printSettingsScale, printSettingsPrintPages, printSettingsPageSet, printSettingsDefaultSource, printSettingsMediaType, printSettingsDither, printSettingsFinishings, printSettingsOutputBin, #if GTK_CHECK_VERSION(2,14,0) printSettingsNumberUpLayout, #endif #if GTK_CHECK_VERSION(2,16,0) printSettingsPrinterLpi, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.UTFString import System.Glib.GError {#import Graphics.UI.Gtk.Types#} #if GTK_CHECK_VERSION(2,10,0) import Graphics.UI.Gtk.Printing.PaperSize (PaperSize(PaperSize), mkPaperSize, Unit(..)) #endif {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Enums {#enum PageOrientation {underscoreToCase} deriving (Bounded,Eq,Show)#} {#enum PrintQuality {underscoreToCase} deriving (Bounded,Eq,Show)#} {#enum PrintDuplex {underscoreToCase} deriving (Bounded,Eq,Show)#} {#enum PrintPages {underscoreToCase} deriving (Bounded,Eq,Show)#} {#enum PageSet {underscoreToCase} deriving (Bounded,Eq,Show)#} #if GTK_CHECK_VERSION(2,14,0) -- | Used to determine the layout of pages on a sheet when printing multiple pages per sheet. {#enum NumberUpLayout {underscoreToCase} deriving (Bounded,Eq,Show)#} #endif -------------------- -- Constructors -- | Creates a new 'PrintSettings' object. -- printSettingsNew :: IO PrintSettings printSettingsNew = wrapNewGObject mkPrintSettings $ {# call gtk_print_settings_new #} #if GTK_CHECK_VERSION(2,12,0) -- | Reads the print settings from @fileName@. Returns a new 'PrintSettings' -- object with the restored settings. -- -- * Available since Gtk+ version 2.12 -- printSettingsNewFromFile :: GlibFilePath fp => fp -- ^ @fileName@ - the filename to read the settings from -> IO PrintSettings printSettingsNewFromFile fileName = wrapNewGObject mkPrintSettings $ propagateGError $ \errorPtr -> withUTFFilePath fileName $ \fileNamePtr -> {# call gtk_print_settings_new_from_file #} fileNamePtr errorPtr #endif -------------------- -- Methods -- | Copies a 'PrintSettings' object. -- printSettingsCopy :: PrintSettingsClass self => self -> IO PrintSettings -- ^ returns a newly allocated copy of @other@ printSettingsCopy self = wrapNewGObject mkPrintSettings $ {# call gtk_print_settings_copy #} (toPrintSettings self) -- | Returns @True@, if a value is associated with @key@. -- printSettingsHasKey :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> IO Bool -- ^ returns @True@, if @key@ has a value printSettingsHasKey self key = liftM toBool $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_has_key #} (toPrintSettings self) keyPtr -- | Looks up the string value associated with @key@. -- printSettingsGet :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> IO string -- ^ returns the string value for @key@ printSettingsGet self key = withUTFString key $ \keyPtr -> {# call gtk_print_settings_get #} (toPrintSettings self) keyPtr >>= peekUTFString -- | Associates @value@ with @key@. -- printSettingsSet :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> string -- ^ @value@ - a string value -> IO () printSettingsSet self key value = withUTFString value $ \valuePtr -> withUTFString key $ \keyPtr -> {# call gtk_print_settings_set #} (toPrintSettings self) keyPtr valuePtr -- | Removes any value associated with @key@ -- printSettingsUnset :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> IO () printSettingsUnset self key = withUTFString key $ \keyPtr -> {# call gtk_print_settings_unset #} (toPrintSettings self) keyPtr -- | Calls @func@ for each key-value pair of @settings@. -- printSettingsForeach :: PrintSettingsClass self => self -> (String -> IO ()) -- ^ @func@ - the function to call -> IO () printSettingsForeach self func = do funcPtr <- mkPrintSettingsFunc $ \_ strPtr _ -> do str <- peekCString strPtr func str {# call gtk_print_settings_foreach #} (toPrintSettings self) funcPtr (castFunPtrToPtr funcPtr) {#pointer PrintSettingsFunc#} foreign import ccall "wrapper" mkPrintSettingsFunc :: (CString -> CString -> Ptr () -> IO ()) -> IO PrintSettingsFunc -- | Returns the boolean represented by the value that is associated with -- @key@. -- -- The string \"true\" represents @True@, any other string @False@. -- printSettingsGetBool :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> IO Bool -- ^ returns @True@, if @key@ maps to a true value. printSettingsGetBool self key = liftM toBool $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_get_bool #} (toPrintSettings self) keyPtr -- | Sets @key@ to a boolean value. -- printSettingsSetBool :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Bool -- ^ @value@ - a boolean -> IO () printSettingsSetBool self key value = withUTFString key $ \keyPtr -> {# call gtk_print_settings_set_bool #} (toPrintSettings self) keyPtr (fromBool value) -- | Returns the double value associated with @key@, or 0. -- printSettingsGetDouble :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> IO Double -- ^ returns the double value of @key@ printSettingsGetDouble self key = liftM realToFrac $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_get_double #} (toPrintSettings self) keyPtr -- | Returns the floating point number represented by the value that is -- associated with @key@, or @defaultVal@ if the value does not represent a -- floating point number. -- -- Floating point numbers are parsed with 'gAsciiStrtod'. -- printSettingsGetDoubleWithDefault :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Double -- ^ @def@ - the default value -> IO Double -- ^ returns the floating point number associated with @key@ printSettingsGetDoubleWithDefault self key def = liftM realToFrac $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_get_double_with_default #} (toPrintSettings self) keyPtr (realToFrac def) -- | Sets @key@ to a double value. -- printSettingsSetDouble :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Double -- ^ @value@ - a double value -> IO () printSettingsSetDouble self key value = withUTFString key $ \keyPtr -> {# call gtk_print_settings_set_double #} (toPrintSettings self) keyPtr (realToFrac value) -- | Returns the value associated with @key@, interpreted as a length. The -- returned value is converted to @units@. -- printSettingsGetLength :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Unit -- ^ @unit@ - the unit of the return value -> IO Double -- ^ returns the length value of @key@, converted to @unit@ printSettingsGetLength self key unit = liftM realToFrac $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_get_length #} (toPrintSettings self) keyPtr ((fromIntegral . fromEnum) unit) -- | Associates a length in units of @unit@ with @key@. -- printSettingsSetLength :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Double -- ^ @value@ - a length -> Unit -- ^ @unit@ - the unit of @length@ -> IO () printSettingsSetLength self key value unit = withUTFString key $ \keyPtr -> {# call gtk_print_settings_set_length #} (toPrintSettings self) keyPtr (realToFrac value) ((fromIntegral . fromEnum) unit) -- | Returns the integer value of @key@, or 0. -- printSettingsGetInt :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> IO Int -- ^ returns the integer value of @key@ printSettingsGetInt self key = liftM fromIntegral $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_get_int #} (toPrintSettings self) keyPtr -- | Returns the value of @key@, interpreted as an integer, or the default -- value. -- printSettingsGetIntWithDefault :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Int -- ^ @def@ - the default value -> IO Int -- ^ returns the integer value of @key@ printSettingsGetIntWithDefault self key def = liftM fromIntegral $ withUTFString key $ \keyPtr -> {# call gtk_print_settings_get_int_with_default #} (toPrintSettings self) keyPtr (fromIntegral def) -- | Sets @key@ to an integer value. -- printSettingsSetInt :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @key@ - a key -> Int -- ^ @value@ - an integer -> IO () printSettingsSetInt self key value = withUTFString key $ \keyPtr -> {# call gtk_print_settings_set_int #} (toPrintSettings self) keyPtr (fromIntegral value) -- | Convenience function to obtain the value of ''PrintSettingsPrinter''. printSettingsGetPrinter :: (PrintSettingsClass self, GlibString string) => self -> IO string -- ^ returns the printer name printSettingsGetPrinter self = {# call gtk_print_settings_get_printer #} (toPrintSettings self) >>= peekUTFString -- | Convenience function to obtain the value of ''PrintSettingsPrinter''. printSettingsSetPrinter :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @printer@ - the printer name -> IO () printSettingsSetPrinter self printer = withUTFString printer $ \printerPtr -> {# call gtk_print_settings_set_printer #} (toPrintSettings self) printerPtr -- | Get the value of ''PrintSettingsOrientation'', converted to a 'PageOrientation'. printSettingsGetOrientation :: PrintSettingsClass self => self -> IO PageOrientation -- ^ returns the orientation printSettingsGetOrientation self = liftM (toEnum . fromIntegral) $ {# call gtk_print_settings_get_orientation #} (toPrintSettings self) -- | Sets the value of ''PrintSettingsOrientation''. printSettingsSetOrientation :: PrintSettingsClass self => self -> PageOrientation -- ^ @orientation@ - a page orientation -> IO () printSettingsSetOrientation self orientation = {# call gtk_print_settings_set_orientation #} (toPrintSettings self) ((fromIntegral . fromEnum) orientation) -- | Gets the value of 'PrintSettingsPaperFormat', converted to a 'PaperSize'. printSettingsGetPaperSize :: PrintSettingsClass self => self -> IO PaperSize -- ^ returns the paper size printSettingsGetPaperSize self = {# call gtk_print_settings_get_paper_size #} (toPrintSettings self) >>= mkPaperSize . castPtr -- | Sets the value of 'PrintSettingsPaperFormat', 'PrintSettingsPaperWidth' and -- 'PrintSettingsPaperHeight'. printSettingsSetPaperSize :: PrintSettingsClass self => self -> PaperSize -- ^ @paperSize@ - a paper size -> IO () printSettingsSetPaperSize self (PaperSize paperSize) = {# call gtk_print_settings_set_paper_size #} (toPrintSettings self) (castPtr $ unsafeForeignPtrToPtr $ paperSize) -- | Gets the value of 'PrintSettingsPaperWidth', converted to unit. -- printSettingsGetPaperWidth :: PrintSettingsClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the paper width, in units of @unit@ printSettingsGetPaperWidth self unit = liftM realToFrac $ {# call gtk_print_settings_get_paper_width #} (toPrintSettings self) ((fromIntegral . fromEnum) unit) -- | Sets the value of 'PrintSettingsPaperWidth'. -- printSettingsSetPaperWidth :: PrintSettingsClass self => self -> Double -- ^ @width@ - the paper width -> Unit -- ^ @unit@ - the units of @width@ -> IO () printSettingsSetPaperWidth self width unit = {# call gtk_print_settings_set_paper_width #} (toPrintSettings self) (realToFrac width) ((fromIntegral . fromEnum) unit) -- | Gets the value of 'PrintSettingsPaperHeight', converted to unit. -- printSettingsGetPaperHeight :: PrintSettingsClass self => self -> Unit -- ^ @unit@ - the unit for the return value -> IO Double -- ^ returns the paper height, in units of @unit@ printSettingsGetPaperHeight self unit = liftM realToFrac $ {# call gtk_print_settings_get_paper_height #} (toPrintSettings self) ((fromIntegral . fromEnum) unit) -- | Sets the value of 'PrintSettingsPaperHeight'. -- printSettingsSetPaperHeight :: PrintSettingsClass self => self -> Double -- ^ @height@ - the paper height -> Unit -- ^ @unit@ - the units of @height@ -> IO () printSettingsSetPaperHeight self height unit = {# call gtk_print_settings_set_paper_height #} (toPrintSettings self) (realToFrac height) ((fromIntegral . fromEnum) unit) -- | Gets the value of ''PrintSettingsUseColor''. printSettingsGetUseColor :: PrintSettingsClass self => self -> IO Bool -- ^ returns whether to use color printSettingsGetUseColor self = liftM toBool $ {# call gtk_print_settings_get_use_color #} (toPrintSettings self) -- | Sets the value of ''PrintSettingsUseColor''. printSettingsSetUseColor :: PrintSettingsClass self => self -> Bool -- ^ @useColor@ - whether to use color -> IO () printSettingsSetUseColor self useColor = {# call gtk_print_settings_set_use_color #} (toPrintSettings self) (fromBool useColor) -- | Gets the value of ''PrintSettingsCollate''. printSettingsGetCollate :: PrintSettingsClass self => self -> IO Bool -- ^ returns whether to collate the printed pages printSettingsGetCollate self = liftM toBool $ {# call gtk_print_settings_get_collate #} (toPrintSettings self) -- | Sets the value of ''PrintSettingsCollate''. printSettingsSetCollate :: PrintSettingsClass self => self -> Bool -- ^ @collate@ - whether to collate the output -> IO () printSettingsSetCollate self collate = {# call gtk_print_settings_set_collate #} (toPrintSettings self) (fromBool collate) -- | Gets the value of ''PrintSettingsReverse''. printSettingsGetReverse :: PrintSettingsClass self => self -> IO Bool -- ^ returns whether to reverse the order of the printed pages printSettingsGetReverse self = liftM toBool $ {# call gtk_print_settings_get_reverse #} (toPrintSettings self) -- | Sets the value of ''PrintSettingsReverse''. printSettingsSetReverse :: PrintSettingsClass self => self -> Bool -- ^ @reverse@ - whether to reverse the output -> IO () printSettingsSetReverse self reverse = {# call gtk_print_settings_set_reverse #} (toPrintSettings self) (fromBool reverse) -- | Gets the value of ''PrintSettingsDuplex''. printSettingsGetDuplex :: PrintSettingsClass self => self -> IO PrintDuplex -- ^ returns whether to print the output in duplex. printSettingsGetDuplex self = liftM (toEnum . fromIntegral) $ {# call gtk_print_settings_get_duplex #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsDuplex'. printSettingsSetDuplex :: PrintSettingsClass self => self -> PrintDuplex -- ^ @duplex@ - a 'PrintDuplex' value -> IO () printSettingsSetDuplex self duplex = {# call gtk_print_settings_set_duplex #} (toPrintSettings self) ((fromIntegral . fromEnum) duplex) -- | Gets the value of 'PrintSettingsQuality'. printSettingsGetQuality :: PrintSettingsClass self => self -> IO PrintQuality -- ^ returns the print quality printSettingsGetQuality self = liftM (toEnum . fromIntegral) $ {# call gtk_print_settings_get_quality #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsQuality'. printSettingsSetQuality :: PrintSettingsClass self => self -> PrintQuality -- ^ @quality@ - a 'PrintQuality' value -> IO () printSettingsSetQuality self quality = {# call gtk_print_settings_set_quality #} (toPrintSettings self) ((fromIntegral . fromEnum) quality) -- | Gets the value of 'PrintSettingsNCopies'. printSettingsGetNCopies :: PrintSettingsClass self => self -> IO Int -- ^ returns the number of copies to print printSettingsGetNCopies self = liftM fromIntegral $ {# call gtk_print_settings_get_n_copies #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsNCopies'. printSettingsSetNCopies :: PrintSettingsClass self => self -> Int -- ^ @numCopies@ - the number of copies -> IO () printSettingsSetNCopies self numCopies = {# call gtk_print_settings_set_n_copies #} (toPrintSettings self) (fromIntegral numCopies) -- | Gets the value of 'PrintSettingsNumberUp'. printSettingsGetNumberUp :: PrintSettingsClass self => self -> IO Int -- ^ returns the number of pages per sheet printSettingsGetNumberUp self = liftM fromIntegral $ {# call gtk_print_settings_get_number_up #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsNumberUp'. printSettingsSetNumberUp :: PrintSettingsClass self => self -> Int -- ^ @numberUp@ - the number of pages per sheet -> IO () printSettingsSetNumberUp self numberUp = {# call gtk_print_settings_set_number_up #} (toPrintSettings self) (fromIntegral numberUp) #if GTK_CHECK_VERSION(2,14,0) -- | Gets the value of 'PrintSettingsNumberUpLayout'. printSettingsGetNumberUpLayout :: PrintSettingsClass self => self -> IO NumberUpLayout -- ^ returns layout of page in number-up mode printSettingsGetNumberUpLayout self = liftM (toEnum . fromIntegral) $ {# call gtk_print_settings_get_number_up_layout #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsNumberUpLayout'. printSettingsSetNumberUpLayout :: PrintSettingsClass self => self -> NumberUpLayout -- ^ @numberUpLayout@ - a 'NumberUpLayout' value -> IO () printSettingsSetNumberUpLayout self numberUpLayout = {# call gtk_print_settings_set_number_up_layout #} (toPrintSettings self) ((fromIntegral . fromEnum) numberUpLayout) #endif -- | Gets the value of 'PrintSettingsResolution'. printSettingsGetResolution :: PrintSettingsClass self => self -> IO Int -- ^ returns the resolution in dpi printSettingsGetResolution self = liftM fromIntegral $ {# call gtk_print_settings_get_resolution #} (toPrintSettings self) -- | Sets the values of 'PrintSettingsResolution', 'PrintSettingsResolutionX' and -- 'PrintSettingsResolutionY'. printSettingsSetResolution :: PrintSettingsClass self => self -> Int -- ^ @resolution@ - the resolution in dpi -> IO () printSettingsSetResolution self resolution = {# call gtk_print_settings_set_resolution #} (toPrintSettings self) (fromIntegral resolution) #if GTK_CHECK_VERSION(2,16,0) -- | Sets the values of 'PrintSettingsResolution', 'PrintSettingsResolutionX' and -- 'PrintSettingsResolutionY'. -- -- * Available since Gtk+ version 2.16 -- printSettingsSetResolutionXy :: PrintSettingsClass self => self -> Int -- ^ @resolutionX@ - the horizontal resolution in dpi -> Int -- ^ @resolutionY@ - the vertical resolution in dpi -> IO () printSettingsSetResolutionXy self resolutionX resolutionY = {# call gtk_print_settings_set_resolution_xy #} (toPrintSettings self) (fromIntegral resolutionX) (fromIntegral resolutionY) -- | Gets the value of @GTK_PRINT_SETTINGS_RESOLUTION_X@. -- -- * Available since Gtk+ version 2.16 -- printSettingsGetResolutionX :: PrintSettingsClass self => self -> IO Int -- ^ returns the horizontal resolution in dpi printSettingsGetResolutionX self = liftM fromIntegral $ {# call gtk_print_settings_get_resolution_x #} (toPrintSettings self) -- | Gets the value of @GTK_PRINT_SETTINGS_RESOLUTION_Y@. -- -- * Available since Gtk+ version 2.16 -- printSettingsGetResolutionY :: PrintSettingsClass self => self -> IO Int -- ^ returns the vertical resolution in dpi printSettingsGetResolutionY self = liftM fromIntegral $ {# call gtk_print_settings_get_resolution_y #} (toPrintSettings self) -- | Gets the value of 'PrintSettingsPrinterLpi'. printSettingsGetPrinterLpi :: PrintSettingsClass self => self -> IO Double -- ^ returns the resolution in lpi (lines per inch) printSettingsGetPrinterLpi self = liftM realToFrac $ {# call gtk_print_settings_get_printer_lpi #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsPrinterLpi'. printSettingsSetPrinterLpi :: PrintSettingsClass self => self -> Double -- ^ @lpi@ - the resolution in lpi (lines per inch) -> IO () printSettingsSetPrinterLpi self lpi = {# call gtk_print_settings_set_printer_lpi #} (toPrintSettings self) (realToFrac lpi) #endif -- | Gets the value of 'PrintSettingsScale'. printSettingsGetScale :: PrintSettingsClass self => self -> IO Double -- ^ returns the scale in percent printSettingsGetScale self = liftM realToFrac $ {# call gtk_print_settings_get_scale #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsScale'. printSettingsSetScale :: PrintSettingsClass self => self -> Double -- ^ @scale@ - the scale in percent -> IO () printSettingsSetScale self scale = {# call gtk_print_settings_set_scale #} (toPrintSettings self) (realToFrac scale) -- | Gets the value of 'PrintSettingsPrintPages'. printSettingsGetPrintPages :: PrintSettingsClass self => self -> IO PrintPages -- ^ returns which pages to print printSettingsGetPrintPages self = liftM (toEnum . fromIntegral) $ {# call gtk_print_settings_get_print_pages #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsPrintPages'. printSettingsSetPrintPages :: PrintSettingsClass self => self -> PrintPages -- ^ @pages@ - a 'PrintPages' value -> IO () printSettingsSetPrintPages self pages = {# call gtk_print_settings_set_print_pages #} (toPrintSettings self) ((fromIntegral . fromEnum) pages) -- | Gets the value of 'PrintSettingsPageRanges'. -- -- printSettingsGetPageRanges :: PrintSettingsClass self => self -- -> IO [PageRange] -- ^ returns an array of 'PageRange'. -- printSettingsGetPageRanges self = -- alloca $ \numRangesPtr -> do -- rangeListPtr <- {# call gtk_print_settings_get_page_ranges #} -- (toPrintSettings self) -- numRangesPtr -- rangeLen <- peek numRangesPtr -- ptrList <- peekArray (fromIntegral rangeLen) (castPtr rangeListPtr) -- rangeList <- mapM peek ptrList -- {#call unsafe g_free#} (castPtr rangeListPtr) -- return rangeList -- | Sets the value of @GTK_PRINT_SETTINGS_PAGE_RANGES@. -- -- printSettingsSetPageRanges :: PrintSettingsClass self => self -- -> [PageRange] -- ^ @pageRanges@ - an array of 'PageRange' -- -> IO () -- printSettingsSetPageRanges self rangeList = -- withArrayLen (concatMap (\(PageRange x y) -> [fromIntegral x, fromIntegral y]) rangeList) -- $ \rangeLen rangeListPtr -> -- {# call gtk_print_settings_set_page_ranges #} -- (toPrintSettings self) -- (castPtr rangeListPtr) -- (fromIntegral rangeLen) -- | Gets the value of 'PrintSettingsPageSet'. printSettingsGetPageSet :: PrintSettingsClass self => self -> IO PageSet -- ^ returns the set of pages to print printSettingsGetPageSet self = liftM (toEnum . fromIntegral) $ {# call gtk_print_settings_get_page_set #} (toPrintSettings self) -- | Sets the value of 'PrintSettingsPageSet'. printSettingsSetPageSet :: PrintSettingsClass self => self -> PageSet -- ^ @pageSet@ - a 'PageSet' value -> IO () printSettingsSetPageSet self pageSet = {# call gtk_print_settings_set_page_set #} (toPrintSettings self) ((fromIntegral . fromEnum) pageSet) -- | Gets the value of 'PrintSettingsDefaultSource'. printSettingsGetDefaultSource :: (PrintSettingsClass self, GlibString string) => self -> IO string -- ^ returns the default source printSettingsGetDefaultSource self = {# call gtk_print_settings_get_default_source #} (toPrintSettings self) >>= peekUTFString -- | Sets the value of 'PrintSettingsDefaultSource'. printSettingsSetDefaultSource :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @defaultSource@ - the default source -> IO () printSettingsSetDefaultSource self defaultSource = withUTFString defaultSource $ \defaultSourcePtr -> {# call gtk_print_settings_set_default_source #} (toPrintSettings self) defaultSourcePtr -- | Gets the value of 'PrintSettingsMediaType'. printSettingsGetMediaType :: (PrintSettingsClass self, GlibString string) => self -> IO string -- ^ returns the media type printSettingsGetMediaType self = {# call gtk_print_settings_get_media_type #} (toPrintSettings self) >>= peekUTFString -- | Sets the value of 'PrintSettingsMediaType'. printSettingsSetMediaType :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @mediaType@ - the media type -> IO () printSettingsSetMediaType self mediaType = withUTFString mediaType $ \mediaTypePtr -> {# call gtk_print_settings_set_media_type #} (toPrintSettings self) mediaTypePtr -- | Gets the value of 'PrintSettingsDither'. printSettingsGetDither :: (PrintSettingsClass self, GlibString string) => self -> IO string -- ^ returns the dithering that is used printSettingsGetDither self = {# call gtk_print_settings_get_dither #} (toPrintSettings self) >>= peekUTFString -- | Sets the value of 'PrintSettingsDither'. printSettingsSetDither :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @dither@ - the dithering that is used -> IO () printSettingsSetDither self dither = withUTFString dither $ \ditherPtr -> {# call gtk_print_settings_set_dither #} (toPrintSettings self) ditherPtr -- | Gets the value of 'PrintSettingsFinishings'. printSettingsGetFinishings :: (PrintSettingsClass self, GlibString string) => self -> IO string -- ^ returns the finishings printSettingsGetFinishings self = {# call gtk_print_settings_get_finishings #} (toPrintSettings self) >>= peekUTFString -- | Sets the value of 'PrintSettingsFinishings'. printSettingsSetFinishings :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @finishings@ - the finishings -> IO () printSettingsSetFinishings self finishings = withUTFString finishings $ \finishingsPtr -> {# call gtk_print_settings_set_finishings #} (toPrintSettings self) finishingsPtr -- | Gets the value of 'PrintSettingsOutputBin'. printSettingsGetOutputBin :: (PrintSettingsClass self, GlibString string) => self -> IO string -- ^ returns the output bin printSettingsGetOutputBin self = {# call gtk_print_settings_get_output_bin #} (toPrintSettings self) >>= peekUTFString -- | Sets the value of 'PrintSettingsOutputBin'. printSettingsSetOutputBin :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @outputBin@ - the output bin -> IO () printSettingsSetOutputBin self outputBin = withUTFString outputBin $ \outputBinPtr -> {# call gtk_print_settings_set_output_bin #} (toPrintSettings self) outputBinPtr #if GTK_CHECK_VERSION(2,14,0) -- | Reads the print settings from @fileName@. See 'printSettingsToFile'. -- -- * Available since Gtk+ version 2.14 -- printSettingsLoadFile :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @fileName@ - the filename to read the settings from -> IO Bool -- ^ returns @True@ on success printSettingsLoadFile self fileName = liftM toBool $ propagateGError $ \errorPtr -> withUTFString fileName $ \fileNamePtr -> {# call gtk_print_settings_load_file #} (toPrintSettings self) fileNamePtr errorPtr #endif #if GTK_CHECK_VERSION(2,12,0) -- | This function saves the print settings from @settings@ to @fileName@. -- -- * Available since Gtk+ version 2.12 -- printSettingsToFile :: (PrintSettingsClass self, GlibString string) => self -> string -- ^ @fileName@ - the file to save to -> IO Bool -- ^ returns @True@ on success printSettingsToFile self fileName = liftM toBool $ propagateGError $ \errorPtr -> withUTFString fileName $ \fileNamePtr -> {# call gtk_print_settings_to_file #} (toPrintSettings self) fileNamePtr errorPtr #endif -- | Obtain the value of 'PrintSettingsPrinter'. printSettingsPrinter :: (PrintSettingsClass self, GlibString string) => Attr self string printSettingsPrinter = newAttr printSettingsGetPrinter printSettingsSetPrinter -- | The value of ''PrintSettingsOrientation'', converted to a 'PageOrientation'. printSettingsOrientation :: PrintSettingsClass self => Attr self PageOrientation printSettingsOrientation = newAttr printSettingsGetOrientation printSettingsSetOrientation -- | The value of 'PrintSettingsPaperFormat', converted to a 'PaperSize'. printSettingsPaperSize :: PrintSettingsClass self => Attr self PaperSize printSettingsPaperSize = newAttr printSettingsGetPaperSize printSettingsSetPaperSize -- | The value of ''PrintSettingsUseColor''. printSettingsUseColor :: PrintSettingsClass self => Attr self Bool printSettingsUseColor = newAttr printSettingsGetUseColor printSettingsSetUseColor -- | The value of ''PrintSettingsCollate''. printSettingsCollate :: PrintSettingsClass self => Attr self Bool printSettingsCollate = newAttr printSettingsGetCollate printSettingsSetCollate -- | The value of ''PrintSettingsReverse''. printSettingsReverse :: PrintSettingsClass self => Attr self Bool printSettingsReverse = newAttr printSettingsGetReverse printSettingsSetReverse -- | The value of ''PrintSettingsDuplex''. printSettingsDuplex :: PrintSettingsClass self => Attr self PrintDuplex printSettingsDuplex = newAttr printSettingsGetDuplex printSettingsSetDuplex -- | The value of ''PrintSettingsQuality''. printSettingsQuality :: PrintSettingsClass self => Attr self PrintQuality printSettingsQuality = newAttr printSettingsGetQuality printSettingsSetQuality -- | The value of 'PrintSettingsNCopies'. printSettingsNCopies :: PrintSettingsClass self => Attr self Int printSettingsNCopies = newAttr printSettingsGetNCopies printSettingsSetNCopies -- | The value of 'PrintSettingsNumberUp'. printSettingsNumberUp :: PrintSettingsClass self => Attr self Int printSettingsNumberUp = newAttr printSettingsGetNumberUp printSettingsSetNumberUp -- | The value of 'PrintSettingsResolution'. printSettingsResolution :: PrintSettingsClass self => Attr self Int printSettingsResolution = newAttr printSettingsGetResolution printSettingsSetResolution -- | The value of 'PrintSettingsScale'. printSettingsScale :: PrintSettingsClass self => Attr self Double printSettingsScale = newAttr printSettingsGetScale printSettingsSetScale -- | The value of 'PrintSettingsPrintPages'. printSettingsPrintPages :: PrintSettingsClass self => Attr self PrintPages printSettingsPrintPages = newAttr printSettingsGetPrintPages printSettingsSetPrintPages -- | The value of 'PrintSettingsPageSet'. printSettingsPageSet :: PrintSettingsClass self => Attr self PageSet printSettingsPageSet = newAttr printSettingsGetPageSet printSettingsSetPageSet -- | The value of 'PrintSettingsDefaultSource'. printSettingsDefaultSource :: (PrintSettingsClass self, GlibString string) => Attr self string printSettingsDefaultSource = newAttr printSettingsGetDefaultSource printSettingsSetDefaultSource -- | The value of 'PrintSettingsMediaType'. printSettingsMediaType :: (PrintSettingsClass self, GlibString string) => Attr self string printSettingsMediaType = newAttr printSettingsGetMediaType printSettingsSetMediaType -- | The value of 'PrintSettingsDither'. printSettingsDither :: (PrintSettingsClass self, GlibString string) => Attr self string printSettingsDither = newAttr printSettingsGetDither printSettingsSetDither -- | The value of 'PrintSettingsFinishings'. printSettingsFinishings :: (PrintSettingsClass self, GlibString string) => Attr self string printSettingsFinishings = newAttr printSettingsGetFinishings printSettingsSetFinishings -- | The value of 'PrintSettingsOutputBin'. printSettingsOutputBin :: (PrintSettingsClass self, GlibString string) => Attr self string printSettingsOutputBin = newAttr printSettingsGetOutputBin printSettingsSetOutputBin #if GTK_CHECK_VERSION(2,14,0) -- | The value of 'PrintSettingsNumberUpLayout'. printSettingsNumberUpLayout :: PrintSettingsClass self => Attr self NumberUpLayout printSettingsNumberUpLayout = newAttr printSettingsGetNumberUpLayout printSettingsSetNumberUpLayout #endif #if GTK_CHECK_VERSION(2,16,0) -- | The value of 'PrintSettingsPrinterLpi'. printSettingsPrinterLpi :: PrintSettingsClass self => Attr self Double printSettingsPrinterLpi = newAttr printSettingsGetPrinterLpi printSettingsSetPrinterLpi #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Recent/0000755000000000000000000000000007346545000014606 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Recent/RecentChooser.chs0000644000000000000000000003305607346545000020057 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface RecentChooser -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Interface implemented by widgets displaying recently used files -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Recent.RecentChooser ( -- * Detail -- -- | 'RecentChooser' is an interface that can be implemented by widgets -- displaying the list of recently used files. In Gtk+, the main objects that -- implement this interface are 'RecentChooserWidget', 'RecentChooserDialog' -- and 'RecentChooserMenu'. -- -- Recently used files are supported since Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GInterface' -- | +----RecentChooser -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types RecentChooser, RecentChooserClass, castToRecentChooser, toRecentChooser, -- * Enums RecentChooserError(..), RecentSortType(..), -- * Methods recentChooserSetSortFunc, recentChooserSetCurrentURI, recentChooserGetCurrentURI, recentChooserGetCurrentItem, recentChooserSelectURI, recentChooserUnselectURI, recentChooserSelectAll, recentChooserUnselectAll, recentChooserGetItems, recentChooserGetURIs, recentChooserAddFilter, recentChooserRemoveFilter, recentChooserListFilters, -- * Attributes recentChooserShowPrivate, recentChooserShowTips, recentChooserShowIcons, recentChooserShowNotFound, recentChooserSelectMultiple, recentChooserLocalOnly, recentChooserLimit, recentChooserSortType, recentChooserFilter, -- * Signals recentChooserSelectionChanged, recentChooserItemActivated, #endif ) where #if GTK_CHECK_VERSION(2,10,0) import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import System.Glib.GList import System.Glib.GError (checkGError) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Recent.RecentInfo#} (RecentInfo, mkRecentInfo) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Enums -- | These identify the various errors that can occur while calling 'RecentChooser' functions. {#enum RecentChooserError {underscoreToCase} deriving (Bounded,Eq,Show)#} -- | Used to specify the sorting method to be applied to the recently used resource list. {#enum RecentSortType {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Methods -- | Sets the comparison function used when sorting to be @sortFunc@. If the -- @chooser@ has the sort type set to 'RecentSortCustom' then the chooser will -- sort using this function. -- -- To the comparison function will be passed two 'RecentInfo' structs and @sortData@; @sortFunc@ should return a positive -- integer if the first item comes before the second, zero if the two items are -- equal and a negative integer if the first item comes after the second. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSetSortFunc :: RecentChooserClass self => self -> (Maybe (RecentInfo -> IO Int)) -> IO () recentChooserSetSortFunc self Nothing = {# call gtk_recent_chooser_set_sort_func #} (toRecentChooser self) nullFunPtr nullPtr nullFunPtr recentChooserSetSortFunc self (Just func) = do fPtr <- mkRecentSortFunc $ \_ infoPtr _ -> do info <- mkRecentInfo infoPtr liftM fromIntegral (func info) {# call gtk_recent_chooser_set_sort_func #} (toRecentChooser self) fPtr (castFunPtrToPtr fPtr) destroyFunPtr {#pointer RecentSortFunc#} foreign import ccall "wrapper" mkRecentSortFunc :: (Ptr RecentInfo -> Ptr RecentInfo -> Ptr () -> IO {#type gint#}) -> IO RecentSortFunc -- | Sets @uri@ as the current URI for @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSetCurrentURI :: (RecentChooserClass self, GlibString string) => self -> string -- ^ @uri@ - a URI -> IO Bool -- ^ returns @True@ if the URI was found. recentChooserSetCurrentURI self uri = checkGError ( \errorPtr -> liftM toBool $ withUTFString uri $ \uriPtr -> {# call gtk_recent_chooser_set_current_uri #} (toRecentChooser self) uriPtr errorPtr) (\_ -> return False) -- | Gets the URI currently selected by @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserGetCurrentURI :: (RecentChooserClass self, GlibString string) => self -> IO string -- ^ returns a newly string holding a URI. recentChooserGetCurrentURI self = {# call gtk_recent_chooser_get_current_uri #} (toRecentChooser self) >>= readUTFString -- | Gets the 'RecentInfo' currently selected by -- @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserGetCurrentItem :: RecentChooserClass self => self -> IO RecentInfo -- ^ returns a 'RecentInfo'. -- Use 'recentInfoUnref' when when you have finished -- using it. recentChooserGetCurrentItem self = do info <- {# call gtk_recent_chooser_get_current_item #} (toRecentChooser self) mkRecentInfo info -- | Selects @uri@ inside @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSelectURI :: (RecentChooserClass self, GlibString string) => self -> string -- ^ @uri@ - a URI -> IO Bool -- ^ returns @True@ if @uri@ was found. recentChooserSelectURI self uri = checkGError ( \errorPtr -> liftM toBool $ withUTFString uri $ \uriPtr -> {# call gtk_recent_chooser_select_uri #} (toRecentChooser self) uriPtr errorPtr) (\_ -> return False) -- | Unselects @uri@ inside @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserUnselectURI :: (RecentChooserClass self, GlibString string) => self -> string -- ^ @uri@ - a URI -> IO () recentChooserUnselectURI self uri = withUTFString uri $ \uriPtr -> {# call gtk_recent_chooser_unselect_uri #} (toRecentChooser self) uriPtr -- | Selects all the items inside @chooser@, if the @chooser@ supports -- multiple selection. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSelectAll :: RecentChooserClass self => self -> IO () recentChooserSelectAll self = {# call gtk_recent_chooser_select_all #} (toRecentChooser self) -- | Unselects all the items inside @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserUnselectAll :: RecentChooserClass self => self -> IO () recentChooserUnselectAll self = {# call gtk_recent_chooser_unselect_all #} (toRecentChooser self) -- | Gets the list of recently used resources in form of 'RecentInfo' -- -- The return value of this function is affected by the \"sort-type\" and -- \"limit\" properties of @chooser@. -- recentChooserGetItems :: RecentChooserClass self => self -> IO [RecentInfo] -- ^ returns A list of 'RecentInfo' objects. recentChooserGetItems self = do glist <- {# call gtk_recent_chooser_get_items #} (toRecentChooser self) list <- fromGList glist mapM mkRecentInfo list -- | Gets the URI of the recently used resources. -- -- The return value of this function is affected by the \"sort-type\" and -- \"limit\" properties of @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserGetURIs :: (RecentChooserClass self, GlibString string) => self -> IO [string] recentChooserGetURIs self = alloca $ \lengthPtr -> do str <- {# call gtk_recent_chooser_get_uris #} (toRecentChooser self) lengthPtr length <- peek lengthPtr mapM peekUTFString =<< peekArray (fromIntegral length) str -- | Adds @filter@ to the list of 'RecentFilter' objects held by @chooser@. -- -- If no previous filter objects were defined, this function will call -- 'recentChooserSetFilter'. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserAddFilter :: (RecentChooserClass self, RecentFilterClass filter) => self -> filter -- ^ @filter@ - a 'RecentFilter' -> IO () recentChooserAddFilter self filter = {# call gtk_recent_chooser_add_filter #} (toRecentChooser self) (toRecentFilter filter) -- | Removes @filter@ from the list of 'RecentFilter' objects held by -- @chooser@. -- recentChooserRemoveFilter :: (RecentChooserClass self, RecentFilterClass filter) => self -> filter -- ^ @filter@ - a 'RecentFilter' -> IO () recentChooserRemoveFilter self filter = {# call gtk_recent_chooser_remove_filter #} (toRecentChooser self) (toRecentFilter filter) -- | Gets the 'RecentFilter' objects held by @chooser@. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserListFilters :: RecentChooserClass self => self -> IO [RecentFilter] -- ^ returns A singly linked list of 'RecentFilter'. recentChooserListFilters self = do glist <- {# call gtk_recent_chooser_list_filters #} (toRecentChooser self) list <- fromGList glist mapM (\x -> makeNewObject mkRecentFilter (return (castPtr x))) list -------------------- -- Attributes -- | Whether the private items should be displayed. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.10 -- recentChooserShowPrivate :: RecentChooserClass self => Attr self Bool recentChooserShowPrivate = newAttrFromBoolProperty "show-private" -- | Whether this 'RecentChooser' should display a tooltip containing the full path of the recently used -- resources. -- -- Default value: 'False' -- -- -- * Available since Gtk+ version 2.10 -- recentChooserShowTips :: RecentChooserClass self => Attr self Bool recentChooserShowTips = newAttrFromBoolProperty "show-tips" -- | Whether this 'RecentChooser' should display an icon near the item. -- -- Default value: 'True' -- -- -- * Available since Gtk+ version 2.10 -- recentChooserShowIcons :: RecentChooserClass self => Attr self Bool recentChooserShowIcons = newAttrFromBoolProperty "show-icons" -- | Whether this 'RecentChooser' should display the recently used resources even if not present -- anymore. Setting this to 'False' will perform a potentially expensive check on every local resource -- (every remote resource will always be displayed). -- -- Default value: 'True' -- -- -- * Available since Gtk+ version 2.10 -- recentChooserShowNotFound :: RecentChooserClass self => Attr self Bool recentChooserShowNotFound = newAttrFromBoolProperty "show-not-found" -- | Allow the user to select multiple resources. -- -- Default value: 'False' -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSelectMultiple :: RecentChooserClass self => Attr self Bool recentChooserSelectMultiple = newAttrFromBoolProperty "select-multiple" -- | Whether this 'RecentChooser' should display only local (file:) resources. -- -- Default value: 'True' -- -- -- * Available since Gtk+ version 2.10 -- recentChooserLocalOnly :: RecentChooserClass self => Attr self Bool recentChooserLocalOnly = newAttrFromBoolProperty "local-only" -- | The maximum number of recently used resources to be displayed, or -1 to display all items. By -- default, the 'Setting':gtk-recent-files-limit setting is respected: you can override that limit on -- a particular instance of 'RecentChooser' by setting this property. -- -- Allowed values: >= 'GMaxulong' -- -- Default value: -1 -- -- -- * Available since Gtk+ version 2.10 -- recentChooserLimit :: RecentChooserClass self => Attr self Int recentChooserLimit = newAttrFromIntProperty "limit" -- | Sorting order to be used when displaying the recently used resources. -- -- Default value: ''RecentSortNone'' -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSortType :: RecentChooserClass self => Attr self RecentSortType recentChooserSortType = newAttrFromEnumProperty "sort-type" {# call pure unsafe gtk_recent_sort_type_get_type #} -- | The 'RecentFilter' object to be used when displaying the recently used resources. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserFilter :: (RecentChooserClass self, RecentFilterClass recentFilter) => ReadWriteAttr self RecentFilter recentFilter recentChooserFilter = newAttrFromObjectProperty "filter" {# call pure unsafe gtk_recent_filter_get_type #} -------------------- -- Signals -- | This signal is emitted when there is a change in the set of selected -- recently used resources. This can happen when a user modifies the selection -- with the mouse or the keyboard, or when explicitly calling functions to -- change the selection. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserSelectionChanged :: RecentChooserClass self => Signal self (IO ()) recentChooserSelectionChanged = Signal (connect_NONE__NONE "selection_changed") -- | This signal is emitted when the user \"activates\" a recent item in the -- recent chooser. This can happen by double-clicking on an item in the -- recently used resources list, or by pressing Enter. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserItemActivated :: RecentChooserClass self => Signal self (IO ()) recentChooserItemActivated = Signal (connect_NONE__NONE "item_activated") #endif gtk-0.15.9/Graphics/UI/Gtk/Recent/RecentChooserMenu.chs0000644000000000000000000001154107346545000020677 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RecentChooserMenu -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Displays recently used files in a menu -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Recent.RecentChooserMenu ( -- * Detail -- -- | 'RecentChooserMenu' is a widget suitable for displaying recently used -- files inside a menu. It can be used to set a sub-menu of a 'MenuItem' using -- 'menuItemSetSubmenu', or as the menu of a 'MenuToolButton'. -- -- Note that 'RecentChooserMenu' does not have any methods of its own. -- Instead, you should use the functions that work on a 'RecentChooser'. -- -- Note also that 'RecentChooserMenu' does not support multiple filters, as -- it has no way to let the user choose between them as the -- 'RecentChooserWidget' and 'RecentChooserDialog' widgets do. Thus using -- 'recentChooserAddFilter' on a 'RecentChooserMenu' widget will yield the same -- effects as using 'recentChooserSetFilter', replacing any currently set -- filter with the supplied filter; 'recentChooserRemoveFilter' will remove any -- currently set 'RecentFilter' object and will unset the current filter; -- 'recentChooserListFilters' will return a list containing a single -- 'RecentFilter' object. -- -- Recently used files are supported since Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'MenuShell' -- | +----'Menu' -- | +----RecentChooserMenu -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types RecentChooserMenu, RecentChooserMenuClass, castToRecentChooserMenu, toRecentChooserMenu, -- * Constructors recentChooserMenuNew, recentChooserMenuNewForManager, -- * Attributes recentChooserMenuShowNumbers, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Constructors -- | Creates a new 'RecentChooserMenu' widget. -- -- This kind of widget shows the list of recently used resources as a menu, -- each item as a menu item. Each item inside the menu might have an icon, -- representing its MIME type, and a number, for mnemonic access. -- -- This widget implements the 'RecentChooser' interface. -- -- This widget creates its own 'RecentManager' object. See the -- 'recentChooserMenuNewForManager' function to know how to create a -- 'RecentChooserMenu' widget bound to another 'RecentManager' object. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserMenuNew :: IO RecentChooserMenu recentChooserMenuNew = makeNewObject mkRecentChooserMenu $ liftM (castPtr :: Ptr Widget -> Ptr RecentChooserMenu) $ {# call gtk_recent_chooser_menu_new #} -- | Creates a new 'RecentChooserMenu' widget using @manager@ as the -- underlying recently used resources manager. -- -- This is useful if you have implemented your own recent manager, or if you -- have a customized instance of a 'RecentManager' object or if you wish to -- share a common 'RecentManager' object among multiple 'RecentChooser' -- widgets. -- -- -- * Available since Gtk+ version 2.10 -- recentChooserMenuNewForManager :: RecentManagerClass manager => manager -- ^ @manager@ - a 'RecentManager' -> IO RecentChooserMenu -- ^ returns a new 'RecentChooserMenu', bound to manager. recentChooserMenuNewForManager manager = makeNewObject mkRecentChooserMenu $ liftM (castPtr :: Ptr Widget -> Ptr RecentChooserMenu) $ {# call gtk_recent_chooser_menu_new_for_manager #} (toRecentManager manager) -------------------- -- Attributes -- | Whether the first ten items in the menu should be prepended by a number acting as a unique mnemonic. -- -- Default value: 'False' -- -- * Available since Gtk+ version 2.10 -- recentChooserMenuShowNumbers :: RecentChooserMenuClass self => Attr self Bool recentChooserMenuShowNumbers = newAttrFromBoolProperty "show-numbers" #endif gtk-0.15.9/Graphics/UI/Gtk/Recent/RecentChooserWidget.chs0000644000000000000000000000637307346545000021225 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RecentChooserWidget -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Displays recently used files -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Recent.RecentChooserWidget ( -- * Detail -- -- | 'RecentChooserWidget' is a widget suitable for selecting recently used -- files. It is the main building block of a 'RecentChooserDialog'. Most -- applications will only need to use the latter; you can use -- 'RecentChooserWidget' as part of a larger window if you have special needs. -- -- Note that 'RecentChooserWidget' does not have any methods of its own. -- Instead, you should use the functions that work on a 'RecentChooser'. -- -- Recently used files are supported since Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'VBox' -- | +----RecentChooserWidget -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types RecentChooserWidget, RecentChooserWidgetClass, castToRecentChooserWidget, toRecentChooserWidget, -- * Constructors recentChooserWidgetNew, recentChooserWidgetNewForManager, #endif ) where #if GTK_CHECK_VERSION(2,10,0) import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'RecentChooserWidget' object. This is an embeddable widget -- used to access the recently used resources list. -- recentChooserWidgetNew :: IO RecentChooserWidget recentChooserWidgetNew = makeNewObject mkRecentChooserWidget $ liftM (castPtr :: Ptr Widget -> Ptr RecentChooserWidget) $ {# call gtk_recent_chooser_widget_new #} -- | Creates a new 'RecentChooserWidget' with a specified recent manager. -- -- This is useful if you have implemented your own recent manager, or if you -- have a customized instance of a 'RecentManager' object. -- recentChooserWidgetNewForManager :: RecentManagerClass manager => manager -- ^ @manager@ - a 'RecentManager' -> IO RecentChooserWidget -- ^ returns a new 'RecentChooserWidget' recentChooserWidgetNewForManager manager = makeNewObject mkRecentChooserWidget $ liftM (castPtr :: Ptr Widget -> Ptr RecentChooserWidget) $ {# call gtk_recent_chooser_widget_new_for_manager #} (toRecentManager manager) #endif gtk-0.15.9/Graphics/UI/Gtk/Recent/RecentFilter.chs0000644000000000000000000001537107346545000017702 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RecentFilter -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A filter for selecting a subset of recently used files -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Recent.RecentFilter ( -- * Detail -- -- | A 'RecentFilter' can be used to restrict the files being shown in a -- 'RecentChooser'. Files can be filtered based on their name (with -- 'recentFilterAddPattern'), on their mime type (with -- 'fileFilterAddMimeType'), on the application that has registered them (with -- 'recentFilterAddApplication'), or by a custom filter function (with -- 'recentFilterAddCustom'). -- -- Filtering by mime type handles aliasing and subclassing of mime types; -- e.g. a filter for text\/plain also matches a file with mime type -- application\/rtf, since application\/rtf is a subclass of text\/plain. Note -- that 'RecentFilter' allows wildcards for the subtype of a mime type, so you -- can e.g. filter for image\/. -- -- Normally, filters are used by adding them to a 'RecentChooser', see -- 'recentChooserAddFilter', but it is also possible to manually use a filter -- on a file with 'recentFilterFilter'. -- -- Recently used files are supported since Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----RecentFilter -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types RecentFilter, RecentFilterClass, castToRecentFilter, toRecentFilter, -- * Enums RecentFilterFlags(..), -- * Constructors recentFilterNew, -- * Methods recentFilterGetName, recentFilterSetName, recentFilterAddMimeType, recentFilterAddPattern, recentFilterAddPixbufFormats, recentFilterAddApplication, recentFilterAddGroup, recentFilterAddAge, #endif ) where #if GTK_CHECK_VERSION(2,10,0) import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} --------------------- -- Enums -- | These flags indicate what parts of a 'RecentFilterInfo' struct are filled or need to be filled. {#enum RecentFilterFlags {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Constructors -- | Creates a new 'RecentFilter' with no rules added to it. Such filter does -- not accept any recently used resources, so is not particularly useful until -- you add rules with 'recentFilterAddPattern', 'recentFilterAddMimeType', -- 'recentFilterAddApplication', 'recentFilterAddAge'. To create a filter that -- accepts any recently used resource, use: -- -- > filter <- recentFilterNew -- > recentFilterAddPattern filter "*" -- -- * Available since Gtk+ version 2.10 -- recentFilterNew :: IO RecentFilter recentFilterNew = makeNewObject mkRecentFilter $ {# call gtk_recent_filter_new #} -------------------- -- Methods -- | Gets the human-readable name for the filter. See 'recentFilterSetName'. -- -- * Available since Gtk+ version 2.10 -- recentFilterGetName :: (RecentFilterClass self, GlibString string) => self -> IO string -- ^ returns the name of the filter recentFilterGetName self = {# call gtk_recent_filter_get_name #} (toRecentFilter self) >>= peekUTFString -- | Sets the human-readable name of the filter; this is the string that will be displayed in the -- recently used resources selector user interface if there is a selectable list of filters. -- -- * Available since Gtk+ version 2.10 -- recentFilterSetName :: (RecentFilterClass self, GlibString string) => self -> string -- ^ @name@ - then human readable name of @filter@ -> IO () recentFilterSetName self name = withUTFString name $ \namePtr -> {# call gtk_recent_filter_set_name #} (toRecentFilter self) namePtr -- | Adds a rule that allows resources based on their registered MIME type. -- -- * Available since Gtk+ version 2.10 -- recentFilterAddMimeType :: (RecentFilterClass self, GlibString string) => self -> string -- ^ @mimeType@ - a MIME type -> IO () recentFilterAddMimeType self mimeType = withUTFString mimeType $ \mimeTypePtr -> {# call gtk_recent_filter_add_mime_type #} (toRecentFilter self) mimeTypePtr -- | Adds a rule that allows resources based on a pattern matching their -- display name. -- -- * Available since Gtk+ version 2.10 -- recentFilterAddPattern :: (RecentFilterClass self, GlibString string) => self -> string -- ^ @pattern@ - a file pattern -> IO () recentFilterAddPattern self pattern = withUTFString pattern $ \patternPtr -> {# call gtk_recent_filter_add_pattern #} (toRecentFilter self) patternPtr -- | Adds a rule allowing image files in the formats supported by 'Pixbuf'. -- recentFilterAddPixbufFormats :: RecentFilterClass self => self -> IO () recentFilterAddPixbufFormats self = {# call gtk_recent_filter_add_pixbuf_formats #} (toRecentFilter self) -- | Adds a rule that allows resources based on the name of the application -- that has registered them. -- -- -- * Available since Gtk+ version 2.10 -- recentFilterAddApplication :: (RecentFilterClass self, GlibString string) => self -> string -- ^ @application@ - an application name -> IO () recentFilterAddApplication self application = withUTFString application $ \applicationPtr -> {# call gtk_recent_filter_add_application #} (toRecentFilter self) applicationPtr -- | Adds a rule that allows resources based on the name of the group to which -- they belong -- -- -- * Available since Gtk+ version 2.10 -- recentFilterAddGroup :: (RecentFilterClass self, GlibString string) => self -> string -- ^ @group@ - a group name -> IO () recentFilterAddGroup self group = withUTFString group $ \groupPtr -> {# call gtk_recent_filter_add_group #} (toRecentFilter self) groupPtr -- | Adds a rule that allows resources based on their age - that is, the -- number of days elapsed since they were last modified. -- -- * Available since Gtk+ version 2.10 -- recentFilterAddAge :: RecentFilterClass self => self -> Int -- ^ @days@ - number of days -> IO () recentFilterAddAge self days = {# call gtk_recent_filter_add_age #} (toRecentFilter self) (fromIntegral days) #endif gtk-0.15.9/Graphics/UI/Gtk/Recent/RecentInfo.chs0000644000000000000000000002702407346545000017346 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RecentInfo -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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 Graphics.UI.Gtk.Recent.RecentInfo ( #if GTK_CHECK_VERSION(2,10,0) -- * Types RecentInfo, mkRecentInfo, -- * Methods recentInfoExists, recentInfoGetAdded, recentInfoGetAge, recentInfoGetApplicationInfo, recentInfoGetApplications, recentInfoGetDescription, recentInfoGetDisplayName, recentInfoGetGroups, recentInfoGetIcon, recentInfoGetMimeType, recentInfoGetModified, recentInfoGetPrivateHint, recentInfoGetShortName, recentInfoGetURI, recentInfoGetURIDisplay, recentInfoGetVisited, recentInfoHasApplication, recentInfoHasGroup, recentInfoIsLocal, recentInfoLastApplication, recentInfoMatch, #endif ) where #if GTK_CHECK_VERSION(2,10,0) import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Types {#pointer *RecentInfo foreign newtype#} -------------------- -- Methods -- | Helper function for build 'RecentInfo' mkRecentInfo :: Ptr RecentInfo -> IO RecentInfo mkRecentInfo rPtr = do info <- newForeignPtr rPtr gtk_recent_info_unref return (RecentInfo info) foreign import ccall unsafe ">k_recent_info_unref" gtk_recent_info_unref :: FinalizerPtr RecentInfo -- | Checks whether the resource pointed by info still exists. At the moment this check is done only on -- resources pointing to local files. -- -- * Available since Gtk+ version 2.10 -- recentInfoExists :: RecentInfo -> IO Bool -- ^ returns 'True' if the resource exists recentInfoExists self = liftM toBool $ {# call gtk_recent_info_exists #} self -- | Gets the timestamp (seconds from system's Epoch) when the resource was added to the recently used -- resources list. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetAdded :: RecentInfo -> IO Int -- ^ returns the number of seconds elapsed from system's Epoch when the resource was added to the list, or -1 on failure. recentInfoGetAdded self = liftM fromIntegral $ {# call gtk_recent_info_get_added #} self -- | Gets the number of days elapsed since the last update of the resource pointed by info. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetAge :: RecentInfo -> IO Int -- ^ returns a positive integer containing the number of days elapsed since the time this resource was last modified. recentInfoGetAge self = liftM fromIntegral $ {# call gtk_recent_info_get_age #} self -- | Gets the data regarding the application that has registered the resource pointed by info. -- -- If the command line contains any escape characters defined inside the storage specification, they -- will be expanded. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetApplicationInfo :: GlibString string => RecentInfo -> string -- ^ @appName@ the name of the application that has registered this item -> IO (Maybe ([string], Int, Int)) -- ^ @appExec@ return location for the string containing the command line. transfer none. -- ^ @count@ return location for the number of times this item was registered. out. -- ^ @time@ out. out. recentInfoGetApplicationInfo self appName = alloca $ \countPtr -> alloca $ \timePtr -> allocaArray 0 $ \execPtr -> withUTFString appName $ \appNamePtr -> do success <- liftM toBool $ {# call gtk_recent_info_get_application_info #} self appNamePtr execPtr countPtr timePtr if success then do exec <- mapM peekUTFString =<< peekArray 0 execPtr count <- peek countPtr time <- peek timePtr return (Just (exec, fromIntegral count, fromIntegral time)) else return Nothing -- | Retrieves the list of applications that have registered this resource. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetApplications :: GlibString string => RecentInfo -> IO [string] recentInfoGetApplications self = alloca $ \lengthPtr -> do str <- {# call gtk_recent_info_get_applications #} self lengthPtr length <- peek lengthPtr mapM peekUTFString =<< peekArray (fromIntegral length) str -- | Gets the (short) description of the resource. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetDescription :: GlibString string => RecentInfo -> IO string -- ^ returns the description of the resource. recentInfoGetDescription self = {# call gtk_recent_info_get_description #} self >>= peekUTFString -- | Gets the name of the resource. If none has been defined, the basename of the resource is obtained. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetDisplayName :: GlibString string => RecentInfo -> IO string -- ^ returns the display name of the resource. recentInfoGetDisplayName self = {# call gtk_recent_info_get_display_name #} self >>= peekUTFString -- | Returns all groups registered for the recently used item info. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetGroups :: GlibString string => RecentInfo -> IO [string] recentInfoGetGroups self = alloca $ \lengthPtr -> do str <- {# call gtk_recent_info_get_groups #} self lengthPtr length <- peek lengthPtr mapM peekUTFString =<< peekArray (fromIntegral length) str -- | Retrieves the icon of size size associated to the resource MIME type. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetIcon :: RecentInfo -> Int -- ^ @size@ the size of the icon in pixels -> IO (Maybe Pixbuf) -- ^ returns a 'Pixbuf' containing the icon, or 'Nothing' recentInfoGetIcon self size = maybeNull (makeNewGObject mkPixbuf) $ {# call gtk_recent_info_get_icon #} self (fromIntegral size) -- | Gets the MIME type of the resource. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetMimeType :: GlibString string => RecentInfo -> IO string -- ^ returns the MIME type of the resource. recentInfoGetMimeType self = {# call gtk_recent_info_get_mime_type #} self >>= peekUTFString -- | Gets the timestamp (seconds from system's Epoch) when the resource was last modified. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetModified :: RecentInfo -> IO Int -- ^ returns the number of seconds elapsed from system's Epoch when the resource was last modified, or -1 on failure. recentInfoGetModified self = liftM fromIntegral $ {# call gtk_recent_info_get_modified #} self -- | Gets the value of the "private" flag. Resources in the recently used list that have this flag set to -- 'True' should only be displayed by the applications that have registered them. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetPrivateHint :: RecentInfo -> IO Bool -- ^ returns 'True' if the private flag was found, 'False' otherwise. recentInfoGetPrivateHint self = liftM toBool $ {# call gtk_recent_info_get_private_hint #} self -- | Computes a valid UTF-8 string that can be used as the name of the item in a menu or list. For -- example, calling this function on an item that refers to \"file:///foo/bar.txt\" will yield \"bar.txt\". -- -- * Available since Gtk+ version 2.10 -- recentInfoGetShortName :: GlibString string => RecentInfo -> IO string recentInfoGetShortName self = {# call gtk_recent_info_get_short_name #} self >>= readUTFString -- | Gets the URI of the resource. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetURI :: GlibString string => RecentInfo -> IO string -- ^ returns the URI of the resource. recentInfoGetURI self = {# call gtk_recent_info_get_uri #} self >>= peekUTFString -- | Gets a displayable version of the resource's URI. If the resource is local, it returns a local path; -- if the resource is not local, it returns the UTF-8 encoded content of 'recentInfoGetUri'. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetURIDisplay :: GlibString string => RecentInfo -> IO string recentInfoGetURIDisplay self = {# call gtk_recent_info_get_uri_display #} self >>= readUTFString -- | Gets the timestamp (seconds from system's Epoch) when the resource was last visited. -- -- * Available since Gtk+ version 2.10 -- recentInfoGetVisited :: RecentInfo -> IO Int -- ^ returns the number of seconds elapsed from system's Epoch when the resource was last visited, or -1 on failure. recentInfoGetVisited self = liftM fromIntegral $ {# call gtk_recent_info_get_visited #} self -- | Checks whether an application registered this resource using @appName@. -- -- * Available since Gtk+ version 2.10 -- recentInfoHasApplication :: GlibString string => RecentInfo -> string -- ^ @appName@ a string containing an application name -> IO Bool -- ^ returns 'True' if an application with name @appName@ was found, 'False' otherwise. recentInfoHasApplication self appName = liftM toBool $ withUTFString appName $ \appNamePtr -> {# call gtk_recent_info_has_application #} self appNamePtr -- | Checks whether @groupName@ appears inside the groups registered for the recently used item info. -- -- * Available since Gtk+ version 2.10 -- recentInfoHasGroup :: GlibString string => RecentInfo -> string -- ^ @groupName@ name of a group -> IO Bool -- ^ returns 'True' if the group was found. recentInfoHasGroup self groupName = liftM toBool $ withUTFString groupName $ \groupNamePtr -> {# call gtk_recent_info_has_group #} self groupNamePtr -- | Checks whether the resource is local or not by looking at the scheme of its URI. -- -- * Available since Gtk+ version 2.10 -- recentInfoIsLocal :: RecentInfo -> IO Bool -- ^ returns 'True' if the resource is local. recentInfoIsLocal self = liftM toBool $ {# call gtk_recent_info_is_local #} self -- | Gets the name of the last application that have registered the recently used resource represented by -- info. -- -- * Available since Gtk+ version 2.10 -- recentInfoLastApplication :: GlibString string => RecentInfo -> IO string -- ^ returns an application name. recentInfoLastApplication self = {# call gtk_recent_info_last_application #} self >>= readUTFString -- | Checks whether two 'RecentInfo' structures point to the same resource. -- -- * Available since Gtk+ version 2.10 -- recentInfoMatch :: RecentInfo -> RecentInfo -> IO Bool -- ^ returns 'True' if both 'RecentInfo' structures point to se same resource, 'False' otherwise. recentInfoMatch self infoB = liftM toBool $ {# call gtk_recent_info_match #} self infoB #endif gtk-0.15.9/Graphics/UI/Gtk/Recent/RecentManager.chs0000644000000000000000000002400607346545000020022 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget RecentManager -- -- Author : Andy Stewart -- -- Created: 27 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Managing Recently Used Files -- -- * Module available since Gtk+ version 2.10 -- -- TODO: -- GtkRecentData -- gtk_recent_manager_add_full -- module Graphics.UI.Gtk.Recent.RecentManager ( -- * Detail -- -- | 'RecentManager' provides a facility for adding, removing and looking up -- recently used files. Each recently used file is identified by its URI, and -- has meta-data associated to it, like the names and command lines of the -- applications that have registered it, the number of time each application -- has registered the same file, the mime type of the file and whether the file -- should be displayed only by the applications that have registered it. -- -- The 'RecentManager' acts like a database of all the recently used files. -- You can create new 'RecentManager' objects, but it is more efficient to use -- the standard recent manager for the 'Screen' so that information about the -- recently used files is shared with other people using them. In case the -- default screen is being used, adding a new recently used file is as simple -- as: -- -- Recently used files are supported since Gtk+ 2.10. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----RecentManager -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types RecentManager, RecentManagerClass, castToRecentManager, toRecentManager, -- * Constructors recentManagerNew, -- * Methods recentManagerGetDefault, recentManagerAddItem, recentManagerRemoveItem, recentManagerLookupItem, recentManagerHasItem, recentManagerMoveItem, recentManagerGetItems, recentManagerPurgeItems, -- * Attributes recentManagerFilename, recentManagerLimit, recentManagerSize, -- * Signals recentManagerChanged, #endif ) where #if GTK_CHECK_VERSION(2,10,0) import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import System.Glib.GList import System.Glib.UTFString import System.Glib.GError (propagateGError, checkGError) {#import Graphics.UI.Gtk.Recent.RecentInfo#} (RecentInfo, mkRecentInfo) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new recent manager object. Recent manager objects are used to -- handle the list of recently used resources. A 'RecentManager' object -- monitors the recently used resources list, and emits the \"changed\" signal -- each time something inside the list changes. -- -- * Available since Gtk+ version 2.10 -- recentManagerNew :: IO RecentManager recentManagerNew = wrapNewGObject mkRecentManager $ {# call gtk_recent_manager_new #} -------------------- -- Methods -- | Gets a unique instance of 'RecentManager'. -- -- * Available since Gtk+ version 2.10 -- recentManagerGetDefault :: IO RecentManager -- ^ returns A unique 'RecentManager'. recentManagerGetDefault = makeNewGObject mkRecentManager $ {# call gtk_recent_manager_get_default #} -- | Adds a new resource, pointed by @uri@, into the recently used resources -- list. -- -- This function automatically retrieves some of the needed metadata and -- setting other metadata to common default values; it then feeds the data to -- 'recentManagerAddFull'. -- -- See 'recentManagerAddFull' if you want to explicitly define the metadata -- for the resource pointed by @uri@. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerAddItem :: (RecentManagerClass self, GlibString string) => self -> string -- ^ @uri@ - a valid URI -> IO Bool -- ^ returns @True@ if the new item was successfully added to the -- recently used resources list recentManagerAddItem self uri = liftM toBool $ withUTFString uri $ \uriPtr -> {# call gtk_recent_manager_add_item #} (toRecentManager self) uriPtr -- | Removes a resource pointed by @uri@ from the recently used resources list -- handled by a recent manager. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerRemoveItem :: (RecentManagerClass self, GlibString string) => self -> string -- ^ @uri@ - the URI of the item you wish to remove -> IO Bool -- ^ returns @True@ if the item pointed by @uri@ has been -- successfully removed by the recently used resources list, and -- @False@ otherwise. recentManagerRemoveItem self uri = checkGError (\errorPtr -> liftM toBool $ withUTFString uri $ \uriPtr -> {# call gtk_recent_manager_remove_item #} (toRecentManager self) uriPtr errorPtr) (\_ -> return False) -- | Searches for a URI inside the recently used resources list, and returns a -- structure containing information about the resource like its MIME type, or -- its display name. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerLookupItem :: (RecentManagerClass self, GlibString string) => self -> string -- ^ @uri@ - a URI -> IO RecentInfo -- ^ returns a 'RecentInfo' -- structure containing information about the -- resource pointed by @uri@, or {@NULL@, FIXME: this -- should probably be converted to a Maybe data type} -- if the URI was not registered in the recently used -- resources list. recentManagerLookupItem self uri = propagateGError $ \errorPtr -> withUTFString uri $ \uriPtr -> do result <- {# call unsafe gtk_recent_manager_lookup_item #} (toRecentManager self) uriPtr errorPtr mkRecentInfo result -- | Checks whether there is a recently used resource registered with @uri@ -- inside the recent manager. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerHasItem :: (RecentManagerClass self, GlibString string) => self -> string -- ^ @uri@ - a URI -> IO Bool -- ^ returns @True@ if the resource was found, @False@ otherwise. recentManagerHasItem self uri = liftM toBool $ withUTFString uri $ \uriPtr -> {# call gtk_recent_manager_has_item #} (toRecentManager self) uriPtr -- | Changes the location of a recently used resource from @uri@ to @newUri@. -- -- Please note that this function will not affect the resource pointed by -- the URIs, but only the URI used in the recently used resources list. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerMoveItem :: (RecentManagerClass self, GlibString string) => self -> string -- ^ @uri@ - the URI of a recently used resource -> string -- ^ @newUri@ - the new URI of the recently used resource to remove the item pointed by @uri@ in the list -> IO Bool -- ^ returns @True@ on success. recentManagerMoveItem self uri newUri = checkGError ( \errorPtr -> liftM toBool $ withUTFString newUri $ \newUriPtr -> withUTFString uri $ \uriPtr -> {# call gtk_recent_manager_move_item #} (toRecentManager self) uriPtr newUriPtr errorPtr) (\_ -> return False) -- | Gets the list of recently used resources. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerGetItems :: RecentManagerClass self => self -> IO [RecentInfo] -- ^ returns a list of newly allocated -- 'RecentInfo' objects. recentManagerGetItems self = do glist <- {# call gtk_recent_manager_get_items #} (toRecentManager self) list <- fromGList glist mapM mkRecentInfo list -- | Purges every item from the recently used resources list. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerPurgeItems :: RecentManagerClass self => self -> IO Int -- ^ returns the number of items that have been removed from the -- recently used resources list. recentManagerPurgeItems self = liftM fromIntegral $ propagateGError $ \errorPtr -> {# call gtk_recent_manager_purge_items #} (toRecentManager self) errorPtr -------------------- -- Attributes -- | The full path to the file to be used to store and read the recently used resources list -- -- Default value: 'Nothing' -- -- * Available since Gtk+ version 2.10 -- recentManagerFilename :: (RecentManagerClass self, GlibString string) => ReadAttr self string recentManagerFilename = readAttrFromStringProperty "filename" -- | The maximum number of items to be returned by the 'recentManagerGetItems' function. -- -- Allowed values: >= 'GMaxulong' -- -- Default value: -1 -- -- -- * Available since Gtk+ version 2.10 -- recentManagerLimit :: RecentManagerClass self => Attr self Int recentManagerLimit = newAttrFromIntProperty "limit" -- | The size of the recently used resources list. -- -- Allowed values: >= 'GMaxulong' -- -- Default value: 0 -- -- -- * Available since Gtk+ version 2.10 -- recentManagerSize :: RecentManagerClass self => ReadAttr self Int recentManagerSize = readAttrFromIntProperty "size" -------------------- -- Signals -- | Emitted when the current recently used resources manager changes its -- contents. -- -- -- * Available since Gtk+ version 2.10 -- recentManagerChanged :: RecentManagerClass self => Signal self (IO ()) recentManagerChanged = Signal (connect_NONE__NONE "changed") #endif gtk-0.15.9/Graphics/UI/Gtk/Scrolling/0000755000000000000000000000000007346545000015322 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Scrolling/HScrollbar.chs0000644000000000000000000000467507346545000020070 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HScrollbar -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A horizontal scrollbar -- module Graphics.UI.Gtk.Scrolling.HScrollbar ( -- * Detail -- -- | The 'HScrollbar' widget is a widget arranged horizontally creating a -- scrollbar. See 'Scrollbar' for details on scrollbars. An 'Adjustment' -- may be added to handle the adjustment of the scrollbar using -- 'hScrollbarNew' or you can use 'hScrollbarNewDefaults' in -- which case one will be created for you. See 'Adjustment' for details. -- -- All interesting functions can be found in 'Range', from which it is derived. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Range' -- | +----'Scrollbar' -- | +----HScrollbar -- @ -- * Types HScrollbar, HScrollbarClass, castToHScrollbar, gTypeHScrollbar, toHScrollbar, -- * Constructors hScrollbarNew, hScrollbarNewDefaults ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new horizontal scrollbar. -- hScrollbarNew :: Adjustment -- ^ @adjustment@ - the 'Adjustment' to use. -> IO HScrollbar hScrollbarNew adjustment = makeNewObject mkHScrollbar $ liftM (castPtr :: Ptr Widget -> Ptr HScrollbar) $ {# call unsafe hscrollbar_new #} adjustment -- | Create a new HScrollbar without specifying an existing 'Adjustment'. A -- new one will be created instead. -- hScrollbarNewDefaults :: IO HScrollbar hScrollbarNewDefaults = hScrollbarNew (Adjustment nullForeignPtr) gtk-0.15.9/Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs0000644000000000000000000004434607346545000020773 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ScrolledWindow -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Adds scrollbars to its child widget -- module Graphics.UI.Gtk.Scrolling.ScrolledWindow ( -- * Detail -- -- | 'ScrolledWindow' is a 'Bin' subclass: it's a container the accepts a -- single child widget. 'ScrolledWindow' adds scrollbars to the child widget -- and optionally draws a beveled frame around the child widget. -- -- The scrolled window can work in two ways. Some widgets have native -- scrolling support; these widgets have \"slots\" for 'Adjustment' objects. -- Widgets with native scroll support include 'TreeView', 'TextView', and -- 'Layout'. -- -- For widgets that lack native scrolling support, the 'Viewport' widget -- acts as an adaptor class, implementing scrollability for child widgets that -- lack their own scrolling capabilities. Use 'Viewport' to scroll child -- widgets such as 'Table', 'Box', and so on. -- -- If a widget has native scrolling abilities, it can be added to the -- 'ScrolledWindow' with 'Graphics.UI.Gtk.Abstract.Container.containerAdd'. -- If a widget does not, you must first add the widget to a 'Viewport', then -- add the 'Viewport' to the scrolled window. The convenience function -- 'scrolledWindowAddWithViewport' does exactly this, so you can ignore the -- presence of the viewport. -- -- The position of the scrollbars is controlled by the scroll adjustments. -- See 'Adjustment' for the fields in an adjustment - for 'Scrollbar', used by -- 'ScrolledWindow', the \"value\" field represents the position of the -- scrollbar, which must be between the \"lower\" field and \"upper - -- page_size.\" The \"page_size\" field represents the size of the visible -- scrollable area. The \"step_increment\" and \"page_increment\" fields are -- used when the user asks to step down (using the small stepper arrows) or -- page down (using for example the PageDown key). -- -- If a 'ScrolledWindow' doesn't behave quite as you would like, or doesn't -- have exactly the right layout, it's very possible to set up your own -- scrolling with 'Scrollbar' and for example a 'Table'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----ScrolledWindow -- @ -- * Types ScrolledWindow, ScrolledWindowClass, castToScrolledWindow, gTypeScrolledWindow, toScrolledWindow, -- * Constructors scrolledWindowNew, -- * Methods scrolledWindowGetHAdjustment, scrolledWindowGetVAdjustment, PolicyType(..), scrolledWindowSetPolicy, scrolledWindowGetPolicy, scrolledWindowAddWithViewport, CornerType(..), scrolledWindowSetPlacement, scrolledWindowGetPlacement, ShadowType(..), scrolledWindowSetShadowType, scrolledWindowGetShadowType, #if GTK_MAJOR_VERSION >= 3 scrolledWindowSetMinContentWidth, scrolledWindowGetMinContentWidth, scrolledWindowSetMinContentHeight, scrolledWindowGetMinContentHeight, #endif scrolledWindowSetHAdjustment, scrolledWindowSetVAdjustment, #if GTK_CHECK_VERSION(2,8,0) scrolledWindowGetHScrollbar, scrolledWindowGetVScrollbar, #endif #if GTK_CHECK_VERSION(3,4,0) scrolledWindowSetKineticScrolling, scrolledWindowGetKineticScrolling, scrolledWindowSetCaptureButtonPress, scrolledWindowGetCaptureButtonPress, #endif -- * Attributes scrolledWindowHAdjustment, scrolledWindowVAdjustment, scrolledWindowHscrollbarPolicy, scrolledWindowVscrollbarPolicy, scrolledWindowWindowPlacement, scrolledWindowShadowType, #if GTK_MAJOR_VERSION >= 3 scrolledWindowMinContentWidth, scrolledWindowMinContentHeight, #endif scrolledWindowPlacement, #if GTK_CHECK_VERSION(3,4,0) scrolledWindowKineticScrolling, #endif ) where import Control.Monad (liftM) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Enums (PolicyType(..), CornerType(..), ShadowType(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new scrolled window. The two arguments are the scrolled -- window's adjustments; these will be shared with the scrollbars and the child -- widget to keep the bars in sync with the child. Usually you want to pass -- @Nothing@ for the adjustments, which will cause the scrolled window to -- create them for you. -- scrolledWindowNew :: Maybe Adjustment -- ^ @hadjustment@ - Horizontal adjustment. -> Maybe Adjustment -- ^ @vadjustment@ - Vertical adjustment. -> IO ScrolledWindow scrolledWindowNew hadjustment vadjustment = makeNewObject mkScrolledWindow $ liftM (castPtr :: Ptr Widget -> Ptr ScrolledWindow) $ {# call unsafe scrolled_window_new #} (fromMaybe (Adjustment nullForeignPtr) hadjustment) (fromMaybe (Adjustment nullForeignPtr) vadjustment) -------------------- -- Methods -- | Returns the horizontal scrollbar's adjustment, used to connect the -- horizontal scrollbar to the child widget's horizontal scroll functionality. -- scrolledWindowGetHAdjustment :: ScrolledWindowClass self => self -> IO Adjustment scrolledWindowGetHAdjustment self = makeNewObject mkAdjustment $ {# call unsafe scrolled_window_get_hadjustment #} (toScrolledWindow self) -- | Returns the vertical scrollbar's adjustment, used to connect the vertical -- scrollbar to the child widget's vertical scroll functionality. -- scrolledWindowGetVAdjustment :: ScrolledWindowClass self => self -> IO Adjustment scrolledWindowGetVAdjustment self = makeNewObject mkAdjustment $ {# call unsafe scrolled_window_get_vadjustment #} (toScrolledWindow self) -- | Sets the scrollbar policy for the horizontal and vertical scrollbars. The -- policy determines when the scrollbar should appear; it is a value from the -- 'PolicyType' enumeration. If 'PolicyAlways', the scrollbar is always -- present; if 'PolicyNever', the scrollbar is never present; if -- 'PolicyAutomatic', the scrollbar is present only if needed (that is, if the -- slider part of the bar would be smaller than the through - the display is -- larger than the page size). -- scrolledWindowSetPolicy :: ScrolledWindowClass self => self -> PolicyType -- ^ @hscrollbarPolicy@ - Policy for horizontal bar. -> PolicyType -- ^ @vscrollbarPolicy@ - Policy for vertical bar. -> IO () scrolledWindowSetPolicy self hscrollbarPolicy vscrollbarPolicy = {# call scrolled_window_set_policy #} (toScrolledWindow self) ((fromIntegral . fromEnum) hscrollbarPolicy) ((fromIntegral . fromEnum) vscrollbarPolicy) -- | Retrieves the current policy values for the horizontal and vertical -- scrollbars. See 'scrolledWindowSetPolicy'. -- scrolledWindowGetPolicy :: ScrolledWindowClass self => self -> IO (PolicyType, PolicyType) -- ^ @(hscrollbarPolicy, vscrollbarPolicy)@ scrolledWindowGetPolicy self = alloca $ \hPolPtr -> alloca $ \vPolPtr -> do {# call unsafe scrolled_window_get_policy #} (toScrolledWindow self) hPolPtr vPolPtr hPol <- liftM (toEnum.fromIntegral) $ peek hPolPtr vPol <- liftM (toEnum.fromIntegral) $ peek vPolPtr return (hPol, vPol) -- | Used to add children without native scrolling capabilities. This is -- simply a convenience function; it is equivalent to adding the unscrollable -- child to a viewport, then adding the viewport to the scrolled window. If a -- child has native scrolling, use -- 'Graphics.UI.Gtk.Abstract.Container.containerAdd' instead of this function. -- -- The viewport scrolls the child by moving its 'DrawWindow', and takes the -- size of the child to be the size of its toplevel 'DrawWindow'. This will be -- very wrong for most widgets that support native scrolling; for example, if -- you add a widget such as 'TreeView' with a viewport, the whole widget will -- scroll, including the column headings. Thus, widgets with native scrolling -- support should not be used with the 'Viewport' proxy. -- scrolledWindowAddWithViewport :: (ScrolledWindowClass self, WidgetClass child) => self -> child -- ^ @child@ - Widget you want to scroll. -> IO () scrolledWindowAddWithViewport self child = {# call scrolled_window_add_with_viewport #} (toScrolledWindow self) (toWidget child) -- | Determines the location of the child widget with respect to the -- scrollbars. The default is 'CornerTopLeft', meaning the child is in the top -- left, with the scrollbars underneath and to the right. Other values in -- 'CornerType' are 'CornerTopRight', 'CornerBottomLeft', and -- 'CornerBottomRight'. -- scrolledWindowSetPlacement :: ScrolledWindowClass self => self -> CornerType -- ^ @windowPlacement@ - Position of the child window. -> IO () scrolledWindowSetPlacement self windowPlacement = {# call scrolled_window_set_placement #} (toScrolledWindow self) ((fromIntegral . fromEnum) windowPlacement) -- | Gets the placement of the scrollbars for the scrolled window. See -- 'scrolledWindowSetPlacement'. -- scrolledWindowGetPlacement :: ScrolledWindowClass self => self -> IO CornerType scrolledWindowGetPlacement self = liftM (toEnum . fromIntegral) $ {# call unsafe scrolled_window_get_placement #} (toScrolledWindow self) -- | Changes the type of shadow drawn around the contents of @scrolledWindow@. -- scrolledWindowSetShadowType :: ScrolledWindowClass self => self -> ShadowType -> IO () scrolledWindowSetShadowType self type_ = {# call scrolled_window_set_shadow_type #} (toScrolledWindow self) ((fromIntegral . fromEnum) type_) -- | Gets the shadow type of the scrolled window. See -- 'scrolledWindowSetShadowType'. -- scrolledWindowGetShadowType :: ScrolledWindowClass self => self -> IO ShadowType scrolledWindowGetShadowType self = liftM (toEnum . fromIntegral) $ {# call unsafe scrolled_window_get_shadow_type #} (toScrolledWindow self) #if GTK_MAJOR_VERSION >= 3 -- | Sets the minimum width that @scrolledWindow@ should keep visible. -- Note that this can and (usually will) be smaller than the minimum size of the content. -- scrolledWindowSetMinContentWidth :: ScrolledWindowClass self => self -> Int -> IO () scrolledWindowSetMinContentWidth self width = {# call gtk_scrolled_window_set_min_content_width #} (toScrolledWindow self) (fromIntegral width) -- | Gets the minimum content width of @scrolledWindow@, or -1 if not set. -- scrolledWindowGetMinContentWidth :: ScrolledWindowClass self => self -> IO Int scrolledWindowGetMinContentWidth self = liftM fromIntegral $ {# call unsafe scrolled_window_get_min_content_width #} (toScrolledWindow self) -- | Sets the minimum height that @scrolledWindow@ should keep visible. -- Note that this can and (usually will) be smaller than the minimum size of the content. -- scrolledWindowSetMinContentHeight :: ScrolledWindowClass self => self -> Int -> IO () scrolledWindowSetMinContentHeight self height = {# call gtk_scrolled_window_set_min_content_height #} (toScrolledWindow self) (fromIntegral height) -- | Gets the minimum content height of @scrolledWindow@, or -1 if not set. -- scrolledWindowGetMinContentHeight :: ScrolledWindowClass self => self -> IO Int scrolledWindowGetMinContentHeight self = liftM fromIntegral $ {# call unsafe scrolled_window_get_min_content_height #} (toScrolledWindow self) #endif -- | Sets the 'Adjustment' for the horizontal scrollbar. -- scrolledWindowSetHAdjustment :: ScrolledWindowClass self => self -> Adjustment -> IO () scrolledWindowSetHAdjustment self hadjustment = {# call scrolled_window_set_hadjustment #} (toScrolledWindow self) hadjustment -- | Sets the 'Adjustment' for the vertical scrollbar. -- scrolledWindowSetVAdjustment :: ScrolledWindowClass self => self -> Adjustment -- ^ @vadjustment@ - Vertical scroll adjustment. -> IO () scrolledWindowSetVAdjustment self vadjustment = {# call scrolled_window_set_vadjustment #} (toScrolledWindow self) vadjustment #if GTK_CHECK_VERSION(2,8,0) -- | Returns the horizontal scrollbar of @scrolledWindow@. -- -- * Available since Gtk+ version 2.8 -- scrolledWindowGetHScrollbar :: ScrolledWindowClass self => self -> IO (Maybe HScrollbar) -- ^ returns the horizontal scrollbar of the scrolled -- window, or @Nothing@ if it does not have one. scrolledWindowGetHScrollbar self = maybeNull (makeNewObject mkHScrollbar) $ liftM (castPtr :: Ptr Widget -> Ptr HScrollbar) $ {# call gtk_scrolled_window_get_hscrollbar #} (toScrolledWindow self) -- | Returns the vertical scrollbar of @scrolledWindow@. -- -- * Available since Gtk+ version 2.8 -- scrolledWindowGetVScrollbar :: ScrolledWindowClass self => self -> IO (Maybe VScrollbar) -- ^ returns the vertical scrollbar of the scrolled -- window, or @Nothing@ if it does not have one. scrolledWindowGetVScrollbar self = maybeNull (makeNewObject mkVScrollbar) $ liftM (castPtr :: Ptr Widget -> Ptr VScrollbar) $ {# call gtk_scrolled_window_get_vscrollbar #} (toScrolledWindow self) #endif #if GTK_CHECK_VERSION(3,4,0) -- | Turns kinetic scrolling on or off. Kinetic scrolling only applies to -- devices with source GDK_SOURCE_TOUCHSCREEN. -- scrolledWindowSetKineticScrolling :: ScrolledWindowClass self => self -> Bool -> IO () scrolledWindowSetKineticScrolling self kineticScrolling = {# call scrolled_window_set_kinetic_scrolling #} (toScrolledWindow self) (fromBool kineticScrolling) -- | Returns the specified kinetic scrolling behavior. -- scrolledWindowGetKineticScrolling :: ScrolledWindowClass self => self -> IO Bool scrolledWindowGetKineticScrolling self = liftM toBool $ {# call scrolled_window_get_kinetic_scrolling #} (toScrolledWindow self) -- | Changes the behaviour of @scrolledWindow@ wrt. to the initial event that -- possibly starts kinetic scrolling. When @captureButtonPress@ is set to -- True, the event is captured by the scrolled window, and then later replayed -- if it is meant to go to the child widget. -- -- This should be enabled if any child widgets perform non-reversible actions -- on "button-press-event". If they don't, and handle additionally handle -- "grab-broken-event", it might be better to set captureButtonPress to False. -- -- This setting only has an effect if kinetic scrolling is enabled. -- scrolledWindowSetCaptureButtonPress :: ScrolledWindowClass self => self -> Bool -> IO () scrolledWindowSetCaptureButtonPress self captureButtonPress = {# call gtk_scrolled_window_set_capture_button_press #} (toScrolledWindow self) (fromBool captureButtonPress) -- | Return whether button presses are captured during kinetic scrolling. -- See @scrolledWindowSetCaptureButtonPress@. -- scrolledWindowGetCaptureButtonPress :: ScrolledWindowClass self => self -> IO Bool scrolledWindowGetCaptureButtonPress self = liftM toBool $ {# call gtk_scrolled_window_get_capture_button_press #} (toScrolledWindow self) #endif -------------------- -- Attributes -- | The 'Adjustment' for the horizontal position. -- scrolledWindowHAdjustment :: ScrolledWindowClass self => Attr self Adjustment scrolledWindowHAdjustment = newAttr scrolledWindowGetHAdjustment scrolledWindowSetHAdjustment -- | The 'Adjustment' for the vertical position. -- scrolledWindowVAdjustment :: ScrolledWindowClass self => Attr self Adjustment scrolledWindowVAdjustment = newAttr scrolledWindowGetVAdjustment scrolledWindowSetVAdjustment -- | When the horizontal scrollbar is displayed. -- -- Default value: 'PolicyAlways' -- scrolledWindowHscrollbarPolicy :: ScrolledWindowClass self => Attr self PolicyType scrolledWindowHscrollbarPolicy = newAttrFromEnumProperty "hscrollbar-policy" {# call pure unsafe gtk_policy_type_get_type #} -- | When the vertical scrollbar is displayed. -- -- Default value: 'PolicyAlways' -- scrolledWindowVscrollbarPolicy :: ScrolledWindowClass self => Attr self PolicyType scrolledWindowVscrollbarPolicy = newAttrFromEnumProperty "vscrollbar-policy" {# call pure unsafe gtk_policy_type_get_type #} -- | Where the contents are located with respect to the scrollbars. -- -- Default value: 'CornerTopLeft' -- scrolledWindowWindowPlacement :: ScrolledWindowClass self => Attr self CornerType scrolledWindowWindowPlacement = newAttrFromEnumProperty "window-placement" {# call pure unsafe gtk_corner_type_get_type #} -- | Style of bevel around the contents. -- -- Default value: 'ShadowNone' -- scrolledWindowShadowType :: ScrolledWindowClass self => Attr self ShadowType scrolledWindowShadowType = newAttr scrolledWindowGetShadowType scrolledWindowSetShadowType #if GTK_MAJOR_VERSION >= 3 -- | Minimum width that @scrolledWindow@ should keep visible. -- -- Default value: -1 -- scrolledWindowMinContentWidth :: ScrolledWindowClass self => Attr self Int scrolledWindowMinContentWidth = newAttr scrolledWindowGetMinContentWidth scrolledWindowSetMinContentWidth -- | Minimum height that @scrolledWindow@ should keep visible. -- -- Default value: -1 -- scrolledWindowMinContentHeight :: ScrolledWindowClass self => Attr self Int scrolledWindowMinContentHeight = newAttr scrolledWindowGetMinContentHeight scrolledWindowSetMinContentHeight #endif -- | \'placement\' property. See 'scrolledWindowGetPlacement' and -- 'scrolledWindowSetPlacement' -- scrolledWindowPlacement :: ScrolledWindowClass self => Attr self CornerType scrolledWindowPlacement = newAttr scrolledWindowGetPlacement scrolledWindowSetPlacement #if GTK_CHECK_VERSION(3,4,0) -- | The kinetic scrolling behavior flags. Kinetic scrolling only applies to -- devices with source GDK_SOURCE_TOUCHSCREEN -- scrolledWindowKineticScrolling :: ScrolledWindowClass self => Attr self Bool scrolledWindowKineticScrolling = newAttr scrolledWindowGetKineticScrolling scrolledWindowSetKineticScrolling #endif gtk-0.15.9/Graphics/UI/Gtk/Scrolling/VScrollbar.chs0000644000000000000000000000466707346545000020107 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VScrollbar -- -- Author : Axel Simon -- -- Created: 23 May 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A vertical scrollbar -- module Graphics.UI.Gtk.Scrolling.VScrollbar ( -- * Detail -- -- | The 'VScrollbar' widget is a widget arranged vertically creating a -- scrollbar. See 'Scrollbar' for details on scrollbars. An 'Adjustment' -- may be added to handle the adjustment of the scrollbar using -- 'vScrollbarNew' or you can use 'vScrollbarNewDefaults' in -- which case one will be created for you. See 'Adjustment' for details. -- -- All interesting functions can be found in 'Range', from which it is derived. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Range' -- | +----'Scrollbar' -- | +----VScrollbar -- @ -- * Types VScrollbar, VScrollbarClass, castToVScrollbar, gTypeVScrollbar, toVScrollbar, -- * Constructors vScrollbarNew, vScrollbarNewDefaults ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new vertical scrollbar. -- vScrollbarNew :: Adjustment -- ^ @adjustment@ - the 'Adjustment' to use. -> IO VScrollbar vScrollbarNew adjustment = makeNewObject mkVScrollbar $ liftM (castPtr :: Ptr Widget -> Ptr VScrollbar) $ {# call unsafe vscrollbar_new #} adjustment -- | Create a new HScrollbar without specifying an existing 'Adjustment'. A -- new one will be created instead. -- vScrollbarNewDefaults :: IO VScrollbar vScrollbarNewDefaults = vScrollbarNew (Adjustment nullForeignPtr) gtk-0.15.9/Graphics/UI/Gtk/Selectors/0000755000000000000000000000000007346545000015331 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Selectors/ColorButton.chs0000644000000000000000000001615307346545000020310 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ColorButton -- -- Author : Duncan Coutts -- -- Created: 5 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) -- -- A button to launch a color selection dialog -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Selectors.ColorButton ( -- * Detail -- -- | The 'ColorButton' is a button which displays the currently selected color -- an allows to open a color selection dialog to change the color. It is -- suitable widget for selecting a color in a preference dialog. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----ColorButton -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ColorButton, ColorButtonClass, castToColorButton, gTypeColorButton, toColorButton, -- * Constructors colorButtonNew, colorButtonNewWithColor, -- * Methods colorButtonSetColor, colorButtonGetColor, colorButtonSetAlpha, colorButtonGetAlpha, colorButtonSetUseAlpha, colorButtonGetUseAlpha, colorButtonSetTitle, colorButtonGetTitle, -- * Attributes colorButtonUseAlpha, colorButtonTitle, colorButtonAlpha, -- * Signals onColorSet, afterColorSet, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Structs (Color) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new color button. This returns a widget in the form of a small -- button containing a swatch representing the current selected color. When the -- button is clicked, a color-selection dialog will open, allowing the user to -- select a color. The swatch will be updated to reflect the new color when the -- user finishes. -- colorButtonNew :: IO ColorButton colorButtonNew = makeNewObject mkColorButton $ liftM (castPtr :: Ptr Widget -> Ptr ColorButton) $ {# call gtk_color_button_new #} -- | Creates a new color button. -- colorButtonNewWithColor :: Color -- ^ @color@ - A 'Color' to set the current color with. -> IO ColorButton colorButtonNewWithColor color = makeNewObject mkColorButton $ liftM (castPtr :: Ptr Widget -> Ptr ColorButton) $ with color $ \colorPtr -> {# call gtk_color_button_new_with_color #} (castPtr colorPtr) -------------------- -- Methods -- | Sets the current color to be @color@. -- colorButtonSetColor :: ColorButtonClass self => self -> Color -- ^ @color@ - A 'Color' to set the current color with. -> IO () colorButtonSetColor self color = with color $ \colorPtr -> {# call gtk_color_button_set_color #} (toColorButton self) (castPtr colorPtr) -- | Returns the current color value. -- colorButtonGetColor :: ColorButtonClass self => self -> IO Color colorButtonGetColor self = alloca $ \colorPtr -> {# call gtk_color_button_get_color #} (toColorButton self) (castPtr colorPtr) >> peek colorPtr >>= \color -> return color -- | Sets the current opacity to be @alpha@. -- colorButtonSetAlpha :: ColorButtonClass self => self -> Word16 -- ^ @alpha@ - an integer between 0 and 65535. -> IO () colorButtonSetAlpha self alpha = {# call gtk_color_button_set_alpha #} (toColorButton self) (fromIntegral alpha) -- | Returns the current alpha value. -- colorButtonGetAlpha :: ColorButtonClass self => self -> IO Word16 -- ^ returns an integer between 0 and 65535. colorButtonGetAlpha self = liftM fromIntegral $ {# call gtk_color_button_get_alpha #} (toColorButton self) -- | Sets whether or not the color button should use the alpha channel. -- colorButtonSetUseAlpha :: ColorButtonClass self => self -> Bool -- ^ @useAlpha@ - @True@ if color button should use alpha channel, -- @False@ if not. -> IO () colorButtonSetUseAlpha self useAlpha = {# call gtk_color_button_set_use_alpha #} (toColorButton self) (fromBool useAlpha) -- | Does the color selection dialog use the alpha channel? -- colorButtonGetUseAlpha :: ColorButtonClass self => self -> IO Bool -- ^ returns @True@ if the color sample uses alpha channel, -- @False@ if not. colorButtonGetUseAlpha self = liftM toBool $ {# call gtk_color_button_get_use_alpha #} (toColorButton self) -- | Sets the title for the color selection dialog. -- colorButtonSetTitle :: (ColorButtonClass self, GlibString string) => self -> string -- ^ @title@ - String containing new window title. -> IO () colorButtonSetTitle self title = withUTFString title $ \titlePtr -> {# call gtk_color_button_set_title #} (toColorButton self) titlePtr -- | Gets the title of the color selection dialog. -- colorButtonGetTitle :: (ColorButtonClass self, GlibString string) => self -> IO string -- ^ returns An internal string, do not free the return value colorButtonGetTitle self = {# call gtk_color_button_get_title #} (toColorButton self) >>= peekUTFString -------------------- -- Attributes -- | If this property is set to @True@, the color swatch on the button is -- rendered against a checkerboard background to show its opacity and the -- opacity slider is displayed in the color selection dialog. -- -- Default value: @False@ -- colorButtonUseAlpha :: ColorButtonClass self => Attr self Bool colorButtonUseAlpha = newAttr colorButtonGetUseAlpha colorButtonSetUseAlpha -- | The title of the color selection dialog -- -- Default value: \"Pick a Color\" -- colorButtonTitle :: (ColorButtonClass self, GlibString string) => Attr self string colorButtonTitle = newAttr colorButtonGetTitle colorButtonSetTitle -- | The selected opacity value (0 fully transparent, 65535 fully opaque). -- -- Allowed values: \<= 65535 -- -- Default value: 65535 -- colorButtonAlpha :: ColorButtonClass self => Attr self Word16 colorButtonAlpha = newAttr colorButtonGetAlpha colorButtonSetAlpha -------------------- -- Signals -- | The 'colorSet' signal is emitted when the user selects a color. When -- handling this signal, use 'colorButtonGetColor' and 'colorButtonGetAlpha' to -- find out which color was just selected. -- onColorSet, afterColorSet :: ColorButtonClass self => self -> IO () -> IO (ConnectId self) onColorSet = connect_NONE__NONE "color_set" False afterColorSet = connect_NONE__NONE "color_set" True #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/ColorSelection.chs0000644000000000000000000002146307346545000020762 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ColorSelection -- -- Author : Duncan Coutts -- -- Created: 2 August 2004 -- -- Copyright (C) 2004-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) -- -- A widget used to select a color -- module Graphics.UI.Gtk.Selectors.ColorSelection ( -- * Detail -- -- | The 'ColorSelection' is a widget that is used to select a color. It -- consists of a color wheel and number of sliders and entry boxes for color -- parameters such as hue, saturation, value, red, green, blue, and opacity. It -- is found on the standard color selection dialog box 'ColorSelectionDialog'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'VBox' -- | +----ColorSelection -- @ -- * Types ColorSelection, ColorSelectionClass, castToColorSelection, gTypeColorSelection, toColorSelection, -- * Constructors colorSelectionNew, -- * Methods colorSelectionGetCurrentAlpha, colorSelectionSetCurrentAlpha, colorSelectionGetCurrentColor, colorSelectionSetCurrentColor, colorSelectionGetHasOpacityControl, colorSelectionSetHasOpacityControl, colorSelectionGetHasPalette, colorSelectionSetHasPalette, colorSelectionGetPreviousAlpha, colorSelectionSetPreviousAlpha, colorSelectionGetPreviousColor, colorSelectionSetPreviousColor, colorSelectionIsAdjusting, -- * Attributes colorSelectionHasOpacityControl, colorSelectionHasPalette, colorSelectionCurrentAlpha, colorSelectionPreviousAlpha, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.General.Structs (Color) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'ColorSelection'. -- colorSelectionNew :: IO ColorSelection colorSelectionNew = makeNewObject mkColorSelection $ liftM (castPtr :: Ptr Widget -> Ptr ColorSelection) $ {# call unsafe color_selection_new #} -------------------- -- Methods -- | Returns the current alpha value. -- colorSelectionGetCurrentAlpha :: ColorSelectionClass self => self -> IO Int -- ^ returns an integer between 0 and 65535. colorSelectionGetCurrentAlpha self = liftM fromIntegral $ {# call unsafe color_selection_get_current_alpha #} (toColorSelection self) -- | Sets the current opacity to be @alpha@. The first time this is called, it -- will also set the original opacity to be @alpha@ too. -- colorSelectionSetCurrentAlpha :: ColorSelectionClass self => self -> Int -- ^ @alpha@ - an integer between 0 and 65535. -> IO () colorSelectionSetCurrentAlpha self alpha = {# call color_selection_set_current_alpha #} (toColorSelection self) (fromIntegral alpha) -- | Gets the current color in the 'ColorSelection' widget. -- colorSelectionGetCurrentColor :: ColorSelectionClass self => self -> IO Color colorSelectionGetCurrentColor self = alloca $ \colorPtr -> do {# call unsafe color_selection_get_current_color #} (toColorSelection self) (castPtr colorPtr) peek colorPtr -- | Sets the current color to be @color@. The first time this is called, it -- will also set the original color to be @color@ too. -- colorSelectionSetCurrentColor :: ColorSelectionClass self => self -> Color -- ^ @color@ - A 'Color' to set the current color with. -> IO () colorSelectionSetCurrentColor self color = with color $ \colorPtr -> {# call color_selection_set_current_color #} (toColorSelection self) (castPtr colorPtr) -- | Determines whether the 'ColorSelection' widget has an opacity control. -- colorSelectionGetHasOpacityControl :: ColorSelectionClass self => self -> IO Bool -- ^ returns @True@ if the color selector has an opacity control. -- @False@ if it doesn't. colorSelectionGetHasOpacityControl self = liftM toBool $ {# call unsafe color_selection_get_has_opacity_control #} (toColorSelection self) -- | Sets the 'ColorSelection' widget to use or not use opacity. -- colorSelectionSetHasOpacityControl :: ColorSelectionClass self => self -> Bool -- ^ @hasOpacity@ - @True@ if color selector can set the opacity, -- @False@ otherwise. -> IO () colorSelectionSetHasOpacityControl self hasOpacity = {# call color_selection_set_has_opacity_control #} (toColorSelection self) (fromBool hasOpacity) -- | Determines whether the color selector has a color palette. -- colorSelectionGetHasPalette :: ColorSelectionClass self => self -> IO Bool -- ^ returns @True@ if the selector has a palette. @False@ if it -- hasn't. colorSelectionGetHasPalette self = liftM toBool $ {# call unsafe color_selection_get_has_palette #} (toColorSelection self) -- | Sets whether to show or hide the palette. -- colorSelectionSetHasPalette :: ColorSelectionClass self => self -> Bool -- ^ @hasPalette@ - @True@ if palette is to be visible, @False@ -- otherwise. -> IO () colorSelectionSetHasPalette self hasPalette = {# call color_selection_set_has_palette #} (toColorSelection self) (fromBool hasPalette) -- | Returns the previous alpha value. -- colorSelectionGetPreviousAlpha :: ColorSelectionClass self => self -> IO Int -- ^ returns an integer between 0 and 65535. colorSelectionGetPreviousAlpha self = liftM fromIntegral $ {# call unsafe color_selection_get_previous_alpha #} (toColorSelection self) -- | Sets the \'previous\' alpha to be @alpha@. This function should be called -- with some hesitations, as it might seem confusing to have that alpha change. -- colorSelectionSetPreviousAlpha :: ColorSelectionClass self => self -> Int -- ^ @alpha@ - an integer between 0 and 65535. -> IO () colorSelectionSetPreviousAlpha self alpha = {# call color_selection_set_previous_alpha #} (toColorSelection self) (fromIntegral alpha) -- | Returns the original color value. -- colorSelectionGetPreviousColor :: ColorSelectionClass self => self -> IO Color colorSelectionGetPreviousColor self = alloca $ \colorPtr -> do {# call unsafe color_selection_get_previous_color #} (toColorSelection self) (castPtr colorPtr) peek colorPtr -- | Sets the \'previous\' color to be @color@. This function should be called -- with some hesitations, as it might seem confusing to have that color change. -- Calling 'colorSelectionSetCurrentColor' will also set this color the first -- time it is called. -- colorSelectionSetPreviousColor :: ColorSelectionClass self => self -> Color -> IO () colorSelectionSetPreviousColor self color = with color $ \colorPtr -> {# call color_selection_set_previous_color #} (toColorSelection self) (castPtr colorPtr) -- | Gets the current state of the widget. Returns True if the user is currently -- dragging a color around, and False if the selection has stopped. -- colorSelectionIsAdjusting :: ColorSelectionClass self => self -> IO Bool colorSelectionIsAdjusting self = liftM toBool $ {# call unsafe color_selection_is_adjusting #} (toColorSelection self) -------------------- -- Attributes -- | Whether the color selector should allow setting opacity. -- -- Default value: @False@ -- colorSelectionHasOpacityControl :: ColorSelectionClass self => Attr self Bool colorSelectionHasOpacityControl = newAttr colorSelectionGetHasOpacityControl colorSelectionSetHasOpacityControl -- | Whether a palette should be used. -- -- Default value: @False@ -- colorSelectionHasPalette :: ColorSelectionClass self => Attr self Bool colorSelectionHasPalette = newAttr colorSelectionGetHasPalette colorSelectionSetHasPalette -- | The current opacity value (0 fully transparent, 65535 fully opaque). -- -- Allowed values: \<= 65535 -- -- Default value: 65535 -- colorSelectionCurrentAlpha :: ColorSelectionClass self => Attr self Int colorSelectionCurrentAlpha = newAttr colorSelectionGetCurrentAlpha colorSelectionSetCurrentAlpha -- | \'previousAlpha\' property. See 'colorSelectionGetPreviousAlpha' and -- 'colorSelectionSetPreviousAlpha' -- colorSelectionPreviousAlpha :: ColorSelectionClass self => Attr self Int colorSelectionPreviousAlpha = newAttr colorSelectionGetPreviousAlpha colorSelectionSetPreviousAlpha gtk-0.15.9/Graphics/UI/Gtk/Selectors/ColorSelectionDialog.chs0000644000000000000000000000560507346545000022102 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ColorSelectionDialog -- -- Author : Duncan Coutts -- -- Created: 2 August 2004 -- -- Copyright (C) 2004-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) -- -- A standard dialog box for selecting a color -- module Graphics.UI.Gtk.Selectors.ColorSelectionDialog ( -- * Detail -- -- | The 'ColorSelectionDialog' provides a standard dialog which allows the -- user to select a color much like the 'FileSelection' provides a standard -- dialog for file selection. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----'Dialog' -- | +----ColorSelectionDialog -- @ -- * Types ColorSelectionDialog, ColorSelectionDialogClass, castToColorSelectionDialog, gTypeColorSelectionDialog, toColorSelectionDialog, -- * Constructors colorSelectionDialogNew, -- * Methods #if GTK_MAJOR_VERSION < 3 colorSelectionDialogGetColor, colorSelectionDialogGetOkButton, colorSelectionDialogGetCancelButton, colorSelectionDialogGetHelpButton, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Structs (colorSelectionDialogGetColor, colorSelectionDialogGetOkButton, colorSelectionDialogGetCancelButton, colorSelectionDialogGetHelpButton) #endif {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'ColorSelectionDialog'. -- colorSelectionDialogNew :: GlibString string => string -- ^ @title@ - a string containing the title text -- for the dialog. -> IO ColorSelectionDialog colorSelectionDialogNew title = makeNewObject mkColorSelectionDialog $ liftM (castPtr :: Ptr Widget -> Ptr ColorSelectionDialog) $ withUTFString title $ \titlePtr -> {# call unsafe color_selection_dialog_new #} titlePtr gtk-0.15.9/Graphics/UI/Gtk/Selectors/FileChooser.chs0000644000000000000000000013262407346545000020242 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface FileChooser -- -- Author : Duncan Coutts -- -- Created: 24 April 2004 -- -- Copyright (C) 2004-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) -- -- File chooser interface used by 'FileChooserWidget' and -- 'FileChooserDialog' -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Selectors.FileChooser ( -- * Detail -- -- | 'FileChooser' is an interface that can be implemented by file selection -- widgets. In Gtk+, the main objects that implement this interface are -- 'FileChooserWidget', 'FileChooserDialog', and 'FileChooserButton'. You do -- not need to write an object that implements the 'FileChooser' interface -- unless you are trying to adapt an existing file selector to expose a -- standard programming interface. -- -- 'FileChooser' allows for shortcuts to various places in the filesystem. -- In the default implementation these are displayed in the left pane. It may -- be a bit confusing at first that these shortcuts come from various sources -- and in various flavours, so lets explain the terminology here: -- ** File Names and Encodings -- -- | When the user is finished selecting files in a 'FileChooser', your -- program can get the selected names either as filenames or as URIs. For URIs, -- the normal escaping rules are applied if the URI contains non-ASCII -- characters. However, filenames are /always/ returned in the character set -- specified by the G_FILENAME_ENCODING environment variable. Please see the -- Glib documentation for more details about this variable. -- ** Adding a Preview Widget -- -- | You can add a custom preview widget to a file chooser and then get -- notification about when the preview needs to be updated. To install a -- preview widget, use 'fileChooserSetPreviewWidget'. Then, connect to the -- updatePreview signal to get notified when you need to update -- the contents of the preview. -- -- Your callback should use 'fileChooserGetPreviewFilename' to see what -- needs previewing. Once you have generated the preview for the corresponding -- file, you must call 'fileChooserSetPreviewWidgetActive' with a boolean flag -- that indicates whether your callback could successfully generate a preview. -- ** Adding Extra Widgets -- -- | You can add extra widgets to a file chooser to provide options that are -- not present in the default design. For example, you can add a toggle button -- to give the user the option to open a file in read-only mode. You can use -- 'fileChooserSetExtraWidget' to insert additional widgets in a file chooser. -- ** Key Bindings -- -- | Internally, Gtk+ implements a file chooser's graphical user interface -- with the private GtkFileChooserDefaultClass. This widget has several key -- bindings and their associated signals. This section describes the available -- key binding signals. -- -- * GtkFileChooser key binding example -- -- The default keys that activate the 'keyBinding' signals in -- GtkFileChooserDefaultClass are as follows: -- -- [Signal name] Key -- -- [location-popup] Control-L -- -- [up-folder] Alt-Up -- -- [down-folder] Alt-Down -- -- [home-folder] Alt-Home -- -- To change these defaults to something else, you could include the -- following fragment in your .gtkrc-2.0 file: -- -- > binding "my-own-gtkfilechooser-bindings" { -- > bind "AltShiftl" { -- > "location-popup" () -- > } -- > bind "AltShiftUp" { -- > "up-folder" () -- > } -- > bind "AltShiftDown" { -- > "down-folder" () -- > } -- > bind "AltShiftHome" { -- > "home-folder-folder" () -- > } -- > } -- > -- > class "GtkFileChooserDefault" binding "my-own-gtkfilechooser-bindings" -- > -- -- * Class Hierarchy -- | -- @ -- | GInterface -- | +----FileChooser -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types FileChooser, FileChooserClass, castToFileChooser, gTypeFileChooser, toFileChooser, FileChooserAction(..), FileChooserError(..), #if GTK_CHECK_VERSION(2,8,0) FileChooserConfirmation(..), #endif -- * Methods fileChooserSetAction, fileChooserGetAction, fileChooserSetLocalOnly, fileChooserGetLocalOnly, fileChooserSetSelectMultiple, fileChooserGetSelectMultiple, fileChooserSetCurrentName, fileChooserGetFilename, fileChooserSetFilename, fileChooserSelectFilename, fileChooserUnselectFilename, fileChooserSelectAll, fileChooserUnselectAll, fileChooserGetFilenames, fileChooserSetCurrentFolder, fileChooserGetCurrentFolder, fileChooserGetURI, fileChooserSetURI, fileChooserSelectURI, fileChooserUnselectURI, fileChooserGetURIs, fileChooserSetCurrentFolderURI, fileChooserGetCurrentFolderURI, fileChooserSetPreviewWidget, fileChooserGetPreviewWidget, fileChooserSetPreviewWidgetActive, fileChooserGetPreviewWidgetActive, fileChooserSetUsePreviewLabel, fileChooserGetUsePreviewLabel, fileChooserGetPreviewFilename, fileChooserGetPreviewURI, fileChooserSetExtraWidget, fileChooserGetExtraWidget, fileChooserAddFilter, fileChooserRemoveFilter, fileChooserListFilters, fileChooserSetFilter, fileChooserGetFilter, fileChooserAddShortcutFolder, fileChooserRemoveShortcutFolder, fileChooserListShortcutFolders, fileChooserAddShortcutFolderURI, fileChooserRemoveShortcutFolderURI, fileChooserListShortcutFolderURIs, fileChooserErrorDomain, #if GTK_CHECK_VERSION(2,6,0) fileChooserSetShowHidden, fileChooserGetShowHidden, #endif #if GTK_CHECK_VERSION(2,8,0) fileChooserSetDoOverwriteConfirmation, fileChooserGetDoOverwriteConfirmation, #endif -- * Attributes fileChooserUsePreviewLabel, #if GTK_CHECK_VERSION(2,6,0) fileChooserShowHidden, #endif fileChooserSelectMultiple, fileChooserPreviewWidgetActive, fileChooserPreviewWidget, fileChooserLocalOnly, fileChooserFilter, fileChooserExtraWidget, #if GTK_CHECK_VERSION(2,8,0) fileChooserDoOverwriteConfirmation, #endif fileChooserAction, -- * Signals currentFolderChanged, fileActivated, fileSelectionChanged, updatePreview, #if GTK_CHECK_VERSION(2,8,0) confirmOverwrite, #endif #ifndef DISABLE_DEPRECATED -- * Deprecated onCurrentFolderChanged, afterCurrentFolderChanged, onFileActivated, afterFileActivated, -- onSelectionChanged, -- afterSelectionChanged, onUpdatePreview, afterUpdatePreview, #if GTK_CHECK_VERSION(2,8,0) onConfirmOverwrite, afterConfirmOverwrite, #endif -- version 2.8 #endif -- deprecated #endif -- version 2.4 ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Signals {#import System.Glib.GList#} import System.Glib.GError (propagateGError, GErrorDomain, GErrorClass(..)) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -- | Describes whether a 'FileChooser' is being used to open existing files -- or to save to a possibly new file. {# enum FileChooserAction {underscoreToCase} #} -- | These identify the various errors that can occur while calling -- 'FileChooser' functions. {# enum FileChooserError {underscoreToCase} #} #if GTK_CHECK_VERSION(2,8,0) -- | Used as a return value of handlers for the 'onConfirmOverwrite' -- signal of a 'FileChooser'. -- -- * This value determines whether the file chooser will present the stock -- confirmation dialog, accept the user's choice of a filename, or let -- the user choose another filename. -- -- Since Gtk 2.8. -- {# enum FileChooserConfirmation {underscoreToCase} #} #endif -------------------- -- Methods fileChooserErrorDomain :: GErrorDomain fileChooserErrorDomain = unsafePerformIO {#call unsafe file_chooser_error_quark#} instance GErrorClass FileChooserError where gerrorDomain _ = fileChooserErrorDomain -- | Sets the type of operation that the chooser is performing; the user -- interface is adapted to suit the selected action. For example, an option to -- create a new folder might be shown if the action is 'FileChooserActionSave' -- but not if the action is 'FileChooserActionOpen'. -- fileChooserSetAction :: FileChooserClass self => self -> FileChooserAction -- ^ @action@ - the action that the file selector is -- performing -> IO () fileChooserSetAction self action = {# call gtk_file_chooser_set_action #} (toFileChooser self) ((fromIntegral . fromEnum) action) -- | Gets the type of operation that the file chooser is performing; see -- 'fileChooserSetAction'. -- fileChooserGetAction :: FileChooserClass self => self -> IO FileChooserAction fileChooserGetAction self = liftM (toEnum . fromIntegral) $ {# call gtk_file_chooser_get_action #} (toFileChooser self) -- | Sets whether only local files can be selected in the file selector. If -- @localOnly@ is @True@ (the default), then the selected file are files are -- guaranteed to be accessible through the operating systems native file file -- system and therefore the application only needs to worry about the filename -- functions in 'FileChooser', like 'fileChooserGetFilename', rather than the -- URI functions like 'fileChooserGetURI', -- fileChooserSetLocalOnly :: FileChooserClass self => self -> Bool -> IO () fileChooserSetLocalOnly self localOnly = {# call gtk_file_chooser_set_local_only #} (toFileChooser self) (fromBool localOnly) -- | Gets whether only local files can be selected in the file selector. See -- 'fileChooserSetLocalOnly' -- fileChooserGetLocalOnly :: FileChooserClass self => self -> IO Bool fileChooserGetLocalOnly self = liftM toBool $ {# call gtk_file_chooser_get_local_only #} (toFileChooser self) -- | Sets whether multiple files can be selected in the file selector. This is -- only relevant if the action is set to be 'FileChooserActionOpen' or -- 'FileChooserActionSave'. It cannot be set with either of the folder actions. -- fileChooserSetSelectMultiple :: FileChooserClass self => self -> Bool -> IO () fileChooserSetSelectMultiple self selectMultiple = {# call gtk_file_chooser_set_select_multiple #} (toFileChooser self) (fromBool selectMultiple) -- | Gets whether multiple files can be selected in the file selector. See -- 'fileChooserSetSelectMultiple'. -- fileChooserGetSelectMultiple :: FileChooserClass self => self -> IO Bool fileChooserGetSelectMultiple self = liftM toBool $ {# call gtk_file_chooser_get_select_multiple #} (toFileChooser self) -- | Sets the current name in the file selector, as if entered by the user. -- Note that the name passed in here is a Unicode string rather than a filename. -- This function is meant for such uses as a suggested name in a \"Save As...\" -- dialog. -- -- If you want to preselect a particular existing file, you should use -- 'fileChooserSetFilename' or 'fileChooserSetURI' instead. Please see the -- documentation for those functions for an example of using -- 'fileChooserSetCurrentName' as well. -- fileChooserSetCurrentName :: (FileChooserClass self, GlibFilePath fp) => self -> fp -- ^ @name@ - the filename to use, as a Unicode string -> IO () fileChooserSetCurrentName self name = withUTFFilePath name $ \namePtr -> {# call gtk_file_chooser_set_current_name #} (toFileChooser self) namePtr -- | Gets the filename for the currently selected file in the file selector. -- If multiple files are selected, one of the filenames will be returned at -- random. -- -- If the file chooser is in folder mode, this function returns the selected -- folder. -- fileChooserGetFilename :: (FileChooserClass self, GlibFilePath fp) => self -> IO (Maybe fp) -- ^ returns The currently selected filename, or -- @Nothing@ if no file is selected, or the selected -- file can't be represented with a local filename. fileChooserGetFilename self = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_get_filename_utf8 #} #else {# call gtk_file_chooser_get_filename #} #endif (toFileChooser self) >>= maybePeek peekUTFFilePath -- | Sets @filename@ as the current filename for the file chooser, by changing -- to the file's parent folder and actually selecting the file in list. If the -- @chooser@ is in 'FileChooserActionSave' mode, the file's base name will also -- appear in the dialog's file name entry. -- -- If the file name isn't in the current folder of @chooser@, then the -- current folder of @chooser@ will be changed to the folder containing -- @filename@. This is equivalent to a sequence of 'fileChooserUnselectAll' -- followed by 'fileChooserSelectFilename'. -- -- Note that the file must exist, or nothing will be done except for the -- directory change. -- -- If you are implementing a File\/Save As... dialog, you should use this -- function if you already have a file name to which the user may save; for -- example, when the user opens an existing file and then does File\/Save As... -- on it. If you don't have a file name already — for example, if the user -- just created a new file and is saving it for the first time, do not call -- this function. Instead, use something similar to this: -- -- > if documentIsNew -- > then do -- the user just created a new document -- > fileChooserSetCurrentFolder chooser defaultFolderForSaving -- > fileChooserSetCurrentName chooser "Untitled document" -- > else do --the user edited an existing document -- > fileChooserSetFilename chooser existingFilename -- fileChooserSetFilename :: FileChooserClass self => self -> FilePath -- ^ @filename@ - the filename to set as current -> IO Bool -- ^ returns @True@ if both the folder could be changed and the -- file was selected successfully, @False@ otherwise. fileChooserSetFilename self filename = liftM toBool $ withCString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_set_filename_utf8 #} #else {# call gtk_file_chooser_set_filename #} #endif (toFileChooser self) filenamePtr -- | Selects a filename. If the file name isn't in the current folder of -- the chooser, then the current folder of the chooser will be changed to the -- folder containing @filename@. -- fileChooserSelectFilename :: FileChooserClass self => self -> FilePath -- ^ @filename@ - the filename to select -> IO Bool -- ^ returns @True@ if both the folder could be changed and the -- file was selected successfully, @False@ otherwise. fileChooserSelectFilename self filename = liftM toBool $ withCString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_select_filename_utf8 #} #else {# call gtk_file_chooser_select_filename #} #endif (toFileChooser self) filenamePtr -- | Unselects a currently selected filename. If the filename is not in the -- current directory, does not exist, or is otherwise not currently selected, -- does nothing. -- fileChooserUnselectFilename :: FileChooserClass self => self -> FilePath -- ^ @filename@ - the filename to unselect -> IO () fileChooserUnselectFilename self filename = withCString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_unselect_filename_utf8 #} #else {# call gtk_file_chooser_unselect_filename #} #endif (toFileChooser self) filenamePtr -- | Selects all the files in the current folder of a file chooser. -- fileChooserSelectAll :: FileChooserClass self => self -> IO () fileChooserSelectAll self = {# call gtk_file_chooser_select_all #} (toFileChooser self) -- | Unselects all the files in the current folder of a file chooser. -- fileChooserUnselectAll :: FileChooserClass self => self -> IO () fileChooserUnselectAll self = {# call gtk_file_chooser_unselect_all #} (toFileChooser self) -- | Lists all the selected files and subfolders in the current folder of -- the chooser. The returned names are full absolute paths. If files in the -- current folder cannot be represented as local filenames they will be -- ignored. (See 'fileChooserGetURIs') -- fileChooserGetFilenames :: FileChooserClass self => self -> IO [FilePath] fileChooserGetFilenames self = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_get_filenames_utf8 #} #else {# call gtk_file_chooser_get_filenames #} #endif (toFileChooser self) >>= fromStringGSList -- | Sets the current folder for the chooser from a local filename. The user -- will be shown the full contents of the current folder, plus user interface -- elements for navigating to other folders. -- fileChooserSetCurrentFolder :: FileChooserClass self => self -> FilePath -- ^ @filename@ - the full path of the new current folder -> IO Bool -- ^ returns @True@ if the folder could be changed successfully, -- @False@ otherwise. fileChooserSetCurrentFolder self filename = liftM toBool $ withCString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_set_current_folder_utf8 #} #else {# call gtk_file_chooser_set_current_folder #} #endif (toFileChooser self) filenamePtr -- | Gets the current folder of the chooser as a local filename. See -- 'fileChooserSetCurrentFolder'. -- fileChooserGetCurrentFolder :: FileChooserClass self => self -> IO (Maybe FilePath) -- ^ returns the full path of the current folder, or -- @Nothing@ if the current path cannot be represented -- as a local filename. fileChooserGetCurrentFolder self = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_get_current_folder_utf8 #} #else {# call gtk_file_chooser_get_current_folder #} #endif (toFileChooser self) >>= maybePeek readCString -- | Gets the URI for the currently selected file in the file selector. If -- multiple files are selected, one of the filenames will be returned at -- random. -- -- If the file chooser is in folder mode, this function returns the selected -- folder. -- fileChooserGetURI :: FileChooserClass self => self -> IO (Maybe String) -- ^ returns The currently selected URI, or @Nothing@ if -- no file is selected. fileChooserGetURI self = {# call gtk_file_chooser_get_uri #} (toFileChooser self) >>= maybePeek readCString -- | Sets the file referred to by @uri@ as the current file for the file -- chooser, by changing to the URI's parent folder and actually selecting the -- URI in the list. If the @chooser@ is 'FileChooserActionSave' mode, the URI's -- base name will also appear in the dialog's file name entry. -- -- If the URI isn't in the current folder of @chooser@, then the current -- folder of @chooser@ will be changed to the folder containing @uri@. This is -- equivalent to a sequence of 'fileChooserUnselectAll' followed by -- 'fileChooserSelectURI'. -- -- Note that the URI must exist, or nothing will be done except for the -- directory change. If you are implementing a File\/Save As... dialog, you -- should use this function if you already have a file name to which the user -- may save; for example, when the user opens an existing file and then does -- File\/Save As... on it. If you don't have a file name already — for -- example, if the user just created a new file and is saving it for the first -- time, do not call this function. Instead, use something similar to this: -- -- > if documentIsNew -- > then do -- the user just created a new document -- > fileChooserSetCurrentFolderURI chooser defaultFolderForSaving -- > fileChooserSetCurrentName chooser "Untitled document" -- > else do --the user edited an existing document -- > fileChooserSetURI chooser existingURI -- fileChooserSetURI :: FileChooserClass self => self -> String -- ^ @uri@ - the URI to set as current -> IO Bool -- ^ returns @True@ if both the folder could be changed and the -- URI was selected successfully, @False@ otherwise. fileChooserSetURI self uri = liftM toBool $ withCString uri $ \uriPtr -> {# call gtk_file_chooser_set_uri #} (toFileChooser self) uriPtr -- | Selects the file to by @uri@. If the URI doesn't refer to a file in the -- current folder of the chooser, then the current folder of the chooser will -- be changed to the folder containing @filename@. -- fileChooserSelectURI :: FileChooserClass self => self -> String -- ^ @uri@ - the URI to select -> IO Bool -- ^ returns @True@ if both the folder could be changed and the -- URI was selected successfully, @False@ otherwise. fileChooserSelectURI self uri = liftM toBool $ withCString uri $ \uriPtr -> {# call gtk_file_chooser_select_uri #} (toFileChooser self) uriPtr -- | Unselects the file referred to by @uri@. If the file is not in the -- current directory, does not exist, or is otherwise not currently selected, -- does nothing. -- fileChooserUnselectURI :: FileChooserClass self => self -> String -- ^ @uri@ - the URI to unselect -> IO () fileChooserUnselectURI self uri = withCString uri $ \uriPtr -> {# call gtk_file_chooser_unselect_uri #} (toFileChooser self) uriPtr -- | Lists all the selected files and subfolders in the current folder of -- the chooser. The returned names are full absolute URIs. -- fileChooserGetURIs :: FileChooserClass self => self -> IO [String] fileChooserGetURIs self = {# call gtk_file_chooser_get_uris #} (toFileChooser self) >>= fromStringGSList -- | Sets the current folder for the chooser from an URI. The user will be -- shown the full contents of the current folder, plus user interface elements -- for navigating to other folders. -- fileChooserSetCurrentFolderURI :: FileChooserClass self => self -> String -- ^ @uri@ - the URI for the new current folder -> IO Bool -- ^ returns @True@ if the folder could be changed successfully, -- @False@ otherwise. fileChooserSetCurrentFolderURI self uri = liftM toBool $ withCString uri $ \uriPtr -> {# call gtk_file_chooser_set_current_folder_uri #} (toFileChooser self) uriPtr -- | Gets the current folder of the chooser as an URI. See -- 'fileChooserSetCurrentFolderURI'. -- fileChooserGetCurrentFolderURI :: FileChooserClass self => self -> IO String -- ^ returns the URI for the current folder. fileChooserGetCurrentFolderURI self = {# call gtk_file_chooser_get_current_folder_uri #} (toFileChooser self) >>= readCString -- | Sets an application-supplied widget to use to display a custom preview of -- the currently selected file. To implement a preview, after setting the -- preview widget, you connect to the UpdatePreview signal, and call -- 'fileChooserGetPreviewFilename' or 'fileChooserGetPreviewURI' on each -- change. If you can display a preview of the new file, update your widget and -- set the preview active using 'fileChooserSetPreviewWidgetActive'. Otherwise, -- set the preview inactive. -- -- When there is no application-supplied preview widget, or the -- application-supplied preview widget is not active, the file chooser may -- display an internally generated preview of the current file or it may -- display no preview at all. -- fileChooserSetPreviewWidget :: (FileChooserClass self, WidgetClass previewWidget) => self -> previewWidget -- ^ @previewWidget@ - widget for displaying preview. -> IO () fileChooserSetPreviewWidget self previewWidget = {# call gtk_file_chooser_set_preview_widget #} (toFileChooser self) (toWidget previewWidget) -- | Gets the current preview widget; see 'fileChooserSetPreviewWidget'. -- fileChooserGetPreviewWidget :: FileChooserClass self => self -> IO (Maybe Widget) -- ^ returns the current preview widget, or @Nothing@ fileChooserGetPreviewWidget self = maybeNull (makeNewObject mkWidget) $ {# call gtk_file_chooser_get_preview_widget #} (toFileChooser self) -- | Sets whether the preview widget set by 'fileChooserSetPreviewWidget' -- should be shown for the current filename. When @active@ is set to false, the -- file chooser may display an internally generated preview of the current file -- or it may display no preview at all. See 'fileChooserSetPreviewWidget' for -- more details. -- fileChooserSetPreviewWidgetActive :: FileChooserClass self => self -> Bool -- ^ @active@ - whether to display the user-specified preview widget -> IO () fileChooserSetPreviewWidgetActive self active = {# call gtk_file_chooser_set_preview_widget_active #} (toFileChooser self) (fromBool active) -- | Gets whether the preview widget set by 'fileChooserSetPreviewWidget' -- should be shown for the current filename. See -- 'fileChooserSetPreviewWidgetActive'. -- fileChooserGetPreviewWidgetActive :: FileChooserClass self => self -> IO Bool -- ^ returns @True@ if the preview widget is active for the -- current filename. fileChooserGetPreviewWidgetActive self = liftM toBool $ {# call gtk_file_chooser_get_preview_widget_active #} (toFileChooser self) -- | Sets whether the file chooser should display a stock label with the name -- of the file that is being previewed; the default is @True@. Applications -- that want to draw the whole preview area themselves should set this to -- @False@ and display the name themselves in their preview widget. -- -- See also: 'fileChooserSetPreviewWidget' -- fileChooserSetUsePreviewLabel :: FileChooserClass self => self -> Bool -- ^ @useLabel@ - whether to display a stock label with the name of -- the previewed file -> IO () fileChooserSetUsePreviewLabel self useLabel = {# call gtk_file_chooser_set_use_preview_label #} (toFileChooser self) (fromBool useLabel) -- | Gets whether a stock label should be drawn with the name of the previewed -- file. See 'fileChooserSetUsePreviewLabel'. -- fileChooserGetUsePreviewLabel :: FileChooserClass self => self -> IO Bool -- ^ returns @True@ if the file chooser is set to display a label -- with the name of the previewed file, @False@ otherwise. fileChooserGetUsePreviewLabel self = liftM toBool $ {# call gtk_file_chooser_get_use_preview_label #} (toFileChooser self) -- | Gets the filename that should be previewed in a custom preview widget. -- See 'fileChooserSetPreviewWidget'. -- fileChooserGetPreviewFilename :: FileChooserClass self => self -> IO (Maybe FilePath) -- ^ returns the filename to preview, or @Nothing@ if -- no file is selected, or if the selected file cannot -- be represented as a local filename. fileChooserGetPreviewFilename self = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_get_preview_filename_utf8 #} #else {# call gtk_file_chooser_get_preview_filename #} #endif (toFileChooser self) >>= maybePeek readCString -- | Gets the URI that should be previewed in a custom preview widget. See -- 'fileChooserSetPreviewWidget'. -- fileChooserGetPreviewURI :: FileChooserClass self => self -> IO (Maybe String) -- ^ returns the URI for the file to preview, or -- @Nothing@ if no file is selected. fileChooserGetPreviewURI self = {# call gtk_file_chooser_get_preview_uri #} (toFileChooser self) >>= maybePeek readCString -- | Sets an application-supplied widget to provide extra options to the user. -- fileChooserSetExtraWidget :: (FileChooserClass self, WidgetClass extraWidget) => self -> extraWidget -- ^ @extraWidget@ - widget for extra options -> IO () fileChooserSetExtraWidget self extraWidget = {# call gtk_file_chooser_set_extra_widget #} (toFileChooser self) (toWidget extraWidget) -- | Gets the current preview widget; see 'fileChooserSetExtraWidget'. -- fileChooserGetExtraWidget :: FileChooserClass self => self -> IO (Maybe Widget) -- ^ returns the current extra widget, or @Nothing@ fileChooserGetExtraWidget self = maybeNull (makeNewObject mkWidget) $ {# call gtk_file_chooser_get_extra_widget #} (toFileChooser self) -- | Adds the filter to the list of filters that the user can select between. -- When a filter is selected, only files that are passed by that filter are -- displayed. -- fileChooserAddFilter :: FileChooserClass self => self -> FileFilter -> IO () fileChooserAddFilter self filter = {# call gtk_file_chooser_add_filter #} (toFileChooser self) filter -- | Removes the filter from the list of filters that the user can select -- between. -- fileChooserRemoveFilter :: FileChooserClass self => self -> FileFilter -> IO () fileChooserRemoveFilter self filter = {# call gtk_file_chooser_remove_filter #} (toFileChooser self) filter -- | Lists the current set of user-selectable filters; see -- 'fileChooserAddFilter', 'fileChooserRemoveFilter'. -- fileChooserListFilters :: FileChooserClass self => self -> IO [FileFilter] fileChooserListFilters self = do filterList <- {# call gtk_file_chooser_list_filters #} (toFileChooser self) filterPtrs <- fromGSList filterList mapM (makeNewObject mkFileFilter . return) filterPtrs -- | Sets the current filter; only the files that pass the filter will be -- displayed. If the user-selectable list of filters is non-empty, then the -- filter should be one of the filters in that list. Setting the current filter -- when the list of filters is empty is useful if you want to restrict the -- displayed set of files without letting the user change it. -- fileChooserSetFilter :: FileChooserClass self => self -> FileFilter -> IO () fileChooserSetFilter self filter = {# call gtk_file_chooser_set_filter #} (toFileChooser self) filter -- | Gets the current filter; see 'fileChooserSetFilter'. -- fileChooserGetFilter :: FileChooserClass self => self -> IO (Maybe FileFilter) -- ^ returns the current filter, or @Nothing@ fileChooserGetFilter self = maybeNull (makeNewObject mkFileFilter) $ {# call gtk_file_chooser_get_filter #} (toFileChooser self) -- | Adds a folder to be displayed with the shortcut folders in a file -- chooser. Note that shortcut folders do not get saved, as they are provided -- by the application. For example, you can use this to add a -- \"\/usr\/share\/mydrawprogram\/Clipart\" folder to the volume list. -- -- If the folder can not be added successfully an exception will be thrown. -- fileChooserAddShortcutFolder :: FileChooserClass self => self -> FilePath -- ^ @folder@ - filename of the folder to add -> IO () fileChooserAddShortcutFolder self folder = propagateGError $ \errorPtr -> withCString folder $ \folderPtr -> do #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_add_shortcut_folder_utf8 #} #else {# call gtk_file_chooser_add_shortcut_folder #} #endif (toFileChooser self) folderPtr errorPtr return () -- | Removes a folder from a file chooser's list of shortcut folders. -- -- If the folder can not be removed successfully an exception will be thrown. -- fileChooserRemoveShortcutFolder :: FileChooserClass self => self -> FilePath -- ^ @folder@ - filename of the folder to remove -> IO () fileChooserRemoveShortcutFolder self folder = propagateGError $ \errorPtr -> withCString folder $ \folderPtr -> do #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_remove_shortcut_folder_utf8 #} #else {# call gtk_file_chooser_remove_shortcut_folder #} #endif (toFileChooser self) folderPtr errorPtr return () -- | Queries the list of shortcut folders in the file chooser, as set by -- 'fileChooserAddShortcutFolder'. -- fileChooserListShortcutFolders :: FileChooserClass self => self -> IO [String] fileChooserListShortcutFolders self = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_file_chooser_list_shortcut_folders_utf8 #} #else {# call gtk_file_chooser_list_shortcut_folders #} #endif (toFileChooser self) >>= fromStringGSList -- | Adds a folder URI to be displayed with the shortcut folders in a file -- chooser. Note that shortcut folders do not get saved, as they are provided -- by the application. For example, you can use this to add a -- \"file:\/\/\/usr\/share\/mydrawprogram\/Clipart\" folder to the volume list. -- -- If the folder can not be added successfully an exception will be thrown. -- fileChooserAddShortcutFolderURI :: FileChooserClass self => self -> String -- ^ @uri@ - URI of the folder to add -> IO () fileChooserAddShortcutFolderURI self uri = propagateGError $ \errorPtr -> withCString uri $ \uriPtr -> do {# call gtk_file_chooser_add_shortcut_folder_uri #} (toFileChooser self) uriPtr errorPtr return () -- | Removes a folder URI from a file chooser's list of shortcut folders. -- fileChooserRemoveShortcutFolderURI :: FileChooserClass self => self -> String -- ^ @uri@ - URI of the folder to remove -> IO () fileChooserRemoveShortcutFolderURI self uri = propagateGError $ \errorPtr -> withCString uri $ \uriPtr -> do {# call gtk_file_chooser_remove_shortcut_folder_uri #} (toFileChooser self) uriPtr errorPtr return () -- | Queries the list of shortcut folders in the file chooser, as set by -- 'fileChooserAddShortcutFolderURI'. -- fileChooserListShortcutFolderURIs :: FileChooserClass self => self -> IO [String] fileChooserListShortcutFolderURIs self = {# call gtk_file_chooser_list_shortcut_folder_uris #} (toFileChooser self) >>= fromStringGSList #if GTK_CHECK_VERSION(2,6,0) -- | Sets whether hidden files and folders are displayed in the file selector. -- -- Available since Gtk+ version 2.6 -- fileChooserSetShowHidden :: FileChooserClass self => self -> Bool -- ^ @showHidden@ - @True@ if hidden files and folders should be -- displayed. -> IO () fileChooserSetShowHidden self showHidden = {# call gtk_file_chooser_set_show_hidden #} (toFileChooser self) (fromBool showHidden) -- | Gets whether hidden files and folders are displayed in the file selector. -- See 'fileChooserSetShowHidden'. -- -- * Available since Gtk+ version 2.6 -- fileChooserGetShowHidden :: FileChooserClass self => self -> IO Bool -- ^ returns @True@ if hidden files and folders are displayed. fileChooserGetShowHidden self = liftM toBool $ {# call gtk_file_chooser_get_show_hidden #} (toFileChooser self) #endif #if GTK_CHECK_VERSION(2,8,0) -- | Sets whether a file chooser in 'FileChooserActionSave' mode will present -- a confirmation dialog if the user types a file name that already exists. -- This is @False@ by default. -- -- Regardless of this setting, the @chooser@ will emit the -- \"confirm-overwrite\" signal when appropriate. -- -- If all you need is the stock confirmation dialog, set this property to -- @True@. You can override the way confirmation is done by actually handling -- the \"confirm-overwrite\" signal; please refer to its documentation for the -- details. -- -- Available since Gtk+ version 2.8 -- fileChooserSetDoOverwriteConfirmation :: FileChooserClass self => self -> Bool -- ^ @doOverwriteConfirmation@ - whether to confirm overwriting in -- save mode -> IO () fileChooserSetDoOverwriteConfirmation self doOverwriteConfirmation = {# call gtk_file_chooser_set_do_overwrite_confirmation #} (toFileChooser self) (fromBool doOverwriteConfirmation) -- | Queries whether a file chooser is set to confirm for overwriting when the -- user types a file name that already exists. -- -- * Available since Gtk+ version 2.8 -- fileChooserGetDoOverwriteConfirmation :: FileChooserClass self => self -> IO Bool -- ^ returns @True@ if the file chooser will present a -- confirmation dialog; @False@ otherwise. fileChooserGetDoOverwriteConfirmation self = liftM toBool $ {# call gtk_file_chooser_get_do_overwrite_confirmation #} (toFileChooser self) #endif -------------------- -- Attributes -- | \'usePreviewLabel\' property. See 'fileChooserGetUsePreviewLabel' and -- 'fileChooserSetUsePreviewLabel' -- fileChooserUsePreviewLabel :: FileChooserClass self => Attr self Bool fileChooserUsePreviewLabel = newAttr fileChooserGetUsePreviewLabel fileChooserSetUsePreviewLabel #if GTK_CHECK_VERSION(2,6,0) -- | \'showHidden\' property. See 'fileChooserGetShowHidden' and -- 'fileChooserSetShowHidden' -- -- Since Gtk 2.6. fileChooserShowHidden :: FileChooserClass self => Attr self Bool fileChooserShowHidden = newAttr fileChooserGetShowHidden fileChooserSetShowHidden #endif -- | \'selectMultiple\' property. See 'fileChooserGetSelectMultiple' and -- 'fileChooserSetSelectMultiple' -- fileChooserSelectMultiple :: FileChooserClass self => Attr self Bool fileChooserSelectMultiple = newAttr fileChooserGetSelectMultiple fileChooserSetSelectMultiple -- | \'previewWidgetActive\' property. See 'fileChooserGetPreviewWidgetActive' -- and 'fileChooserSetPreviewWidgetActive' -- fileChooserPreviewWidgetActive :: FileChooserClass self => Attr self Bool fileChooserPreviewWidgetActive = newAttr fileChooserGetPreviewWidgetActive fileChooserSetPreviewWidgetActive -- | \'previewWidget\' property. See 'fileChooserGetPreviewWidget' and -- 'fileChooserSetPreviewWidget' -- fileChooserPreviewWidget :: (FileChooserClass self, WidgetClass previewWidget) => ReadWriteAttr self (Maybe Widget) previewWidget fileChooserPreviewWidget = newAttr fileChooserGetPreviewWidget fileChooserSetPreviewWidget -- | \'localOnly\' property. See 'fileChooserGetLocalOnly' and -- 'fileChooserSetLocalOnly' -- fileChooserLocalOnly :: FileChooserClass self => Attr self Bool fileChooserLocalOnly = newAttr fileChooserGetLocalOnly fileChooserSetLocalOnly -- | \'filter\' property. See 'fileChooserGetFilter' and -- 'fileChooserSetFilter' -- fileChooserFilter :: FileChooserClass self => ReadWriteAttr self (Maybe FileFilter) FileFilter fileChooserFilter = newAttr fileChooserGetFilter fileChooserSetFilter -- | \'extraWidget\' property. See 'fileChooserGetExtraWidget' and -- 'fileChooserSetExtraWidget' -- fileChooserExtraWidget :: (FileChooserClass self, WidgetClass extraWidget) => ReadWriteAttr self (Maybe Widget) extraWidget fileChooserExtraWidget = newAttr fileChooserGetExtraWidget fileChooserSetExtraWidget #if GTK_CHECK_VERSION(2,8,0) -- | \'doOverwriteConfirmation\' property. See -- 'fileChooserGetDoOverwriteConfirmation' and -- 'fileChooserSetDoOverwriteConfirmation' -- fileChooserDoOverwriteConfirmation :: FileChooserClass self => Attr self Bool fileChooserDoOverwriteConfirmation = newAttr fileChooserGetDoOverwriteConfirmation fileChooserSetDoOverwriteConfirmation #endif -- | \'action\' property. See 'fileChooserGetAction' and -- 'fileChooserSetAction' -- fileChooserAction :: FileChooserClass self => Attr self FileChooserAction fileChooserAction = newAttr fileChooserGetAction fileChooserSetAction -------------------- -- Signals -- | This signal is emitted when the current folder in a 'FileChooser' -- changes. This can happen due to the user performing some action that changes -- folders, such as selecting a bookmark or visiting a folder on the file list. -- It can also happen as a result of calling a function to explicitly change -- the current folder in a file chooser. -- -- Normally you do not need to connect to this signal, unless you need to -- keep track of which folder a file chooser is showing. -- -- See also: 'fileChooserSetCurrentFolder', 'fileChooserGetCurrentFolder', -- 'fileChooserSetCurrentFolderURI', 'fileChooserGetCurrentFolderURI'. -- currentFolderChanged :: FileChooserClass self => Signal self (IO ()) currentFolderChanged = Signal (connect_NONE__NONE "current-folder-changed") -- | This signal is emitted when there is a change in the set of selected -- files in a 'FileChooser'. This can happen when the user modifies the -- selection with the mouse or the keyboard, or when explicitly calling -- functions to change the selection. -- -- Normally you do not need to connect to this signal, as it is easier to -- wait for the file chooser to finish running, and then to get the list of -- selected files using the functions mentioned below. -- -- See also: 'fileChooserSelectFilename', 'fileChooserUnselectFilename', -- 'fileChooserGetFilename', 'fileChooserGetFilenames', 'fileChooserSelectURI', -- 'fileChooserUnselectURI', 'fileChooserGetURI', 'fileChooserGetURIs'. -- fileSelectionChanged :: FileChooserClass self => Signal self (IO ()) fileSelectionChanged = Signal (connect_NONE__NONE "selection-changed") -- | This signal is emitted when the preview in a file chooser should be -- regenerated. For example, this can happen when the currently selected file -- changes. You should use this signal if you want your file chooser to have a -- preview widget. -- -- Once you have installed a preview widget with -- 'fileChooserSetPreviewWidget', you should update it when this signal is -- emitted. You can use the functions 'fileChooserGetPreviewFilename' or -- 'fileChooserGetPreviewURI' to get the name of the file to preview. Your -- widget may not be able to preview all kinds of files; your callback must -- call 'fileChooserSetPreviewWidgetActive' to inform the file chooser about -- whether the preview was generated successfully or not. -- -- See also: 'fileChooserSetPreviewWidget', -- 'fileChooserSetPreviewWidgetActive', 'fileChooserSetUsePreviewLabel', -- 'fileChooserGetPreviewFilename', 'fileChooserGetPreviewURI'. -- updatePreview :: FileChooserClass self => Signal self (IO ()) updatePreview = Signal (connect_NONE__NONE "update-preview") -- | This signal is emitted when the user \"activates\" a file in the file -- chooser. This can happen by double-clicking on a file in the file list, or -- by pressing Enter. -- -- Normally you do not need to connect to this signal. It is used internally -- by 'FileChooserDialog' to know when to activate the default button in the -- dialog. -- -- See also: 'fileChooserGetFilename', 'fileChooserGetFilenames', -- 'fileChooserGetURI', 'fileChooserGetURIs'. -- fileActivated :: FileChooserClass self => Signal self (IO ()) fileActivated = Signal (connect_NONE__NONE "file-activated") #if GTK_CHECK_VERSION(2,8,0) -- | This signal gets emitted whenever it is appropriate to present a -- confirmation dialog when the user has selected a file name that already -- exists. The signal only gets emitted when the file chooser is in -- 'FileChooserActionSave' mode. -- -- Most applications just need to turn on the do-overwrite-confirmation -- property (or call the 'fileChooserSetDoOverwriteConfirmation' function), and -- they will automatically get a stock confirmation dialog. Applications which -- need to customize this behavior should do that, and also connect to the -- 'confirmOverwrite' signal. -- -- A signal handler for this signal must return a 'FileChooserConfirmation' -- value, which indicates the action to take. If the handler determines that -- the user wants to select a different filename, it should return -- 'FileChooserConfirmationSelectAgain'. If it determines that the user is -- satisfied with his choice of file name, it should return -- 'FileChooserConfirmationAcceptFilename'. On the other hand, if it determines -- that the stock confirmation dialog should be used, it should return -- 'FileChooserConfirmationConfirm'. -- -- Since Gtk 2.8. -- confirmOverwrite :: FileChooserClass self => Signal self (IO FileChooserConfirmation) confirmOverwrite = Signal (connect_NONE__ENUM "confirm-overwrite") #endif #ifndef DISABLE_DEPRECATED -- * Deprecated onCurrentFolderChanged, afterCurrentFolderChanged :: FileChooserClass self => self -> IO () -> IO (ConnectId self) onCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" False afterCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" True {-# DEPRECATED onCurrentFolderChanged "use currentFolderChanged instead" #-} {-# DEPRECATED afterCurrentFolderChanged "use currentFolderChanged instead" #-} --onSelectionChanged, afterSelectionChanged :: FileChooserClass self => self -- -> IO () -- -> IO (ConnectId self) --onSelectionChanged = connect_NONE__NONE "selection-changed" False --afterSelectionChanged = connect_NONE__NONE "selection-changed" True onUpdatePreview, afterUpdatePreview :: FileChooserClass self => self -> IO () -> IO (ConnectId self) onUpdatePreview = connect_NONE__NONE "update-preview" False afterUpdatePreview = connect_NONE__NONE "update-preview" True {-# DEPRECATED onUpdatePreview "use updatePreview instead" #-} {-# DEPRECATED afterUpdatePreview "use updatePreview instead" #-} onFileActivated, afterFileActivated :: FileChooserClass self => self -> IO () -> IO (ConnectId self) onFileActivated = connect_NONE__NONE "file-activated" False afterFileActivated = connect_NONE__NONE "file-activated" True {-# DEPRECATED onFileActivated "use fileActivated instead" #-} {-# DEPRECATED afterFileActivated "use fileActivated instead" #-} #if GTK_CHECK_VERSION(2,8,0) onConfirmOverwrite, afterConfirmOverwrite :: FileChooserClass self => self -> IO FileChooserConfirmation -> IO (ConnectId self) onConfirmOverwrite = connect_NONE__ENUM "confirm-overwrite" False afterConfirmOverwrite = connect_NONE__ENUM "confirm-overwrite" True {-# DEPRECATED onConfirmOverwrite "use confirmOverwrite instead" #-} {-# DEPRECATED afterConfirmOverwrite "use confirmOverwrite instead" #-} #endif #endif #endif ------------------------------------------------------ -- Utility functions that really ought to go elsewhere -- convenience functions for GSlists of strings fromStringGSList :: GSList -> IO [String] fromStringGSList strList = do strPtrs <- fromGSList strList mapM readCString strPtrs gtk-0.15.9/Graphics/UI/Gtk/Selectors/FileChooserButton.chs0000644000000000000000000001641607346545000021436 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FileChooserButton -- -- Author : Duncan Coutts -- -- Created: 5 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) -- -- A button to launch a file selection dialog -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.Selectors.FileChooserButton ( -- * Detail -- -- | The 'FileChooserButton' is a widget that lets the user select a file. It -- implements the 'FileChooser' interface. Visually, it is a file name with a -- button to bring up a 'FileChooserDialog'. The user can then use that dialog -- to change the file associated with that button. This widget does not support -- setting the \"select-multiple\" property to @True@. -- -- The 'FileChooserButton' supports the 'FileChooserAction's -- 'FileChooserActionOpen' and 'FileChooserActionSelectFolder'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'HBox' -- | +----FileChooserButton -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types FileChooserButton, FileChooserButtonClass, castToFileChooserButton, gTypeFileChooserButton, toFileChooserButton, -- * Constructors fileChooserButtonNew, #if GTK_MAJOR_VERSION < 3 fileChooserButtonNewWithBackend, #endif fileChooserButtonNewWithDialog, -- * Methods fileChooserButtonGetTitle, fileChooserButtonSetTitle, fileChooserButtonGetWidthChars, fileChooserButtonSetWidthChars, -- * Attributes fileChooserButtonDialog, fileChooserButtonTitle, fileChooserButtonWidthChars, -- * Signals fileChooserButtonFileSet #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} #if GTK_CHECK_VERSION(2,6,0) {#import Graphics.UI.Gtk.Selectors.FileChooser#} (FileChooserAction) {# context lib="gtk" prefix="gtk" #} -------------------- -- Interfaces instance FileChooserClass FileChooserButton -------------------- -- Constructors -- | Creates a new file-selecting button widget. -- fileChooserButtonNew :: GlibString string => string -- ^ @title@ - the title of the browse dialog. -> FileChooserAction -- ^ @action@ - the open mode for the widget. -> IO FileChooserButton fileChooserButtonNew title action = makeNewObject mkFileChooserButton $ liftM (castPtr :: Ptr Widget -> Ptr FileChooserButton) $ withUTFString title $ \titlePtr -> {# call gtk_file_chooser_button_new #} titlePtr ((fromIntegral . fromEnum) action) #if GTK_MAJOR_VERSION < 3 -- | Creates a new file-selecting button widget using @backend@. -- -- Removed in Gtk3. fileChooserButtonNewWithBackend :: GlibString string => string -- ^ @title@ - the title of the browse dialog. -> FileChooserAction -- ^ @action@ - the open mode for the widget. -> string -- ^ @backend@ - the name of the file system backend -- to use. -> IO FileChooserButton fileChooserButtonNewWithBackend title action backend = makeNewObject mkFileChooserButton $ liftM (castPtr :: Ptr Widget -> Ptr FileChooserButton) $ withUTFString backend $ \backendPtr -> withUTFString title $ \titlePtr -> {# call gtk_file_chooser_button_new_with_backend #} titlePtr ((fromIntegral . fromEnum) action) backendPtr #endif -- | Creates a 'FileChooserButton' widget which uses @dialog@ as it's -- file-picking window. -- fileChooserButtonNewWithDialog :: FileChooserDialogClass dialog => dialog -- ^ @dialog@ - the 'FileChooserDialog' widget to -- use. -> IO FileChooserButton fileChooserButtonNewWithDialog dialog = makeNewObject mkFileChooserButton $ liftM (castPtr :: Ptr Widget -> Ptr FileChooserButton) $ {# call gtk_file_chooser_button_new_with_dialog #} (toWidget dialog) -------------------- -- Methods -- | Retrieves the title of the browse dialog used by the button. -- fileChooserButtonGetTitle :: (FileChooserButtonClass self, GlibString string) => self -> IO string -- ^ returns a pointer to the browse dialog's title. fileChooserButtonGetTitle self = {# call gtk_file_chooser_button_get_title #} (toFileChooserButton self) >>= peekUTFString -- | Modifies the @title@ of the browse dialog used by the button. -- fileChooserButtonSetTitle :: (FileChooserButtonClass self, GlibString string) => self -> string -- ^ @title@ - the new browse dialog title. -> IO () fileChooserButtonSetTitle self title = withUTFString title $ \titlePtr -> {# call gtk_file_chooser_button_set_title #} (toFileChooserButton self) titlePtr -- | Retrieves the width in characters of the @button@ widget's entry and\/or -- label. -- fileChooserButtonGetWidthChars :: FileChooserButtonClass self => self -> IO Int -- ^ returns an integer width (in characters) that the button will -- use to size itself. fileChooserButtonGetWidthChars self = liftM fromIntegral $ {# call gtk_file_chooser_button_get_width_chars #} (toFileChooserButton self) -- | Sets the width (in characters) that the button will use to @nChars@. -- fileChooserButtonSetWidthChars :: FileChooserButtonClass self => self -> Int -- ^ @nChars@ - the new width, in characters. -> IO () fileChooserButtonSetWidthChars self nChars = {# call gtk_file_chooser_button_set_width_chars #} (toFileChooserButton self) (fromIntegral nChars) -------------------- -- Attributes -- | Instance of the 'FileChooserDialog' associated with the button. -- fileChooserButtonDialog :: (FileChooserButtonClass self, FileChooserDialogClass fileChooserDialog) => WriteAttr self fileChooserDialog fileChooserButtonDialog = writeAttrFromObjectProperty "dialog" {# call pure unsafe gtk_file_chooser_dialog_get_type #} -- | Title to put on the 'FileChooserDialog' associated with the button. -- -- Default value: \"Select A File\" -- fileChooserButtonTitle :: (FileChooserButtonClass self, GlibString string) => Attr self string fileChooserButtonTitle = newAttr fileChooserButtonGetTitle fileChooserButtonSetTitle -- | -- fileChooserButtonWidthChars :: FileChooserButtonClass self => Attr self Int fileChooserButtonWidthChars = newAttr fileChooserButtonGetWidthChars fileChooserButtonSetWidthChars -------------------- -- Signals -- %hash c:b660 d:ab72 -- | Emitted when the user selects a file. -- fileChooserButtonFileSet :: FileChooserButtonClass self => Signal self (IO ()) fileChooserButtonFileSet = Signal (connect_NONE__NONE "file-set") #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/FileChooserDialog.chs0000644000000000000000000001324507346545000021357 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FileChooserDialog -- -- Author : Duncan Coutts -- -- Created: 24 April 2004 -- -- Copyright (C) 2004-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) -- -- A file chooser dialog, suitable for \"File\/Open\" or \"File\/Save\" -- commands -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Selectors.FileChooserDialog ( -- * Detail -- -- | 'FileChooserDialog' is a dialog box suitable for use with \"File\/Open\" -- or \"File\/Save as\" commands. This widget works by putting a -- 'FileChooserWidget' inside a 'Dialog'. It exposes the 'FileChooser', -- interface, so you can use all of the -- 'FileChooser' functions on the file chooser dialog as well as those for -- 'Dialog'. -- -- Note that 'FileChooserDialog' does not have any methods of its own. -- Instead, you should use the functions that work on a 'FileChooser'. -- ** Response Codes -- -- | 'FileChooserDialog' inherits from 'Dialog', so buttons that go in its -- action area have response codes such as 'ResponseAccept' and -- 'ResponseCancel'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----'Dialog' -- | +----FileChooserDialog -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types FileChooserDialog, FileChooserDialogClass, castToFileChooserDialog, gTypeFileChooserDialog, toFileChooserDialog, -- * Constructors fileChooserDialogNew, fileChooserDialogNewWithBackend #endif ) where import Control.Monad (liftM, when) import Data.Maybe (isJust, fromJust) import System.Glib.FFI import System.Glib.UTFString {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Selectors.FileChooser#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Windows.Window import Graphics.UI.Gtk.Windows.Dialog import System.Glib.GValue (allocaGValue) import System.Glib.GValueTypes (valueSetMaybeString) import System.Glib.Attributes {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Interfaces instance FileChooserClass FileChooserDialog -------------------- -- Constructors -- | Creates a new 'FileChooserDialog'. -- fileChooserDialogNew :: GlibString string => Maybe string -- ^ Title of the dialog (or default) -> Maybe Window -- ^ Transient parent of the dialog (or none) -> FileChooserAction -- ^ Open or save mode for the dialog -> [(string, ResponseId)] -- ^ Buttons and their response codes -> IO FileChooserDialog fileChooserDialogNew title parent action buttons = internalFileChooserDialogNew title parent action buttons Nothing -- | Creates a new 'FileChooserDialog' with a specified backend. This is -- especially useful if you use 'fileChooserSetLocalOnly' to allow non-local -- files and you use a more expressive vfs, such as gnome-vfs, to load files. -- fileChooserDialogNewWithBackend :: GlibString string => Maybe string -- ^ Title of the dialog (or default) -> Maybe Window -- ^ Transient parent of the dialog (or none) -> FileChooserAction -- ^ Open or save mode for the dialog -> [(string, ResponseId)] -- ^ Buttons and their response codes -> string -- ^ The name of the filesystem backend to use -> IO FileChooserDialog fileChooserDialogNewWithBackend title parent action buttons backend = internalFileChooserDialogNew title parent action buttons (Just backend) -- Annoyingly, the constructor for FileChooserDialog uses varargs so we can't -- call it using the Haskell FFI. The GTK people do not consider this an api -- bug, see -- The solution is to call objectNew and add the buttons manually. internalFileChooserDialogNew :: GlibString string => Maybe string -> -- Title of the dialog (or default) Maybe Window -> -- Transient parent of the dialog (or none) FileChooserAction -> -- Open or save mode for the dialog [(string, ResponseId)] -> -- Buttons and their response codes Maybe string -> -- The name of the backend to use (optional) IO FileChooserDialog internalFileChooserDialogNew title parent action buttons backend = do objType <- {# call unsafe gtk_file_chooser_dialog_get_type #} dialog <-makeNewObject mkFileChooserDialog $ liftM castPtr $ if (isJust backend) then allocaGValue $ \backendGValue -> do valueSetMaybeString backendGValue backend objectNew objType [("file-system-backend", backendGValue)] else objectNew objType [] when (isJust title) (set dialog [windowTitle := fromJust title]) when (isJust parent) (set dialog [windowTransientFor := fromJust parent]) dialog `fileChooserSetAction` action mapM_ (\(btnName, btnResponse) -> dialogAddButton dialog btnName btnResponse) buttons return dialog #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/FileChooserWidget.chs0000644000000000000000000000741507346545000021405 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FileChooserWidget -- -- Author : Duncan Coutts -- -- Created: 24 April 2004 -- -- Copyright (C) 2004-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) -- -- File chooser widget that can be embedded in other widgets -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Selectors.FileChooserWidget ( -- * Detail -- -- | 'FileChooserWidget' is a widget suitable for selecting files. It is the -- main building block of a 'FileChooserDialog'. Most applications will only -- need to use the latter; you can use 'FileChooserWidget' as part of a larger -- window if you have special needs. -- -- Note that 'FileChooserWidget' does not have any methods of its own. -- Instead, you should use the functions that work on a 'FileChooser'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'VBox' -- | +----FileChooserWidget -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types FileChooserWidget, FileChooserWidgetClass, castToFileChooserWidget, gTypeFileChooserWidget, toFileChooserWidget, -- * Constructors FileChooserAction, fileChooserWidgetNew, #if GTK_MAJOR_VERSION < 3 fileChooserWidgetNewWithBackend, #endif #endif ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object {#import Graphics.UI.Gtk.Types#} #if GTK_CHECK_VERSION(2,4,0) {#import Graphics.UI.Gtk.Selectors.FileChooser#} (FileChooserAction) {# context lib="gtk" prefix="gtk" #} -------------------- -- Interfaces instance FileChooserClass FileChooserWidget -------------------- -- Constructors -- | Creates a new 'FileChooserWidget'. This is a file chooser widget that can -- be embedded in custom windows, and it is the same widget that is used by -- 'FileChooserDialog'. -- fileChooserWidgetNew :: FileChooserAction -- ^ @action@ - Open or save mode for the widget -> IO FileChooserWidget fileChooserWidgetNew action = makeNewObject mkFileChooserWidget $ liftM (castPtr :: Ptr Widget -> Ptr FileChooserWidget) $ {# call unsafe gtk_file_chooser_widget_new #} ((fromIntegral . fromEnum) action) #if GTK_MAJOR_VERSION < 3 -- | Creates a new 'FileChooserWidget' with a specified backend. This is -- especially useful if you use 'fileChooserSetLocalOnly' to allow non-local -- files. This is a file chooser widget that can be embedded in custom windows -- and it is the same widget that is used by 'FileChooserDialog'. -- -- Removed in Gtk3. fileChooserWidgetNewWithBackend :: FileChooserAction -- ^ @action@ - Open or save mode for the widget -> String -- ^ @backend@ - The name of the specific filesystem -- backend to use. -> IO FileChooserWidget fileChooserWidgetNewWithBackend action backend = makeNewObject mkFileChooserWidget $ liftM (castPtr :: Ptr Widget -> Ptr FileChooserWidget) $ withCString backend $ \backendPtr -> {# call unsafe gtk_file_chooser_widget_new_with_backend #} ((fromIntegral . fromEnum) action) backendPtr #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/FileFilter.chs0000644000000000000000000001600307346545000020055 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FileFilter -- -- Author : Duncan Coutts -- -- Created: 26 February 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) -- -- A filter for selecting a file subset -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Selectors.FileFilter ( -- * Detail -- -- | A 'FileFilter' can be used to restrict the files being shown in a -- 'FileChooser'. Files can be filtered based on their name (with -- 'fileFilterAddPattern'), on their mime type (with 'fileFilterAddMimeType'), -- or by a custom filter function (with 'fileFilterAddCustom'). -- -- Filtering by mime types handles aliasing and subclassing of mime types; -- e.g. a filter for \"text\/plain\" also matches a file with mime type -- \"application\/rtf\", since \"application\/rtf\" is a subclass of -- \"text\/plain\". Note that 'FileFilter' allows wildcards for the subtype of -- a mime type, so you can e.g. filter for \"image\/\*\". -- -- Normally, filters are used by adding them to a 'FileChooser', see -- 'Graphics.UI.Gtk.Selectors.FileChooser.fileChooserAddFilter'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----FileFilter -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types FileFilter, FileFilterClass, castToFileFilter, gTypeFileFilter, toFileFilter, FileFilterFlags(..), -- * Constructors fileFilterNew, -- * Methods fileFilterSetName, fileFilterGetName, fileFilterAddMimeType, fileFilterAddPattern, fileFilterAddCustom, #if GTK_CHECK_VERSION(2,6,0) fileFilterAddPixbufFormats, #endif -- * Attributes fileFilterName, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Flags (Flags, fromFlags) import System.Glib.UTFString import System.Glib.Attributes {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) {# enum FileFilterFlags {underscoreToCase} deriving(Bounded,Show,Eq) #} instance Flags FileFilterFlags -------------------- -- Constructors -- | Creates a new 'FileFilter' with no rules added to it. Such a filter -- doesn't accept any files, so is not particularly useful until you add rules -- with 'fileFilterAddMimeType', 'fileFilterAddPattern', or -- 'fileFilterAddCustom'. -- fileFilterNew :: IO FileFilter fileFilterNew = makeNewObject mkFileFilter $ {# call gtk_file_filter_new #} -------------------- -- Methods -- | Sets the human-readable name of the filter; this is the string that will -- be displayed in the file selector user interface if there is a selectable -- list of filters. -- fileFilterSetName :: GlibString string => FileFilter -> string -- ^ @name@ - the human-readable-name for the filter -> IO () fileFilterSetName self name = withUTFString name $ \namePtr -> {# call gtk_file_filter_set_name #} self namePtr -- | Gets the human-readable name for the filter. See 'fileFilterSetName'. -- fileFilterGetName :: GlibString string => FileFilter -> IO string -- ^ returns The human-readable name of the filter fileFilterGetName self = {# call gtk_file_filter_get_name #} self >>= peekUTFString -- | Adds a rule allowing a given mime type to @filter@. -- fileFilterAddMimeType :: GlibString string => FileFilter -> string -- ^ @mimeType@ - name of a MIME type -> IO () fileFilterAddMimeType self mimeType = withUTFString mimeType $ \mimeTypePtr -> {# call gtk_file_filter_add_mime_type #} self mimeTypePtr -- | Adds a rule allowing a shell style glob to a filter. -- fileFilterAddPattern :: GlibString string => FileFilter -> string -- ^ @pattern@ - a shell style glob -> IO () fileFilterAddPattern self pattern = withUTFString pattern $ \patternPtr -> {# call gtk_file_filter_add_pattern #} self patternPtr -- | Adds rule to a filter that allows files based on a custom callback -- function. The list of flags @needed@ which is passed in provides information -- about what sorts of information that the filter function needs; this allows -- Gtk+ to avoid retrieving expensive information when it isn't needed by the -- filter. -- fileFilterAddCustom :: GlibString string => FileFilter -> [FileFilterFlags] -- ^ @needed@ - list of flags indicating the -- information that the custom filter function needs. -> ( Maybe string -- filename -> Maybe string -- uri -> Maybe string -- display name -> Maybe string -- mime type -> IO Bool) -- ^ @(\filename uri displayName mimeType -> ...)@ - -- filter function; if the function -- returns @True@, then the file will be displayed. -> IO () fileFilterAddCustom self needed func = do hPtr <- mkHandler_GtkFileFilterFunc (\filterInfoPtr _ -> do filenamePtr <- {# get GtkFileFilterInfo->filename #} filterInfoPtr uriPtr <- {# get GtkFileFilterInfo->uri #} filterInfoPtr displayNamePtr <- {# get GtkFileFilterInfo->display_name #} filterInfoPtr mimeTypePtr <- {# get GtkFileFilterInfo->mime_type #} filterInfoPtr filename <- maybePeek peekUTFString filenamePtr uri <- maybePeek peekUTFString uriPtr displayName <- maybePeek peekUTFString displayNamePtr mimeType <- maybePeek peekUTFString mimeTypePtr liftM fromBool $ func filename uri displayName mimeType) {# call gtk_file_filter_add_custom #} self ((fromIntegral . fromFlags) needed) hPtr (castFunPtrToPtr hPtr) destroyFunPtr {#pointer *GtkFileFilterInfo as GtkFileFilterInfoPtr #} type GtkFileFilterFunc = GtkFileFilterInfoPtr -> --GtkFileFilterInfo *filter_info Ptr () -> --gpointer user_data IO CInt foreign import ccall "wrapper" mkHandler_GtkFileFilterFunc :: GtkFileFilterFunc -> IO (FunPtr GtkFileFilterFunc) #if GTK_CHECK_VERSION(2,6,0) -- | Adds a rule allowing image files in the formats supported by 'Pixbuf'. -- -- * Available since Gtk+ version 2.6 -- fileFilterAddPixbufFormats :: FileFilter -> IO () fileFilterAddPixbufFormats self = {# call gtk_file_filter_add_pixbuf_formats #} self #endif -------------------- -- Attributes -- | \'name\' property. See 'fileFilterGetName' and 'fileFilterSetName' -- fileFilterName :: GlibString string => Attr FileFilter string fileFilterName = newAttr fileFilterGetName fileFilterSetName #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/FileSelection.chs0000644000000000000000000002240507346545000020560 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FileSelection -- -- Author : Manuel M T Chakravarty -- -- Created: 20 January 1999 -- -- Copyright (C) 1999-2005 Manuel M T Chakravarty, Jens Petersen -- -- 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) -- -- Prompt the user for a file or directory name -- -- * As of Gtk+ 2.4 this module has been deprecated in favour of 'FileChooser' -- -- This module is empty in Gtk3. module Graphics.UI.Gtk.Selectors.FileSelection ( -- * Detail -- -- | 'FileSelection' should be used to retrieve file or directory names from -- the user. It will create a new dialog window containing a directory list, -- and a file list corresponding to the current working directory. The -- filesystem can be navigated using the directory list or the drop-down -- history menu. Alternatively, the TAB key can be used to navigate using -- filename completion - common in text based editors such as emacs and jed. -- -- File selection dialogs are created with a call to 'fileSelectionNew'. -- -- The default filename can be set using 'fileSelectionSetFilename' and the -- selected filename retrieved using 'fileSelectionGetFilename'. -- -- Use 'fileSelectionComplete' to display files and directories that match a -- given pattern. This can be used for example, to show only *.txt files, or -- only files beginning with gtk*. -- -- Simple file operations; create directory, delete file, and rename file, -- are available from buttons at the top of the dialog. These can be hidden -- using 'fileSelectionHideFileopButtons' and shown again using -- 'fileSelectionShowFileopButtons'. -- -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----'Dialog' -- | +----FileSelection -- @ #if GTK_MAJOR_VERSION < 3 -- * Types FileSelection, FileSelectionClass, castToFileSelection, gTypeFileSelection, toFileSelection, -- * Constructors fileSelectionNew, -- * Methods fileSelectionSetFilename, fileSelectionGetFilename, fileSelectionShowFileopButtons, fileSelectionHideFileopButtons, fileSelectionGetButtons, fileSelectionComplete, fileSelectionGetSelections, fileSelectionSetSelectMultiple, fileSelectionGetSelectMultiple, -- * Attributes fileSelectionFilename, fileSelectionShowFileops, fileSelectionSelectMultiple, #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties {#import Graphics.UI.Gtk.Types#} import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.General.Structs (fileSelectionGetButtons) {# context lib="libgtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new file selection dialog box. By default it will contain a -- 'TreeView' of the application's current working directory, and a file -- listing. Operation buttons that allow the user to create a directory, delete -- files and rename files, are also present. -- fileSelectionNew :: GlibString string => string -- ^ @title@ - a message that will be placed in the file -- requestor's titlebar. -> IO FileSelection fileSelectionNew title = makeNewObject mkFileSelection $ liftM (castPtr :: Ptr Widget -> Ptr FileSelection) $ withUTFString title $ \titlePtr -> {# call unsafe file_selection_new #} titlePtr -------------------- -- Methods -- | Sets a default path for the file requestor. If @filename@ includes a -- directory path, then the requestor will open with that path as its current -- working directory. -- -- This has the consequence that in order to open the requestor with a -- working directory and an empty filename, @filename@ must have a trailing -- directory separator. -- fileSelectionSetFilename :: (FileSelectionClass self, GlibString string) => self -> string -- ^ @filename@ - a string to set as the default file name. -> IO () fileSelectionSetFilename self filename = withUTFString filename $ \filenamePtr -> #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) {# call unsafe gtk_file_selection_set_filename_utf8 #} #else {# call unsafe gtk_file_selection_set_filename #} #endif (toFileSelection self) filenamePtr -- | This function returns the selected filename. -- -- If no file is selected then the selected directory path is returned. -- fileSelectionGetFilename :: (FileSelectionClass self, GlibString string) => self -> IO string -- ^ returns currently-selected filename fileSelectionGetFilename self = #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) {# call unsafe gtk_file_selection_get_filename_utf8 #} #else {# call unsafe gtk_file_selection_get_filename #} #endif (toFileSelection self) >>= peekUTFString -- | Shows the file operation buttons, if they have previously been hidden. -- The rest of the widgets in the dialog will be resized accordingly. -- fileSelectionShowFileopButtons :: FileSelectionClass self => self -> IO () fileSelectionShowFileopButtons self = {# call file_selection_show_fileop_buttons #} (toFileSelection self) -- | Hides the file operation buttons that normally appear at the top of the -- dialog. Useful if you wish to create a custom file selector, based on -- 'FileSelection'. -- fileSelectionHideFileopButtons :: FileSelectionClass self => self -> IO () fileSelectionHideFileopButtons self = {# call file_selection_hide_fileop_buttons #} (toFileSelection self) -- | Will attempt to match @pattern@ to a valid filenames or subdirectories in -- the current directory. If a match can be made, the matched filename will -- appear in the text entry field of the file selection dialog. If a partial -- match can be made, the \"Files\" list will contain those file names which -- have been partially matched, and the \"Folders\" list those directories -- which have been partially matched. -- fileSelectionComplete :: (FileSelectionClass self, GlibString string) => self -> string -- ^ @pattern@ - a string of characters which may or may not match -- any filenames in the current directory. -> IO () fileSelectionComplete self pattern = withUTFString pattern $ \patternPtr -> {# call file_selection_complete #} (toFileSelection self) patternPtr -- | Retrieves the list of file selections the user has made in the dialog -- box. This function is intended for use when the user can select multiple -- files in the file list. -- fileSelectionGetSelections :: (FileSelectionClass self, GlibString string) => self -> IO [string] fileSelectionGetSelections self = do cStrArr <- #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) {# call gtk_file_selection_get_selections_utf8 #} #else {# call gtk_file_selection_get_selections #} #endif (toFileSelection self) cStrs <- peekArray0 nullPtr cStrArr result <- mapM peekUTFString cStrs {# call unsafe g_strfreev #} cStrArr return result -- | Sets whether the user is allowed to select multiple files in the file -- list. Use 'fileSelectionGetSelections' to get the list of selected files. -- fileSelectionSetSelectMultiple :: FileSelectionClass self => self -> Bool -- ^ @selectMultiple@ - whether or not the user is allowed to select -- multiple files in the file list. -> IO () fileSelectionSetSelectMultiple self selectMultiple = {# call gtk_file_selection_set_select_multiple #} (toFileSelection self) (fromBool selectMultiple) -- | Determines whether or not the user is allowed to select multiple files in -- the file list. See 'fileSelectionSetSelectMultiple'. -- fileSelectionGetSelectMultiple :: FileSelectionClass self => self -> IO Bool -- ^ returns @True@ if the user is allowed to select multiple -- files in the file list fileSelectionGetSelectMultiple self = liftM toBool $ {# call gtk_file_selection_get_select_multiple #} (toFileSelection self) -------------------- -- Attributes -- | The currently selected filename. -- -- fileSelectionFilename :: (FileSelectionClass self, GlibString string) => Attr self string fileSelectionFilename = newAttr fileSelectionGetFilename fileSelectionSetFilename -- | Whether buttons for creating\/manipulating files should be displayed. -- -- Default value: @False@ -- fileSelectionShowFileops :: FileSelectionClass self => Attr self Bool fileSelectionShowFileops = newAttrFromBoolProperty "show-fileops" -- | Whether to allow multiple files to be selected. -- -- Default value: @False@ -- fileSelectionSelectMultiple :: FileSelectionClass self => Attr self Bool fileSelectionSelectMultiple = newAttr fileSelectionGetSelectMultiple fileSelectionSetSelectMultiple #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/FontButton.chs0000644000000000000000000002310007346545000020126 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FontButton -- -- Author : Duncan Coutts -- -- Created: 5 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) -- -- A button to launch a font selection dialog -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.Selectors.FontButton ( -- * Detail -- -- | The 'FontButton' is a button which displays the currently selected font -- an allows to open a font selection dialog to change the font. It is suitable -- widget for selecting a font in a preference dialog. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Button' -- | +----FontButton -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types FontButton, FontButtonClass, castToFontButton, gTypeFontButton, toFontButton, -- * Constructors fontButtonNew, fontButtonNewWithFont, -- * Methods fontButtonSetFontName, fontButtonGetFontName, fontButtonSetShowStyle, fontButtonGetShowStyle, fontButtonSetShowSize, fontButtonGetShowSize, fontButtonSetUseFont, fontButtonGetUseFont, fontButtonSetUseSize, fontButtonGetUseSize, fontButtonSetTitle, fontButtonGetTitle, -- * Attributes fontButtonTitle, fontButtonFontName, fontButtonUseFont, fontButtonUseSize, fontButtonShowStyle, fontButtonShowSize, -- * Signals onFontSet, afterFontSet, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new font picker widget. -- fontButtonNew :: IO FontButton fontButtonNew = makeNewObject mkFontButton $ liftM (castPtr :: Ptr Widget -> Ptr FontButton) $ {# call gtk_font_button_new #} -- | Creates a new font picker widget. -- fontButtonNewWithFont :: GlibString string => string -- ^ @fontname@ - Name of font to display in font selection -- dialog -> IO FontButton fontButtonNewWithFont fontname = makeNewObject mkFontButton $ liftM (castPtr :: Ptr Widget -> Ptr FontButton) $ withUTFString fontname $ \fontnamePtr -> {# call gtk_font_button_new_with_font #} fontnamePtr -------------------- -- Methods -- | Sets or updates the currently-displayed font in font picker dialog. -- fontButtonSetFontName :: (FontButtonClass self, GlibString string) => self -> string -- ^ @fontname@ - Name of font to display in font selection dialog -> IO Bool -- ^ returns Return value of 'Graphics.UI.Gtk.Selectors.FontSelectionDialog.fontSelectionDialogSetFontName' if -- the font selection dialog exists, otherwise @False@. fontButtonSetFontName self fontname = liftM toBool $ withUTFString fontname $ \fontnamePtr -> {# call gtk_font_button_set_font_name #} (toFontButton self) fontnamePtr -- | Retrieves the name of the currently selected font. -- fontButtonGetFontName :: (FontButtonClass self, GlibString string) => self -> IO string -- ^ returns an internal copy of the font name which must not be -- freed. fontButtonGetFontName self = {# call gtk_font_button_get_font_name #} (toFontButton self) >>= peekUTFString -- | If @showStyle@ is @True@, the font style will be displayed along with -- name of the selected font. -- fontButtonSetShowStyle :: FontButtonClass self => self -> Bool -- ^ @showStyle@ - @True@ if font style should be displayed in -- label. -> IO () fontButtonSetShowStyle self showStyle = {# call gtk_font_button_set_show_style #} (toFontButton self) (fromBool showStyle) -- | Returns whether the name of the font style will be shown in the label. -- fontButtonGetShowStyle :: FontButtonClass self => self -> IO Bool -- ^ returns whether the font style will be shown in the label. fontButtonGetShowStyle self = liftM toBool $ {# call gtk_font_button_get_show_style #} (toFontButton self) -- | If @showSize@ is @True@, the font size will be displayed along with the -- name of the selected font. -- fontButtonSetShowSize :: FontButtonClass self => self -> Bool -- ^ @showSize@ - @True@ if font size should be displayed in dialog. -> IO () fontButtonSetShowSize self showSize = {# call gtk_font_button_set_show_size #} (toFontButton self) (fromBool showSize) -- | Returns whether the font size will be shown in the label. -- fontButtonGetShowSize :: FontButtonClass self => self -> IO Bool -- ^ returns whether the font size will be shown in the label. fontButtonGetShowSize self = liftM toBool $ {# call gtk_font_button_get_show_size #} (toFontButton self) -- | If @useFont@ is @True@, the font name will be written using the selected -- font. -- fontButtonSetUseFont :: FontButtonClass self => self -> Bool -- ^ @useFont@ - If @True@, font name will be written using font -- chosen. -> IO () fontButtonSetUseFont self useFont = {# call gtk_font_button_set_use_font #} (toFontButton self) (fromBool useFont) -- | Returns whether the selected font is used in the label. -- fontButtonGetUseFont :: FontButtonClass self => self -> IO Bool -- ^ returns whether the selected font is used in the label. fontButtonGetUseFont self = liftM toBool $ {# call gtk_font_button_get_use_font #} (toFontButton self) -- | If @useSize@ is @True@, the font name will be written using the selected -- size. -- fontButtonSetUseSize :: FontButtonClass self => self -> Bool -- ^ @useSize@ - If @True@, font name will be written using the -- selected size. -> IO () fontButtonSetUseSize self useSize = {# call gtk_font_button_set_use_size #} (toFontButton self) (fromBool useSize) -- | Returns whether the selected size is used in the label. -- fontButtonGetUseSize :: FontButtonClass self => self -> IO Bool -- ^ returns whether the selected size is used in the label. fontButtonGetUseSize self = liftM toBool $ {# call gtk_font_button_get_use_size #} (toFontButton self) -- | Sets the title for the font selection dialog. -- fontButtonSetTitle :: (FontButtonClass self, GlibString string) => self -> string -- ^ @title@ - a string containing the font selection dialog title -> IO () fontButtonSetTitle self title = withUTFString title $ \titlePtr -> {# call gtk_font_button_set_title #} (toFontButton self) titlePtr -- | Retrieves the title of the font selection dialog. -- fontButtonGetTitle :: (FontButtonClass self, GlibString string) => self -> IO string -- ^ returns an internal copy of the title string which must not -- be freed. fontButtonGetTitle self = {# call gtk_font_button_get_title #} (toFontButton self) >>= peekUTFString -------------------- -- Attributes -- | The title of the font selection dialog. -- -- Default value: \"Pick a Font\" -- fontButtonTitle :: (FontButtonClass self, GlibString string) => Attr self string fontButtonTitle = newAttr fontButtonGetTitle fontButtonSetTitle -- | The name of the currently selected font. -- -- Default value: \"Sans 12\" -- fontButtonFontName :: (FontButtonClass self, GlibString string) => Attr self string fontButtonFontName = newAttrFromStringProperty "font-name" -- | If this property is set to @True@, the label will be drawn in the -- selected font. -- -- Default value: @False@ -- fontButtonUseFont :: FontButtonClass self => Attr self Bool fontButtonUseFont = newAttr fontButtonGetUseFont fontButtonSetUseFont -- | If this property is set to @True@, the label will be drawn with the -- selected font size. -- -- Default value: @False@ -- fontButtonUseSize :: FontButtonClass self => Attr self Bool fontButtonUseSize = newAttr fontButtonGetUseSize fontButtonSetUseSize -- | If this property is set to @True@, the name of the selected font style -- will be shown in the label. For a more WYSIWIG way to show the selected -- style, see the ::use-font property. -- -- Default value: @True@ -- fontButtonShowStyle :: FontButtonClass self => Attr self Bool fontButtonShowStyle = newAttr fontButtonGetShowStyle fontButtonSetShowStyle -- | If this property is set to @True@, the selected font size will be shown -- in the label. For a more WYSIWIG way to show the selected size, see the -- ::use-size property. -- -- Default value: @True@ -- fontButtonShowSize :: FontButtonClass self => Attr self Bool fontButtonShowSize = newAttr fontButtonGetShowSize fontButtonSetShowSize -------------------- -- Signals -- | The 'fontSet' signal is emitted when the user selects a font. When -- handling this signal, use 'fontButtonGetFontName' to find out which font was -- just selected. -- onFontSet, afterFontSet :: FontButtonClass self => self -> IO () -> IO (ConnectId self) onFontSet = connect_NONE__NONE "font-set" False afterFontSet = connect_NONE__NONE "font-set" True #endif gtk-0.15.9/Graphics/UI/Gtk/Selectors/FontSelection.chs0000644000000000000000000001076507346545000020615 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FontSelection -- -- Author : Duncan Coutts -- -- Created: 2 August 2004 -- -- Copyright (C) 2004-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) -- -- A widget for selecting fonts -- module Graphics.UI.Gtk.Selectors.FontSelection ( -- * Detail -- -- | The 'FontSelection' widget lists the available fonts, styles and sizes, -- allowing the user to select a font. It is used in the 'FontSelectionDialog' -- widget to provide a dialog box for selecting fonts. -- -- To set the font which is initially selected, use -- 'fontSelectionSetFontName'. -- -- To get the selected font use 'fontSelectionGetFontName'. -- -- To change the text which is shown in the preview area, use -- 'fontSelectionSetPreviewText'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Box' -- | +----'VBox' -- | +----FontSelection -- @ -- * Types FontSelection, FontSelectionClass, castToFontSelection, gTypeFontSelection, toFontSelection, -- * Constructors fontSelectionNew, -- * Methods fontSelectionGetFontName, fontSelectionSetFontName, fontSelectionGetPreviewText, fontSelectionSetPreviewText, -- * Attributes fontSelectionFontName, fontSelectionPreviewText, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'FontSelection'. -- fontSelectionNew :: IO FontSelection fontSelectionNew = makeNewObject mkFontSelection $ liftM (castPtr :: Ptr Widget -> Ptr FontSelection) $ {# call unsafe font_selection_new #} -------------------- -- Methods -- | Gets the currently-selected font name. -- fontSelectionGetFontName :: (FontSelectionClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the name of the currently selected font, or -- @Nothing@ if no font is selected. fontSelectionGetFontName self = {# call unsafe font_selection_get_font_name #} (toFontSelection self) >>= maybePeek readUTFString -- | Sets the currently-selected font. -- fontSelectionSetFontName :: (FontSelectionClass self, GlibString string) => self -> string -- ^ @fontname@ - a fontname. -> IO Bool -- ^ returns @True@ if the font was found. fontSelectionSetFontName self fontname = liftM toBool $ withUTFString fontname $ \fontnamePtr -> {# call font_selection_set_font_name #} (toFontSelection self) fontnamePtr -- | Gets the text displayed in the preview area. -- fontSelectionGetPreviewText :: (FontSelectionClass self, GlibString string) => self -> IO string fontSelectionGetPreviewText self = {# call unsafe font_selection_get_preview_text #} (toFontSelection self) >>= peekUTFString -- | Sets the text displayed in the preview area. -- fontSelectionSetPreviewText :: (FontSelectionClass self, GlibString string) => self -> string -> IO () fontSelectionSetPreviewText self text = withUTFString text $ \textPtr -> {# call font_selection_set_preview_text #} (toFontSelection self) textPtr -------------------- -- Attributes -- | The X string that represents this font. -- -- Default value: \"\" -- fontSelectionFontName :: (FontSelectionClass self, GlibString string) => Attr self string fontSelectionFontName = newAttrFromStringProperty "font_name" -- | The text to display in order to demonstrate the selected font. -- -- Default value: \"abcdefghijk ABCDEFGHIJK\" -- fontSelectionPreviewText :: (FontSelectionClass self, GlibString string) => Attr self string fontSelectionPreviewText = newAttr fontSelectionGetPreviewText fontSelectionSetPreviewText gtk-0.15.9/Graphics/UI/Gtk/Selectors/FontSelectionDialog.chs0000644000000000000000000001421107346545000021723 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget FontSelectionDialog -- -- Author : Duncan Coutts -- -- Created: 2 August 2004 -- -- Copyright (C) 2004-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) -- -- A dialog box for selecting fonts -- module Graphics.UI.Gtk.Selectors.FontSelectionDialog ( -- * Detail -- -- | The 'FontSelectionDialog' widget is a dialog box for selecting a font. -- -- To set the font which is initially selected, use -- 'fontSelectionDialogSetFontName'. -- -- To get the selected font use 'fontSelectionDialogGetFontName'. -- -- To change the text which is shown in the preview area, use -- 'fontSelectionDialogSetPreviewText'. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----'Dialog' -- | +----FontSelectionDialog -- @ -- * Types FontSelectionDialog, FontSelectionDialogClass, castToFontSelectionDialog, gTypeFontSelectionDialog, toFontSelectionDialog, -- * Constructors fontSelectionDialogNew, -- * Methods fontSelectionDialogGetFontName, fontSelectionDialogSetFontName, fontSelectionDialogGetPreviewText, fontSelectionDialogSetPreviewText, #if GTK_CHECK_VERSION(2,14,0) fontSelectionDialogGetCancelButton, fontSelectionDialogGetOkButton, #endif #if GTK_CHECK_VERSION(2,22,0) fontSelectionDialogGetFontSelection, #endif -- * Attributes fontSelectionDialogPreviewText, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'FontSelectionDialog'. -- fontSelectionDialogNew :: GlibString string => string -- ^ @title@ - the title of the dialog box. -> IO FontSelectionDialog fontSelectionDialogNew title = makeNewObject mkFontSelectionDialog $ liftM (castPtr :: Ptr Widget -> Ptr FontSelectionDialog) $ withUTFString title $ \titlePtr -> {# call unsafe font_selection_dialog_new #} titlePtr -------------------- -- Methods -- | Gets the currently-selected font name. -- fontSelectionDialogGetFontName :: (FontSelectionDialogClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the currently-selected font name, or -- @Nothing@ if no font is selected. fontSelectionDialogGetFontName self = {# call font_selection_dialog_get_font_name #} (toFontSelectionDialog self) >>= maybePeek readUTFString -- | Sets the currently-selected font. -- fontSelectionDialogSetFontName :: (FontSelectionDialogClass self, GlibString string) => self -> string -- ^ @fontname@ - a fontname. -> IO Bool -- ^ returns @True@ if the font was found. fontSelectionDialogSetFontName self fontname = liftM toBool $ withUTFString fontname $ \fontnamePtr -> {# call font_selection_dialog_set_font_name #} (toFontSelectionDialog self) fontnamePtr -- | Gets the text displayed in the preview area. -- fontSelectionDialogGetPreviewText :: (FontSelectionDialogClass self, GlibString string) => self -> IO string fontSelectionDialogGetPreviewText self = {# call unsafe font_selection_dialog_get_preview_text #} (toFontSelectionDialog self) >>= peekUTFString -- | Sets the text displayed in the preview area. -- fontSelectionDialogSetPreviewText :: (FontSelectionDialogClass self, GlibString string) => self -> string -> IO () fontSelectionDialogSetPreviewText self text = withUTFString text $ \textPtr -> {# call font_selection_dialog_set_preview_text #} (toFontSelectionDialog self) textPtr #if GTK_CHECK_VERSION(2,14,0) -- | Gets the 'Cancel' button. -- -- * Available since Gtk+ version 2.14 -- fontSelectionDialogGetCancelButton :: FontSelectionDialogClass self => self -> IO Widget -- ^ returns the 'Widget' used in the dialog for the 'Cancel' button. fontSelectionDialogGetCancelButton self = makeNewObject mkWidget $ {#call gtk_font_selection_dialog_get_cancel_button #} (toFontSelectionDialog self) -- | Gets the 'OK' button. -- -- * Available since Gtk+ version 2.14 -- fontSelectionDialogGetOkButton :: FontSelectionDialogClass self => self -> IO Widget -- ^ returns the 'Widget' used in the dialog for the 'OK' button. fontSelectionDialogGetOkButton self = makeNewObject mkWidget $ {#call gtk_font_selection_dialog_get_ok_button #} (toFontSelectionDialog self) #endif #if GTK_CHECK_VERSION(2,22,0) -- | Retrieves the 'FontSelection' widget embedded in the dialog. -- -- * Available since Gtk+ version 2.22 -- fontSelectionDialogGetFontSelection :: FontSelectionDialogClass self => self -> IO FontSelection -- ^ returns the embedded 'FontSelection' fontSelectionDialogGetFontSelection self = makeNewObject mkFontSelection $ liftM (castPtr :: Ptr Widget -> Ptr FontSelection) $ {#call gtk_font_selection_dialog_get_font_selection #} (toFontSelectionDialog self) #endif -------------------- -- Attributes -- | \'previewText\' property. See 'fontSelectionDialogGetPreviewText' and -- 'fontSelectionDialogSetPreviewText' -- fontSelectionDialogPreviewText :: (FontSelectionDialogClass self, GlibString string) => Attr self string fontSelectionDialogPreviewText = newAttr fontSelectionDialogGetPreviewText fontSelectionDialogSetPreviewText gtk-0.15.9/Graphics/UI/Gtk/Selectors/HSV.chs0000644000000000000000000001624007346545000016473 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HSV -- -- Author : Andy Stewart -- -- Created: 25 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A \'color wheel\' widget -- -- * Module available since Gtk+ version 2.14 -- module Graphics.UI.Gtk.Selectors.HSV ( -- * Detail -- -- | 'HSV' is the \'color wheel\' part of a complete color selector widget. It -- allows to select a color by determining its 'HSV' components in an intuitive -- way. Moving the selection around the outer ring changes the hue, and moving -- the selection point inside the inner triangle changes value and saturation. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----HSV -- @ #if GTK_CHECK_VERSION(2,14,0) -- * Types HSV, HSVClass, castToHSV, toHSV, -- * Constructors hsvNew, -- * Methods hsvIsAdjusting, hsvToRgb, rgbToHsv, -- * Attributes hsvColor, hsvMetrics, -- * Signals hsvChanged, hsvMove, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.Attributes import Graphics.UI.Gtk.General.Enums (DirectionType (..)) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,14,0) -------------------- -- Constructors -- | Creates a new 'HSV' color selector. -- -- * Available since 2.14 -- hsvNew :: IO HSV hsvNew = makeNewObject mkHSV $ liftM (castPtr :: Ptr Widget -> Ptr HSV) $ {# call gtk_hsv_new #} -------------------- -- Methods -- | Sets the current color in an 'HSV' color selector. Color component values -- must be in the [0.0, 1.0] range. -- -- * Available since 2.14 -- hsvSetColor :: HSVClass self => self -> (Double, Double, Double) -- ^ @(h, s, v)@ -- @h@ - value for the hue -- @s@ value for the saturation -- @v@ value for the value -> IO () hsvSetColor self (h, s, v) = {# call gtk_hsv_set_color #} (toHSV self) (realToFrac h) (realToFrac s) (realToFrac v) -- | Queries the current color in an 'HSV' color selector. Returned values will -- be in the [0.0, 1.0] range. -- hsvGetColor :: HSVClass self => self -> IO (Double, Double, Double) -- ^ @(h, s, v)@ @h@ - Return value for the hue @s@ - -- Return value for the saturation @v@ - Return -- value for the value hsvGetColor self = alloca $ \hPtr -> alloca $ \sPtr -> alloca $ \vPtr -> do {# call gtk_hsv_get_color #} (toHSV self) hPtr sPtr vPtr h <- peek hPtr s <- peek sPtr v <- peek vPtr return (realToFrac h, realToFrac s, realToFrac v) -- | Sets the size and ring width of an 'HSV' color selector. -- hsvSetMetrics :: HSVClass self => self -> (Int, Int) -- ^ @(size, ringWidth)@ -- ^ @size@ - Diameter for the hue ring -- ^ @ringWidth@ - Width of the hue ring -> IO () hsvSetMetrics self (size, ringWidth) = {# call gtk_hsv_set_metrics #} (toHSV self) (fromIntegral size) (fromIntegral ringWidth) -- | Queries the size and ring width of an 'HSV' color selector. -- hsvGetMetrics :: HSVClass self => self -> IO (Int, Int) -- ^ @(size, ringWidth)@ -- @size@ - Return value for the diameter of the hue ring -- @ringWidth@ - Return value for the width of the hue ring hsvGetMetrics self = alloca $ \sizePtr -> alloca $ \ringWidthPtr -> do {# call gtk_hsv_get_metrics #} (toHSV self) sizePtr ringWidthPtr size <- peek sizePtr ringWidth <- peek ringWidthPtr return (fromIntegral size, fromIntegral ringWidth) -- | An 'HSV' color selector can be said to be adjusting if multiple rapid -- changes are being made to its value, for example, when the user is adjusting -- the value with the mouse. This function queries whether the 'HSV' color -- selector is being adjusted or not. -- hsvIsAdjusting :: HSVClass self => self -> IO Bool -- ^ returns @True@ if clients can ignore changes to the color -- value, since they may be transitory, or @False@ if they should -- consider the color value status to be final. hsvIsAdjusting self = liftM toBool $ {# call gtk_hsv_is_adjusting #} (toHSV self) -- | Converts a color from 'HSV' space to RGB. Input values must be in the [0.0, -- 1.0] range; output values will be in the same range. -- hsvToRgb :: (Double, Double, Double) -- ^ @(h, s, v)@ -- @h@ - value for the hue -- @s@ value for the saturation -- @v@ value for the value -> (Double, Double, Double) -- ^ @(r, g, b)@ @r@ - Return value for the red -- component @g@ - Return value for the green -- component @b@ - Return value for the blue -- component hsvToRgb (h, s, v) = unsafePerformIO $ alloca $ \rPtr -> alloca $ \gPtr -> alloca $ \bPtr -> do {# call gtk_hsv_to_rgb #} (realToFrac h) (realToFrac s) (realToFrac v) rPtr gPtr bPtr r <- peek rPtr g <- peek gPtr b <- peek bPtr return (realToFrac r, realToFrac g, realToFrac b) -- | Converts a color from RGB space to 'HSV'. Input values must be in the [0.0, 1.0] range; output values -- will be in the same range. rgbToHsv :: (Double, Double, Double) -- ^ @(r, g, b)@ @r@ value for the red component -- @g@ value for the green component -- @b@ value for the blue component -> (Double, Double, Double) -- ^ @(h, s, v)@ -- @h@ - Return value for the hue -- @s@ - Return value for the saturation -- @v@ - Return value for the value rgbToHsv (r, g, b) = unsafePerformIO $ alloca $ \hPtr -> alloca $ \sPtr -> alloca $ \vPtr -> do {# call rgb_to_hsv #} (realToFrac r) (realToFrac g) (realToFrac b) hPtr sPtr vPtr h <- peek hPtr s <- peek sPtr v <- peek vPtr return (realToFrac h, realToFrac s, realToFrac v) -------------------- -- Attributes -- | Color in an 'HSV' color selector. -- Color component values must be in the [0.0, 1.0] range. hsvColor :: HSVClass self => Attr self (Double, Double, Double) hsvColor = newAttr hsvGetColor hsvSetColor -- | The size and ring width of an 'HSV' color selector. hsvMetrics :: HSVClass self => Attr self (Int, Int) hsvMetrics = newAttr hsvGetMetrics hsvSetMetrics -------------------- -- Signals -- | -- hsvChanged :: HSVClass self => Signal self (IO ()) hsvChanged = Signal (connect_NONE__NONE "changed") -- | -- hsvMove :: HSVClass self => Signal self (DirectionType -> IO ()) hsvMove = Signal (connect_ENUM__NONE "move") #endif gtk-0.15.9/Graphics/UI/Gtk/Special/0000755000000000000000000000000007346545000014746 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Special/HRuler.chs0000644000000000000000000000413407346545000016650 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget HRuler -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A horizontal ruler -- -- * Rulers are removed in Gtk3 and thus this module is blank. There is no -- replacement module Graphics.UI.Gtk.Special.HRuler ( -- * Detail -- -- | The 'HRuler' widget is a widget arranged horizontally creating a ruler that -- is utilized around other widgets such as a text widget. The ruler is used to -- show the location of the mouse on the window and to show the size of the -- window in specified units. The available units of measurement are 'Pixels', -- 'Inches' and 'Centimeters'. 'Pixels' is the default. rulers. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Ruler' -- | +----HRuler -- @ #if GTK_MAJOR_VERSION < 3 -- * Types HRuler, HRulerClass, castToHRuler, toHRuler, -- * Constructors hRulerNew, #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new horizontal ruler. -- hRulerNew :: IO HRuler hRulerNew = makeNewObject mkHRuler $ liftM (castPtr :: Ptr Widget -> Ptr HRuler) $ {# call gtk_hruler_new #} #endif gtk-0.15.9/Graphics/UI/Gtk/Special/Ruler.chs0000644000000000000000000001073007346545000016537 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Ruler -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- Base class for horizontal or vertical rulers -- module Graphics.UI.Gtk.Special.Ruler ( -- * Detail -- -- | The 'Ruler' widget is a base class for horizontal and vertical rulers. -- Rulers are used to show the mouse pointer's location in a window. The ruler -- can either be horizontal or vertical on the window. Within the ruler a small -- triangle indicates the location of the mouse relative to the horizontal or -- vertical ruler. See 'HRuler' to learn how to create a new horizontal ruler. -- See 'VRuler' to learn how to create a new vertical ruler. -- -- * Rulers are removed in Gtk3 and thus this module is blank. There is no -- replacement -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Ruler -- | +----'HRuler' -- | +----'VRuler' -- @ #if GTK_MAJOR_VERSION < 3 -- * Types Ruler, RulerClass, castToRuler, toRuler, -- * Enums MetricType (..), -- * Attributes rulerRange, rulerLower, rulerUpper, rulerPosition, rulerMaxSize, #if GTK_CHECK_VERSION(2,8,0) rulerMetric, #endif #endif ) where #if GTK_MAJOR_VERSION < 3 import System.Glib.FFI import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.General.Enums {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Methods -- | This sets the range of the ruler. -- rulerSetRange :: RulerClass self => self -> (Double ,Double ,Double ,Double) -- ^ @lower@ - the lower limit of the ruler -- ^ @upper@ - the upper limit of the ruler -- ^ @position@ - the mark on the ruler -- ^ @maxSize@ - the maximum size of the ruler used when calculating the space to leave for the text -> IO () rulerSetRange self (lower, upper, position, maxSize) = {# call gtk_ruler_set_range #} (toRuler self) (realToFrac lower) (realToFrac upper) (realToFrac position) (realToFrac maxSize) -- | Retrieves values indicating the range and current position of a 'Ruler'. -- See 'rulerSetRange'. -- rulerGetRange :: RulerClass self => self -> IO (Double, Double, Double, Double) rulerGetRange self = alloca $ \lowerPtr -> alloca $ \upperPtr -> alloca $ \positionPtr -> alloca $ \maxSizePtr -> do {# call gtk_ruler_get_range #} (toRuler self) lowerPtr upperPtr positionPtr maxSizePtr lower <- peek lowerPtr upper <- peek upperPtr position <- peek positionPtr maxSize <- peek maxSizePtr return (realToFrac lower, realToFrac upper, realToFrac position, realToFrac maxSize) -------------------- -- Attributes -- | Range of ruler -- rulerRange :: RulerClass self => Attr self (Double, Double, Double, Double) rulerRange = newAttr rulerGetRange rulerSetRange -- | Lower limit of ruler. -- -- Default value: 0 -- rulerLower :: RulerClass self => Attr self Double rulerLower = newAttrFromDoubleProperty "lower" -- | Upper limit of ruler. -- -- Default value: 0 -- rulerUpper :: RulerClass self => Attr self Double rulerUpper = newAttrFromDoubleProperty "upper" -- | Position of mark on the ruler. -- -- Default value: 0 -- rulerPosition :: RulerClass self => Attr self Double rulerPosition = newAttrFromDoubleProperty "position" -- | Maximum size of the ruler. -- -- Default value: 0 -- rulerMaxSize :: RulerClass self => Attr self Double rulerMaxSize = newAttrFromDoubleProperty "max-size" #if GTK_CHECK_VERSION(2,8,0) -- | The metric used for the ruler. -- -- Default value: ''Pixels'' -- -- Since 2.8 -- rulerMetric :: RulerClass self => Attr self MetricType rulerMetric = newAttrFromEnumProperty "metric" {# call pure unsafe gtk_metric_type_get_type #} #endif #endif gtk-0.15.9/Graphics/UI/Gtk/Special/VRuler.chs0000644000000000000000000000413007346545000016662 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget VRuler -- -- Author : Andy Stewart -- -- Created: 28 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A vertical ruler -- module Graphics.UI.Gtk.Special.VRuler ( -- * Detail -- -- | The 'VRuler' widget is a widget arranged vertically creating a ruler that -- is utilized around other widgets such as a text widget. The ruler is used to -- show the location of the mouse on the window and to show the size of the -- window in specified units. The available units of measurement are 'Pixels', -- 'Inches' and 'Centimeters'. 'Pixels' is the default. rulers. -- -- * Rulers are removed in Gtk3 and thus this module is blank. There is no -- replacement -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Ruler' -- | +----VRuler -- @ #if GTK_MAJOR_VERSION < 3 -- * Types VRuler, VRulerClass, castToVRuler, toVRuler, -- * Constructors vRulerNew, #endif ) where #if GTK_MAJOR_VERSION < 3 import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new vertical ruler -- vRulerNew :: IO VRuler vRulerNew = makeNewObject mkVRuler $ liftM (castPtr :: Ptr Widget -> Ptr VRuler) $ {# call gtk_vruler_new #} #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/0000755000000000000000000000000007346545000015020 5ustar0000000000000000gtk-0.15.9/Graphics/UI/Gtk/Windows/AboutDialog.chs0000644000000000000000000005147707346545000017727 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget AboutDialog -- -- Author : Duncan Coutts -- -- Created: 1 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Display information about an application -- -- * Module available since Gtk+ version 2.6 -- module Graphics.UI.Gtk.Windows.AboutDialog ( -- * Detail -- -- | The 'AboutDialog' offers a simple way to display information about a -- program like its logo, name, copyright, website and license. It is also -- possible to give credits to the authors, documenters, translators and -- artists who have worked on the program. An about dialog is typically opened -- when the user selects the @About@ option from the @Help@ menu. All parts of -- the dialog are optional. -- -- About dialog often contain links and email addresses. 'AboutDialog' -- supports this by offering global hooks, which are called when the user -- clicks on a link or email address, see 'aboutDialogSetEmailHook' and -- 'aboutDialogSetUrlHook'. Email addresses in the authors, documenters and -- artists properties are recognized by looking for @\@, URLs are -- recognized by looking for @http:\/\/url@, with @url@ extending to the next -- space, tab or line break. -- Since 2.18 'AboutDialog' provides default website and email hooks that -- use 'showURI'. -- -- Note that Gtk+ sets a default title of @_(\"About %s\")@ on the dialog -- window (where %s is replaced by the name of the application, but in order to -- ensure proper translation of the title, applications should set the title -- property explicitly when constructing a 'AboutDialog', as shown in the -- following example: -- -- Note that prior to Gtk+ 2.12, the 'aboutDialogProgramName' property was called -- 'aboutDialogName'. Both names may be used in Gtk2Hs. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----'Dialog' -- | +----AboutDialog -- @ #if GTK_CHECK_VERSION(2,6,0) -- * Types AboutDialog, AboutDialogClass, castToAboutDialog, gTypeAboutDialog, toAboutDialog, -- * Constructors aboutDialogNew, -- * Methods #if GTK_MAJOR_VERSION < 3 aboutDialogSetEmailHook, aboutDialogSetUrlHook, #endif -- * Attributes aboutDialogProgramName, aboutDialogName, aboutDialogVersion, aboutDialogCopyright, aboutDialogComments, aboutDialogLicense, aboutDialogWebsite, aboutDialogWebsiteLabel, aboutDialogAuthors, aboutDialogDocumenters, aboutDialogArtists, aboutDialogTranslatorCredits, aboutDialogLogo, aboutDialogLogoIconName, #if GTK_CHECK_VERSION(2,8,0) aboutDialogWrapLicense, #endif -- * Deprecated #ifndef DISABLE_DEPRECATED aboutDialogGetName, aboutDialogSetName, aboutDialogGetVersion, aboutDialogSetVersion, aboutDialogGetCopyright, aboutDialogSetCopyright, aboutDialogGetComments, aboutDialogSetComments, aboutDialogGetLicense, aboutDialogSetLicense, aboutDialogGetWebsite, aboutDialogSetWebsite, aboutDialogGetWebsiteLabel, aboutDialogSetWebsiteLabel, aboutDialogSetAuthors, aboutDialogGetAuthors, aboutDialogSetArtists, aboutDialogGetArtists, aboutDialogSetDocumenters, aboutDialogGetDocumenters, aboutDialogGetTranslatorCredits, aboutDialogSetTranslatorCredits, aboutDialogGetLogo, aboutDialogSetLogo, aboutDialogGetLogoIconName, aboutDialogSetLogoIconName, #if GTK_CHECK_VERSION(2,8,0) aboutDialogGetWrapLicense, aboutDialogSetWrapLicense, #endif #endif #endif ) where import Control.Monad (liftM) import Data.Maybe (fromMaybe) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,6,0) -------------------- -- Constructors -- | Creates a new 'AboutDialog'. -- aboutDialogNew :: IO AboutDialog aboutDialogNew = makeNewObject mkAboutDialog $ liftM (castPtr :: Ptr Widget -> Ptr AboutDialog) $ {# call gtk_about_dialog_new #} -------------------- -- Methods #ifndef DISABLE_DEPRECATED -- | Returns the program name displayed in the about dialog. -- aboutDialogGetName :: (AboutDialogClass self, GlibString string) => self -> IO string -- ^ returns The program name. aboutDialogGetName self = #if GTK_CHECK_VERSION(2,12,0) {# call gtk_about_dialog_get_program_name #} #else {# call gtk_about_dialog_get_name #} #endif (toAboutDialog self) >>= peekUTFString -- | Sets the name to display in the about dialog. If this is not set, it -- defaults to the program executable name. -- aboutDialogSetName :: (AboutDialogClass self, GlibString string) => self -> string -- ^ @name@ - the program name -> IO () aboutDialogSetName self name = withUTFString name $ \namePtr -> #if GTK_CHECK_VERSION(2,12,0) {# call gtk_about_dialog_set_program_name #} #else {# call gtk_about_dialog_set_name #} #endif (toAboutDialog self) namePtr -- | Returns the version string. -- aboutDialogGetVersion :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetVersion self = {# call gtk_about_dialog_get_version #} (toAboutDialog self) >>= peekUTFString -- | Sets the version string to display in the about dialog. -- aboutDialogSetVersion :: (AboutDialogClass self, GlibString string) => self -> string -> IO () aboutDialogSetVersion self version = withUTFString version $ \versionPtr -> {# call gtk_about_dialog_set_version #} (toAboutDialog self) versionPtr -- | Returns the copyright string. -- aboutDialogGetCopyright :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetCopyright self = {# call gtk_about_dialog_get_copyright #} (toAboutDialog self) >>= peekUTFString -- | Sets the copyright string to display in the about dialog. This should be -- a short string of one or two lines. -- aboutDialogSetCopyright :: (AboutDialogClass self, GlibString string) => self -> string -> IO () aboutDialogSetCopyright self copyright = withUTFString copyright $ \copyrightPtr -> {# call gtk_about_dialog_set_copyright #} (toAboutDialog self) copyrightPtr -- | Returns the comments string. -- aboutDialogGetComments :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetComments self = {# call gtk_about_dialog_get_comments #} (toAboutDialog self) >>= peekUTFString -- | Sets the comments string to display in the about dialog. This should be a -- short string of one or two lines. -- aboutDialogSetComments :: (AboutDialogClass self, GlibString string) => self -> string -> IO () aboutDialogSetComments self comments = withUTFString comments $ \commentsPtr -> {# call gtk_about_dialog_set_comments #} (toAboutDialog self) commentsPtr -- | Returns the license information. -- aboutDialogGetLicense :: (AboutDialogClass self, GlibString string) => self -> IO (Maybe string) aboutDialogGetLicense self = {# call gtk_about_dialog_get_license #} (toAboutDialog self) >>= maybePeek peekUTFString -- | Sets the license information to be displayed in the secondary license -- dialog. If @license@ is @Nothing@, the license button is hidden. -- aboutDialogSetLicense :: (AboutDialogClass self, GlibString string) => self -> Maybe string -- ^ @license@ - the license information or @Nothing@ -> IO () aboutDialogSetLicense self license = maybeWith withUTFString license $ \licensePtr -> {# call gtk_about_dialog_set_license #} (toAboutDialog self) licensePtr -- | Returns the website URL. -- aboutDialogGetWebsite :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetWebsite self = {# call gtk_about_dialog_get_website #} (toAboutDialog self) >>= peekUTFString -- | Sets the URL to use for the website link. -- aboutDialogSetWebsite :: (AboutDialogClass self, GlibString string) => self -> string -- ^ @website@ - a URL string starting with \"http:\/\/\" -> IO () aboutDialogSetWebsite self website = withUTFString website $ \websitePtr -> {# call gtk_about_dialog_set_website #} (toAboutDialog self) websitePtr -- | Returns the label used for the website link. -- aboutDialogGetWebsiteLabel :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetWebsiteLabel self = {# call gtk_about_dialog_get_website_label #} (toAboutDialog self) >>= peekUTFString -- | Sets the label to be used for the website link. It defaults to the -- website URL. -- aboutDialogSetWebsiteLabel :: (AboutDialogClass self, GlibString string) => self -> string -> IO () aboutDialogSetWebsiteLabel self websiteLabel = withUTFString websiteLabel $ \websiteLabelPtr -> {# call gtk_about_dialog_set_website_label #} (toAboutDialog self) websiteLabelPtr #endif -- | Sets the strings which are displayed in the authors tab of the secondary -- credits dialog. -- aboutDialogSetAuthors :: (AboutDialogClass self, GlibString string) => self -> [string] -- ^ @authors@ - a list of author names -> IO () aboutDialogSetAuthors self authors = withUTFStringArray0 authors $ \authorsPtr -> {# call gtk_about_dialog_set_authors #} (toAboutDialog self) authorsPtr -- | Returns the string which are displayed in the authors tab of the -- secondary credits dialog. -- aboutDialogGetAuthors :: (AboutDialogClass self, GlibString string) => self -> IO [string] aboutDialogGetAuthors self = {# call gtk_about_dialog_get_authors #} (toAboutDialog self) >>= peekUTFStringArray0 -- | Sets the strings which are displayed in the artists tab of the secondary -- credits dialog. -- aboutDialogSetArtists :: (AboutDialogClass self, GlibString string) => self -> [string] -- ^ @artists@ - a list of artist names -> IO () aboutDialogSetArtists self artists = withUTFStringArray0 artists $ \artistsPtr -> {# call gtk_about_dialog_set_artists #} (toAboutDialog self) artistsPtr -- | Returns the string which are displayed in the artists tab of the -- secondary credits dialog. -- aboutDialogGetArtists :: (AboutDialogClass self, GlibString string) => self -> IO [string] aboutDialogGetArtists self = {# call gtk_about_dialog_get_artists #} (toAboutDialog self) >>= peekUTFStringArray0 -- | Sets the strings which are displayed in the documenters tab of the -- secondary credits dialog. -- aboutDialogSetDocumenters :: (AboutDialogClass self, GlibString string) => self -> [string] -- ^ @artists@ - a list of documenter names -> IO () aboutDialogSetDocumenters self documenters = withUTFStringArray0 documenters $ \documentersPtr -> {# call gtk_about_dialog_set_documenters #} (toAboutDialog self) documentersPtr -- | Returns the string which are displayed in the documenters tab of the -- secondary credits dialog. -- aboutDialogGetDocumenters :: (AboutDialogClass self, GlibString string) => self -> IO [string] aboutDialogGetDocumenters self = {# call gtk_about_dialog_get_documenters #} (toAboutDialog self) >>= peekUTFStringArray0 #ifndef DISABLE_DEPRECATED -- | Returns the translator credits string which is displayed in the -- translators tab of the secondary credits dialog. -- aboutDialogGetTranslatorCredits :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetTranslatorCredits self = {# call gtk_about_dialog_get_translator_credits #} (toAboutDialog self) >>= peekUTFString -- | Sets the translator credits string which is displayed in the translators -- tab of the secondary credits dialog. -- -- The intended use for this string is to display the translator of the -- language which is currently used in the user interface. -- aboutDialogSetTranslatorCredits :: (AboutDialogClass self, GlibString string) => self -> string -> IO () aboutDialogSetTranslatorCredits self translatorCredits = withUTFString translatorCredits $ \translatorCreditsPtr -> {# call gtk_about_dialog_set_translator_credits #} (toAboutDialog self) translatorCreditsPtr #endif -- | Returns the pixbuf displayed as logo in the about dialog. -- aboutDialogGetLogo :: AboutDialogClass self => self -> IO Pixbuf aboutDialogGetLogo self = makeNewGObject mkPixbuf $ {# call gtk_about_dialog_get_logo #} (toAboutDialog self) -- | Sets the pixbuf to be displayed as logo in the about dialog. If it is -- @Nothing@, the default window icon set with 'windowSetDefaultIcon' will be -- used. -- aboutDialogSetLogo :: AboutDialogClass self => self -> Maybe Pixbuf -- ^ @logo@ - a 'Pixbuf', or @Nothing@ -> IO () aboutDialogSetLogo self logo = {# call gtk_about_dialog_set_logo #} (toAboutDialog self) (fromMaybe (Pixbuf nullForeignPtr) logo) -- | Returns the icon name displayed as logo in the about dialog. -- aboutDialogGetLogoIconName :: (AboutDialogClass self, GlibString string) => self -> IO string aboutDialogGetLogoIconName self = {# call gtk_about_dialog_get_logo_icon_name #} (toAboutDialog self) >>= peekUTFString -- | Sets the pixbuf to be displayed as logo in the about dialog. If it is -- @Nothing@, the default window icon set with 'windowSetDefaultIcon' will be -- used. -- aboutDialogSetLogoIconName :: (AboutDialogClass self, GlibString string) => self -> Maybe string -- ^ @iconName@ - an icon name, or @Nothing@ -> IO () aboutDialogSetLogoIconName self iconName = maybeWith withUTFString iconName $ \iconNamePtr -> {# call gtk_about_dialog_set_logo_icon_name #} (toAboutDialog self) iconNamePtr #if GTK_MAJOR_VERSION < 3 -- | Installs a global function to be called whenever the user activates an -- email link in an about dialog. -- -- Removed in Gtk3. aboutDialogSetEmailHook :: GlibString string => (string -> IO ()) -- ^ @(\url -> ...)@ - a function to call when an email -- link is activated. -> IO () aboutDialogSetEmailHook func = do funcPtr <- mkAboutDialogActivateLinkFunc (\_ linkPtr _ -> do link <- peekUTFString linkPtr func link ) {# call gtk_about_dialog_set_email_hook #} funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr return () -- | Installs a global function to be called whenever the user activates a URL -- link in an about dialog. -- -- Removed in Gtk3. aboutDialogSetUrlHook ::GlibString string => (string -> IO ()) -- ^ @(\url -> ...)@ - a function to call when a URL link -- is activated. -> IO () aboutDialogSetUrlHook func = do funcPtr <- mkAboutDialogActivateLinkFunc (\_ linkPtr _ -> do link <- peekUTFString linkPtr func link ) {# call gtk_about_dialog_set_url_hook #} funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr return () {# pointer AboutDialogActivateLinkFunc #} foreign import ccall "wrapper" mkAboutDialogActivateLinkFunc :: (Ptr AboutDialog -> CString -> Ptr () -> IO ()) -> IO AboutDialogActivateLinkFunc #endif #ifndef DISABLE_DEPRECATED #if GTK_CHECK_VERSION(2,8,0) -- | Returns whether the license text in @about@ is automatically wrapped. -- -- * Available since Gtk+ version 2.8 -- aboutDialogGetWrapLicense :: AboutDialogClass self => self -> IO Bool -- ^ returns @True@ if the license text is wrapped aboutDialogGetWrapLicense self = liftM toBool $ {# call gtk_about_dialog_get_wrap_license #} (toAboutDialog self) -- | Sets whether the license text in @about@ is automatically wrapped. -- -- * Available since Gtk+ version 2.8 -- aboutDialogSetWrapLicense :: AboutDialogClass self => self -> Bool -- ^ @wrapLicense@ - whether to wrap the license -> IO () aboutDialogSetWrapLicense self wrapLicense = {# call gtk_about_dialog_set_wrap_license #} (toAboutDialog self) (fromBool wrapLicense) #endif #endif -------------------- -- Attributes -- | The name of the program. If this is not set, it defaults to -- 'gGetApplicationName'. -- aboutDialogName :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogName = newAttrFromStringProperty "name" -- | The name of the program. If this is not set, it defaults to -- 'gGetApplicationName'. -- #if GTK_CHECK_VERSION(2,12,0) aboutDialogProgramName :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogProgramName = newAttrFromStringProperty "program-name" #else aboutDialogProgramName :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogProgramName = newAttrFromStringProperty "name" #endif -- | The version of the program. -- aboutDialogVersion :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogVersion = newAttrFromStringProperty "version" -- | Copyright information for the program. -- aboutDialogCopyright :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogCopyright = newAttrFromStringProperty "copyright" -- | Comments about the program. This string is displayed in a label in the -- main dialog, thus it should be a short explanation of the main purpose of -- the program, not a detailed list of features. -- aboutDialogComments :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogComments = newAttrFromStringProperty "comments" -- | The license of the program. This string is displayed in a text view in a -- secondary dialog, therefore it is fine to use a long multi-paragraph text. -- Note that the text is only wrapped in the text view if the 'aboutDialogWrapLicense' -- property is set to @True@; otherwise the text itself must contain the -- intended linebreaks. -- -- Default value: @Nothing@ -- aboutDialogLicense :: (AboutDialogClass self, GlibString string) => Attr self (Maybe string) aboutDialogLicense = newAttrFromMaybeStringProperty "license" -- | The URL for the link to the website of the program. This should be a -- string starting with \"http:\/\/. -- aboutDialogWebsite :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogWebsite = newAttrFromStringProperty "website" -- | The label for the link to the website of the program. If this is not set, -- it defaults to the URL specified in the website property. -- aboutDialogWebsiteLabel :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogWebsiteLabel = newAttrFromStringProperty "website-label" -- | The authors of the program. Each string may -- contain email addresses and URLs, which will be displayed as links, see the -- introduction for more details. -- aboutDialogAuthors :: (AboutDialogClass self, GlibString string) => Attr self [string] aboutDialogAuthors = newAttr aboutDialogGetAuthors aboutDialogSetAuthors -- | The people documenting the program. -- Each string may contain email addresses and URLs, which will be displayed as -- links, see the introduction for more details. -- aboutDialogDocumenters :: (AboutDialogClass self, GlibString string) => Attr self [string] aboutDialogDocumenters = newAttr aboutDialogGetDocumenters aboutDialogSetDocumenters -- | The people who contributed artwork to the program. -- Each string may contain email addresses and URLs, which will be -- displayed as links, see the introduction for more details. -- aboutDialogArtists :: (AboutDialogClass self, GlibString string) => Attr self [string] aboutDialogArtists = newAttr aboutDialogGetArtists aboutDialogSetArtists -- | Credits to the translators. This string should be marked as translatable. -- The string may contain email addresses and URLs, which will be displayed as -- links, see the introduction for more details. -- aboutDialogTranslatorCredits :: (AboutDialogClass self, GlibString string) => Attr self string aboutDialogTranslatorCredits = newAttrFromStringProperty "translator-credits" -- | A logo for the about box. If this is not set, it defaults to -- 'windowGetDefaultIconList'. -- aboutDialogLogo :: AboutDialogClass self => ReadWriteAttr self Pixbuf (Maybe Pixbuf) aboutDialogLogo = newAttr aboutDialogGetLogo aboutDialogSetLogo -- | A named icon to use as the logo for the about box. This property -- overrides the logo property. -- -- Default value: @Nothing@ -- aboutDialogLogoIconName :: (AboutDialogClass self, GlibString string) => ReadWriteAttr self string (Maybe string) aboutDialogLogoIconName = newAttr aboutDialogGetLogoIconName aboutDialogSetLogoIconName #endif #if GTK_CHECK_VERSION(2,8,0) -- | Whether to wrap the text in the license dialog. -- -- Default value: @False@ -- aboutDialogWrapLicense :: AboutDialogClass self => Attr self Bool aboutDialogWrapLicense = newAttrFromBoolProperty "wrap-license" #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/Assistant.chs0000644000000000000000000004515207346545000017477 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Assistant -- -- Author : Andy Stewart -- -- Created: 22 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A widget used to guide users through multi-step operations -- -- * Module available since Gtk+ version 2.10 -- module Graphics.UI.Gtk.Windows.Assistant ( -- * Detail -- -- | A 'Assistant' is a widget used to represent a generally complex operation -- split in several steps, guiding the user through its pages and -- controlling the page flow to collect the necessary data. -- ** GtkAssistant as GtkBuildable -- -- | The 'Assistant' implementation of the 'Buildable' interface exposes the -- @actionArea@ as internal children with the name \"action_area\". -- -- To add pages to an assistant in 'Builder', simply add it as a \ to -- the 'Assistant' object, and set its child properties as necessary. -- * Class Hierarchy -- -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----Assistant -- @ #if GTK_CHECK_VERSION(2,10,0) -- * Types Assistant, AssistantClass, castToAssistant, toAssistant, -- * Enums. AssistantPageType(..), -- * Constructors assistantNew, -- * Methods assistantGetNPages, assistantGetNthPage, assistantPrependPage, assistantAppendPage, assistantInsertPage, assistantSetForwardPageFunc, assistantAddActionWidget, assistantRemoveActionWidget, assistantUpdateButtonsState, assistantSetPageType, assistantGetPageType, assistantSetPageTitle, assistantGetPageTitle, assistantSetPageHeaderImage, assistantGetPageHeaderImage, assistantSetPageSideImage, assistantGetPageSideImage, assistantSetPageComplete, assistantGetPageComplete, #if GTK_CHECK_VERSION(2,22,0) assistantCommit, #endif -- * Attributes assistantCurrentPage, -- * Child Attributes assistantChildPageType, assistantChildTitle, assistantChildHeaderImage, assistantChildSidebarImage, assistantChildComplete, -- * Signals assistantCancel, assistantPrepare, assistantApply, assistantClose, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,10,0) -------------------- -- Enum {#enum GtkAssistantPageType as AssistantPageType {underscoreToCase} deriving (Bounded,Eq,Show)#} -------------------- -- Constructors -- | Creates a new 'Assistant'. -- -- * Available since Gtk+ version 2.10 -- assistantNew :: IO Assistant assistantNew = makeNewObject mkAssistant $ liftM (castPtr :: Ptr Widget -> Ptr Assistant) $ {# call gtk_assistant_new #} -------------------- -- Methods -- | Returns the page number of the current page -- -- * Available since Gtk+ version 2.10 -- assistantGetCurrentPage :: AssistantClass self => self -> IO Int -- ^ returns The index (starting from 0) of the current page in the -- @assistant@, if the @assistant@ has no pages, -1 will be returned assistantGetCurrentPage self = liftM fromIntegral $ {# call gtk_assistant_get_current_page #} (toAssistant self) -- | Switches the page to @pageNum@. Note that this will only be necessary in custom buttons, as the -- assistant flow can be set with 'assistantSetForwardPageFunc'. -- -- * Available since Gtk+ version 2.10 -- assistantSetCurrentPage :: AssistantClass self => self -> Int -- ^ @pageNum@ - index of the page to switch to, starting from 0. If -- negative, the last page will be used. If greater than the number of -- pages in the @assistant@, nothing will be done. -> IO () assistantSetCurrentPage self pageNum = {# call gtk_assistant_set_current_page #} (toAssistant self) (fromIntegral pageNum) -- | Returns the number of pages in the @assistant@ -- -- -- * Available since Gtk+ version 2.10 -- assistantGetNPages :: AssistantClass self => self -> IO Int -- ^ returns The number of pages in the @assistant@. assistantGetNPages self = liftM fromIntegral $ {# call gtk_assistant_get_n_pages #} (toAssistant self) -- | Returns the child widget contained in page number @pageNum@. -- -- -- * Available since Gtk+ version 2.10 -- assistantGetNthPage :: AssistantClass self => self -> Int -- ^ @pageNum@ - The index of a page in the @assistant@, or -1 -- to get the last page; -> IO (Maybe Widget) -- ^ returns The child widget, or 'Nothing' if @pageNum@ is out of bounds. assistantGetNthPage self pageNum = maybeNull (makeNewObject mkWidget) $ {# call gtk_assistant_get_nth_page #} (toAssistant self) (fromIntegral pageNum) -- | Prepends a page to the @assistant@. -- -- -- * Available since Gtk+ version 2.10 -- assistantPrependPage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a 'Widget' -> IO Int -- ^ returns the index (starting at 0) of the inserted page assistantPrependPage self page = liftM fromIntegral $ {# call gtk_assistant_prepend_page #} (toAssistant self) (toWidget page) -- | Appends a page to the @assistant@. -- -- -- * Available since Gtk+ version 2.10 -- assistantAppendPage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a 'Widget' -> IO Int -- ^ returns the index (starting at 0) of the inserted page assistantAppendPage self page = liftM fromIntegral $ {# call gtk_assistant_append_page #} (toAssistant self) (toWidget page) -- | Inserts a page in the @assistant@ at a given position. -- -- -- * Available since Gtk+ version 2.10 -- assistantInsertPage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a 'Widget' -> Int -- ^ @position@ - the index (starting at 0) at which to insert the -- page, or -1 to append the page to the @assistant@ -> IO Int -- ^ returns the index (starting from 0) of the inserted page assistantInsertPage self page position = liftM fromIntegral $ {# call gtk_assistant_insert_page #} (toAssistant self) (toWidget page) (fromIntegral position) -- | Sets the page forwarding function to be @pageFunc@, this function will be -- used to determine what will be the next page when the user presses the -- forward button. Setting @pageFunc@ to 'Nothing' will make the assistant to use the -- default forward function, which just goes to the next visible page. -- -- -- * Available since Gtk+ version 2.10 -- assistantSetForwardPageFunc :: AssistantClass self => self -> Maybe (Int -> IO Int) -- ^ @pageFunc@ - the 'AssistantPage', or 'Nothing' to use the default one. -> IO () assistantSetForwardPageFunc self Nothing = do {# call gtk_assistant_set_forward_page_func #} (toAssistant self) nullFunPtr (castFunPtrToPtr nullFunPtr) destroyFunPtr assistantSetForwardPageFunc self (Just pageFunc) = do pfPtr <- mkAssistantPageFunc $ \ c _ -> do result <- pageFunc (fromIntegral c) return $ fromIntegral result {# call gtk_assistant_set_forward_page_func #} (toAssistant self) pfPtr (castFunPtrToPtr pfPtr) destroyFunPtr {#pointer AssistantPageFunc#} foreign import ccall "wrapper" mkAssistantPageFunc :: ({#type gint#} -> Ptr () -> IO {#type gint#}) -> IO AssistantPageFunc -- | Sets the page type for @page@. The page type determines the page behavior -- in the @assistant@. -- -- -- * Available since Gtk+ version 2.10 -- assistantSetPageType :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> AssistantPageType -- ^ @type@ - the new type for @page@ -> IO () assistantSetPageType self page type_ = {# call gtk_assistant_set_page_type #} (toAssistant self) (toWidget page) ((fromIntegral . fromEnum) type_) -- | Gets the page type of @page@. -- -- -- * Available since Gtk+ version 2.10 -- assistantGetPageType :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> IO AssistantPageType -- ^ returns the page type of @page@. assistantGetPageType self page = liftM (toEnum . fromIntegral) $ {# call gtk_assistant_get_page_type #} (toAssistant self) (toWidget page) -- | Sets a title for @page@. The title is displayed in the header area of the -- assistant when @page@ is the current page. -- -- -- * Available since Gtk+ version 2.10 -- assistantSetPageTitle :: (AssistantClass self, WidgetClass page, GlibString string) => self -> page -- ^ @page@ - a page of @assistant@ -> string -- ^ @title@ - the new title for @page@ -> IO () assistantSetPageTitle self page title = withUTFString title $ \titlePtr -> {# call gtk_assistant_set_page_title #} (toAssistant self) (toWidget page) titlePtr -- | Gets the title for @page@. -- -- -- * Available since Gtk+ version 2.10 -- assistantGetPageTitle :: (AssistantClass self, WidgetClass page, GlibString string) => self -> page -- ^ @page@ - a page of @assistant@ -> IO string -- ^ returns the title for @page@. assistantGetPageTitle self page = {# call gtk_assistant_get_page_title #} (toAssistant self) (toWidget page) >>= peekUTFString -- | Sets a header image for @page@. This image is displayed in the header -- area of the assistant when @page@ is the current page. -- -- -- * Available since Gtk+ version 2.10 -- assistantSetPageHeaderImage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> Pixbuf -- ^ @pixbuf@ - the new header image @page@ -> IO () assistantSetPageHeaderImage self page pixbuf = {# call gtk_assistant_set_page_header_image #} (toAssistant self) (toWidget page) pixbuf -- | Gets the header image for @page@. -- -- -- * Available since Gtk+ version 2.10 -- assistantGetPageHeaderImage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> IO (Maybe Pixbuf) -- ^ returns the header image for @page@, or 'Nothing' if there's no header image for the page. assistantGetPageHeaderImage self page = maybeNull (makeNewGObject mkPixbuf) $ {# call gtk_assistant_get_page_header_image #} (toAssistant self) (toWidget page) -- | Sets a header image for @page@. This image is displayed in the side area -- of the assistant when @page@ is the current page. -- -- -- * Available since Gtk+ version 2.10 -- assistantSetPageSideImage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> Pixbuf -- ^ @pixbuf@ - the new header image @page@ -> IO () assistantSetPageSideImage self page pixbuf = {# call gtk_assistant_set_page_side_image #} (toAssistant self) (toWidget page) pixbuf -- | Gets the header image for @page@. -- -- -- * Available since Gtk+ version 2.10 -- assistantGetPageSideImage :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> IO (Maybe Pixbuf) -- ^ returns the side image for @page@, or 'Nothing' if there's no side image for the page. assistantGetPageSideImage self page = maybeNull (makeNewGObject mkPixbuf) $ {# call gtk_assistant_get_page_side_image #} (toAssistant self) (toWidget page) -- | Sets whether @page@ contents are complete. This will make @assistant@ -- update the buttons state to be able to continue the task. -- -- -- * Available since Gtk+ version 2.10 -- assistantSetPageComplete :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> Bool -- ^ @complete@ - the completeness status of the page -> IO () assistantSetPageComplete self page complete = {# call gtk_assistant_set_page_complete #} (toAssistant self) (toWidget page) (fromBool complete) -- | Gets whether @page@ is complete. -- -- -- * Available since Gtk+ version 2.10 -- assistantGetPageComplete :: (AssistantClass self, WidgetClass page) => self -> page -- ^ @page@ - a page of @assistant@ -> IO Bool -- ^ returns @True@ if @page@ is complete. assistantGetPageComplete self page = liftM toBool $ {# call gtk_assistant_get_page_complete #} (toAssistant self) (toWidget page) #if GTK_CHECK_VERSION(2,22,0) -- | Erases the visited page history so the back button is not shown on the current page, and removes the -- cancel button from subsequent pages. -- -- Use this when the information provided up to the current page is hereafter deemed permanent and -- cannot be modified or undone. For example, showing a progress page to track a long-running, -- unreversible operation after the user has clicked apply on a confirmation page. -- -- * Available since Gtk+ version 2.22 -- assistantCommit :: AssistantClass self => self -> IO () assistantCommit self = {#call gtk_assistant_commit#} (toAssistant self) #endif -- | Adds a widget to the action area of a 'Assistant'. -- -- -- * Available since Gtk+ version 2.10 -- assistantAddActionWidget :: (AssistantClass self, WidgetClass child) => self -> child -- ^ @child@ - a 'Widget' -> IO () assistantAddActionWidget self child = {# call gtk_assistant_add_action_widget #} (toAssistant self) (toWidget child) -- | Removes a widget from the action area of a 'Assistant'. -- -- -- * Available since Gtk+ version 2.10 -- assistantRemoveActionWidget :: (AssistantClass self, WidgetClass child) => self -> child -- ^ @child@ - a 'Widget' -> IO () assistantRemoveActionWidget self child = {# call gtk_assistant_remove_action_widget #} (toAssistant self) (toWidget child) -- | Forces @assistant@ to recompute the buttons state. -- -- Gtk+ automatically takes care of this in most situations, e.g. when the -- user goes to a different page, or when the visibility or completeness of a -- page changes. -- -- One situation where it can be necessary to call this function is when -- changing a value on the current page affects the future page flow of the -- assistant. -- -- -- * Available since Gtk+ version 2.10 -- assistantUpdateButtonsState :: AssistantClass self => self -> IO () assistantUpdateButtonsState self = {# call gtk_assistant_update_buttons_state #} (toAssistant self) -------------------- -- Attributes -- | Switches the page to @pageNum@. Note that this will only be necessary in -- custom buttons, as the @assistant@ flow can be set with -- 'assistantSetForwardPageFunc'. -- -- Returns the page number of the current page -- -- -- * Available since Gtk+ version 2.10 -- assistantCurrentPage :: AssistantClass self => Attr self Int assistantCurrentPage = newAttr assistantGetCurrentPage assistantSetCurrentPage -------------------- -- Child Attributes -- | The type of the assistant page. -- -- Default value: 'AssistantPageContent' -- -- -- * Available since Gtk+ version 2.10 -- assistantChildPageType :: AssistantClass self => Attr self AssistantPageType assistantChildPageType = newAttrFromEnumProperty "page-type" {#call pure unsafe assistant_page_type_get_type#} -- | The title that is displayed in the page header. -- -- If title and header-image are both, no header is displayed. -- -- -- * Available since Gtk+ version 2.10 -- assistantChildTitle :: (AssistantClass self, GlibString string) => Attr self string assistantChildTitle = newAttrFromStringProperty "title" -- | The image that is displayed next to the page. -- -- -- * Available since Gtk+ version 2.10 -- assistantChildHeaderImage :: AssistantClass self => Attr self Pixbuf assistantChildHeaderImage = newAttrFromObjectProperty "header-image" {# call pure unsafe gdk_pixbuf_get_type #} -- | Sidebar image for the assistant page. -- -- -- * Available since Gtk+ version 2.10 -- assistantChildSidebarImage :: AssistantClass self => Attr self Pixbuf assistantChildSidebarImage = newAttrFromObjectProperty "sidebar-image" {# call pure unsafe gdk_pixbuf_get_type #} -- | Setting the \"complete\" child property to @True@ marks a page as -- complete (i.e.: all the required fields are filled out). Gtk+ uses this -- information to control the sensitivity of the navigation buttons. -- -- Default value: @False@ -- -- -- * Available since Gtk+ version 2.10 -- assistantChildComplete :: AssistantClass self => Attr self Bool assistantChildComplete = newAttrFromBoolProperty "complete" -------------------- -- Signals -- | The ::assistantCancel signal is emitted when then the assistantCancel button is clicked. -- -- -- * Available since Gtk+ version 2.10 -- assistantCancel :: AssistantClass self => Signal self (IO ()) assistantCancel = Signal (connect_NONE__NONE "cancel") -- | The ::assistantPrepare signal is emitted when a new page is set as the assistant's -- current page, before making the new page visible. A handler for this signal -- can do any preparation which are necessary before showing @page@. -- -- -- * Available since Gtk+ version 2.10 -- assistantPrepare :: AssistantClass self => Signal self (Widget -> IO ()) assistantPrepare = Signal (connect_OBJECT__NONE "prepare") -- | The ::assistantApply signal is emitted when the assistantApply button is clicked. The -- default behavior of the 'Assistant' is to switch to the page after the -- current page, unless the current page is the last one. -- -- A handler for the ::assistantApply signal should carry out the actions for which -- the wizard has collected data. If the action takes a long time to complete, -- you might consider to put a page of type 'AssistantPageProgress' after the -- confirmation page and handle this operation within the 'assistantPrepare' signal of the progress page. -- -- -- * Available since Gtk+ version 2.10 -- assistantApply :: AssistantClass self => Signal self (IO ()) assistantApply = Signal (connect_NONE__NONE "apply") -- | The ::assistantClose signal is emitted either when the assistantClose button of a summary -- page is clicked, or when the apply button in the last page in the flow (of -- type 'AssistantPageConfirm') is clicked. -- assistantClose :: AssistantClass self => Signal self (IO ()) assistantClose = Signal (connect_NONE__NONE "close") #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/Dialog.chs0000644000000000000000000004174607346545000016732 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Dialog -- -- Author : Axel Simon, Andy Stewart -- -- Created: 23 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- Copyright (C) 2009-2010 Andy Stewart -- -- 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) -- -- Create popup windows -- -- NOTE: -- Now FFI haven't support variadic function `gtk_dialog_set_alternative_button_order` -- module Graphics.UI.Gtk.Windows.Dialog ( -- * Detail -- -- | Dialog boxes are a convenient way to prompt the user for a small amount -- of input, e.g. to display a message, ask a question, or anything else that -- does not require extensive effort on the user's part. -- -- Gtk+ treats a dialog as a window split vertically. The top section is a -- 'VBox', and is where widgets such as a 'Label' or a 'Entry' should be -- packed. The bottom area is known as the action_area. This is generally used -- for packing buttons into the dialog which may perform functions such as -- cancel, ok, or apply. The two areas are separated by a 'HSeparator'. -- -- 'Dialog' boxes are created with a call to 'dialogNew' or -- 'dialogNewWithButtons'. 'dialogNewWithButtons' is recommended; it allows you -- to set the dialog title, some convenient flags, and add simple buttons. -- -- If \'dialog\' is a newly created dialog, the two primary areas of the -- window can be accessed using 'dialogGetUpper' and -- 'dialogGetActionArea'. -- -- A \'modal\' dialog (that is, one which freezes the rest of the -- application from user input), can be created by calling 'windowSetModal' on -- the dialog. When using 'dialogNewWithButtons' you can also -- pass the 'DialogModal' flag to make a dialog modal. -- -- If you add buttons to 'Dialog' using 'dialogNewWithButtons', -- 'dialogAddButton', or 'dialogAddActionWidget', clicking -- the button will emit a signal called \"response\" with a response ID that -- you specified. Gtk+ will never assign a meaning to positive response IDs; -- these are entirely user-defined. But for convenience, you can use the -- response IDs in the 'ResponseType' enumeration (these all have values less -- than zero). If a dialog receives a delete event, the \"response\" signal -- will be emitted with a response ID of 'ResponseNone'. -- -- If you want to block waiting for a dialog to return before returning -- control flow to your code, you can call 'dialogRun'. This function enters a -- recursive main loop and waits for the user to respond to the dialog, -- returning the response ID corresponding to the button the user clicked. -- -- For a simple message box, you probably want to use -- 'Graphics.UI.Gtk.Windows.MessageDialog.MessageDialog' which provides -- convenience functions -- for creating standard dialogs containing simple messages to inform -- or ask the user. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----Dialog -- | +----'AboutDialog' -- | +----'ColorSelectionDialog' -- | +----'FileChooserDialog' -- | +----'FileSelection' -- | +----'FontSelectionDialog' -- | +----'InputDialog' -- | +----'MessageDialog' -- @ -- * Types Dialog, DialogClass, castToDialog, gTypeDialog, toDialog, -- * Enums ResponseId(..), -- * Constructors dialogNew, -- * Methods #if GTK_MAJOR_VERSION < 3 dialogGetUpper, #endif dialogGetContentArea, dialogGetActionArea, dialogRun, dialogResponse, dialogAddButton, dialogAddActionWidget, dialogSetDefaultResponse, #if GTK_MAJOR_VERSION < 3 dialogGetHasSeparator, dialogSetHasSeparator, #endif dialogSetResponseSensitive, dialogGetResponseForWidget, dialogAlternativeDialogButtonOrder, dialogSetAlternativeButtonOrderFromArray, #if GTK_CHECK_VERSION(2,20,0) dialogGetWidgetForResponse, #endif -- * Attributes #if GTK_MAJOR_VERSION < 3 dialogHasSeparator, #endif dialogActionAreaBorder, dialogButtonSpacing, dialogContentAreaBorder, dialogContentAreaSpacing, -- * Signals response, -- * Deprecated #ifndef DISABLE_DEPRECATED onResponse, afterResponse, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Structs ( #if GTK_MAJOR_VERSION < 3 dialogGetUpper, dialogGetActionArea, #endif ResponseId(..), fromResponse, toResponse) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new dialog box. Widgets should not be packed into this 'Window' -- directly, but into the \"upper\" and \"action area\", which are obtained -- using 'dialogGetUpper' and 'dialogGetActionArea'. -- dialogNew :: IO Dialog dialogNew = makeNewObject mkDialog $ liftM (castPtr :: Ptr Widget -> Ptr Dialog) $ {# call unsafe dialog_new #} -------------------- -- Methods -- | Blocks in a recursive main loop until the dialog either emits the -- response signal, or is destroyed. If the dialog is destroyed during the call -- to 'dialogRun', it returns 'ResponseNone'. Otherwise, it returns the -- response ID from the \"response\" signal emission. Before entering the -- recursive main loop, 'dialogRun' calls 'widgetShow' on the dialog for you. -- Note that you still need to show any children of the dialog yourself. -- -- During 'dialogRun', the default behavior of \"delete_event\" is disabled; -- if the dialog receives \"delete_event\", it will not be destroyed as windows -- usually are, and 'dialogRun' will return 'ResponseDeleteEvent'. Also, during -- 'dialogRun' the dialog will be modal. You can force 'dialogRun' to return at -- any time by calling 'dialogResponse' to emit the \"response\" signal. -- Destroying the dialog during 'dialogRun' is a very bad idea, because your -- post-run code won't know whether the dialog was destroyed or not. -- Hence, you should not call 'Graphics.UI.Gtk.Abstract.widgetDestroy' -- before 'dialogRun' has returned. -- -- After 'dialogRun' returns, you are responsible for hiding or destroying -- the dialog if you wish to do so. -- -- Note that even though the recursive main loop gives the effect of a modal -- dialog (it prevents the user from interacting with other windows while the -- dialog is run), callbacks such as timeouts, IO channel watches, DND drops, -- etc, /will/ be triggered during a 'dialogRun' call. -- dialogRun :: DialogClass self => self -> IO ResponseId dialogRun self = liftM toResponse $ {# call dialog_run #} (toDialog self) -- | Emits the \"response\" signal with the given response ID. Used to -- indicate that the user has responded to the dialog in some way; typically -- either you or 'dialogRun' will be monitoring the \"response\" signal and -- take appropriate action. -- -- This function can be used to add a custom widget to the action area that -- should close the dialog when activated or to close the dialog otherwise. -- dialogResponse :: DialogClass self => self -> ResponseId -> IO () dialogResponse self responseId = {# call dialog_response #} (toDialog self) (fromResponse responseId) -- | Adds a button with the given text (or a stock button, if @buttonText@ is -- a stock ID) and sets things up so that clicking the button will emit the -- \"response\" signal with the given @responseId@. The button is appended to -- the end of the dialog's action area. The button widget is returned, but -- usually you don't need it. -- dialogAddButton :: (DialogClass self, GlibString string) => self -> string -- ^ @buttonText@ - text of button, or stock ID -> ResponseId -- ^ @responseId@ - response ID for the button -> IO Button -- ^ returns the button widget that was added dialogAddButton self buttonText responseId = makeNewObject mkButton $ liftM castPtr $ withUTFString buttonText $ \buttonTextPtr -> {# call dialog_add_button #} (toDialog self) buttonTextPtr (fromResponse responseId) -- | Adds an activatable widget to the action area of a 'Dialog', connecting a -- signal handler that will emit the \"response\" signal on the dialog when the -- widget is activated. The widget is appended to the end of the dialog's -- action area. If you want to add a non-activatable widget, simply pack it -- into the action area. -- dialogAddActionWidget :: (DialogClass self, WidgetClass child) => self -> child -- ^ @child@ - an activatable widget -> ResponseId -- ^ @responseId@ - response ID for @child@ -> IO () dialogAddActionWidget self child responseId = {# call dialog_add_action_widget #} (toDialog self) (toWidget child) (fromResponse responseId) #if GTK_MAJOR_VERSION < 3 -- | Query if the dialog has a visible horizontal separator. -- -- Removed in Gtk3. dialogGetHasSeparator :: DialogClass self => self -> IO Bool dialogGetHasSeparator self = liftM toBool $ {# call unsafe dialog_get_has_separator #} (toDialog self) -- | Sets whether the dialog has a separator above the buttons. @True@ by -- default. -- -- Removed in Gtk3. dialogSetHasSeparator :: DialogClass self => self -> Bool -> IO () dialogSetHasSeparator self setting = {# call dialog_set_has_separator #} (toDialog self) (fromBool setting) #endif -- | Sets the last widget in the dialog's action area with the given -- 'ResponseId' as the default widget for the dialog. Pressing \"Enter\" -- normally activates the default widget. -- -- * The default response is reset once it is triggered. Hence, if you -- hide the dialog (rather than closing it) and re-display it later, -- you need to call this function again. -- dialogSetDefaultResponse :: DialogClass self => self -> ResponseId -> IO () dialogSetDefaultResponse self responseId = {# call dialog_set_default_response #} (toDialog self) (fromResponse responseId) -- | Calls @'widgetSetSensitive' widget setting@ for each widget in the -- dialog's action area with the given @responseId@. A convenient way to -- sensitize\/desensitize dialog buttons. -- dialogSetResponseSensitive :: DialogClass self => self -> ResponseId -- ^ @responseId@ - a response ID -> Bool -- ^ @setting@ - @True@ for sensitive -> IO () dialogSetResponseSensitive self responseId setting = {# call dialog_set_response_sensitive #} (toDialog self) (fromResponse responseId) (fromBool setting) -- | Gets the response id of a widget in the action area of a dialog. dialogGetResponseForWidget :: (DialogClass self, WidgetClass widget) => self -> widget -- ^ @widget@ - a widget in the action area of dialog -> IO ResponseId -- ^ return the response id of widget, or 'ResponseNone' if widget doesn't have a response id set. dialogGetResponseForWidget self widget = liftM toResponse $ {# call dialog_get_response_for_widget #} (toDialog self) (toWidget widget) -- | Returns @True@ if dialogs are expected to use an alternative button order on the screen screen. -- See 'dialogSetAlternativeButtonOrder' for more details about alternative button order. -- -- If you need to use this function, you should probably connect to the 'alternativeButtonOrder' signal on the GtkSettings object associated to screen, in order to be notified if the button order setting changes. -- -- * Available since Gtk+ version 2.6 -- dialogAlternativeDialogButtonOrder :: Maybe Screen -- ^ @screen@ - a 'Screen', or @Nothing@ to use the default screen -> IO Bool -- ^ returns whether the alternative button order should be used dialogAlternativeDialogButtonOrder (Just screen) = liftM toBool $ {# call alternative_dialog_button_order #} screen dialogAlternativeDialogButtonOrder Nothing = liftM toBool $ {# call alternative_dialog_button_order #} (Screen nullForeignPtr) -- | Sets an alternative button order. -- -- If the 'alternativeButtonOrder' setting is set to @True@, the dialog -- buttons are reordered according to the order of the response ids in -- @newOrder@. -- -- See 'dialogSetAlternativeButtonOrder' for more information. -- -- This function is for use by language bindings. -- -- * Available since Gtk+ version 2.6 -- dialogSetAlternativeButtonOrderFromArray :: DialogClass self => self -> [ResponseId] -- ^ @newOrder@ - an array of response ids of dialog's buttons -> IO () dialogSetAlternativeButtonOrderFromArray self newOrder = withArray (map fromResponse newOrder) $ \newOrderPtr -> {# call dialog_set_alternative_button_order_from_array #} (toDialog self) (fromIntegral (length newOrder)) newOrderPtr #if GTK_CHECK_VERSION(2,20,0) -- | Gets the widget button that uses the given response ID in the action area of a dialog. dialogGetWidgetForResponse :: DialogClass self => self -> ResponseId -- ^ @responseId@ the response ID used by the dialog widget -> IO (Maybe Widget) -- ^ returns the widget button that uses the given @responseId@, or 'Nothing'. dialogGetWidgetForResponse self responseId = maybeNull (makeNewObject mkWidget) $ {#call gtk_dialog_get_widget_for_response #} (toDialog self) (fromResponse responseId) #endif #if GTK_MAJOR_VERSION >= 3 -- | Returns the content area of dialog. dialogGetContentArea :: DialogClass self => self -> IO Widget dialogGetContentArea self = makeNewObject mkWidget $ {#call gtk_dialog_get_content_area #} (toDialog self) -- | Returns the action area of dialog. -- -- * This is useful to add some special widgets that cannot be added with -- dialogAddActionWidget. -- dialogGetActionArea :: DialogClass self => self -> IO Widget dialogGetActionArea self = makeNewObject mkWidget $ {#call gtk_dialog_get_content_area #} (toDialog self) #else dialogGetContentArea self = liftM toWidget $ dialogGetUpper self #endif -------------------- -- Attributes #if GTK_MAJOR_VERSION < 3 -- | The dialog has a separator bar above its buttons. -- -- Default value: @True@ -- -- Removed in Gtk3. dialogHasSeparator :: DialogClass self => Attr self Bool dialogHasSeparator = newAttr dialogGetHasSeparator dialogSetHasSeparator #endif -- | Width of border around the button area at the bottom of the dialog. -- -- Allowed values: >= 0 -- -- Default value: 5 -- dialogActionAreaBorder :: DialogClass self => ReadAttr self Int dialogActionAreaBorder = readAttrFromIntProperty "action-area-border" -- | Spacing between buttons. -- -- Allowed values: >= 0 -- -- Default value: 6 -- dialogButtonSpacing :: DialogClass self => ReadAttr self Int dialogButtonSpacing = readAttrFromIntProperty "button-spacing" -- | Width of border around the main dialog area. -- -- Allowed values: >= 0 -- -- Default value: 2 -- dialogContentAreaBorder :: DialogClass self => ReadAttr self Int dialogContentAreaBorder = readAttrFromIntProperty "content-area-border" -- | The default spacing used between elements of the content area of the dialog, -- as returned by 'dialogSetContentArea', unless 'boxSetSpacing' was called on that widget directly. -- -- Allowed values: >= 0 -- -- Default value: 0 -- -- * Available since Gtk+ version 2.16 -- dialogContentAreaSpacing :: DialogClass self => ReadAttr self Int dialogContentAreaSpacing = readAttrFromIntProperty "content-area-spacing" -------------------- -- Signals -- | Emitted when an action widget is clicked, the dialog receives a delete -- event, or the application programmer calls 'dialogResponse'. On a delete -- event, the response ID is 'ResponseNone'. Otherwise, it depends on which -- action widget was clicked. -- response :: DialogClass self => Signal self (ResponseId -> IO ()) response = Signal (\after obj fun -> connect_INT__NONE "response" after obj (\i -> fun (toResponse i))) -- * Deprecated #ifndef DISABLE_DEPRECATED -- | Emitted when an action widget is clicked, the dialog receives a delete -- event, or the application programmer calls 'dialogResponse'. On a delete -- event, the response ID is 'ResponseNone'. Otherwise, it depends on which -- action widget was clicked. -- onResponse, afterResponse :: DialogClass self => self -> (ResponseId -> IO ()) -> IO (ConnectId self) onResponse dia act = connect_INT__NONE "response" False dia (act . toResponse) afterResponse dia act = connect_INT__NONE "response" True dia (act . toResponse) #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/Invisible.chs0000644000000000000000000000533307346545000017447 0ustar0000000000000000-- -*-haskell-*- -- GIMP Toolkit (GTK) Window -- -- Author : Andy Stewart -- -- Created: 7 Oct 2009 -- -- Copyright (C) 2009 Andy Stewart -- -- 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) -- -- A widget which is not displayed -- The 'Invisible' widget is used internally in GTK+, and is probably not very useful for application developers. -- It is used for reliable pointer grabs and selection handling in the code for drag-and-drop. -- module Graphics.UI.Gtk.Windows.Invisible ( -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----Invisible -- @ -- * Types Invisible, -- * Constructors invisibleNew, invisibleNewForScreen, -- * Methods invisibleSetScreen, invisibleGetScreen, ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.Gdk.Screen {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'Invisible'. -- invisibleNew :: IO Invisible invisibleNew = makeNewObject mkInvisible $ liftM (castPtr :: Ptr Widget -> Ptr Invisible) $ {# call invisible_new #} -- | Creates a new 'Invisible' object for a specified screen -- -- * Available since Gdk version 2.2 -- invisibleNewForScreen :: Screen -- ^ @screen@ - a 'Screen' which identifies on which the new 'Invisible' will be created. -> IO Invisible invisibleNewForScreen screen = makeNewObject mkInvisible $ liftM (castPtr :: Ptr Widget -> Ptr Invisible) $ {# call invisible_new_for_screen #} screen -- | Sets the 'Screen' where the 'Invisible' object will be displayed. -- -- * Available since Gdk version 2.2 -- invisibleSetScreen :: Invisible -> Screen -- ^ @screen@ - the 'Screen' to set -> IO () invisibleSetScreen invisible screen = {# call invisible_set_screen #} invisible screen -- | Returns the 'Screen' object associated with invisible -- -- * Available since Gdk version 2.2 -- invisibleGetScreen :: Invisible -> IO Screen invisibleGetScreen invisible = makeNewGObject mkScreen $ {# call invisible_get_screen #} invisible gtk-0.15.9/Graphics/UI/Gtk/Windows/MessageDialog.chs0000644000000000000000000002640107346545000020226 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget MessageDialog -- -- Author : Axel Simon -- -- Created: 20 October 2006 -- -- Copyright (C) 2006 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) -- -- A convenient message window -- module Graphics.UI.Gtk.Windows.MessageDialog ( -- * Detail -- -- | 'MessageDialog' presents a dialog with an image representing the type of -- message (Error, Question, etc.) alongside some message text. It's simply a -- convenience widget; you could construct the equivalent of 'MessageDialog' -- from 'Dialog' without too much effort, but 'MessageDialog' saves typing. -- -- The easiest way to do a modal message dialog is to use 'dialogRun', -- though you can also pass in the 'DialogModal' flag, 'dialogRun' -- automatically makes the dialog modal and waits for the user to respond to -- it. 'dialogRun' returns when any dialog button is clicked. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----'Window' -- | +----'Dialog' -- | +----MessageDialog -- @ -- * Types MessageDialog, MessageDialogClass, castToMessageDialog, gTypeMessageDialog, toMessageDialog, MessageType(..), ButtonsType(..), DialogFlags(..), -- * Constructors messageDialogNew, #if GTK_CHECK_VERSION(2,4,0) messageDialogNewWithMarkup, #endif -- * Methods #if GTK_CHECK_VERSION(2,4,0) messageDialogSetMarkup, #endif #if GTK_CHECK_VERSION(2,10,0) messageDialogSetImage, #endif #if GTK_CHECK_VERSION(2,6,0) messageDialogSetSecondaryMarkup, messageDialogSetSecondaryText, #endif -- * Attributes messageDialogMessageType, #if GTK_CHECK_VERSION(2,10,0) messageDialogText, messageDialogUseMarkup, messageDialogSecondaryText, messageDialogSecondaryUseMarkup, messageDialogImage, #endif messageDialogButtons, #if GTK_CHECK_VERSION(2,22,0) messageDialogMessageArea, #endif ) where import Control.Monad (liftM) import System.Glib.FFI {#import Graphics.UI.Gtk.Types#} import System.Glib.UTFString import System.Glib.Attributes import System.Glib.Properties import System.Glib.Flags (Flags, fromFlags) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {# context lib="gtk" prefix="gtk" #} -------------------- -- Types -- | Specify what message icon this dialog should show. -- #if GTK_CHECK_VERSION(2,10,0) -- -- * From Gtk 2.10 onwards, you can pass 'MessageOther' and supply your -- own image using 'messageDialogSetImage'. -- #endif {#enum MessageType {underscoreToCase} deriving(Show,Eq)#} -- | Specify what buttons this dialog should show. -- -- * Prebuilt sets of buttons for the dialog. If none of these choices -- are appropriate, simply use 'ButtonsNone' then call 'dialogAddButton'. -- {#enum ButtonsType {underscoreToCase} deriving(Show,Eq)#} -- | Flags used to influence dialog construction. -- -- * Marking a dialog as model will call 'widgetSetModal' on the dialog -- window, the 'DialogDestroyWithParent' will call -- 'windowSetDestroyWithParent' on the dialog window. Note that in -- case the dialog is simply destroyed, no response signal is ever -- emitted. Finally, 'DialogNoSeparator' omits the separator between -- the action area and the dialog content which is preferable for -- very simple messages, i.e. those that only contain one button. -- {#enum DialogFlags {underscoreToCase} deriving (Show,Eq,Bounded)#} instance Flags DialogFlags -------------------- -- Constructors -- | Create a new message dialog, which is a simple dialog with an icon -- indicating the dialog type (error, warning, etc.) and some text the -- user may want to see. When the user clicks a button a \"response\" signal -- is emitted with response IDs from 'ResponseType'. See 'Dialog' for more -- details. -- messageDialogNew :: GlibString string => Maybe Window -- ^ Transient parent of the dialog (or none) -> [DialogFlags] -> MessageType -> ButtonsType -> string -- ^ The text of the message -> IO MessageDialog messageDialogNew mWindow flags mType bType msg = withUTFString (unPrintf msg) $ \msgPtr -> makeNewObject mkMessageDialog $ liftM (castPtr :: Ptr Widget -> Ptr MessageDialog) $ call_message_dialog_new mWindow flags mType bType msgPtr call_message_dialog_new :: Maybe Window -> [DialogFlags] -> MessageType -> ButtonsType -> Ptr CChar -> IO (Ptr Widget) call_message_dialog_new (Just (Window fPtr)) flags mType bType msgPtr = withForeignPtr fPtr $ \ptr -> message_dialog_new ptr (fromIntegral (fromFlags flags)) (fromIntegral (fromEnum mType)) (fromIntegral (fromEnum bType)) msgPtr call_message_dialog_new Nothing flags mType bType msgPtr = message_dialog_new nullPtr (fromIntegral (fromFlags flags)) (fromIntegral (fromEnum mType)) (fromIntegral (fromEnum bType)) msgPtr foreign import ccall unsafe "gtk_message_dialog_new" message_dialog_new :: Ptr Window -> CInt -> CInt -> CInt -> Ptr CChar -> IO (Ptr Widget) #if GTK_CHECK_VERSION(2,4,0) -- | Creates a new message dialog, which is a simple dialog with an icon -- indicating the dialog type (error, warning, etc.) and some text which -- is marked up with the Pango text markup language. When the user clicks -- a button a \"response\" signal is emitted with response IDs from -- 'ResponseType'. See 'Dialog' and 'PangoMarkup' for more details. -- -- * Available since Gtk+ version 2.4 -- messageDialogNewWithMarkup :: GlibString string => Maybe Window -- ^ Transient parent of the dialog (or none) -> [DialogFlags] -> MessageType -> ButtonsType -> string -- ^ The text of the message -> IO MessageDialog messageDialogNewWithMarkup mWindow flags mType bType msg = do md <- makeNewObject mkMessageDialog $ liftM (castPtr :: Ptr Widget -> Ptr MessageDialog) $ call_message_dialog_new mWindow flags mType bType nullPtr messageDialogSetMarkup md msg return md #endif -------------------- -- Methods #if GTK_CHECK_VERSION(2,4,0) -- | Sets the text of the message dialog to be @str@, which is marked up with -- the Pango text markup language. -- -- * Available since Gtk+ version 2.4 -- messageDialogSetMarkup :: (MessageDialogClass self, GlibString string) => self -> string -- ^ @str@ - markup string (see Pango markup format) -> IO () messageDialogSetMarkup self str = withUTFString (unPrintf str) $ \strPtr -> {# call gtk_message_dialog_set_markup #} (toMessageDialog self) strPtr #endif #if GTK_CHECK_VERSION(2,6,0) messageDialogSetSecondaryMarkup :: (MessageDialogClass self, GlibString string) => self -> string -- ^ @str@ - markup string (see Pango markup format) -> IO () messageDialogSetSecondaryMarkup self str = withUTFString (unPrintf str) $ \strPtr -> let (MessageDialog fPtr) = toMessageDialog self in withForeignPtr fPtr $ \ptr -> message_dialog_format_secondary_markup ptr strPtr foreign import ccall unsafe "gtk_message_dialog_format_secondary_markup" message_dialog_format_secondary_markup :: Ptr MessageDialog -> Ptr CChar -> IO () messageDialogSetSecondaryText :: (MessageDialogClass self, GlibString string) => self -> string -- ^ @str@ - text to be shown as second line -> IO () messageDialogSetSecondaryText self str = withUTFString str $ \strPtr -> let (MessageDialog fPtr) = toMessageDialog self in withForeignPtr fPtr $ \ptr -> message_dialog_format_secondary_text ptr strPtr foreign import ccall unsafe "gtk_message_dialog_format_secondary_text" message_dialog_format_secondary_text :: Ptr MessageDialog -> Ptr CChar -> IO () #if GTK_CHECK_VERSION(2,10,0) -- %hash c:6cb7 d:ebdd -- | Sets the dialog's image to @image@. -- -- * Available since Gtk+ version 2.10 -- messageDialogSetImage :: (MessageDialogClass self, WidgetClass image) => self -> image -- ^ @image@ - the image -> IO () messageDialogSetImage self image = {# call gtk_message_dialog_set_image #} (toMessageDialog self) (toWidget image) #endif #endif -------------------- -- Attributes -- | The type of message. -- -- Default value: 'MessageInfo' -- messageDialogMessageType :: MessageDialogClass self => Attr self MessageType messageDialogMessageType = newAttrFromEnumProperty "message-type" {#call pure unsafe gtk_message_type_get_type #} #if GTK_CHECK_VERSION(2,10,0) -- %hash c:a2fe d:e4a2 -- | The primary text of the message dialog. If the dialog has a secondary -- text, this will appear as the title. -- -- Default value: @Nothing@ -- -- * Available since Gtk+ version 2.10 -- messageDialogText :: (MessageDialogClass self, GlibString string) => Attr self (Maybe string) messageDialogText = newAttrFromMaybeStringProperty "text" -- %hash c:e1dd d:ca3 -- | Interpret the string 'messageDialogText' as markup. -- -- Default value: @False@ -- -- * Available since Gtk+ version 2.10 -- messageDialogUseMarkup :: MessageDialogClass self => Attr self Bool messageDialogUseMarkup = newAttrFromBoolProperty "use-markup" -- %hash c:9623 d:1fbe -- | The secondary text of the message dialog. -- -- Default value: @Nothing@ -- -- * Available since Gtk+ version 2.10 -- messageDialogSecondaryText :: (MessageDialogClass self, GlibString string) => Attr self (Maybe string) messageDialogSecondaryText = newAttrFromMaybeStringProperty "secondary-text" -- %hash c:1ce2 d:ca3 -- | Default value: @False@ -- -- * Available since Gtk+ version 2.10 -- messageDialogSecondaryUseMarkup :: MessageDialogClass self => Attr self Bool messageDialogSecondaryUseMarkup = newAttrFromBoolProperty "secondary-use-markup" -- %hash c:da36 d:b7dd -- | The image for this dialog. -- -- * Available since Gtk+ version 2.10 -- messageDialogImage :: (MessageDialogClass self, WidgetClass widget) => ReadWriteAttr self Widget widget messageDialogImage = newAttrFromObjectProperty "image" {# call pure unsafe gtk_widget_get_type #} #endif -- | The buttons shown in the message dialog. -- -- Default value: 'ButtonsNone' -- messageDialogButtons :: MessageDialogClass self => WriteAttr self ButtonsType messageDialogButtons = writeAttrFromEnumProperty "buttons" {#call pure unsafe gtk_buttons_type_get_type #} #if GTK_CHECK_VERSION(2,22,0) -- | The 'VBox' that corresponds to the message area of this dialog. -- -- * Available since Gtk+ version 2.22 -- messageDialogMessageArea :: MessageDialogClass self => ReadAttr self VBox messageDialogMessageArea = readAttrFromObjectProperty "message-area" {# call pure unsafe gtk_vbox_get_type #} #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/OffscreenWindow.chs0000644000000000000000000001065407346545000020627 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget OffscreenWindow -- -- Author : Andy Stewart -- -- Created: 25 Mar 2010 -- -- Copyright (C) 2010 Andy Stewart -- -- 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) -- -- A toplevel container widget used to manage offscreen rendering of child widgets. -- -- * Module available since Gtk+ version 2.20 -- module Graphics.UI.Gtk.Windows.OffscreenWindow ( -- * Detail -- | 'OffscreenWindow' is strictly intended to be used for obtaining snapshots of widgets that are not -- part of a normal widget hierarchy. It differs from 'widgetGetSnapshot' in that the widget you -- want to get a snapshot of need not be displayed on the user's screen as a part of a widget -- hierarchy. However, since 'OffscreenWindow' is a toplevel widget you cannot obtain snapshots of a -- full window with it since you cannot pack a toplevel widget in another toplevel. -- -- The idea is to take a widget and manually set the state of it, add it to a 'OffscreenWindow' and -- then retrieve the snapshot as a 'Pixmap' or 'Pixbuf'. -- -- 'OffscreenWindow' derives from 'Window' only as an implementation detail. Applications should not -- use any API specific to 'Window' to operate on this object. It should be treated as a 'Bin' that -- has no parent widget. -- -- When contained offscreen widgets are redrawn, 'OffscreenWindow' will emit a 'damageEvent' signal. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Window -- | +----'OffscreenWindow' -- @ #if GTK_CHECK_VERSION(2,20,0) -- * Types OffscreenWindow, OffscreenWindowClass, castToOffscreenWindow, gTypeOffscreenWindow, toOffscreenWindow, -- * Constructors offscreenWindowNew, -- * Methods #if GTK_MAJOR_VERSION < 3 offscreenWindowGetPixmap, #endif offscreenWindowGetPixbuf, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,20,0) -- | Creates a toplevel container widget that is used to retrieve snapshots of widgets without showing -- them on the screen. For widgets that are on the screen and part of a normal widget hierarchy, -- 'widgetGetSnapshot' can be used instead. -- -- * Available since Gtk+ version 2.20 -- offscreenWindowNew :: IO OffscreenWindow offscreenWindowNew = makeNewObject mkOffscreenWindow $ liftM (castPtr :: Ptr Widget -> Ptr OffscreenWindow) $ {#call gtk_offscreen_window_new #} #if GTK_MAJOR_VERSION < 3 -- | Retrieves a snapshot of the contained widget in the form of a 'Pixmap'. If you need to keep this -- around over window resizes then you should add a reference to it. -- -- * Available since Gtk+ version 2.20 -- offscreenWindowGetPixmap :: OffscreenWindowClass self => self -- ^ @offscreen@ the 'OffscreenWindow' contained widget. -> IO (Maybe Pixmap) -- ^ returns A 'Pixmap' pointer to the offscreen pixmap, or 'Nothing'. offscreenWindowGetPixmap offscreen = maybeNull (makeNewGObject mkPixmap) $ {#call gtk_offscreen_window_get_pixmap #} (toOffscreenWindow offscreen) #endif -- | Retrieves a snapshot of the contained widget in the form of a 'Pixbuf'. -- -- * Available since Gtk+ version 2.20 -- offscreenWindowGetPixbuf :: OffscreenWindowClass self => self -- ^ @offscreen@ the 'OffscreenWindow' contained widget. -> IO (Maybe Pixbuf) -- ^ returns A 'Pixbuf' pointer to the offscreen pixbuf, or 'Nothing'. offscreenWindowGetPixbuf offscreen = maybeNull (wrapNewGObject mkPixbuf) $ {#call gtk_offscreen_window_get_pixbuf #} (toOffscreenWindow offscreen) #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/Window.chs0000644000000000000000000024642407346545000017002 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Window -- -- Author : Manuel M. T. Chakravarty, Axel Simon, Andy Stewart -- -- Created: 27 April 2001 -- -- Copyright (C) 2001-2005 Manuel M. T. Chakravarty, Axel Simon -- Copyright (C) 2009 Andy Stewart -- -- 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) -- -- Toplevel which can contain other widgets -- module Graphics.UI.Gtk.Windows.Window ( -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----'Object' -- | +----'Widget' -- | +----'Container' -- | +----'Bin' -- | +----Window -- | +----'Dialog' -- | +----'Plug' -- @ -- * Types Window, WindowClass, castToWindow, gTypeWindow, toWindow, WindowType(..), WindowEdge(..), WindowTypeHint(..), Gravity(..), -- * Constructors windowNew, windowNewPopup, -- * Methods windowActivateFocus, windowActivateDefault, windowSetDefaultSize, windowGetDefaultSize, windowSetPosition, WindowPosition(..), #if GTK_CHECK_VERSION(2,4,0) windowIsActive, windowHasToplevelFocus, #endif windowListToplevels, windowSetDefault, #if GTK_CHECK_VERSION(2,14,0) windowGetDefaultWidget, #endif windowAddMnemonic, windowRemoveMnemonic, windowMnemonicActivate, windowActivateKey, windowPropagateKeyEvent, windowPresent, windowDeiconify, windowIconify, windowMaximize, windowUnmaximize, #if GTK_CHECK_VERSION(2,2,0) windowFullscreen, windowUnfullscreen, #endif #if GTK_CHECK_VERSION(2,4,0) windowSetKeepAbove, windowSetKeepBelow, #endif #if GTK_CHECK_VERSION(2,12,0) windowSetStartupId, #endif #if GTK_MAJOR_VERSION < 3 windowGetFrame, windowSetFrameDimensions, windowGetFrameDimensions, #endif windowStick, windowUnstick, windowAddAccelGroup, windowRemoveAccelGroup, windowSetDefaultIconList, windowGetDefaultIconList, #if GTK_CHECK_VERSION(2,4,0) windowSetDefaultIcon, #endif #if GTK_CHECK_VERSION(2,2,0) windowSetDefaultIconFromFile, windowSetDefaultIconName, #if GTK_CHECK_VERSION(2,16,0) windowGetDefaultIconName, #endif #endif windowSetGravity, windowGetGravity, #if GTK_CHECK_VERSION(2,2,0) windowSetScreen, windowGetScreen, #endif windowBeginResizeDrag, windowBeginMoveDrag, windowSetTypeHint, windowGetTypeHint, windowGetIcon, windowGetPosition, windowGetSize, windowMove, windowParseGeometry, windowReshowWithInitialSize, windowResize, #if GTK_CHECK_VERSION(2,2,0) windowSetIconFromFile, windowSetAutoStartupNotification, #endif #if GTK_CHECK_VERSION(2,8,0) windowPresentWithTime, #endif windowSetGeometryHints, #if GTK_CHECK_VERSION(2,10,0) windowGetGroup, #endif #if GTK_CHECK_VERSION(2,20,0) windowGetWindowType, #endif -- * Attributes windowTitle, windowType, windowAllowShrink, windowAllowGrow, windowResizable, #if GTK_MAJOR_VERSION >= 3 windowHasResizeGrip, #endif windowModal, #if GTK_CHECK_VERSION(2,12,0) windowOpacity, #endif windowRole, #if GTK_CHECK_VERSION(2,12,0) windowStartupId, #endif windowWindowPosition, windowDefaultWidth, windowDefaultHeight, windowDeletable, windowDestroyWithParent, windowIcon, windowIconName, #if GTK_CHECK_VERSION(2,2,0) windowScreen, #endif windowTypeHint, #if GTK_CHECK_VERSION(2,2,0) windowSkipTaskbarHint, windowSkipPagerHint, #endif #if GTK_CHECK_VERSION(2,8,0) windowUrgencyHint, #endif #if GTK_CHECK_VERSION(2,4,0) windowAcceptFocus, #endif #if GTK_CHECK_VERSION(2,6,0) windowFocusOnMap, #endif #if GTK_CHECK_VERSION(2,4,0) windowDecorated, windowGravity, #endif windowToplevelFocus, windowTransientFor, windowFocus, #if GTK_MAJOR_VERSION < 3 windowHasFrame, #endif windowIconList, windowMnemonicModifier, #if GTK_CHECK_VERSION(2,20,0) windowMnemonicVisible, #endif -- * Signals frameEvent, keysChanged, setFocus, -- * Deprecated #ifndef DISABLE_DEPRECATED windowSetTitle, windowGetTitle, windowSetResizable, windowGetResizable, #if GTK_MAJOR_VERSION >= 3 windowSetHasResizeGrip, windowGetHasResizeGrip, #endif windowSetModal, windowGetModal, #if GTK_MAJOR_VERSION < 3 windowSetPolicy, #endif windowSetTransientFor, windowGetTransientFor, windowSetDestroyWithParent, windowGetDestroyWithParent, windowGetFocus, windowSetFocus, windowSetMnemonicModifier, windowGetMnemonicModifier, #if GTK_CHECK_VERSION(2,2,0) windowSetSkipTaskbarHint, windowGetSkipTaskbarHint, windowSetSkipPagerHint, windowGetSkipPagerHint, #if GTK_CHECK_VERSION(2,4,0) windowSetAcceptFocus, windowGetAcceptFocus, #if GTK_CHECK_VERSION(2,6,0) windowSetFocusOnMap, windowGetFocusOnMap, #endif #endif #endif windowSetDecorated, windowGetDecorated, #if GTK_CHECK_VERSION(2,10,0) windowSetDeletable, windowGetDeletable, #endif #if GTK_MAJOR_VERSION < 3 windowSetHasFrame, windowGetHasFrame, #endif windowSetRole, windowGetRole, windowSetIcon, windowSetIconList, windowGetIconList, #if GTK_CHECK_VERSION(2,6,0) windowSetIconName, windowGetIconName, #endif #if GTK_CHECK_VERSION(2,8,0) windowSetUrgencyHint, windowGetUrgencyHint, #if GTK_CHECK_VERSION(2,12,0) windowSetOpacity, windowGetOpacity, #endif #endif onSetFocus, afterSetFocus #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import System.Glib.GError import System.Glib.Attributes import System.Glib.Properties import System.Glib.GList (fromGList, withGList) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import Graphics.UI.Gtk.General.Enums (WindowType(..), WindowPosition(..)) #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.General.Structs (windowGetFrame) #endif {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} {#import Graphics.UI.Gtk.Gdk.Enums#} (Modifier(..)) {#import Graphics.UI.Gtk.Gdk.Keys#} (KeyVal) import Graphics.UI.Gtk.Gdk.EventM (EventM, EAny, EKey, MouseButton, TimeStamp) import Control.Monad.Reader ( runReaderT, ask ) import Control.Monad.Trans ( liftIO ) import Graphics.UI.Gtk.Gdk.Enums (WindowEdge(..), WindowTypeHint(..), Gravity(..)) {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Create a new top level window. -- windowNew :: IO Window windowNew = makeNewObject mkWindow $ liftM (castPtr :: Ptr Widget -> Ptr Window) $ {# call window_new #} ((fromIntegral . fromEnum) WindowToplevel) -- | Create a popup window. -- windowNewPopup :: IO Window windowNewPopup = makeNewObject mkWindow $ liftM (castPtr :: Ptr Widget -> Ptr Window) $ {# call window_new #} ((fromIntegral . fromEnum) WindowPopup) -------------------- -- Methods -- | Sets the title of the 'Window'. The title of a window will be displayed -- in its title bar; on the X Window System, the title bar is rendered by the -- window manager, so exactly how the title appears to users may vary according -- to a user's exact configuration. The title should help a user distinguish -- this window from other windows they may have open. A good title might -- include the application name and current document filename, for example. -- windowSetTitle :: (WindowClass self, GlibString string) => self -> string -> IO () windowSetTitle self title = withUTFString title $ \titlePtr -> {# call gtk_window_set_title #} (toWindow self) titlePtr -- | Retrieves the title of the window. See 'windowSetTitle'. -- windowGetTitle :: (WindowClass self, GlibString string) => self -> IO string windowGetTitle self = {# call gtk_window_get_title #} (toWindow self) >>= \strPtr -> if strPtr == nullPtr then return "" else peekUTFString strPtr -- | Sets whether the user can resize a window. Windows are user resizable by -- default. -- windowSetResizable :: WindowClass self => self -> Bool -> IO () windowSetResizable self resizable = {# call window_set_resizable #} (toWindow self) (fromBool resizable) -- | Gets the value set by 'windowSetResizable'. -- windowGetResizable :: WindowClass self => self -> IO Bool -- ^ returns @True@ if the user can resize the window windowGetResizable self = liftM toBool $ {# call unsafe window_get_resizable #} (toWindow self) #if GTK_MAJOR_VERSION >= 3 -- | Sets whether the window has a resize grip. @True@ by default. -- windowSetHasResizeGrip :: WindowClass self => self -> Bool -> IO () windowSetHasResizeGrip self setting = {# call window_set_has_resize_grip #} (toWindow self) (fromBool setting) -- | Returns whether the window has a resize grip. -- windowGetHasResizeGrip :: WindowClass self => self -> IO Bool windowGetHasResizeGrip self = liftM toBool $ {# call unsafe window_get_has_resize_grip #} (toWindow self) #endif -- | Activates the current focused widget within the window. -- windowActivateFocus :: WindowClass self => self -> IO Bool -- ^ returns @True@ if a widget got activated. windowActivateFocus self = liftM toBool $ {# call window_activate_focus #} (toWindow self) -- | Activates the default widget for the window, unless the current focused -- widget has been configured to receive the default action (see -- 'ReceivesDefault' in 'WidgetFlags'), in which case the focused widget is -- activated. -- windowActivateDefault :: WindowClass self => self -> IO Bool -- ^ returns @True@ if a widget got activated. windowActivateDefault self = liftM toBool $ {# call window_activate_default #} (toWindow self) #if GTK_MAJOR_VERSION < 3 #ifndef DISABLE_DEPRECATED {-# DEPRECATED windowSetPolicy "Use windowSetResizable instead." #-} -- | Sets the window resizing policy. -- -- * Warning: this function is deprecated and should not be used in -- newly-written code. Use 'windowSetResizable' instead. -- -- Removed in Gtk3. windowSetPolicy :: WindowClass self => self -> Bool -> Bool -> Bool -> IO () windowSetPolicy self allowShrink allowGrow autoShrink = {# call window_set_policy #} (toWindow self) (fromBool allowShrink) (fromBool allowGrow) (fromBool autoShrink) #endif #endif -- | Sets a window modal or non-modal. Modal windows prevent interaction with -- other windows in the same application. To keep modal dialogs on top of main -- application windows, use 'windowSetTransientFor' to make the dialog -- transient for the parent; most window managers will then disallow lowering -- the dialog below the parent. -- windowSetModal :: WindowClass self => self -> Bool -- ^ @modal@ - whether the window is modal -> IO () windowSetModal self modal = {# call window_set_modal #} (toWindow self) (fromBool modal) -- | Returns whether the window is modal. See 'windowSetModal'. -- windowGetModal :: WindowClass self => self -> IO Bool -- ^ returns @True@ if the window is set to be modal and -- establishes a grab when shown windowGetModal self = liftM toBool $ {# call gtk_window_get_modal #} (toWindow self) -- | Sets the default size of a window. If the window's \"natural\" size (its -- size request) is larger than the default, the default will be ignored. More -- generally, if the default size does not obey the geometry hints for the -- window ('windowSetGeometryHints' can be used to set these explicitly), the -- default size will be clamped to the nearest permitted size. -- -- Unlike 'widgetSetSizeRequest', which sets a size request for a widget and -- thus would keep users from shrinking the window, this function only sets the -- initial size, just as if the user had resized the window themselves. Users -- can still shrink the window again as they normally would. Setting a default -- size of -1 means to use the \"natural\" default size (the size request of -- the window). -- -- For more control over a window's initial size and how resizing works, -- investigate 'windowSetGeometryHints'. -- -- For some uses, 'windowResize' is a more appropriate function. -- 'windowResize' changes the current size of the window, rather than the size -- to be used on initial display. 'windowResize' always affects the window -- itself, not the geometry widget. -- -- The default size of a window only affects the first time a window is -- shown; if a window is hidden and re-shown, it will remember the size it had -- prior to hiding, rather than using the default size. -- -- Windows can't actually be 0x0 in size, they must be at least 1x1, but -- passing 0 for @width@ and @height@ is OK, resulting in a 1x1 default size. -- windowSetDefaultSize :: WindowClass self => self -> Int -- ^ @height@ - height in pixels, or -1 to unset the default height -> Int -- ^ @width@ - width in pixels, or -1 to unset the default width -> IO () windowSetDefaultSize self height width = {# call window_set_default_size #} (toWindow self) (fromIntegral height) (fromIntegral width) -- | Adds a mnemonic to this window. -- windowAddMnemonic :: (WindowClass self, WidgetClass widget) => self -> KeyVal -- ^ @keyval@ - the mnemonic -> widget -- ^ @target@ - the widget that gets activated by the mnemonic -> IO () windowAddMnemonic self keyval target = {# call window_add_mnemonic #} (toWindow self) (fromIntegral keyval) (toWidget target) -- | Removes a mnemonic from this window. -- windowRemoveMnemonic :: (WindowClass self, WidgetClass widget) => self -> KeyVal -- ^ @keyval@ - the mnemonic -> widget -- ^ @target@ - the widget that gets activated by the mnemonic -> IO () windowRemoveMnemonic self keyval target = {# call window_remove_mnemonic #} (toWindow self) (fromIntegral keyval) (toWidget target) -- | Activates the targets associated with the mnemonic. windowMnemonicActivate :: WindowClass self => self -> KeyVal -- ^ @keyval@ - the mnemonic -> [Modifier] -- ^ @modifier@ - the modifiers -> IO Bool -- ^ return @True@ if the activation is done. windowMnemonicActivate self keyval modifier = liftM toBool $ {# call window_mnemonic_activate #} (toWindow self) (fromIntegral keyval) (fromIntegral (fromFlags modifier)) -- | Sets the mnemonic modifier for this window. windowSetMnemonicModifier :: WindowClass self => self -> [Modifier] -- ^ @modifier@ - the modifier mask used to activate mnemonics on this window. -> IO () windowSetMnemonicModifier self modifier = {# call window_set_mnemonic_modifier #} (toWindow self) (fromIntegral (fromFlags modifier)) -- | Returns the mnemonic modifier for this window. See 'windowSetMnemonicModifier'. windowGetMnemonicModifier :: WindowClass self => self -> IO [Modifier] -- ^ return the modifier mask used to activate mnemonics on this window. windowGetMnemonicModifier self = liftM (toFlags . fromIntegral) $ {# call window_get_mnemonic_modifier #} (toWindow self) -- | Activates mnemonics and accelerators for this 'Window'. -- This is normally called by the default 'keyPressEvent' handler for toplevel windows, -- however in some cases it may be useful to call this directly when overriding the standard key handling for a toplevel window. -- windowActivateKey :: WindowClass self => self -> EventM EKey Bool -- ^ return @True@ if a mnemonic or accelerator was found and activated. windowActivateKey self = do ptr <- ask liftIO $ liftM toBool $ {# call window_activate_key #} (toWindow self) (castPtr ptr) -- | Propagate a key press or release event to the focus widget and up the focus container chain until a widget handles event. -- This is normally called by the default 'keyPressEvent' and 'keyReleaseEvent' handlers for toplevel windows, -- however in some cases it may be useful to call this directly when overriding the standard key handling for a toplevel window. -- windowPropagateKeyEvent :: WindowClass self => self -> EventM EKey Bool -- ^ return @True@ if a widget in the focus chain handled the event. windowPropagateKeyEvent self = do ptr <- ask liftIO $ liftM toBool $ {# call window_propagate_key_event #} (toWindow self) (castPtr ptr) -- | Gets the default size of the window. A value of -1 for the width or -- height indicates that a default size has not been explicitly set for that -- dimension, so the \"natural\" size of the window will be used. -- windowGetDefaultSize :: WindowClass self => self -> IO (Int, Int) -- ^ @(width, height)@ - the default width and height windowGetDefaultSize self = alloca $ \widthPtr -> alloca $ \heightPtr -> do {# call gtk_window_get_default_size #} (toWindow self) widthPtr heightPtr width <- peek widthPtr height <- peek heightPtr return (fromIntegral width, fromIntegral height) -- | Sets a position constraint for this window. If the old or new constraint -- is 'WinPosCenterAlways', this will also cause the window to be repositioned -- to satisfy the new constraint. -- windowSetPosition :: WindowClass self => self -> WindowPosition -> IO () windowSetPosition self position = {# call window_set_position #} (toWindow self) ((fromIntegral . fromEnum) position) -- | Dialog windows should be set transient for the main application window -- they were spawned from. This allows window managers to e.g. keep the dialog -- on top of the main window, or center the dialog over the main window. -- 'dialogNewWithButtons' and other convenience functions in Gtk+ will -- sometimes call 'windowSetTransientFor' on your behalf. -- -- On Windows, this function will and put the child window on top of the -- parent, much as the window manager would have done on X. -- -- Note that if you want to show a window @self@ on top of a full-screen window @parent@, you need to -- turn the @self@ window into a dialog (using 'windowSetTypeHint' with 'WindowTypeHintDialog'). -- Otherwise the @parent@ window will always cover the @self@ window. -- windowSetTransientFor :: (WindowClass self, WindowClass parent) => self -> parent -- ^ @parent@ - parent window -> IO () windowSetTransientFor self parent = {# call window_set_transient_for #} (toWindow self) (toWindow parent) -- | Fetches the transient parent for this window. See -- 'windowSetTransientFor'. -- windowGetTransientFor :: WindowClass self => self -> IO (Maybe Window) -- ^ returns the transient parent for this window, or -- @Nothing@ if no transient parent has been set. windowGetTransientFor self = maybeNull (makeNewObject mkWindow) $ {# call gtk_window_get_transient_for #} (toWindow self) -- | If this setting is @True@, then destroying the transient parent of the -- window will also destroy the window itself. This is useful for dialogs that -- shouldn't persist beyond the lifetime of the main window they\'re associated -- with, for example. -- windowSetDestroyWithParent :: WindowClass self => self -> Bool -> IO () windowSetDestroyWithParent self setting = {# call window_set_destroy_with_parent #} (toWindow self) (fromBool setting) -- | Returns whether the window will be destroyed with its transient parent. -- See 'windowSetDestroyWithParent'. -- windowGetDestroyWithParent :: WindowClass self => self -> IO Bool -- ^ returns @True@ if the window will be destroyed with its -- transient parent. windowGetDestroyWithParent self = liftM toBool $ {# call gtk_window_get_destroy_with_parent #} (toWindow self) #if GTK_CHECK_VERSION(2,4,0) -- | Returns whether the window is part of the current active toplevel. (That -- is, the toplevel window receiving keystrokes.) The return value is @True@ if -- the window is active toplevel itself, but also if it is, say, a 'Plug' -- embedded in the active toplevel. You might use this function if you wanted -- to draw a widget differently in an active window from a widget in an -- inactive window. See 'windowHasToplevelFocus' -- -- * Available since Gtk+ version 2.4 -- windowIsActive :: WindowClass self => self -> IO Bool -- ^ returns @True@ if the window part of the current active -- window. windowIsActive self = liftM toBool $ {# call gtk_window_is_active #} (toWindow self) -- | Returns whether the input focus is within this 'Window'. For real -- toplevel windows, this is identical to 'windowIsActive', but for embedded -- windows, like 'Plug', the results will differ. -- -- * Available since Gtk+ version 2.4 -- windowHasToplevelFocus :: WindowClass self => self -> IO Bool -- ^ returns @True@ if the the input focus is within this 'Window' windowHasToplevelFocus self = liftM toBool $ {# call gtk_window_has_toplevel_focus #} (toWindow self) #endif -- | Returns a list of all existing toplevel windows. -- windowListToplevels :: IO [Window] windowListToplevels = do glistPtr <- {#call unsafe gtk_window_list_toplevels#} winPtrs <- fromGList glistPtr mapM (\ptr -> makeNewGObject mkWindow (return ptr)) winPtrs -- | Retrieves the current focused widget within the window. -- | Note that this is the widget that would have the focus if the toplevel -- | window focused; if the toplevel window is not focused then -- | 'widgetHasFocus' will not be True for the widget. -- windowGetFocus :: WindowClass self => self -> IO (Maybe Widget) windowGetFocus self = maybeNull (makeNewObject mkWidget) $ {# call unsafe gtk_window_get_focus #} (toWindow self) -- | If focus is not the current focus widget, and is focusable, sets it as -- | the focus widget for the window. If focus is Nothing, unsets the focus -- | widget for this window. To set the focus to a particular widget in the -- | toplevel, it is usually more convenient to use 'widgetGrabFocus' instead -- | of this function. -- windowSetFocus :: (WindowClass self, WidgetClass widget) => self -> Maybe widget -> IO () windowSetFocus self focus = {# call unsafe gtk_window_set_focus #} (toWindow self) (maybe (Widget nullForeignPtr) toWidget focus) #if GTK_CHECK_VERSION(2,14,0) -- | Returns the default widget for window. See 'windowSetDefault' for more details. -- -- * Available since Gtk+ version 2.14 -- windowGetDefaultWidget :: WindowClass self => self -> IO (Maybe Widget) windowGetDefaultWidget self = maybeNull (makeNewObject mkWidget) $ {# call window_get_default_widget #} (toWindow self) #endif -- | The default widget is the widget that's activated when the user presses -- Enter in a dialog (for example). This function sets or unsets the default -- widget for a Window about. When setting (rather than unsetting) the -- default widget it's generally easier to call widgetGrabDefault on the -- widget. Before making a widget the default widget, you must set the -- 'widgetCanDefault' flag on the widget. -- windowSetDefault :: (WindowClass self, WidgetClass widget) => self -> Maybe widget -> IO () windowSetDefault self defaultWidget = {# call unsafe gtk_window_set_focus #} (toWindow self) (maybe (Widget nullForeignPtr) toWidget defaultWidget) -- | Presents a window to the user. This may mean raising the window in the -- stacking order, deiconifying it, moving it to the current desktop, and\/or -- giving it the keyboard focus, possibly dependent on the user's platform, -- window manager, and preferences. -- -- If @window@ is hidden, this function calls 'widgetShow' as well. -- -- This function should be used when the user tries to open a window that's -- already open. Say for example the preferences dialog is currently open, and -- the user chooses Preferences from the menu a second time; use -- 'windowPresent' to move the already-open dialog where the user can see it. -- -- If you are calling this function in response to a user interaction, it is -- preferable to use 'windowPresentWithTime'. -- windowPresent :: WindowClass self => self -> IO () windowPresent self = {# call gtk_window_present #} (toWindow self) -- | Asks to deiconify (i.e. unminimize) the specified @window@. Note that you -- shouldn't assume the window is definitely deiconified afterward, because -- other entities (e.g. the user or window manager) could iconify it again -- before your code which assumes deiconification gets to run. -- -- You can track iconification via the 'windowStateEvent' signal on -- 'Widget'. -- windowDeiconify :: WindowClass self => self -> IO () windowDeiconify self = {# call window_deiconify #} (toWindow self) -- | Asks to iconify (i.e. minimize) the specified @window@. Note that you -- shouldn't assume the window is definitely iconified afterward, because other -- entities (e.g. the user or window manager) could deiconify it again, or -- there may not be a window manager in which case iconification isn't -- possible, etc. But normally the window will end up iconified. Just don't -- write code that crashes if not. -- -- It's permitted to call this function before showing a window, in which -- case the window will be iconified before it ever appears onscreen. -- -- You can track iconification via the 'windowStateEvent' signal on -- 'Widget'. -- windowIconify :: WindowClass self => self -> IO () windowIconify self = {# call window_iconify #} (toWindow self) -- | Asks to maximize the window, so that it becomes full-screen. Note that you -- shouldn't assume the window is definitely maximized afterward, because other -- entities (e.g. the user or window manager) could unmaximize it again, and -- not all window managers support maximization. But normally the window will -- end up maximized. Just don't write code that crashes if not. -- -- It's permitted to call this function before showing a window, in which -- case the window will be maximized when it appears onscreen initially. -- -- You can track maximization via the 'windowStateEvent' signal on -- 'Widget'. -- windowMaximize :: WindowClass self => self -> IO () windowMaximize self = {# call window_maximize #} (toWindow self) -- | Asks to unmaximize the window. Note that you shouldn't assume the window is -- definitely unmaximized afterward, because other entities (e.g. the user or -- window manager) could maximize it again, and not all window managers honor -- requests to unmaximize. But normally the window will end up unmaximized. -- Just don't write code that crashes if not. -- -- You can track maximization via the 'windowStateEvent' signal on -- 'Widget'. -- windowUnmaximize :: WindowClass self => self -> IO () windowUnmaximize self = {# call window_unmaximize #} (toWindow self) #if GTK_CHECK_VERSION(2,2,0) -- | Asks to place @window@ in the fullscreen state. Note that you shouldn't -- assume the window is definitely full screen afterward, because other -- entities (e.g. the user or window manager) could unfullscreen it again, and -- not all window managers honor requests to fullscreen windows. But normally -- the window will end up fullscreen. Just don't write code that crashes if -- not. -- -- You can track the fullscreen state via the 'windowStateEvent' signal -- on 'Widget'. -- -- * Available since Gtk+ version 2.2 -- windowFullscreen :: WindowClass self => self -> IO () windowFullscreen self = {# call gtk_window_fullscreen #} (toWindow self) -- | Asks to toggle off the fullscreen state for @window@. Note that you -- shouldn't assume the window is definitely not full screen afterward, because -- other entities (e.g. the user or window manager) could fullscreen it again, -- and not all window managers honor requests to unfullscreen windows. But -- normally the window will end up restored to its normal state. Just don't -- write code that crashes if not. -- -- You can track the fullscreen state via the 'windowStateEvent' signal -- on 'Widget'. -- -- * Available since Gtk+ version 2.2 -- windowUnfullscreen :: WindowClass self => self -> IO () windowUnfullscreen self = {# call gtk_window_unfullscreen #} (toWindow self) #if GTK_CHECK_VERSION(2,4,0) -- | Asks to keep @window@ above, so that it stays on top. Note that you -- shouldn't assume the window is definitely above afterward, because other -- entities (e.g. the user or window manager) could not keep it above, and not -- all window managers support keeping windows above. But normally the window -- will end kept above. Just don't write code that crashes if not. -- -- It's permitted to call this function before showing a window, in which -- case the window will be kept above when it appears onscreen initially. -- -- You can track the above state via the 'windowStateEvent' signal on -- 'Widget'. -- -- Note that, according to the Extended Window Manager Hints specification, -- the above state is mainly meant for user preferences and should not be used -- by applications e.g. for drawing attention to their dialogs. -- -- * Available since Gtk+ version 2.4 -- windowSetKeepAbove :: WindowClass self => self -> Bool -- ^ @setting@ - whether to keep @window@ above other windows -> IO () windowSetKeepAbove self setting = {# call gtk_window_set_keep_above #} (toWindow self) (fromBool setting) -- | Asks to keep @window@ below, so that it stays in bottom. Note that you -- shouldn't assume the window is definitely below afterward, because other -- entities (e.g. the user or window manager) could not keep it below, and not -- all window managers support putting windows below. But normally the window -- will be kept below. Just don't write code that crashes if not. -- -- It's permitted to call this function before showing a window, in which -- case the window will be kept below when it appears onscreen initially. -- -- You can track the below state via the 'windowStateEvent' signal on -- 'Widget'. -- -- Note that, according to the Extended Window Manager Hints specification, -- the above state is mainly meant for user preferences and should not be used -- by applications e.g. for drawing attention to their dialogs. -- -- * Available since Gtk+ version 2.4 -- windowSetKeepBelow :: WindowClass self => self -> Bool -- ^ @setting@ - whether to keep @window@ below other windows -> IO () windowSetKeepBelow self setting = {# call gtk_window_set_keep_below #} (toWindow self) (fromBool setting) #endif -- | Windows may set a hint asking the desktop environment not to display the -- window in the task bar. This function sets this hint. -- -- * Available since Gtk+ version 2.2 -- windowSetSkipTaskbarHint :: WindowClass self => self -> Bool -- ^ @setting@ - @True@ to keep this window from appearing in the -- task bar -> IO () windowSetSkipTaskbarHint self setting = {# call gtk_window_set_skip_taskbar_hint #} (toWindow self) (fromBool setting) -- | Gets the value set by 'windowSetSkipTaskbarHint' -- -- * Available since Gtk+ version 2.2 -- windowGetSkipTaskbarHint :: WindowClass self => self -> IO Bool -- ^ returns @True@ if window shouldn't be in taskbar windowGetSkipTaskbarHint self = liftM toBool $ {# call gtk_window_get_skip_taskbar_hint #} (toWindow self) -- | Windows may set a hint asking the desktop environment not to display the -- window in the pager. This function sets this hint. (A \"pager\" is any -- desktop navigation tool such as a workspace switcher that displays a -- thumbnail representation of the windows on the screen.) -- -- * Available since Gtk+ version 2.2 -- windowSetSkipPagerHint :: WindowClass self => self -> Bool -- ^ @setting@ - @True@ to keep this window from appearing in the -- pager -> IO () windowSetSkipPagerHint self setting = {# call gtk_window_set_skip_pager_hint #} (toWindow self) (fromBool setting) -- | Gets the value set by 'windowSetSkipPagerHint'. -- -- * Available since Gtk+ version 2.2 -- windowGetSkipPagerHint :: WindowClass self => self -> IO Bool -- ^ returns @True@ if window shouldn't be in pager windowGetSkipPagerHint self = liftM toBool $ {# call gtk_window_get_skip_pager_hint #} (toWindow self) #endif #if GTK_CHECK_VERSION(2,4,0) -- | Windows may set a hint asking the desktop environment not to receive the -- input focus. This function sets this hint. -- -- * Available since Gtk+ version 2.4 -- windowSetAcceptFocus :: WindowClass self => self -> Bool -- ^ @setting@ - @True@ to let this window receive input focus -> IO () windowSetAcceptFocus self setting = {# call gtk_window_set_accept_focus #} (toWindow self) (fromBool setting) -- | Gets the value set by 'windowSetAcceptFocus'. -- -- * Available since Gtk+ version 2.4 -- windowGetAcceptFocus :: WindowClass self => self -> IO Bool -- ^ returns @True@ if window should receive the input focus windowGetAcceptFocus self = liftM toBool $ {# call gtk_window_get_accept_focus #} (toWindow self) #endif #if GTK_CHECK_VERSION(2,6,0) -- | Windows may set a hint asking the desktop environment not to receive the -- input focus when the window is mapped. This function sets this hint. -- -- * Available since Gtk+ version 2.6 -- windowSetFocusOnMap :: WindowClass self => self -> Bool -- ^ @setting@ - @True@ to let this window receive input focus on -- map -> IO () windowSetFocusOnMap self setting = {# call gtk_window_set_focus_on_map #} (toWindow self) (fromBool setting) -- | Gets the value set by 'windowSetFocusOnMap'. -- -- * Available since Gtk+ version 2.6 -- windowGetFocusOnMap :: WindowClass self => self -> IO Bool -- ^ returns @True@ if window should receive the input focus when -- mapped. windowGetFocusOnMap self = liftM toBool $ {# call gtk_window_get_focus_on_map #} (toWindow self) #endif #if GTK_CHECK_VERSION(2,12,0) -- | Startup notification identifiers are used by desktop environment to track application startup, -- to provide user feedback and other features. This function changes the corresponding property on the underlying GdkWindow. -- Normally, startup identifier is managed automatically and you should only use this function in special cases like transferring focus from other processes. You should use this function before calling 'windowPresent' or any equivalent function generating a window map event. -- -- This function is only useful on X11, not with other GTK+ targets. -- -- * Available since Gtk+ version 2.12 -- windowSetStartupId :: (WindowClass self, GlibString string) => self -> string -> IO () windowSetStartupId self startupId = withUTFString startupId $ \idPtr -> {# call window_set_startup_id #} (toWindow self) idPtr #endif -- | By default, windows are decorated with a title bar, resize controls, etc. -- Some window managers allow Gtk+ to disable these decorations, creating a -- borderless window. If you set the decorated property to @False@ using this -- function, Gtk+ will do its best to convince the window manager not to -- decorate the window. Depending on the system, this function may not have any -- effect when called on a window that is already visible, so you should call -- it before calling 'windowShow'. -- -- On Windows, this function always works, since there's no window manager -- policy involved. -- windowSetDecorated :: WindowClass self => self -> Bool -> IO () windowSetDecorated self setting = {# call window_set_decorated #} (toWindow self) (fromBool setting) -- | Returns whether the window has been set to have decorations such as a -- title bar via 'windowSetDecorated'. -- windowGetDecorated :: WindowClass self => self -> IO Bool -- ^ returns @True@ if the window has been set to have decorations windowGetDecorated self = liftM toBool $ {# call gtk_window_get_decorated #} (toWindow self) #if GTK_CHECK_VERSION(2,10,0) #ifndef DISABLE_DEPRECATED -- | By default, windows have a close button in the window frame. -- Some window managers allow GTK+ to disable this button. -- If you set the deletable property to @False@ using this function, GTK+ will do its best to convince the window manager not to show a close button. -- Depending on the system, this function may not have any effect when called on a window that is already visible, -- so you should call it before calling 'windowShow'. -- -- On Windows, this function always works, since there's no window manager policy involved. -- -- * Available since Gtk+ version 2.10 -- windowSetDeletable :: WindowClass self => self -> Bool -- ^ @setting@ - @True@ to decorate the window as deletable -> IO () windowSetDeletable self setting = {# call window_set_deletable #} (toWindow self) (fromBool setting) -- | Returns whether the window has been set to have a close button via 'windowSetDeletable'. -- -- * Available since Gtk+ version 2.10 -- windowGetDeletable :: WindowClass self => self -> IO Bool -- ^ return @True@ if the window has been set to have a close button windowGetDeletable self = liftM toBool $ {# call window_get_deletable #} (toWindow self) #endif #endif #if GTK_MAJOR_VERSION < 3 -- | (Note: this is a special-purpose function intended for the framebuffer -- port; see 'windowSetHasFrame'. It will have no effect on the window border -- drawn by the window manager, which is the normal case when using the X -- Window system.) -- -- For windows with frames (see 'windowSetHasFrame') this function can be -- used to change the size of the frame border. -- -- Removed in Gtk3. windowSetFrameDimensions :: WindowClass self => self -> Int -- ^ @left@ - The width of the left border -> Int -- ^ @top@ - The height of the top border -> Int -- ^ @right@ - The width of the right border -> Int -- ^ @bottom@ - The height of the bottom border -> IO () windowSetFrameDimensions self left top right bottom = {# call window_set_frame_dimensions #} (toWindow self) (fromIntegral left) (fromIntegral top) (fromIntegral right) (fromIntegral bottom) -- | Retrieves the dimensions of the frame window for this toplevel. See -- 'windowSetHasFrame', 'windowSetFrameDimensions'. -- -- (Note: this is a special-purpose function intended for the framebuffer port; -- see 'windowSetHasFrame'. -- It will not return the size of the window border drawn by the window manager, -- which is the normal case when using a windowing system. -- See 'drawWindowGetFrameExtents' to get the standard window border extents.) -- -- Removed in Gtk3. windowGetFrameDimensions :: WindowClass self => self -> IO (Int, Int, Int, Int) -- ^ returns @(left, top, right, bottom)@. @left@ is the -- width of the frame at the left, @top@ is the height of the frame at the top, @right@ -- is the width of the frame at the right, @bottom@ is the height of the frame at the bottom. windowGetFrameDimensions self = alloca $ \lPtr -> alloca $ \tPtr -> alloca $ \rPtr -> alloca $ \bPtr -> do {# call window_get_frame_dimensions #} (toWindow self) lPtr tPtr rPtr bPtr lv <- peek lPtr tv <- peek tPtr rv <- peek rPtr bv <- peek bPtr return (fromIntegral lv, fromIntegral tv, fromIntegral rv, fromIntegral bv) -- | If this function is called on a window with setting of @True@, before it is realized -- or showed, it will have a "frame" window around its 'DrawWindow', -- accessible using 'windowGetFrame'. Using the signal 'windowFrameEvent' you can -- receive all events targeted at the frame. -- -- (Note: this is a special-purpose function for the framebuffer port, that causes GTK+ to draw its own window border. -- For most applications, you want 'windowSetDecorated' instead, which tells the window manager whether to draw the window border.) -- -- This function is used by the linux-fb port to implement managed windows, -- but it could conceivably be used by X-programs that want to do their own window -- decorations. -- -- Removed in Gtk3. windowSetHasFrame :: WindowClass self => self -> Bool -- ^ @setting@ - a boolean -> IO () windowSetHasFrame self setting = {# call window_set_has_frame #} (toWindow self) (fromBool setting) -- | Accessor for whether the window has a frame window exterior to window->window. Gets the value set by 'windowSetHasFrame'. -- -- Removed in Gtk3. windowGetHasFrame :: WindowClass self => self -> IO Bool -- ^ return @True@ if a frame has been added to the window via 'windowSetHasFrame'. windowGetHasFrame self = liftM toBool $ {# call window_get_has_frame #} (toWindow self) #endif #ifndef DISABLE_DEPRECATED -- | This function is only useful on X11, not with other Gtk+ targets. -- -- In combination with the window title, the window role allows a window -- manager to identify \"the same\" window when an application is restarted. So -- for example you might set the \"toolbox\" role on your app's toolbox window, -- so that when the user restarts their session, the window manager can put the -- toolbox back in the same place. -- -- If a window already has a unique title, you don't need to set the role, -- since the WM can use the title to identify the window when restoring the -- session. -- windowSetRole :: (WindowClass self, GlibString string) => self -> string -- ^ @role@ - unique identifier for the window to be used when -- restoring a session -> IO () windowSetRole self role = withUTFString role $ \rolePtr -> {# call window_set_role #} (toWindow self) rolePtr -- | Returns the role of the window. See 'windowSetRole' for further -- explanation. -- windowGetRole :: (WindowClass self, GlibString string) => self -> IO (Maybe string) -- ^ returns the role of the window if set, or -- @Nothing@. windowGetRole self = {# call gtk_window_get_role #} (toWindow self) >>= maybePeek peekUTFString #endif -- | Asks to stick @window@, which means that it will appear on all user -- desktops. Note that you shouldn't assume the window is definitely stuck -- afterward, because other entities (e.g. the user or window manager) could -- unstick it again, and some window managers do not support sticking windows. -- But normally the window will end up stuck. Just don't write code that -- crashes if not. -- -- It's permitted to call this function before showing a window. -- -- You can track stickiness via the 'windowStateEvent' signal on -- 'Widget'. -- windowStick :: WindowClass self => self -> IO () windowStick self = {# call window_stick #} (toWindow self) -- | Asks to unstick @window@, which means that it will appear on only one of -- the user's desktops. Note that you shouldn't assume the window is definitely -- unstuck afterward, because other entities (e.g. the user or window manager) -- could stick it again. But normally the window will end up stuck. Just don't -- write code that crashes if not. -- -- You can track stickiness via the 'windowStateEvent' signal on -- 'Widget'. -- windowUnstick :: WindowClass self => self -> IO () windowUnstick self = {# call window_unstick #} (toWindow self) -- | Associate @accelGroup@ with @window@, such that calling -- 'accelGroupsActivate' on @window@ will activate accelerators in -- @accelGroup@. -- windowAddAccelGroup :: WindowClass self => self -> AccelGroup -- ^ @accelGroup@ - a 'AccelGroup' -> IO () windowAddAccelGroup self accelGroup = {# call gtk_window_add_accel_group #} (toWindow self) accelGroup -- | Reverses the effects of 'windowAddAccelGroup'. -- windowRemoveAccelGroup :: WindowClass self => self -> AccelGroup -- ^ @accelGroup@ - a 'AccelGroup' -> IO () windowRemoveAccelGroup self accelGroup = {# call gtk_window_remove_accel_group #} (toWindow self) accelGroup -- | Sets up the icon representing a 'Window'. This icon is used when the -- window is minimized (also known as iconified). Some window managers or -- desktop environments may also place it in the window frame, or display it in -- other contexts. -- -- The icon should be provided in whatever size it was naturally drawn; that -- is, don't scale the image before passing it to Gtk+. Scaling is postponed -- until the last minute, when the desired final size is known, to allow best -- quality. -- -- If you have your icon hand-drawn in multiple sizes, use -- 'windowSetIconList'. Then the best size will be used. -- -- This function is equivalent to calling 'windowSetIconList' with a -- 1-element list. -- -- See also 'windowSetDefaultIconList' to set the icon for all windows in -- your application in one go. -- windowSetIcon :: WindowClass self => self -> Maybe Pixbuf -- ^ @icon@ - icon image -> IO () windowSetIcon self Nothing = {# call gtk_window_set_icon #} (toWindow self) (Pixbuf nullForeignPtr) windowSetIcon self (Just icon) = {# call gtk_window_set_icon #} (toWindow self) icon -- | Gets the value set by 'windowSetIcon' (or if you\'ve called -- 'windowSetIconList', gets the first icon in the icon list). -- windowGetIcon :: WindowClass self => self -> IO (Maybe Pixbuf) -- ^ returns icon for window, or @Nothing@ if none was set windowGetIcon self = maybeNull (makeNewGObject mkPixbuf) $ {# call gtk_window_get_icon #} (toWindow self) -- | Sets up the icon representing a 'Window'. The icon is used when the window is minimized (also known as iconified). -- Some window managers or desktop environments may also place it in the window frame, or display it in other contexts. -- -- 'windowSetIconList' allows you to pass in the same icon in several hand-drawn sizes. -- The list should contain the natural sizes your icon is available in; that is, don't scale the image before passing it to GTK+. -- Scaling is postponed until the last minute, when the desired final size is known, to allow best quality. -- -- By passing several sizes, you may improve the final image quality of the icon, by reducing or eliminating automatic image scaling. -- -- Recommended sizes to provide: 16x16, 32x32, 48x48 at minimum, and larger images (64x64, 128x128) if you have them. -- -- See also 'windowSetDefaultIconList' to set the icon for all windows in your application in one go. -- -- Note that transient windows (those who have been set transient for another window using 'windowSetTransientFor' will inherit their icon from their -- transient parent. -- So there's no need to explicitly set the icon on transient windows. -- windowSetIconList :: WindowClass self => self -> [Pixbuf] -> IO () windowSetIconList self list = withForeignPtrs (map unPixbuf list) $ \ptrList -> withGList ptrList $ \glist -> {# call window_set_icon_list #} (toWindow self) glist -- | Retrieves the list of icons set by 'windowSetIconList'. -- windowGetIconList :: WindowClass self => self -> IO [Pixbuf] windowGetIconList self = do glist <- {# call window_get_icon_list #} (toWindow self) ptrList <- fromGList glist mapM (makeNewGObject mkPixbuf . return) ptrList -- | Sets an icon list to be used as fallback for windows that haven't had 'windowSetIconList' called on them to set up a window-specific icon list. -- This function allows you to set up the icon for all windows in your app at once. -- -- See 'windowSetIconList' for more details. -- windowSetDefaultIconList :: [Pixbuf] -> IO () windowSetDefaultIconList list = withForeignPtrs (map unPixbuf list) $ \ptrList -> withGList ptrList $ \glist -> {# call window_set_default_icon_list #} glist -- | Gets the value set by 'windowSetDefaultIconList'. -- windowGetDefaultIconList :: IO [Pixbuf] windowGetDefaultIconList = do glist <- {# call window_get_default_icon_list #} ptrList <- fromGList glist mapM (makeNewGObject mkPixbuf . return) ptrList #if GTK_CHECK_VERSION(2,6,0) #ifndef DISABLE_DEPRECATED -- | Sets the icon for the window from a named themed icon. See the docs for -- 'IconTheme' for more details. -- -- Note that this has nothing to do with the WM_ICON_NAME property which is -- mentioned in the ICCCM. -- -- * Available since Gtk+ version 2.6 -- windowSetIconName :: (WindowClass self, GlibString string) => self -> string -- ^ @name@ - the name of the themed icon -> IO () windowSetIconName self name = withUTFString name $ \namePtr -> {# call gtk_window_set_icon_name #} (toWindow self) namePtr -- | Returns the name of the themed icon for the window, see -- 'windowSetIconName'. -- -- * Available since Gtk+ version 2.6 -- windowGetIconName :: (WindowClass self, GlibString string) => self -> IO string -- ^ returns the icon name or @\"\"@ if the window has no themed -- icon. windowGetIconName self = {# call gtk_window_get_icon_name #} (toWindow self) >>= \strPtr -> if strPtr == nullPtr then return "" else peekUTFString strPtr #endif -- | Sets an icon to be used as fallback for windows that haven't had -- 'windowSetIconList' called on them from a named themed icon, see -- 'windowSetIconName'. -- -- * Available since Gtk+ version 2.6 -- windowSetDefaultIconName :: GlibString string => string -- ^ @name@ - the name of the themed icon -> IO () windowSetDefaultIconName name = withUTFString name $ \namePtr -> {# call gtk_window_set_default_icon_name #} namePtr #endif #if GTK_CHECK_VERSION(2,4,0) -- | Sets an icon to be used as fallback for windows that haven't had 'windowSetIcon' called on them from a pixbuf. -- -- * Available since Gtk+ version 2.4 -- windowSetDefaultIcon :: Maybe Pixbuf -> IO () windowSetDefaultIcon (Just icon) = {# call window_set_default_icon #} icon windowSetDefaultIcon Nothing = {# call window_set_default_icon #} (Pixbuf nullForeignPtr) #endif #if GTK_CHECK_VERSION(2,2,0) -- | Sets an icon to be used as fallback for windows that haven't had -- 'windowSetIconList' called on them from a file on disk. May throw a 'GError' if -- the file cannot be loaded. -- -- * Available since Gtk+ version 2.2 -- windowSetDefaultIconFromFile :: GlibString string => string -- ^ @filename@ - location of icon file -> IO Bool -- ^ returns @True@ if setting the icon succeeded. windowSetDefaultIconFromFile filename = liftM toBool $ propagateGError $ \errPtr -> withUTFString filename $ \filenamePtr -> {# call gtk_window_set_default_icon_from_file #} filenamePtr errPtr #endif #if GTK_CHECK_VERSION(2,16,0) -- | Returns the fallback icon name for windows that has been set with -- 'windowSetDefaultIconName'. -- -- * Available since Gtk+ version 2.16 -- windowGetDefaultIconName :: GlibString string => IO string -- ^ returns the fallback icon name for windows windowGetDefaultIconName = {# call window_get_default_icon_name #} >>= peekUTFString #endif #if GTK_CHECK_VERSION(2,2,0) -- | Sets the 'Screen' where the @window@ is displayed; if the window is -- already mapped, it will be unmapped, and then remapped on the new screen. -- -- * Available since Gtk+ version 2.2 -- windowSetScreen :: WindowClass self => self -> Screen -- ^ @screen@ - a 'Screen'. -> IO () windowSetScreen self screen = {# call gtk_window_set_screen #} (toWindow self) screen -- | Returns the 'Screen' associated with the window. -- -- * Available since Gtk+ version 2.2 -- windowGetScreen :: WindowClass self => self -> IO Screen -- ^ returns a 'Screen'. windowGetScreen self = makeNewGObject mkScreen $ {# call gtk_window_get_screen #} (toWindow self) -- | Sets the icon for @window@. -- -- This function is equivalent to calling 'windowSetIcon' with a pixbuf -- created by loading the image from @filename@. -- -- This may throw an exception if the file cannot be loaded. -- -- * Available since Gtk+ version 2.2 -- windowSetIconFromFile :: (WindowClass self, GlibFilePath fp) => self -> fp -- ^ @filename@ - location of icon file -> IO () windowSetIconFromFile self filename = propagateGError $ \errPtr -> withUTFFilePath filename $ \filenamePtr -> do #if defined (WIN32) && GTK_CHECK_VERSION(2,6,0) && GTK_MAJOR_VERSION < 3 {# call gtk_window_set_icon_from_file_utf8 #} #else {# call gtk_window_set_icon_from_file #} #endif (toWindow self) filenamePtr errPtr return () -- | By default, after showing the first 'Window' for each 'Screen', Gtk+ -- calls 'screenNotifyStartupComplete'. Call this function to disable the -- automatic startup notification. You might do this if your first window is a -- splash screen, and you want to delay notification until after your real main -- window has been shown, for example. -- -- In that example, you would disable startup notification temporarily, show -- your splash screen, then re-enable it so that showing the main window would -- automatically result in notification. -- -- * Available since Gtk+ version 2.2 -- windowSetAutoStartupNotification :: Bool -- ^ @setting@ - @True@ to automatically do startup notification -> IO () windowSetAutoStartupNotification setting = {# call gtk_window_set_auto_startup_notification #} (fromBool setting) #endif -- | Window gravity defines the meaning of coordinates passed to 'windowMove'. -- See 'windowMove' and 'Gravity' for more details. -- -- The default window gravity is 'GravityNorthWest' which will typically -- \"do what you mean.\" -- windowSetGravity :: WindowClass self => self -> Gravity -- ^ @gravity@ - window gravity -> IO () windowSetGravity self gravity = {# call gtk_window_set_gravity #} (toWindow self) ((fromIntegral . fromEnum) gravity) -- | Gets the value set by 'windowSetGravity'. -- windowGetGravity :: WindowClass self => self -> IO Gravity -- ^ returns window gravity windowGetGravity self = liftM (toEnum . fromIntegral) $ {# call gtk_window_get_gravity #} (toWindow self) -- | Asks the window manager to move @window@ to the given position. Window -- managers are free to ignore this; most window managers ignore requests for -- initial window positions (instead using a user-defined placement algorithm) -- and honor requests after the window has already been shown. -- -- Note: the position is the position of the gravity-determined reference -- point for the window. The gravity determines two things: first, the location -- of the reference point in root window coordinates; and second, which point -- on the window is positioned at the reference point. -- -- By default the gravity is 'GravityNorthWest', so the reference point is -- simply the @x@, @y@ supplied to 'windowMove'. The top-left corner of the -- window decorations (aka window frame or border) will be placed at @x@, @y@. -- Therefore, to position a window at the top left of the screen, you want to -- use the default gravity (which is 'GravityNorthWest') and move the window to -- 0,0. -- -- To position a window at the bottom right corner of the screen, you would -- set 'GravitySouthEast', which means that the reference point is at @x@ + the -- window width and @y@ + the window height, and the bottom-right corner of the -- window border will be placed at that reference point. So, to place a window -- in the bottom right corner you would first set gravity to south east, then -- write: @gtk_window_move (window, gdk_screen_width() - window_width, -- gdk_screen_height() - window_height)@. -- -- The Extended Window Manager Hints specification at -- http:\/\/www.freedesktop.org\/Standards\/wm-spec has a nice table of -- gravities in the \"implementation notes\" section. -- -- The 'windowGetPosition' documentation may also be relevant. -- windowMove :: WindowClass self => self -> Int -- ^ @x@ - X coordinate to move window to -> Int -- ^ @y@ - Y coordinate to move window to -> IO () windowMove self x y = {# call gtk_window_move #} (toWindow self) (fromIntegral x) (fromIntegral y) -- | Parses a standard X Window System geometry string - see the manual page for X (type 'man X') for details on this. -- 'windowParseGeometry' does work on all GTK+ ports including Win32 but is primarily intended for an X environment. -- -- If either a size or a position can be extracted from the geometry string, -- 'windowParseGeometry' returns @True@ and calls gtk_window_set_default_size() and/or gtk_window_move() to resize/move the window. -- -- If 'windowParseGeometry' returns @True@, -- it will also set the 'HintUserPos' and/or 'HintUserSize' hints indicating to the window manager that the size/position of the window was user-specified -- This causes most window managers to honor the geometry. -- -- Note that for 'windowParseGeometry' to work as expected, it has to be called when the window has its "final" size, i.e. -- after calling 'widgetShowAll' on the contents and 'windowSetGeometryHints' on the window. -- windowParseGeometry :: (WindowClass self, GlibString string) => self -> string -> IO Bool windowParseGeometry self geometry = liftM toBool $ withUTFString geometry $ \geometryPtr -> {# call window_parse_geometry #} (toWindow self) geometryPtr -- | Hides window, then reshows it, resetting the default size and position of the window. Used by GUI builders only. -- windowReshowWithInitialSize :: WindowClass self => self -> IO () windowReshowWithInitialSize self = {# call window_reshow_with_initial_size #} (toWindow self) -- | Resizes the window as if the user had done so, obeying geometry -- constraints. The default geometry constraint is that windows may not be -- smaller than their size request; to override this constraint, call -- 'widgetSetSizeRequest' to set the window's request to a smaller value. -- -- If 'windowResize' is called before showing a window for the first time, -- it overrides any default size set with 'windowSetDefaultSize'. -- -- Windows may not be resized smaller than 1 by 1 pixels. -- windowResize :: WindowClass self => self -> Int -- ^ @width@ - width in pixels to resize the window to -> Int -- ^ @height@ - height in pixels to resize the window to -> IO () windowResize self width height = {# call gtk_window_resize #} (toWindow self) (fromIntegral width) (fromIntegral height) -- | Starts resizing a window. This function is used if an application has -- window resizing controls. When GDK can support it, the resize will be done -- using the standard mechanism for the window manager or windowing system. -- Otherwise, GDK will try to emulate window resizing, potentially not all that -- well, depending on the windowing system. -- windowBeginResizeDrag :: WindowClass self => self -> WindowEdge -- ^ @edge@ - position of the resize control -> MouseButton -- ^ @button@ - mouse button that initiated the drag -> Int -- ^ @rootX@ - X position where the user clicked to initiate -- the drag, in root window coordinates -> Int -- ^ @rootY@ - Y position where the user clicked to initiate -- the drag -> TimeStamp -- ^ @timestamp@ - timestamp from the click event that -- initiated the drag -> IO () windowBeginResizeDrag self edge button rootX rootY timestamp = {# call gtk_window_begin_resize_drag #} (toWindow self) ((fromIntegral . fromEnum) edge) ((fromIntegral . fromEnum) button) (fromIntegral rootX) (fromIntegral rootY) (fromIntegral timestamp) -- | Starts moving a window. This function is used if an application has -- window movement grips. When GDK can support it, the window movement will be -- done using the standard mechanism for the window manager or windowing -- system. Otherwise, GDK will try to emulate window movement, potentially not -- all that well, depending on the windowing system. -- windowBeginMoveDrag :: WindowClass self => self -> MouseButton -- ^ @button@ - mouse button that initiated the drag -> Int -- ^ @rootX@ - X position where the user clicked to initiate the -- drag, in root window coordinates -> Int -- ^ @rootY@ - Y position where the user clicked to initiate the -- drag -> TimeStamp -- ^ @timestamp@ - timestamp from the click event that initiated -- the drag -> IO () windowBeginMoveDrag self button rootX rootY timestamp = {# call gtk_window_begin_move_drag #} (toWindow self) ((fromIntegral . fromEnum) button) (fromIntegral rootX) (fromIntegral rootY) (fromIntegral timestamp) -- | This function returns the position you need to pass to 'windowMove' to -- keep @window@ in its current position. This means that the meaning of the -- returned value varies with window gravity. See 'windowMove' for more -- details. -- -- If you haven't changed the window gravity, its gravity will be -- 'GravityNorthWest'. This means that 'windowGetPosition' gets the position of -- the top-left corner of the window manager frame for the window. 'windowMove' -- sets the position of this same top-left corner. -- -- Moreover, nearly all window managers are historically broken with respect -- to their handling of window gravity. So moving a window to its current -- position as returned by 'windowGetPosition' tends to result in moving the -- window slightly. Window managers are slowly getting better over time. -- -- If a window has gravity 'GravityStatic' the window manager frame is not -- relevant, and thus 'windowGetPosition' will always produce accurate results. -- However you can't use static gravity to do things like place a window in a -- corner of the screen, because static gravity ignores the window manager -- decorations. -- -- If you are saving and restoring your application's window positions, you -- should know that it's impossible for applications to do this without getting -- it somewhat wrong because applications do not have sufficient knowledge of -- window manager state. The Correct Mechanism is to support the session -- management protocol (see the \"GnomeClient\" object in the GNOME libraries -- for example) and allow the window manager to save your window sizes and -- positions. -- windowGetPosition :: WindowClass self => self -> IO (Int, Int) -- ^ @(rootX, rootY)@ - X and Y coordinate of -- gravity-determined reference point windowGetPosition self = alloca $ \rootXPtr -> alloca $ \rootYPtr -> do {# call gtk_window_get_position #} (toWindow self) rootXPtr rootYPtr rootX <- peek rootXPtr rootY <- peek rootYPtr return (fromIntegral rootX, fromIntegral rootY) -- | Obtains the current size of the window. If the window is not onscreen, it -- returns the size Gtk+ will suggest to the window manager for the initial -- window size (but this is not reliably the same as the size the window -- manager will actually select). The size obtained by 'windowGetSize' is the -- last size received in a 'EventConfigure', that is, -- Gtk+ uses its locally-stored size, rather than querying the X server for the -- size. As a result, if you call 'windowResize' then immediately call -- 'windowGetSize', the size won't have taken effect yet. After the window -- manager processes the resize request, Gtk+ receives notification that the -- size has changed via a configure event, and the size of the window gets -- updated. -- -- Note 1: Nearly any use of this function creates a race condition, because -- the size of the window may change between the time that you get the size and -- the time that you perform some action assuming that size is the current -- size. To avoid race conditions, connect to \"configure_event\" on the window -- and adjust your size-dependent state to match the size delivered in the -- 'EventConfigure'. -- -- Note 2: The returned size does /not/ include the size of the window -- manager decorations (aka the window frame or border). Those are not drawn by -- Gtk+ and Gtk+ has no reliable method of determining their size. -- -- Note 3: If you are getting a window size in order to position the window -- onscreen, there may be a better way. The preferred way is to simply set the -- window's semantic type with 'windowSetTypeHint', which allows the window -- manager to e.g. center dialogs. Also, if you set the transient parent of -- dialogs with 'windowSetTransientFor' window managers will often center the -- dialog over its parent window. It's much preferred to let the window manager -- handle these things rather than doing it yourself, because all apps will -- behave consistently and according to user prefs if the window manager -- handles it. Also, the window manager can take the size of the window -- decorations\/border into account, while your application cannot. -- -- In any case, if you insist on application-specified window positioning, -- there's /still/ a better way than doing it yourself - 'windowSetPosition' -- will frequently handle the details for you. -- windowGetSize :: WindowClass self => self -> IO (Int, Int) -- ^ @(width, height)@ windowGetSize self = alloca $ \widthPtr -> alloca $ \heightPtr -> do {# call gtk_window_get_size #} (toWindow self) widthPtr heightPtr width <- peek widthPtr height <- peek heightPtr return (fromIntegral width, fromIntegral height) -- | By setting the type hint for the window, you allow the window manager to -- decorate and handle the window in a way which is suitable to the function of -- the window in your application. -- -- This function should be called before the window becomes visible. -- windowSetTypeHint :: WindowClass self => self -> WindowTypeHint -- ^ @hint@ - the window type -> IO () windowSetTypeHint self hint = {# call gtk_window_set_type_hint #} (toWindow self) ((fromIntegral . fromEnum) hint) -- | Gets the type hint for this window. See 'windowSetTypeHint'. -- windowGetTypeHint :: WindowClass self => self -> IO WindowTypeHint -- ^ returns the type hint for @window@. windowGetTypeHint self = liftM (toEnum . fromIntegral) $ {# call gtk_window_get_type_hint #} (toWindow self) #if GTK_CHECK_VERSION(2,8,0) -- | Presents a window to the user in response to a user interaction. If you -- need to present a window without a timestamp, use 'windowPresent'. See -- 'windowPresent' for details. -- -- * Available since Gtk+ version 2.8 -- windowPresentWithTime :: WindowClass self => self -> TimeStamp -- ^ @timestamp@ - the timestamp of the user interaction -- (typically a button or key press event) which triggered this -- call -> IO () windowPresentWithTime self timestamp = {# call gtk_window_present_with_time #} (toWindow self) (fromIntegral timestamp) -- | Windows may set a hint asking the desktop environment to draw the users -- attention to the window. This function sets this hint. -- -- * Available since Gtk+ version 2.8 -- windowSetUrgencyHint :: WindowClass self => self -> Bool -- ^ @setting@ - @True@ to mark this window as urgent -> IO () windowSetUrgencyHint self setting = {# call gtk_window_set_urgency_hint #} (toWindow self) (fromBool setting) -- | Gets the value set by 'windowSetUrgencyHint' -- -- * Available since Gtk+ version 2.8 -- windowGetUrgencyHint :: WindowClass self => self -> IO Bool -- ^ returns @True@ if window is urgent windowGetUrgencyHint self = liftM toBool $ {# call gtk_window_get_urgency_hint #} (toWindow self) #endif -- | This function sets up hints about how a window can be resized by the -- user. You can set a minimum and maximum size, the allowed resize increments -- (e.g. for xterm, you can only resize by the size of a character) and aspect -- ratios. -- -- If you set a geometry widget, the hints will apply to the geometry widget -- instead of directly to the toplevel window. Of course since the geometry -- widget is a child widget of the top level window, constraining the sizing -- behaviour of the widget will have a knock-on effect on the sizing of the -- toplevel window. -- -- The @minWidth@\/@minHeight@\/@maxWidth@\/@maxHeight@ fields may be set to -- @-1@, to use the size request of the window or geometry widget. If the -- minimum size hint is not provided, Gtk+ will use the size requisition of the -- window (or the geometry widget if it set) as the minimum size. The base size -- is treated similarly. -- -- The canonical use-case for 'windowSetGeometryHints' is to get a terminal -- widget to resize properly. Here, the terminal text area should be the -- geometry widget. Gtk+ will then automatically set the base size of the -- terminal window to the size of other widgets in the terminal window, such as -- the menubar and scrollbar. Then, the @widthInc@ and @heightInc@ values -- should be set to the size of one character in the terminal. Finally, the -- base size should be set to the size of one character. The net effect is that -- the minimum size of the terminal will have a 1x1 character terminal area, -- and only terminal sizes on the \"character grid\" will be allowed. -- -- The other useful settings are @minAspect@ and @maxAspect@. These specify a -- width\/height ratio as a floating point number. If a geometry widget is set, -- the aspect applies to the geometry widget rather than the entire window. The -- most common use of these hints is probably to set @minAspect@ and -- @maxAspect@ to the same value, thus forcing the window to keep a constant -- aspect ratio. -- windowSetGeometryHints :: (WindowClass self, WidgetClass widget) => self -- ^ @window@ - the top level window -> Maybe widget -- ^ @geometryWidget@ - optional a widget the geometry -- hints will be applied to rather than directly to the -- top level window -> Maybe (Int, Int) -- ^ @(minWidth, minHeight)@ - minimum width and height -- of window (or -1 to use requisition) -> Maybe (Int, Int) -- ^ @(maxWidth, maxHeight)@ - maximum width and height -- of window (or -1 to use requisition) -> Maybe (Int, Int) -- ^ @(baseWidth, baseHeight)@ - the allowed window widths -- are @base_width + width_inc * N@ for any int @N@. -- Similarly, the allowed window widths are @base_height + -- height_inc * N@ for any int @N@. For either the base -- width or height -1 is allowed as described above. -> Maybe (Int, Int) -- ^ @(widthInc, heightInc)@ - width and height resize -- increment -> Maybe (Double, Double) -- ^ @(minAspect, maxAspect)@ - minimum and maximum -- width\/height ratio -> IO () windowSetGeometryHints self geometryWidget minSize maxSize baseSize incSize aspect = allocaBytes {# sizeof GdkGeometry #} $ \geometryPtr -> do minSizeFlag <- case minSize of Nothing -> return 0 Just (width, height) -> do {# set GdkGeometry->min_width #} geometryPtr (fromIntegral width) {# set GdkGeometry->min_height #} geometryPtr (fromIntegral height) return (fromEnum GdkHintMinSize) maxSizeFlag <- case maxSize of Nothing -> return 0 Just (width, height) -> do {# set GdkGeometry->max_width #} geometryPtr (fromIntegral width) {# set GdkGeometry->max_height #} geometryPtr (fromIntegral height) return (fromEnum GdkHintMaxSize) baseSizeFlag <- case baseSize of Nothing -> return 0 Just (width, height) -> do {# set GdkGeometry->base_width #} geometryPtr (fromIntegral width) {# set GdkGeometry->base_height #} geometryPtr (fromIntegral height) return (fromEnum GdkHintBaseSize) incSizeFlag <- case incSize of Nothing -> return 0 Just (width, height) -> do {# set GdkGeometry->width_inc #} geometryPtr (fromIntegral width) {# set GdkGeometry->height_inc #} geometryPtr (fromIntegral height) return (fromEnum GdkHintResizeInc) aspectFlag <- case aspect of Nothing -> return 0 Just (min, max) -> do {# set GdkGeometry->min_aspect #} geometryPtr (realToFrac min) {# set GdkGeometry->max_aspect #} geometryPtr (realToFrac max) return (fromEnum GdkHintAspect) {# call gtk_window_set_geometry_hints #} (toWindow self) (maybe (Widget nullForeignPtr) toWidget geometryWidget) geometryPtr (fromIntegral $ minSizeFlag .|. maxSizeFlag .|. baseSizeFlag .|. incSizeFlag .|. aspectFlag) {# enum GdkWindowHints {underscoreToCase} #} #if GTK_CHECK_VERSION(2,12,0) #ifndef DISABLE_DEPRECATED -- | Request the windowing system to make window partially transparent, with opacity 0 being fully transparent and 1 fully opaque. -- (Values of the opacity parameter are clamped to the [0,1] range.) -- On X11 this has any effect only on X screens with a compositing manager running. -- See 'widgetIsComposited'. On Windows it should work always. -- -- Note that setting a window's opacity after the window has been shown causes it to -- flicker once on Windows. -- -- * Available since Gtk+ version 2.12 -- windowSetOpacity :: WindowClass self => self -> Double -- ^ @opacity@ - desired opacity, between 0 and 1 -> IO () windowSetOpacity self opacity = {#call window_set_opacity #} (toWindow self) (realToFrac opacity) -- | Fetches the requested opacity for this window. See 'windowSetOpacity'. -- -- * Available since Gtk+ version 2.12 -- windowGetOpacity :: WindowClass self => self -> IO Double -- ^ return the requested opacity for this window. windowGetOpacity self = liftM realToFrac $ {#call window_get_opacity#} (toWindow self) #endif #endif #if GTK_CHECK_VERSION(2,10,0) -- | Returns the group for window or the default group, if window is @Nothing@ or if window does not have an explicit window group. -- -- * Available since Gtk+ version 2.10 -- windowGetGroup :: WindowClass self => Maybe self -> IO WindowGroup -- ^ return the 'WindowGroup' for a window or the default group windowGetGroup self = makeNewGObject mkWindowGroup $ {# call window_get_group #} (maybe (Window nullForeignPtr) toWindow self) #endif #if GTK_CHECK_VERSION(2,20,0) -- | Gets the type of the window. See 'WindowType'. -- -- * Available since Gtk version 2.20 -- windowGetWindowType :: WindowClass self => self -> IO WindowType -- ^ returns the type of the window windowGetWindowType self = liftM (toEnum . fromIntegral) $ {#call gtk_window_get_window_type #} (toWindow self) #endif -------------------- -- Attributes -- | The title of the window. -- windowTitle :: (WindowClass self, GlibString string) => Attr self string windowTitle = newAttr windowGetTitle windowSetTitle -- | The type of the window. -- -- Default value: 'WindowToplevel' -- windowType :: WindowClass self => ReadAttr self WindowType windowType = readAttrFromEnumProperty "type" {# call pure unsafe gtk_window_type_get_type #} -- | If @True@, the window has no minimum size. Setting this to @True@ is 99% -- of the time a bad idea. -- -- Default value: @False@ -- windowAllowShrink :: WindowClass self => Attr self Bool windowAllowShrink = newAttrFromBoolProperty "allow-shrink" -- | If @True@, users can expand the window beyond its minimum size. -- -- Default value: @True@ -- windowAllowGrow :: WindowClass self => Attr self Bool windowAllowGrow = newAttrFromBoolProperty "allow-grow" -- | If @True@, users can resize the window. -- -- Default value: @True@ -- windowResizable :: WindowClass self => Attr self Bool windowResizable = newAttr windowGetResizable windowSetResizable #if GTK_MAJOR_VERSION >= 3 -- | If @True@, window has a resize grip. -- -- Default value: @True@ -- windowHasResizeGrip :: WindowClass self => Attr self Bool windowHasResizeGrip = newAttr windowGetHasResizeGrip windowSetHasResizeGrip #endif -- | If @True@, the window is modal (other windows are not usable while this -- one is up). -- -- Default value: @False@ -- windowModal :: WindowClass self => Attr self Bool windowModal = newAttr windowGetModal windowSetModal #if GTK_CHECK_VERSION(2,12,0) -- | The requested opacity of the window. See 'windowSetOpacity' for more details about window opacity. -- -- Allowed values: [0,1] -- -- Default values: 1 -- -- * Available since Gtk+ version 2.12 -- windowOpacity :: WindowClass self => Attr self Double windowOpacity = newAttrFromDoubleProperty "opacity" #endif -- | If @focus@ is not the current focus widget, and is focusable, sets it as -- the focus widget for the window. If @focus@ is @Nothing@, unsets the focus widget for -- this window. To set the focus to a particular widget in the toplevel, it is -- usually more convenient to use 'widgetGrabFocus' instead of this function. -- windowFocus :: WindowClass self => Attr self (Maybe Widget) windowFocus = newAttr windowGetFocus windowSetFocus #if GTK_MAJOR_VERSION < 3 -- | (Note: this is a special-purpose function for the framebuffer port, that -- causes Gtk+ to draw its own window border. For most applications, you want -- 'windowSetDecorated' instead, which tells the window manager whether to draw -- the window border.) -- -- If this function is called on a window with setting of @True@, before it -- is realized or showed, it will have a \"frame\" window around -- its 'DrawWindow', accessible using 'windowGetFrame'. Using the signal -- 'windowFrameEvent' you can receive all events targeted at the frame. -- -- This function is used by the linux-fb port to implement managed windows, -- but it could conceivably be used by X-programs that want to do their own -- window decorations. -- -- Removed in Gtk3. windowHasFrame :: WindowClass self => Attr self Bool windowHasFrame = newAttr windowGetHasFrame windowSetHasFrame #endif -- | Sets up the icon representing a 'Window'. The icon is used when the -- window is minimized (also known as iconified). Some window managers or -- desktop environments may also place it in the window frame, or display it in -- other contexts. -- -- By passing several sizes, you may improve the final image quality of the -- icon, by reducing or eliminating automatic image scaling. -- -- Recommended sizes to provide: 16x16, 32x32, 48x48 at minimum, and larger -- images (64x64, 128x128) if you have them. -- -- See also 'windowSetDefaultIconList' to set the icon for all windows in -- your application in one go. -- -- Note that transient windows (those who have been set transient for -- another window using 'windowSetTransientFor') will inherit their icon from -- their transient parent. So there's no need to explicitly set the icon on -- transient windows. -- windowIconList :: WindowClass self => Attr self [Pixbuf] windowIconList = newAttr windowGetIconList windowSetIconList -- | The mnemonic modifier for this window. -- windowMnemonicModifier :: WindowClass self => Attr self [Modifier] windowMnemonicModifier = newAttr windowGetMnemonicModifier windowSetMnemonicModifier #if GTK_CHECK_VERSION(2,20,0) windowMnemonicVisible :: WindowClass self => Attr self Bool windowMnemonicVisible = newAttrFromBoolProperty "mnemonics-visible" #endif -- | Unique identifier for the window to be used when restoring a session. -- -- Default value: "\\" -- windowRole :: (WindowClass self, GlibString string) => Attr self string windowRole = newAttrFromStringProperty "role" #if GTK_CHECK_VERSION(2,12,0) -- | The 'windowStartupId' is a write-only property for setting window's startup notification identifier. -- -- Default value: "\\" -- -- * Available since Gtk+ version 2.12 -- windowStartupId :: (WindowClass self, GlibString string) => Attr self string windowStartupId = newAttrFromStringProperty "startup-id" #endif -- | The initial position of the window. -- -- Default value: 'WinPosNone' -- windowWindowPosition :: WindowClass self => Attr self WindowPosition windowWindowPosition = newAttrFromEnumProperty "window-position" {# call pure unsafe gtk_window_position_get_type #} -- | The default width of the window, used when initially showing the window. -- -- Allowed values: >= -1 -- -- Default value: -1 -- windowDefaultWidth :: WindowClass self => Attr self Int windowDefaultWidth = newAttrFromIntProperty "default-width" -- | The default height of the window, used when initially showing the window. -- -- Allowed values: >= -1 -- -- Default value: -1 -- windowDefaultHeight :: WindowClass self => Attr self Int windowDefaultHeight = newAttrFromIntProperty "default-height" -- | Whether the window frame should have a close button. -- -- Default values: @True@ -- -- * Available since Gtk+ version 2.10 -- windowDeletable :: WindowClass self => Attr self Bool windowDeletable = newAttrFromBoolProperty "deletable" -- | If this window should be destroyed when the parent is destroyed. -- -- Default value: @False@ -- windowDestroyWithParent :: WindowClass self => Attr self Bool windowDestroyWithParent = newAttr windowGetDestroyWithParent windowSetDestroyWithParent -- | Icon for this window. -- windowIcon :: WindowClass self => Attr self (Maybe Pixbuf) windowIcon = newAttr windowGetIcon windowSetIcon -- | The 'windowIconName' property specifies the name of the themed icon to use as the window icon. See 'IconTheme' for more details. -- -- Default values: "\\" -- -- * Available since Gtk+ version 2.6 -- -- windowIconName :: (WindowClass self, GlibString string) => Attr self string windowIconName = newAttrFromStringProperty "icon-name" #if GTK_CHECK_VERSION(2,2,0) -- | The screen where this window will be displayed. -- windowScreen :: WindowClass self => Attr self Screen windowScreen = newAttr windowGetScreen windowSetScreen #endif -- | Hint to help the desktop environment understand what kind of window this -- is and how to treat it. -- -- Default value: 'WindowTypeHintNormal' -- windowTypeHint :: WindowClass self => Attr self WindowTypeHint windowTypeHint = newAttr windowGetTypeHint windowSetTypeHint #if GTK_CHECK_VERSION(2,2,0) -- | @True@ if the window should not be in the task bar. -- -- Default value: @False@ -- windowSkipTaskbarHint :: WindowClass self => Attr self Bool windowSkipTaskbarHint = newAttr windowGetSkipTaskbarHint windowSetSkipTaskbarHint -- | @True@ if the window should not be in the pager. -- -- Default value: @False@ -- windowSkipPagerHint :: WindowClass self => Attr self Bool windowSkipPagerHint = newAttr windowGetSkipPagerHint windowSetSkipPagerHint #endif #if GTK_CHECK_VERSION(2,8,0) -- | @True@ if the window should be brought to the user's attention. -- -- Default value: @False@ -- windowUrgencyHint :: WindowClass self => Attr self Bool windowUrgencyHint = newAttr windowGetUrgencyHint windowSetUrgencyHint #endif #if GTK_CHECK_VERSION(2,4,0) -- | @True@ if the window should receive the input focus. -- -- Default value: @True@ -- windowAcceptFocus :: WindowClass self => Attr self Bool windowAcceptFocus = newAttr windowGetAcceptFocus windowSetAcceptFocus #endif #if GTK_CHECK_VERSION(2,6,0) -- | @True@ if the window should receive the input focus when mapped. -- -- Default value: @True@ -- windowFocusOnMap :: WindowClass self => Attr self Bool windowFocusOnMap = newAttr windowGetFocusOnMap windowSetFocusOnMap #endif #if GTK_CHECK_VERSION(2,4,0) -- | Whether the window should be decorated by the window manager. -- -- Default value: @True@ -- windowDecorated :: WindowClass self => Attr self Bool windowDecorated = newAttr windowGetDecorated windowSetDecorated -- | The window gravity of the window. See 'windowMove' and 'Gravity' for more -- details about window gravity. -- -- Default value: 'GravityNorthWest' -- windowGravity :: WindowClass self => Attr self Gravity windowGravity = newAttr windowGetGravity windowSetGravity #endif -- | Whether the input focus is within this GtkWindow. -- -- Note: If add `window` before `HasToplevelFocus` (has-toplevel-focus attribute) -- will conflicts with function `windowHasToplevelFocus`, so we named this attribute -- to `windowToplevelFocus`. -- -- Default values: @False@ -- windowToplevelFocus :: WindowClass self => Attr self Bool windowToplevelFocus = newAttrFromBoolProperty "has-toplevel-focus" -- | \'transientFor\' property. See 'windowGetTransientFor' and -- 'windowSetTransientFor' -- windowTransientFor :: (WindowClass self, WindowClass parent) => ReadWriteAttr self (Maybe Window) parent windowTransientFor = newAttr windowGetTransientFor windowSetTransientFor -------------------- -- Signals -- | Observe events that are emitted on the frame of this window. -- frameEvent :: WindowClass self => Signal self (EventM EAny Bool) frameEvent = Signal (\after obj fun -> connect_PTR__BOOL "frame-event" after obj (runReaderT fun)) -- | The 'keysChanged' signal gets emitted when the set of accelerators or mnemonics that are associated with window changes. -- keysChanged :: WindowClass self => Signal self (IO ()) keysChanged = Signal (connect_NONE__NONE "keys-changed") -- | Observe a change in input focus. -- setFocus :: WindowClass self => Signal self (Maybe Widget -> IO ()) setFocus = Signal (connect_MOBJECT__NONE "set-focus") -- * Deprecated #ifndef DISABLE_DEPRECATED -- | Observe a change in input focus. -- onSetFocus, afterSetFocus :: (WindowClass self, WidgetClass foc) => self -> (Maybe foc -> IO ()) -> IO (ConnectId self) onSetFocus = connect_MOBJECT__NONE "set-focus" False afterSetFocus = connect_MOBJECT__NONE "set-focus" True #endif gtk-0.15.9/Graphics/UI/Gtk/Windows/WindowGroup.chs0000644000000000000000000000550107346545000020004 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget WindowGroup -- -- Author : Duncan Coutts -- -- Created: 25 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. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Limit the effect of grabs -- module Graphics.UI.Gtk.Windows.WindowGroup ( -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----WindowGroup -- @ -- * Types WindowGroup, WindowGroupClass, castToWindowGroup, gTypeWindowGroup, toWindowGroup, -- * Constructors windowGroupNew, -- * Methods windowGroupAddWindow, windowGroupRemoveWindow, #if GTK_CHECK_VERSION(2,14,0) windowGroupListWindows, #endif ) where import System.Glib.FFI import System.Glib.GList (fromGList) {#import Graphics.UI.Gtk.Types#} {# context lib="gtk" prefix="gtk" #} -------------------- -- Constructors -- | Creates a new 'WindowGroup' object. Grabs added with -- 'Graphics.UI.Gtk.General.General.grabAdd' only affect windows within the -- same 'WindowGroup'. -- windowGroupNew :: IO WindowGroup windowGroupNew = wrapNewGObject mkWindowGroup $ {# call gtk_window_group_new #} -------------------- -- Methods -- | Adds a window to a 'WindowGroup'. -- windowGroupAddWindow :: (WindowGroupClass self, WindowClass window) => self -> window -- ^ @window@ - the 'Window' to add -> IO () windowGroupAddWindow self window = {# call gtk_window_group_add_window #} (toWindowGroup self) (toWindow window) -- | Removes a window from a 'WindowGroup'. -- windowGroupRemoveWindow :: (WindowGroupClass self, WindowClass window) => self -> window -- ^ @window@ - the 'Window' to remove -> IO () windowGroupRemoveWindow self window = {# call gtk_window_group_remove_window #} (toWindowGroup self) (toWindow window) #if GTK_CHECK_VERSION(2,14,0) -- | Returns a list of the 'Window's that belong to @windowGroup@. -- -- * Available since Gtk+ version 2.14 -- windowGroupListWindows :: WindowGroupClass self => self -- ^ @windowGroup@ - the window group -> IO [Window] -- ^ returns the list of windows inside this group windowGroupListWindows self = do glist <- {# call window_group_list_windows #} (toWindowGroup self) ptrList <- fromGList glist mapM (makeNewGObject mkWindow . return) ptrList #endif gtk-0.15.9/Graphics/UI/GtkInternals.chs0000644000000000000000000000245007346545000015746 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- Internal functions for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Axel Simon -- -- Copyright (C) 2010 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) -- -- This file contains functions that are needed by other library wrappers that build -- on Gtk2Hs. An application should not need this function nor include this file. -- module Graphics.UI.GtkInternals ( module Graphics.UI.Gtk.Types, module Graphics.UI.Gtk.General.DNDTypes, module Graphics.UI.Gtk.Multiline.Types, ) where {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.General.DNDTypes#} (mkTargetList) {#import Graphics.UI.Gtk.Multiline.Types#} gtk-0.15.9/Setup.hs0000644000000000000000000000040307346545000012215 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 gtk-0.15.9/demo/actionMenu/0000755000000000000000000000000007346545000013612 5ustar0000000000000000gtk-0.15.9/demo/actionMenu/ActionMenu.hs0000644000000000000000000001025407346545000016212 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} import Graphics.UI.Gtk import Data.Text (Text) -- A function like this can be used to tag string literals for i18n. -- It also avoids a lot of type annotations. __ :: Text -> Text __ = id -- Replace with getText from the hgettext package in localised versions uiDef = "\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \" :: Text main = do initGUI -- Create the menus fileAct <- actionNew "FileAction" (__"File") Nothing Nothing editAct <- actionNew "EditAction" (__"Edit") Nothing Nothing -- Create menu items newAct <- actionNew "NewAction" (__"New") (Just (__"Clear the spreadsheet area.")) (Just stockNew) on newAct actionActivated $ putStrLn "New activated." openAct <- actionNew "OpenAction" (__"Open") (Just (__"Open an existing spreadsheet.")) (Just stockOpen) on openAct actionActivated $ putStrLn "Open activated." saveAct <- actionNew "SaveAction" (__"Save") (Just (__"Save the current spreadsheet.")) (Just stockSave) on saveAct actionActivated $ putStrLn "Save activated." saveAsAct <- actionNew "SaveAsAction" (__"SaveAs") (Just (__"Save spreadsheet under new name.")) (Just stockSaveAs) on saveAsAct actionActivated $ putStrLn "SaveAs activated." exitAct <- actionNew "ExitAction" (__"Exit") (Just (__"Exit this application.")) (Just stockSaveAs) on exitAct actionActivated $ mainQuit cutAct <- actionNew "CutAction" (__"Cut") (Just (__"Cut out the current selection.")) (Just stockCut) on cutAct actionActivated $ putStrLn "Cut activated." copyAct <- actionNew "CopyAction" (__"Copy") (Just (__"Copy the current selection.")) (Just stockCopy) on copyAct actionActivated $ putStrLn "Copy activated." pasteAct <- actionNew "PasteAction" (__"Paste") (Just (__"Paste the current selection.")) (Just stockPaste) on pasteAct actionActivated $ putStrLn "Paste activated." standardGroup <- actionGroupNew ("standard"::Text) mapM_ (actionGroupAddAction standardGroup) [fileAct, editAct] mapM_ (\act -> actionGroupAddActionWithAccel standardGroup act (Nothing::Maybe Text)) [newAct, openAct, saveAct, saveAsAct, exitAct, cutAct, copyAct, pasteAct] ui <- uiManagerNew mid <- uiManagerAddUiFromString ui uiDef uiManagerInsertActionGroup ui standardGroup 0 win <- windowNew on win objectDestroy mainQuit on win sizeRequest $ return (Requisition 200 100) (Just menuBar) <- uiManagerGetWidget ui ("/ui/menubar"::Text) (Just toolBar) <- uiManagerGetWidget ui ("/ui/toolbar"::Text) edit <- textViewNew vBox <- vBoxNew False 0 set vBox [boxHomogeneous := False] boxPackStart vBox menuBar PackNatural 0 boxPackStart vBox toolBar PackNatural 0 boxPackStart vBox edit PackGrow 0 containerAdd win vBox widgetShowAll win mainGUI gtk-0.15.9/demo/actionMenu/Makefile0000644000000000000000000000025107346545000015250 0ustar0000000000000000 PROG = actionmenu SOURCES = ActionMenu.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/buttonbox/0000755000000000000000000000000007346545000013534 5ustar0000000000000000gtk-0.15.9/demo/buttonbox/ButtonBox.hs0000644000000000000000000000300007346545000016005 0ustar0000000000000000module Main (main) where import Graphics.UI.Gtk main :: IO () main = do initGUI -- Create a new window window <- windowNew -- Here we connect the "destroy" event to a signal handler. on window objectDestroy mainQuit -- Sets the border width of the window. set window [ containerBorderWidth := 10 ] hbuttonbox <- hButtonBoxNew set window [ containerChild := hbuttonbox ] button1 <- buttonNewWithLabel "One" button2 <- buttonNewWithLabel "Two" button3 <- buttonNewWithLabel "Three" -- Add each button to the button box with the default packing and padding set hbuttonbox [ containerChild := button | button <- [button1, button2, button3] ] -- This sets button3 to be a so called 'secondary child'. When the layout -- style is ButtonboxStart or ButtonboxEnd, the secondary children are -- grouped separately from the others. Resize the window to see the effect. -- -- This is not interesting in itself but shows how to set child attributes. -- Note that the child attribute 'buttonBoxChildSecondary' takes the -- button box container child 'button3' as a parameter. set hbuttonbox [ buttonBoxLayoutStyle := ButtonboxStart , buttonBoxChildSecondary button3 := True ] -- The final step is to display everything (the window and all the widgets -- contained within it) widgetShowAll window -- All Gtk+ applications must run the main event loop. Control ends here and -- waits for an event to occur (like a key press or mouse event). mainGUI gtk-0.15.9/demo/buttonbox/Makefile0000644000000000000000000000024607346545000015176 0ustar0000000000000000 PROG = buttonbox SOURCES = ButtonBox.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/carsim/0000755000000000000000000000000007346545000012766 5ustar0000000000000000gtk-0.15.9/demo/carsim/CarSim.hs0000644000000000000000000002171307346545000014504 0ustar0000000000000000-- program: S.A.R.A.H. jam simulator -- author: Maurício C. Antunes -- e-mail: mauricio.antunes@gmail.com -- license: public domain module Main where import Control.Applicative import Prelude import Data.Maybe import Graphics.UI.Gtk import Graphics.Rendering.Cairo import Control.Monad import Data.IORef import Data.List import Data.Time import Data.Complex -- Constants accelerator = 0.7*carSize :: Double brake = 10*accelerator:: Double carSize = 2*pi/59 :: Double responseTime = 0.24 :: Double drawSide = 5/2 :: Double -- A few conveniences eventWindowSize = do dr <- eventWindow w <- liftIO $ drawWindowGetWidth dr h <- liftIO $ drawWindowGetHeight dr return $ if w*h > 1 then (fromIntegral w, fromIntegral h) else (1,1) eventPolarCoordinates = do (w,h) <- eventWindowSize (x,y) <- eventCoordinates let (origX, origY) = (w/2, h/2) let (scaleX, scaleY) = (drawSide/w, drawSide/h) let (x',y') = (scaleX*(x-origX), scaleY*(y-origY)) let (radius,theta) = polar $ x' :+ y' return $ (radius,theta) getAndSet :: a -> IO (IO a, a -> IO ()) getAndSet a = do ior <- newIORef a let get = readIORef ior let set = writeIORef ior return (get,set) diffTime :: UTCTime -> UTCTime -> Double diffTime = (realToFrac .) . diffUTCTime moveToLineTo :: Double -> Double -> Double -> Double -> Render () moveToLineTo a b c d = moveTo a b >> lineTo c d -- Car list handling -- Each car is represented by a pair of Doubles. The first -- Double is its position in a circular road, represented by -- an angle. The second is its angular velocity. The general -- idea behind the simulation is that in a list of cars each -- one will try to keep a safe speed to avoid a crash in the -- event of a sudden brake of the next car. newCarList nCars = take nCars $ zip [0,2*pi/nCars'..] (repeat 0) where nCars' = fromIntegral nCars -- This resizes car lists by copying or keeping those -- at lower speeds. newCarListFromList nCars [] = newCarListFromList nCars [(0,0)] newCarListFromList nCars list = sortBy ((. fst).(compare . fst)) $ take nCars $ cycle $ sortBy ((. snd).(compare . snd)) list -- Safe speed for car, given data from itself and the next -- and, possibly, a forced (by the user) jam. Speed changes -- are limited by accelerator and brake maxima. newSpeed dt jam (p1,s1) (p2,s2) = min cv $ max bv $ ds - br where pd = (p2-p1-carSize) - responseTime*(s2-s1) pj = maybe pd ((subtract $ carSize/2) . (until (>0) (+2*pi)) . (subtract p1)) jam dd = brake*(max 0 $ min pd pj) br = brake*responseTime ds = sqrt $ br^2 + 2*dd cv = s1 + accelerator*dt bv = s1 - brake*dt -- Update positions and speeds based on a timestep and maybe -- taking a forced congestion into account updateCarList _ _ [] = [] updateCarList timestep jam list = zip newPositions' newSpeeds where fakeCar = (p+2*pi,s) where (p,s) = head list newSpeeds = zipWith ns list (tail list ++ [fakeCar]) where ns = newSpeed timestep jam newPositions = zipWith3 mean fsts snds newSpeeds where mean a b c = a + timestep*(b+c)/2 fsts = map fst list snds = map snd list newPositions' = map (subtract base) newPositions base = (*(2*pi)) $ fromIntegral $ floor $ (/ (2*pi)) $ head newPositions about = do ad <- aboutDialogNew set ad [ aboutDialogName := "S.A.R.A.H." , aboutDialogVersion := "1.0" , aboutDialogAuthors := ["Maurício C. Antunes " ++ ""] , aboutDialogComments := "Software Automation of " ++ "Road Automobile Headache"] dialogRun ad widgetDestroy ad main :: IO () main = do initGUI mainWindow <- windowNew drawingArea <- drawingAreaNew (getTimeStamp,setTimeStamp) <- getCurrentTime >>= getAndSet (getCars,setCars) <- getAndSet $ newCarList 20 (getJam,setJam) <- getAndSet Nothing (getTimeoutId,setTimeoutId) <- getAndSet Nothing -- If 'resume' is called, 'step' will be called at small -- timesteps to update car data. If 'pause' is called, 'step' -- calls are stopped. 'resume' is called at program startup, -- and then the pause button alternates 'resume' and 'pause'. let step = do time <- getCurrentTime dt <- getTimeStamp >>= return . (diffTime time) setTimeStamp time liftM2 (updateCarList dt) getJam getCars >>= setCars let pause = do maybe (return ()) timeoutRemove =<< getTimeoutId setTimeoutId Nothing let resume = do setTimeoutId . Just =<< flip timeoutAdd 33 (step >> widgetQueueDraw drawingArea >> return True) getCurrentTime >>= setTimeStamp -- The elements of the graphic interface are the set of -- buttons, the scale to set the number of cars and the -- car track. They are named as 'buttons', 'howMany' and -- 'track'. Each of them contains other widgets inside, but -- there's no reason to expose their names to the main IO. buttons <- do qr <- buttonNewFromStock stockClear on qr buttonActivated $ do (liftM length) getCars >>= setCars . newCarList getCurrentTime >>= setTimeStamp widgetQueueDraw drawingArea qp <- toggleButtonNewWithLabel stockMediaPause buttonSetUseStock qp True on qp toggled $ do p <- toggleButtonGetActive qp case p of True -> pause False -> resume qa <- buttonNewFromStock stockAbout on qa buttonActivated $ about qq <- buttonNewFromStock stockQuit on qq buttonActivated (do widgetDestroy mainWindow mainQuit) bb <- hButtonBoxNew containerAdd bb qr containerAdd bb qp containerAdd bb qa containerAdd bb qq return bb howMany <- do sc <- vScaleNewWithRange 1 40 1 after sc valueChanged $ do v <- liftM floor $ rangeGetValue sc c <- getCars setCars $ newCarListFromList v c widgetQueueDraw drawingArea scaleSetValuePos sc PosTop scaleSetDigits sc 0 -- rangeSetUpdatePolicy sc UpdateDiscontinuous rangeSetValue sc =<< liftM (fromIntegral . length) getCars al <- alignmentNew 0.5 0.5 0 1 alignmentSetPadding al 15 15 15 15 containerAdd al sc return al track <- do let dr = drawingArea widgetAddEvents dr [PointerMotionMask] on dr motionNotifyEvent $ do (r,t) <- eventPolarCoordinates liftIO $ if (0.8> return True on dr draw $ do w <- liftIO $ (fromIntegral <$> widgetGetAllocatedWidth dr) h <- liftIO $ (fromIntegral <$> widgetGetAllocatedHeight dr) jam <- liftIO getJam cars <- liftIO getCars translate (w/2) (h/2) scale (w/drawSide) (h/drawSide) road2render jam cars -- return True af <- aspectFrameNew 0.5 0.5 (Just 1) frameSetShadowType af ShadowNone containerAdd af dr return af -- 'layout' is a widget that contains all interface elements -- properly arranged. layout <- do vb <- vBoxNew False 0 hb <- hBoxNew False 0 boxPackStart vb track PackGrow 0 boxPackStart vb buttons PackNatural 0 boxPackStart hb howMany PackNatural 0 boxPackStart hb vb PackGrow 0 return hb set mainWindow [ windowTitle := "S.A.R.A.H." , windowDefaultWidth := 400 , windowDefaultHeight := 400 ] on mainWindow objectDestroy mainQuit containerAdd mainWindow layout widgetShowAll mainWindow resume mainGUI -- As the name says, this takes road info, in the form of a -- possible jam and a list of cars, and make it into a Cairo -- render. Road will have radius 1. road2render :: Maybe Double -> [(Double,Double)] -> Render () road2render jam cars = do newPath setSourceRGB 0 0 0 drawRoad when (isJust jam) drawJam setSourceRGBA 0 0 0 0.55 let cars' = map fst cars let rotations = zipWith subtract (0:cars') cars' sequence_ $ map ((>> drawCar) . rotate) rotations where drawRoad = setLineWidth 0.01 >> setDash [2*pi/34,2*pi/34] (pi/34) >> arc 0.0 0.0 1.0 0.0 (2*pi) >> stroke drawJam = setLineWidth 0.005 >> setDash [0.03,0.02] 0.04 >> save >> rotate (fromJust jam) >> moveToLineTo 0.8 0 1.2 0 >> stroke >> setDash [] 0 >> moveToLineTo 0.8 (-0.015) 0.8 0.015 >> moveToLineTo 1.2 (-0.015) 1.2 0.015 >> stroke >> restore drawCar = arc 1 0 (carSize/2) 0 (2*pi) >> fill gtk-0.15.9/demo/carsim/Makefile0000644000000000000000000000030607346545000014425 0ustar0000000000000000 PROGS = carsim SOURCES = CarSim.hs all : $(PROGS) carsim : CarSim.hs $(HC_RULE) HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc gtk-0.15.9/demo/concurrent/0000755000000000000000000000000007346545000013672 5ustar0000000000000000gtk-0.15.9/demo/concurrent/Makefile0000644000000000000000000000047507346545000015340 0ustar0000000000000000 PROGS = progress progressThreadedRTS SOURCES = Progress.hs ProgressThreadedRTS.hs all : $(PROGS) progress : Progress.hs $(HC) --make $< -o $@ $(HCFLAGS) progressThreadedRTS : ProgressThreadedRTS.hs $(HC) --make $< -o $@ -threaded $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc gtk-0.15.9/demo/concurrent/Progress.hs0000644000000000000000000000205607346545000016035 0ustar0000000000000000-- Example of concurrent Haskell and Gtk. -- -- As long as GHC does not support OS level threads by default, a trick has -- to be used to let Haskell programs continue while the GUI is running. -- We attach a call to the Haskell function "yield" to the timeout handler of -- Gtk's main loop. Thus GHC regularly gets a chance to execute Haskell -- threads. import Graphics.UI.Gtk import Control.Applicative import Prelude import Control.Concurrent main :: IO () main = do initGUI dia <- dialogNew dialogAddButton dia stockClose ResponseClose contain <- castToBox <$> dialogGetContentArea dia pb <- progressBarNew boxPackStart contain pb PackNatural 0 widgetShowAll dia forkIO (doTask pb) -- 50ms timeout, so GHC will get a chance to scheule about 20 times a second -- which gives reasonable latency without the polling generating too much -- cpu load. timeoutAddFull (yield >> return True) priorityDefaultIdle 50 dialogRun dia return () doTask :: ProgressBar -> IO () doTask pb = do progressBarPulse pb threadDelay 100000 doTask pb gtk-0.15.9/demo/concurrent/ProgressThreadedRTS.hs0000644000000000000000000000207307346545000020066 0ustar0000000000000000-- Example of concurrent Haskell and Gtk. -- -- This demo uses GHC's support for OS level threads. It has to be -- linked using the ghc -threaded flag. -- -- Because Gtk+ is single threaded we have to be very careful to call -- Gtk+ only from the main GUI thread. So while it's ok to forkIO, -- any GUI actions in that thread have to be 'posted' to the main GUI -- thread using postGUI, or postGUIAsync as in the example here. import Graphics.UI.Gtk import Control.Applicative import Prelude import Control.Concurrent main :: IO () main = do -- It is marked unsafe because it is your obligation to ensure you -- only call Gtk+ from one OS thread, or 'bad things' will happen. unsafeInitGUIForThreadedRTS dia <- dialogNew dialogAddButton dia stockClose ResponseClose contain <- castToBox <$> dialogGetContentArea dia pb <- progressBarNew boxPackStart contain pb PackNatural 0 widgetShowAll dia forkIO (doTask pb) dialogRun dia return () doTask :: ProgressBar -> IO () doTask pb = do postGUIAsync $ progressBarPulse pb threadDelay 100000 doTask pb gtk-0.15.9/demo/0000755000000000000000000000000007346545000011510 5ustar0000000000000000gtk-0.15.9/demo/demos.txt0000644000000000000000000001120707346545000013361 0ustar0000000000000000Written by Paul Dufresne , january, 2008 This is hereby released in public domain This describe the demos available with Gtk2HS library, an Haskell GTK+ wrapper. Sometimes, you may have to press Control-C to quit a program. actionMenu: Show you how to make a small File and a small Edit menu (also a button bar) You will learn how to attach actions you want to do when they are activated. buttonBox: Build a window with three buttons, the third one, not following others when you grow the window. cairo: Contains some examples that use the cairo drawing library: http://cairographics.org/ ./graph shows a mathematical curve ./drawing shows some color lines and curves, and some 45 degree text ./drawing2 shows some semi-transparent figures, an apple, and a snake ./text make text.png, an image with some text in it ./starandring make a star inside a circle, in 4 different documents: .png, .pdf, .ps, .svg ./clock shows a very nice looking analog clock Needs: --enable-cairo or/and cairo lib installed at build time of gtk2hs calc: a simple calculator carsim: on a ring track, up to 40 simulated cars are circulating, you can stop the traffic by putting the mouse cursor in front of a car Needs: --enable-cairo or/and cairo lib installed at build time of gtk2hs concurrent: Show how to let Haskell programs continue while the GUI is running. embedded: You will need uzbl installed (http://uzbl.org/) to run the Uzbl demo. fastdraw: shows a palette of colors constantly changing (Example of a drawing graphics onto a canvas) filechooser: examples of Save and Open dialogs. requires the glade package fonts: shows info on all your installed fonts. gconf: at first execution, will show you how to enter values in gnome configuration database (much like Windows registry), and on second execution, will monitor the values glade: Show how to load a simple made with Glade, and use it gnomevfs: Gnome virtual file system TODO (install gnomefs and try again) Could not find module System.Gnome.VFS graphics: same as ./drawing in Cairo (but without Cairo) gstreamer: Seems to try to play a sound file (Vorbis) TODO (install gstreamer and try again) Could not find module `Media.Streaming.GStreamer' gtkbuilder: same as ./glade, but with GtkBuilder hello: just a button HelloWorld that quit program (which is full of comments) mozembed: Probably show a web page inside a window? TODO (install mozembed and try again) Could not find module `Graphics.UI.Gtk.MozEmbed': noughty: What I call Tic-Tac-Toe game (2 human players) where one have X the other O, and the goal of the game is to make a line of 3 yours symbols 2 versions, one without glade, and with the GUI built with Glade opengl: shows how to use HOpenGL inside Gtk2HS to make a rotating cube Needs: --enable-opengl and/or mesa? installed a gtk2hs build time pango: use pango (http://www.pango.org/) layout to make a long paragraph adjust to wide of the window Needs: --enable-cairo and/or cairo lib installed at Gtk2HS build time(to render the fonts) profileviewer: This is a slightly larger demo that combines use of glade, the file chooser dialog, program state (IORefs) and use of the mogul tree view wrapper interface. The program is a simple viewer for the log files that ghc produces when you do time profiling. soe: SOE (School of Expression) is an alternative implementation of the graphics library used in a book by Paul Hudak, http://www.haskell.org/soe/. API at http://www.haskell.org/gtk2hs/docs/devel/Graphics-SOE-Gtk.html sourceview: a program showing itself with syntax highlighting Needs: --enable-sourceview and/or sourceview installed at Gtk2HS build time statusicon: Show a door icon in Gnome (upper right), and give a message when you click on it Use right button on it to get a menu that will allow you to quit the program Warning: Deprecated use of `I.onPopupMenu' and `I.onActivate' svg: Scalable Vector Graphics, see http://www.w3.org/Graphics/SVG/About './svgviewer imagefile.svg' to see a svg image (XML file) './svg2png imagefile.svg imagefile.png' will create imagefile.png from imagefile.svg (avoid thinking about doing the reverse ;-)) Hint: if you have use starandring from cairo, 'cp ../cairo/StarAndRing.svg .' Needs: --enable-cairo and/or cairo lib installed at Gtk2HS build time Feature request: avoid svgviewer: user error (Pattern match failure in do expression at SvgViewer.hs:11:2-9) when not giving any parameter textdrop: a minimal sample program showing how to become a drag-n-drop destination treelist: some examples showing how to use ListView and TreeView widgets; requires the glade package unicode: Example of an international dialog box (in arabic) gtk-0.15.9/demo/embedded/0000755000000000000000000000000007346545000013241 5ustar0000000000000000gtk-0.15.9/demo/embedded/Embedded.hs0000644000000000000000000000473007346545000015272 0ustar0000000000000000-- Use GtkSocket and GtkPlug for cross-process embedded. -- Just startup program, press 'm' to create tab with new button. -- Click button for hang to simulate plug hanging process, -- but socket process still running, can switch to other tab. module Main where import System.Process import System.Environment import System.Directory import System.FilePath (()) import Control.Monad import Control.Monad.Trans import Control.Concurrent import Data.Text (unpack) import Graphics.UI.Gtk import Graphics.UI.Gtk.Gdk.DrawWindow import Graphics.UI.Gtk.Gdk.EventM -- | Main. main :: IO () main = do -- Get program arguments. args <- getArgs case args of -- Entry plug main when have two arguments. [id] -> plugMain (toNativeWindowId $ read id :: NativeWindowId) -- get GtkSocket id -- Othersise entry socket main when no arguments. _ -> socketMain -- | GtkSocekt main. socketMain :: IO () socketMain = do initGUI -- Create top-level window. window <- windowNew windowSetPosition window WinPosCenter windowSetDefaultSize window 600 400 set window [windowTitle := "Press `m` to new tab, press `q` exit."] on window objectDestroy mainQuit -- Create notebook to contain GtkSocekt. notebook <- notebookNew window `containerAdd` notebook -- Handle key press. window `on` keyPressEvent $ tryEvent $ do keyName <- eventKeyName liftIO $ case unpack keyName of "m" -> do -- Create new GtkSocket. socket <- socketNew widgetShow socket -- must show before add GtkSocekt to container notebookAppendPage notebook socket "Tab" -- add to GtkSocekt notebook id <- socketGetId socket -- get GtkSocket id -- Fork process to add GtkPlug into GtkSocekt. path <- liftM2 () getCurrentDirectory getProgName -- get program full path runCommand $ path ++ " " ++ (show $ fromNativeWindowId id) -- don't use `forkProcess` return () "q" -> mainQuit -- quit widgetShowAll window mainGUI -- | GtkPlug main. plugMain :: NativeWindowId -> IO () plugMain id = do initGUI plug <- plugNew $ Just id on plug objectDestroy $ mainQuit button <- buttonNewWithLabel "Click me to hang." plug `containerAdd` button -- Simulate a plugin hanging to see if it blocks the outer process. on button buttonActivated $ threadDelay 5000000 widgetShowAll plug mainGUI gtk-0.15.9/demo/embedded/MPlayer.hs0000644000000000000000000000417407346545000015154 0ustar0000000000000000-- | MPlayer client demo -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart module Main where import Control.Applicative import Control.Concurrent import Control.Concurrent.STM import Control.Monad import Control.Monad.Trans import Graphics.UI.Gtk import System.Exit import System.IO import System.Process import System.Environment import Text.Printf main :: IO () main = do args <- getArgs case args of [filepath] -> do initGUI mainWindow <- windowNew windowSetDefaultSize mainWindow 800 450 windowSetPosition mainWindow WinPosCenter mplayer <- mplayerNew mplayerStick mplayer (toContainer mainWindow) mainWindow `afterShow` do mplayerRun mplayer filepath mainWindow `onDestroy` do mplayerQuit mplayer mainQuit return () widgetShowAll mainWindow mainGUI _ -> putStrLn "Usage : mplayer file" data MPlayer = MPlayer {mplayerWidget :: DrawingArea ,mplayerHandle :: TVar (Maybe (Handle, Handle, Handle, ProcessHandle))} mplayerNew :: IO MPlayer mplayerNew = MPlayer <$> drawingAreaNew <*> newTVarIO Nothing mplayerStick :: MPlayer -> Container -> IO () mplayerStick (MPlayer {mplayerWidget = mWidget}) container = do widgetShowAll mWidget container `containerAdd` mWidget mplayerRun :: MPlayer -> FilePath -> IO () mplayerRun (MPlayer {mplayerWidget = mWidget ,mplayerHandle = mHandle}) filepath = do drawWindow <- widgetGetDrawWindow mWidget -- you just can get DrawWindow after widget realized wid <- liftM fromNativeWindowId $ drawableGetID drawWindow handle <- runInteractiveCommand $ printf "mplayer %s -slave -wid %d" filepath (wid :: Int) writeTVarIO mHandle (Just handle) mplayerQuit :: MPlayer -> IO () mplayerQuit MPlayer {mplayerHandle = mHandle} = do handle <- readTVarIO mHandle case handle of Just (inp, _, _, _) -> hPutStrLn inp "quit" Nothing -> return () -- | The IO version of `writeTVar`. writeTVarIO :: TVar a -> a -> IO () writeTVarIO a b = atomically $ writeTVar a b gtk-0.15.9/demo/embedded/Makefile0000644000000000000000000000050207346545000014676 0ustar0000000000000000 PROGS = Embedded Uzbl MPlayer SOURCES = Embedded.hs Uzbl.hs MPlayer.hs all : $(PROGS) Embedded : Embedded.hs $(HC) --make $< -o $@ $(HCFLAGS) Uzbl : Uzbl.hs $(HC) --make $< -o $@ $(HCFLAGS) MPlayer : MPlayer.hs $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc gtk-0.15.9/demo/embedded/Notes.txt0000644000000000000000000000104307346545000015070 0ustar0000000000000000If you use GtkSocket/GtkPlug with multi-processes framework. DON'T use function `forkProcess` to spawn process! Because `forkProcess` just simple call C `fork`, haven't any protection, then two processes will got *race condition*, you will get X Window error (such as `BadWindow`) when those two processes try to access same X resource. So use `runProcess` or `runCommand` instead. Above two functions add MVar lock when spawn processes (call c_runInteractiveProcess) to make sure two processes won't get *race condition* problem on X resource. gtk-0.15.9/demo/embedded/Uzbl.hs0000644000000000000000000000237707346545000014522 0ustar0000000000000000-- | This is program use uzbl embedded in window to render webpage. -- Just simple model demo for view, haven't handle event or else. -- -- You need install uzbl (git clone git://github.com/Dieterbe/uzbl.git) first. -- -- How to use: -- ./Uzbl default open Google page. -- ./Uzbl url will open url you input -- module Main where import Graphics.UI.Gtk import System.Process import System.Environment main :: IO () main = do -- Init. initGUI -- Get program arguments. args <- getArgs let url = case args of [arg] -> arg -- get user input url _ -> "http://www.google.com" -- set default url -- Create window. window <- windowNew windowSetDefaultSize window 900 600 windowSetPosition window WinPosCenter windowSetOpacity window 0.8 -- this function need window-manager support Alpha channel in X11 -- Create socket. socket <- socketNew widgetShow socket -- must show before add to parent window `containerAdd` socket -- Get socket id. socketId <- fmap (show . fromNativeWindowId) $ socketGetId socket -- Start uzbl-core process. runCommand $ "uzbl-core -s " ++ socketId ++ " -u " ++ url -- Show. window `onDestroy` mainQuit widgetShowAll window mainGUI gtk-0.15.9/demo/fastdraw/0000755000000000000000000000000007346545000013323 5ustar0000000000000000gtk-0.15.9/demo/fastdraw/FastDraw.hs0000644000000000000000000000555407346545000015403 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -O #-} -- Example of an drawing graphics onto a canvas. import Graphics.UI.Gtk import Control.Applicative import Prelude import Data.IORef import Graphics.Rendering.Cairo import Foreign (allocaArray) import Graphics.Rendering.Cairo.Types (PixelData) import Foreign.Storable (Storable(..)) import Foreign.C (CUChar) main = do initGUI dia <- dialogNew dialogAddButton dia stockOk ResponseOk contain <- castToBox <$> dialogGetContentArea dia canvas <- drawingAreaNew let w = 256 h = 256 chan = 4 row = w * chan stride = row widgetSetSizeRequest canvas 256 256 -- create the Pixbuf allocaArray (w * h * chan) $ \ pbData -> do -- draw into the Pixbuf doFromTo 0 (h-1) $ \y -> doFromTo 0 (w-1) $ \x -> do pokeByteOff pbData (2+x*chan+y*row) (fromIntegral x :: CUChar) pokeByteOff pbData (1+x*chan+y*row) (fromIntegral y :: CUChar) pokeByteOff pbData (0+x*chan+y*row) (0 :: CUChar) -- a function to update the Pixbuf blueRef <- newIORef (0 :: CUChar) dirRef <- newIORef True let updateBlue = do blue <- readIORef blueRef -- print blue doFromTo 0 (h-1) $ \y -> doFromTo 0 (w-1) $ \x -> pokeByteOff pbData (0+x*chan+y*row) blue -- unchecked indexing -- arrange for the canvas to be redrawn now that we've changed -- the Pixbuf widgetQueueDraw canvas -- update the blue state ready for next time dir <- readIORef dirRef let diff = 1 let blue' = if dir then blue+diff else blue-diff if dir then if blue<=maxBound-diff then writeIORef blueRef blue' else writeIORef blueRef maxBound >> modifyIORef dirRef not else if blue>=minBound+diff then writeIORef blueRef blue' else writeIORef blueRef minBound >> modifyIORef dirRef not return True idleAdd updateBlue priorityLow canvas `on` draw $ updateCanvas pbData w h stride boxPackStart contain canvas PackGrow 0 widgetShow canvas dialogRun dia return () updateCanvas :: PixelData -> Int -> Int -> Int -> Render () updateCanvas pb w h stride = do s <- liftIO $ createImageSurfaceForData pb FormatRGB24 w h stride setSourceSurface s 0 0 paint -- GHC is much better at opimising loops like this: -- -- > doFromTo 0 255 $ \y -> -- > doFromTo 0 255 $ \x -> do ... -- -- Than it is at optimising loops like this: -- -- > sequence_ [ do ... -- > | x <- [0..255] -- > , y <- [0..255] ] -- -- The first kind of loop runs significantly faster (with GHC 6.2 and 6.4) {-# INLINE doFromTo #-} -- do the action for [from..to], ie it's inclusive. doFromTo :: Int -> Int -> (Int -> IO ()) -> IO () doFromTo from to action = let loop n | n > to = return () | otherwise = do action n loop (n+1) in loop from gtk-0.15.9/demo/fastdraw/Makefile0000644000000000000000000000024407346545000014763 0ustar0000000000000000 PROG = fastDraw SOURCES = FastDraw.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/filechooser/0000755000000000000000000000000007346545000014012 5ustar0000000000000000gtk-0.15.9/demo/filechooser/FileChooserDemo.glade0000644000000000000000000004701307346545000020024 0ustar0000000000000000 10 True File Chooser Demo GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False True False True False 0 True This is a demo of the GtkFileChooser that was intoduced in Gtk+ 2.4 The dialog has four modes: * open file (selects existing file) * save file (select existing or new file) * select folder (select existing folder) * create folder (selects existing or bew folder) The last demo show how you can install extra widgets or a preview widget in the file open dialog False False GTK_JUSTIFY_LEFT True False 0 0 10 10 0 True False True GTK_BUTTONBOX_EDGE 5 True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-open 4 0.5 0.5 0 0 0 False False True Open File True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-save-as 4 0.5 0.5 0 0 0 False False True Save File True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-open 4 0.5 0.5 0 0 0 False False True Select Folder True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-open 4 0.5 0.5 0 0 0 False False True Create Folder True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False 5 False True True GTK_BUTTONBOX_SPREAD 5 True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-open 4 0.5 0.5 0 0 0 False False True Open File (with preview) True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False True True True gtk-quit True GTK_RELIEF_NORMAL 0 True True gtk-0.15.9/demo/filechooser/FileChooserDemo.hs0000644000000000000000000001602607346545000017362 0ustar0000000000000000module Main where import Graphics.UI.Gtk hiding (response) main :: IO () main = do initGUI -- load up our main window gui <- builderNew builderAddFromFile gui "FileChooserDemo.glade" mainWindow <- builderGetObject gui castToWindow "mainWindow" -- get a handle on a various objects from the glade file on mainWindow objectDestroy mainQuit let onClicked obj = on obj buttonActivated -- -- and associate actions with the buttons selectFolderButton <- builderGetObject gui castToButton "selectFolderButton" selectFolderButton `onClicked` openSelectFolderDialog mainWindow createFolderButton <- builderGetObject gui castToButton "createFolderButton" createFolderButton `onClicked` openCreateFolderDialog mainWindow openFileButton <- builderGetObject gui castToButton "openFileButton" openFileButton `onClicked` openOpenFileDialog mainWindow saveFileButton <- builderGetObject gui castToButton "saveFileButton" saveFileButton `onClicked` openSaveFileDialog mainWindow openFilePreviewButton <- builderGetObject gui castToButton "openFilePreviewButton" openFilePreviewButton `onClicked` openFilePreviewDialog mainWindow quitButton <- builderGetObject gui castToButton "quitButton" quitButton `onClicked` (do widgetDestroy mainWindow mainQuit) -- The final step is to display the main window and run the main loop widgetShowAll mainWindow mainGUI openSelectFolderDialog :: Window -> IO () openSelectFolderDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog " ++ "to select an existing folder") --dialog title (Just parentWindow) --the parent window FileChooserActionSelectFolder --the kind of dialog we want [("Yes, this new dialog looks nice" --The buttons to display , ResponseAccept) ,("Eugh! Take me away!" ,ResponseCancel)] widgetShow dialog response <- dialogRun dialog case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the folder " ++ show fileName ResponseCancel -> putStrLn "dialog canceled" ResponseDeleteEvent -> putStrLn "dialog closed" widgetHide dialog openCreateFolderDialog :: Window -> IO () openCreateFolderDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " ++ "a new folder (or existing) folder") --dialog title (Just parentWindow) --the parent window FileChooserActionCreateFolder --the kind of dialog we want [("I want this new folder" --The buttons to display , ResponseAccept) ,("Bored now." ,ResponseCancel)] widgetShow dialog response <- dialogRun dialog case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the folder " ++ show fileName ResponseCancel -> putStrLn "Getting bored?" ResponseDeleteEvent -> putStrLn "dialog closed" widgetHide dialog openOpenFileDialog :: Window -> IO () openOpenFileDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " ++ "an existing file") --dialog title (Just parentWindow) --the parent window FileChooserActionOpen --the kind of dialog we want [("gtk-cancel" --The buttons to display ,ResponseCancel) ,("gtk-open" , ResponseAccept)] widgetShow dialog response <- dialogRun dialog case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the file " ++ show fileName ResponseCancel -> putStrLn "dialog canceled" ResponseDeleteEvent -> putStrLn "dialog closed" widgetHide dialog openSaveFileDialog :: Window -> IO () openSaveFileDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " ++ "a new file") --dialog title (Just parentWindow) --the parent window FileChooserActionSave --the kind of dialog we want [("gtk-cancel" --The buttons to display ,ResponseCancel) --you can use stock buttons ,("gtk-save" , ResponseAccept)] widgetShow dialog response <- dialogRun dialog case response of ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog putStrLn $ "you called the new file " ++ show fileName ResponseCancel -> putStrLn "dialog canceled" ResponseDeleteEvent -> putStrLn "dialog closed" widgetHide dialog openFilePreviewDialog :: Window -> IO () openFilePreviewDialog parentWindow = do dialog <- fileChooserDialogNew (Just $ "Demo of the standard dialog to select " ++ "a new file - with a preview widget") --dialog title (Just parentWindow) --the parent window FileChooserActionOpen --the kind of dialog we want [("_Yes, yes that's very clever" --The buttons to display , ResponseAccept) ,("_No, I'm not impressed" ,ResponseCancel)] --create and set an extra widget checkButton <- checkButtonNewWithLabel "frobnicate this file" dialog `fileChooserSetExtraWidget` checkButton --create and set a preview widget previewLabel <- labelNew $ Just "Preview appears here" previewLabel `labelSetLineWrap` True dialog `fileChooserSetPreviewWidget` previewLabel on dialog updatePreview $ do previewFile <- fileChooserGetPreviewFilename dialog previewLabel `labelSetText` case previewFile of Nothing -> "Preview appears here" (Just filename) -> "Just pretend this is a preview of the file:\n" ++ show filename widgetShow dialog response <- dialogRun dialog case response of ResponseAccept -> do fileName <- fileChooserGetFilename dialog putStrLn $ "you selected the new file " ++ show fileName --check the state of the extra widget frobnicate <- toggleButtonGetActive checkButton putStrLn $ if frobnicate then "you foolishly decided to frobnicate the file" else "you wisely decided not to frobnicate the file" ResponseCancel -> putStrLn "you were not impressed" ResponseDeleteEvent -> putStrLn "dialog closed" widgetHide dialog gtk-0.15.9/demo/filechooser/Makefile0000644000000000000000000000025607346545000015455 0ustar0000000000000000 PROG = filechooser SOURCES = FileChooserDemo.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/fonts/0000755000000000000000000000000007346545000012641 5ustar0000000000000000gtk-0.15.9/demo/fonts/Fonts.hs0000644000000000000000000000107707346545000014273 0ustar0000000000000000-- Example of an drawing graphics onto a canvas. import Graphics.UI.Gtk import Data.List ( intersperse ) main = do initGUI fm <- cairoFontMapGetDefault ffs <- pangoFontMapListFamilies fm mapM_ (\ff -> do putStrLn (show ff++": ") fcs <- pangoFontFamilyListFaces ff mapM_ (\fc -> do sizes <- pangoFontFaceListSizes fc let showSize Nothing = "all sizes" showSize (Just sz) = concat (intersperse ", " (map show sz))++ " points" putStrLn (" "++show fc++" in "++showSize sizes) ) fcs ) ffs gtk-0.15.9/demo/fonts/Makefile0000644000000000000000000000023707346545000014303 0ustar0000000000000000 PROG = fonts SOURCES = Fonts.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/graphic/0000755000000000000000000000000007346545000013125 5ustar0000000000000000gtk-0.15.9/demo/graphic/Drawing.hs0000644000000000000000000000247307346545000015062 0ustar0000000000000000-- Example of an drawing graphics onto a canvas. Note that this example -- uses the old-style Gdk drawing functions. New implementations should -- use Cairo. See examples in that directory. import Graphics.UI.Gtk import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.Gdk.GC import Control.Monad.Trans ( liftIO ) main = do initGUI dia <- dialogNew dialogAddButton dia stockOk ResponseOk contain <- dialogGetUpper dia canvas <- drawingAreaNew canvas `on` sizeRequest $ return (Requisition 40 40) text <- canvas `widgetCreateLayout` "Hello World." canvas `on` exposeEvent $ updateCanvas text boxPackStartDefaults contain canvas widgetShow canvas dialogRun dia return () updateCanvas :: PangoLayout -> EventM EExpose Bool updateCanvas text = do win <- eventWindow liftIO $ do (width,height) <- drawableGetSize win gc <- gcNew win gcSetValues gc $ newGCValues { foreground = Color 65535 0 0, capStyle = CapRound, lineWidth = 20, joinStyle = JoinRound } drawLines win gc [(30,30),(width-30,height-30),(width-30,30),(30,height-30)] gcSetValues gc $ newGCValues { foreground = Color 65535 65535 0, lineWidth = 4 } drawArc win gc False 0 0 width height (135*64) (90*64) drawLayoutWithColors win gc 30 (height `div` 2) text (Just (Color 0 0 0)) Nothing return True gtk-0.15.9/demo/graphic/Makefile0000644000000000000000000000024207346545000014563 0ustar0000000000000000 PROG = drawing SOURCES = Drawing.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/gtkbuilder/0000755000000000000000000000000007346545000013644 5ustar0000000000000000gtk-0.15.9/demo/gtkbuilder/GtkBuilderTest.hs0000644000000000000000000000112007346545000017066 0ustar0000000000000000module Main where import Graphics.UI.Gtk main = do initGUI -- Create the builder, and load the UI file builder <- builderNew builderAddFromFile builder "simple.ui" -- Retrieve some objects from the UI window <- builderGetObject builder castToWindow "window1" button <- builderGetObject builder castToButton "button1" -- Basic user interaction on button buttonActivated $ putStrLn "button pressed!" on window objectDestroy mainQuit -- Display the window widgetShowAll window mainGUI gtk-0.15.9/demo/gtkbuilder/Makefile0000644000000000000000000000026007346545000015302 0ustar0000000000000000 PROG = gtkbuildertest SOURCES = GtkBuilderTest.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/gtkbuilder/simple.ui0000644000000000000000000001144007346545000015474 0ustar0000000000000000 True window1 GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False True False 6 True False 0 True A simple dialog created in Glade False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 True True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-apply 4 0.5 0.5 0 0 0 False False True Press me! True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False 0 True True gtk-0.15.9/demo/hello/0000755000000000000000000000000007346545000012613 5ustar0000000000000000gtk-0.15.9/demo/hello/Makefile0000644000000000000000000000024307346545000014252 0ustar0000000000000000 PROG = helloworld SOURCES = World.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/hello/World.hs0000644000000000000000000000320507346545000014236 0ustar0000000000000000-- A simple program to demonstrate Gtk2Hs. module Main (Main.main) where import Graphics.UI.Gtk main :: IO () main = do initGUI -- Create a new window window <- windowNew -- Here we connect the "destroy" event to a signal handler. -- This event occurs when we call widgetDestroy on the window -- or if the user closes the window. on window objectDestroy mainQuit -- Sets the border width and tile of the window. Note that border width -- attribute is in 'Container' from which 'Window' is derived. set window [ containerBorderWidth := 10, windowTitle := "Hello World" ] -- Creates a new button with the label "Hello World". button <- buttonNew set button [ buttonLabel := "Hello World" ] -- When the button receives the "clicked" signal, it will call the -- function given as the second argument. on button buttonActivated (putStrLn "Hello World") -- Gtk+ allows several callbacks for the same event. -- This one will cause the window to be destroyed by calling -- widgetDestroy. The callbacks are called in the sequence they were added. on button buttonActivated $ do putStrLn "A \"clicked\"-handler to say \"destroy\"" widgetDestroy window -- Insert the hello-world button into the window. set window [ containerChild := button ] -- The final step is to display this newly created widget. Note that this -- also allocates the right amount of space to the windows and the button. widgetShowAll window -- All Gtk+ applications must have a main loop. Control ends here -- and waits for an event to occur (like a key press or mouse event). -- This function returns if the program should finish. mainGUI gtk-0.15.9/demo/inputmethod/0000755000000000000000000000000007346545000014050 5ustar0000000000000000gtk-0.15.9/demo/inputmethod/Layout.hs0000644000000000000000000001245107346545000015664 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Example of using a PangoLayout import Data.IORef import Data.Monoid ((<>)) import qualified Data.Text as T import Graphics.UI.Gtk import Graphics.Rendering.Cairo loremIpsum = "Lorem ipsum dolor sit amet, consectetur adipisicing elit,\ \ sed do eiusmod tempor incididunt ut labore et dolore magna\ \ aliqua. Ut enim ad minim veniam, quis nostrud exercitation\ \ ullamco laboris nisi ut aliquip ex ea commodo consequat.\ \ Duis aute irure dolor in reprehenderit in voluptate\ \ velit esse cillum dolore eu fugiat nulla pariatur.\ \ Excepteur sint occaecat cupidatat non proident, sunt in culpa\ \ qui officia deserunt mollit anim id est laborum." data Buffer = Buffer T.Text Int defaultBuffer = Buffer loremIpsum (T.length loremIpsum) displayBuffer (Buffer str pos) = before <> "" <> after where (before,after) = T.splitAt pos str displayBufferPreedit (Buffer str pos) preeditStr preeditPos = before <> "[" <> prebefore <> "" <> preafter <> "]" <> after where (before,after) = T.splitAt pos str (prebefore, preafter) = T.splitAt preeditPos preeditStr insertStr new (Buffer str pos) = Buffer (before<>new<>after) (pos+T.length new) where (before,after) = T.splitAt pos str deleteChar b@(Buffer str 0) = b deleteChar (Buffer str pos) = Buffer (T.init before <> after) (pos-1) where (before,after) = T.splitAt pos str moveLeft b@(Buffer str pos) | pos==0 = b | otherwise = Buffer str (pos-1) moveRight b@(Buffer str pos) | pos==T.length str = b | otherwise = Buffer str (pos+1) main = do initGUI -- Create the main window. win <- windowNew on win objectDestroy mainQuit -- Create a drawing area in which we can render text. area <- drawingAreaNew containerAdd win area widgetSetSizeRequest area 100 100 -- Our widget's data buffer <- newIORef defaultBuffer preeditRef <- newIORef Nothing -- Create a Cairo Context that contains information about the current font, -- etc. ctxt <- cairoCreateContext Nothing lay <- layoutEmpty ctxt layoutSetWrap lay WrapWholeWords let relayout = do buffer@(Buffer _ cursor) <- readIORef buffer preedit <- readIORef preeditRef case preedit of Nothing -> do layoutSetText lay (displayBuffer buffer) layoutSetAttributes lay [] Just (str,attrs,pos) -> do layoutSetText lay (displayBufferPreedit buffer str pos) layoutSetAttributes lay (map (shiftAttribute (cursor + 1)) (concat attrs)) widgetQueueDraw area relayout -- Wrap the layout to a different width each time the window is resized. on area sizeAllocate $ \(Rectangle _ _ w _) -> layoutSetWidth lay (Just (fromIntegral w)) -- Setup the handler to draw the layout. on area draw $ updateArea area lay -- Set up input method im <- imMulticontextNew on im imContextPreeditStart $ do writeIORef preeditRef (Just ("",[],0)) relayout on im imContextPreeditEnd $ do writeIORef preeditRef Nothing relayout on im imContextPreeditChanged $ do writeIORef preeditRef . Just =<< imContextGetPreeditString im relayout on im imContextCommit $ \str -> do modifyIORef buffer (insertStr str) relayout on im imContextRetrieveSurrounding $ do Buffer text pos <- readIORef buffer imContextSetSurrounding im text pos return True on im imContextDeleteSurrounding' $ \off nchars -> do putStrLn $ "delete-surrounding("++show off++","++show nchars++")" return False on win realize $ do imContextSetClientWindow im =<< widgetGetWindow win on win focusInEvent $ liftIO (imContextFocusIn im) >> return False on win focusOutEvent $ liftIO (imContextFocusOut im) >> return False on win keyReleaseEvent $ imContextFilterKeypress im on win keyPressEvent $ do imHandled <- imContextFilterKeypress im if imHandled then return True else do mod <- interpretKeyPress case mod of Just f -> liftIO $ modifyIORef buffer f >> relayout >> return True Nothing -> return False widgetShowAll win mainGUI updateArea :: DrawingArea -> PangoLayout -> Render () updateArea area lay = do moveTo 0 0 showLayout lay interpretKeyPress :: EventM EKey (Maybe (Buffer -> Buffer)) interpretKeyPress = do modifiers <- eventModifier if modifiers /= [] then return Nothing else do keyName <- eventKeyName keyChar <- fmap keyToChar eventKeyVal case keyChar of Just ch -> do -- This does not appear to get called; the IM handles -- unmodified keypresses. liftIO $ putStrLn "Literal character not handled by IM" returnJust (insertStr $ T.singleton ch) Nothing -> do case keyName of "Left" -> returnJust moveLeft "Right" -> returnJust moveRight "BackSpace" -> returnJust deleteChar _ -> return Nothing where returnJust = return . Just shiftAttribute :: Int -> PangoAttribute -> PangoAttribute shiftAttribute x attr = attr { paStart = x + paStart attr, paEnd = x + paEnd attr } gtk-0.15.9/demo/inputmethod/Makefile0000644000000000000000000000024107346545000015505 0ustar0000000000000000 PROG = layout SOURCES = Layout.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/menu/0000755000000000000000000000000007346545000012454 5ustar0000000000000000gtk-0.15.9/demo/menu/ComboDemo.hs0000644000000000000000000000214007346545000014651 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Graphics.UI.Gtk import Data.List ( findIndex ) import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.Text as T main = do initGUI win <- windowNew on win deleteEvent $ liftIO mainQuit >> return False combo <- comboBoxNewWithEntry comboBoxSetModelText combo mapM_ (comboBoxAppendText combo) (T.words "ice-cream turkey pasta sandwich steak") -- select the first item comboBoxSetActive combo 0 -- Get the entry widget that the ComboBoxEntry uses. (Just w) <- binGetChild combo let entry = castToEntry w -- Whenever the user has completed editing the text, append the new -- text to the store unless it's already in there. on entry entryActivated $ do str <- entryGetText entry store <- comboBoxGetModelText combo elems <- listStoreToList store comboBoxSetActive combo (-1) idx <- case (findIndex ((==) str) elems) of Just idx -> return idx Nothing -> listStoreAppend store str comboBoxSetActive combo idx return () containerAdd win combo widgetShowAll win mainGUI gtk-0.15.9/demo/menu/Makefile0000644000000000000000000000041307346545000014112 0ustar0000000000000000 PROGS = menudemo combodemo SOURCES = MenuDemo.hs ComboDemo.hs all : $(PROGS) menudemo : MenuDemo.hs $(HC_RULE) combodemo : ComboDemo.hs $(HC_RULE) HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc gtk-0.15.9/demo/menu/MenuDemo.hs0000644000000000000000000000455407346545000014531 0ustar0000000000000000module Main (main) where import Graphics.UI.Gtk {- widgets that go into making a menubar and submenus: * menu item (what the user wants to select) * menu (acts as a container for the menu items) * menubar (container for each of the individual menus) menuitem widgets are used for two different things: * they are packed into the menu * they are packed into the menubar, which, when selected, activates the menu Functions: * menuBarNew creates a new menubar, which can be packed into a container like a window or a box * menuNew creates a new menu, which is never actually shown; it is just a container for the menu items * menuItemNew, menuItemNewWithLabel, menuItemMenuWithMnemonic create the menu items that are to be displayed; they are actually buttons with associated actions Once a menu item has been created, it should be put into a menu with the menuShellAppend function. In order to capture when the item is selected by the user, the activate signal need to be connected in the usual way. -} createMenuBar descr = do bar <- menuBarNew mapM_ (createMenu bar) descr return bar where createMenu bar (name,items) = do menu <- menuNew item <- menuItemNewWithLabelOrMnemonic name menuItemSetSubmenu item menu menuShellAppend bar item mapM_ (createMenuItem menu) items createMenuItem menu (name,action) = do item <- menuItemNewWithLabelOrMnemonic name menuShellAppend menu item case action of Just act -> on item menuItemActivate act Nothing -> on item menuItemActivate (return ()) menuItemNewWithLabelOrMnemonic name | elem '_' name = menuItemNewWithMnemonic name | otherwise = menuItemNewWithLabel name menuBarDescr = [ ("_File", [ ("Open", Nothing) , ("Save", Nothing) , ("_Quit", Just mainQuit) ] ) , ("Help", [ ("_Help", Nothing) ] ) ] main = do initGUI window <- windowNew menuBar <- createMenuBar menuBarDescr set window [ windowTitle := "Demo" , containerChild := menuBar ] on window objectDestroy mainQuit widgetShowAll window mainGUI gtk-0.15.9/demo/notebook/0000755000000000000000000000000007346545000013330 5ustar0000000000000000gtk-0.15.9/demo/notebook/Makefile0000644000000000000000000000031607346545000014770 0ustar0000000000000000 PROGS = notebook SOURCES = Notebook.hs all : $(PROGS) notebook : Notebook.hs $(HC_RULE) HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc gtk-0.15.9/demo/notebook/Notebook.hs0000644000000000000000000001113107346545000015441 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Notebook demo (include Spinner animation). -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart module Main where import Control.Monad import Control.Monad.IO.Class import Data.Maybe import Data.Text (Text) import Data.Monoid ((<>)) import Graphics.UI.Gtk import qualified Data.Text as T (unpack) data NotebookTab = NotebookTab {ntBox :: HBox ,ntSpinner :: Spinner ,ntLabel :: Label ,ntCloseButton :: ToolButton ,ntSize :: Int} -- | Main main :: IO () main = do -- Init. initGUI -- Create window and notebook. window <- windowNew notebook <- notebookNew -- Set window. windowSetDefaultSize window 800 600 windowSetPosition window WinPosCenter set window [windowTitle := ("Press Ctrl + n to create new tab."::Text)] -- Handle key press action. window `on` keyPressEvent $ tryEvent $ do -- Create new tab when user press Ctrl+n [Control] <- eventModifier "n" <- eventKeyName liftIO $ do -- Create text view. textView <- textViewNew widgetShowAll textView -- must show before add notebook, -- otherwise notebook won't display child widget -- even have add in notebook. -- Create notebook tab. tab <- notebookTabNew (Just "Cool tab") Nothing menuLabel <- labelNew (Nothing :: Maybe Text) -- Add widgets in notebook. notebookAppendPageMenu notebook textView (ntBox tab) menuLabel -- Start spinner animation when create tab. notebookTabStart tab -- Stop spinner animation after finish load. timeoutAdd (notebookTabStop tab >> return False) 5000 -- Close tab when click button. ntCloseButton tab `onToolButtonClicked` do index <- notebookPageNum notebook textView index ?>= \i -> notebookRemovePage notebook i return () -- Show window. window `containerAdd` notebook widgetShowAll window on window objectDestroy mainQuit mainGUI -- | Create notebook tab. notebookTabNew :: Maybe Text -> Maybe Int -> IO NotebookTab notebookTabNew name size = do -- Init. let iconSize = fromMaybe 12 size box <- hBoxNew False 0 spinner <- spinnerNew label <- labelNew name image <- imageNewFromIcon "window-close" iconSize closeButton <- toolButtonNew (Just image) (Nothing::Maybe Text) -- Show. boxPackStart box label PackNatural 0 boxPackStart box closeButton PackNatural 0 widgetShowAll box return $ NotebookTab box spinner label closeButton iconSize -- | Set tab name. notebookTabSetName :: NotebookTab -> Text -> IO () notebookTabSetName tab = labelSetText (ntLabel tab) -- | Start spinner animation. notebookTabStart :: NotebookTab -> IO () notebookTabStart NotebookTab {ntBox = box ,ntSpinner = spinner ,ntSize = size} = do boxTryPack box spinner PackNatural (Just 0) (size `div` 2) spinnerStart spinner widgetShow spinner -- | Stop spinner animation. notebookTabStop :: NotebookTab -> IO () notebookTabStop NotebookTab {ntBox = box ,ntSpinner = spinner} = do containerTryRemove box spinner spinnerStop spinner -- | Create image widget with given icon name and size. imageNewFromIcon :: Text -> Int -> IO Image imageNewFromIcon iconName size = do iconTheme <- iconThemeGetDefault pixbuf <- do -- Function 'iconThemeLoadIcon' can scale icon with specified size. pixbuf <- iconThemeLoadIcon iconTheme iconName size IconLookupUseBuiltin case pixbuf of Just p -> return p Nothing -> error $ "imageNewFromIcon : search icon " <> T.unpack iconName <> " failed." imageNewFromPixbuf pixbuf -- | Try to packing widget in box. -- If @child@ have exist parent, do nothing, -- otherwise, add @child@ to @parent@. boxTryPack :: (BoxClass parent, WidgetClass child) => parent -> child -> Packing -> Maybe Int -> Int -> IO () boxTryPack box widget packing order space = do parent <- widgetGetParent widget when (isNothing parent) $ do boxPackStart box widget packing space order ?>= boxReorderChild box widget -- | Try to remove child from parent. containerTryRemove :: (ContainerClass parent, WidgetClass child) => parent -> child -> IO () containerTryRemove parent widget = do hasParent <- widgetGetParent widget unless (isNothing hasParent) $ containerRemove parent widget -- | Maybe. (?>=) :: Monad m => Maybe a -> (a -> m ()) -> m () m ?>= f = maybe (return ()) f m gtk-0.15.9/demo/statusicon/0000755000000000000000000000000007346545000013704 5ustar0000000000000000gtk-0.15.9/demo/statusicon/Makefile0000644000000000000000000000025007346545000015341 0ustar0000000000000000 PROG = statusIcon SOURCES = StatusIcon.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/demo/statusicon/StatusIcon.hs0000644000000000000000000000132507346545000016335 0ustar0000000000000000-- Simple StatusIcon example import Graphics.UI.Gtk main = do initGUI icon <- statusIconNewFromStock stockQuit statusIconSetVisible icon True statusIconSetTooltipText icon $ Just "This is a test" menu <- mkmenu icon on icon statusIconPopupMenu $ \b a -> do widgetShowAll menu print (b,a) menuPopup menu $ maybe Nothing (\b' -> Just (b',a)) b on icon statusIconActivate $ do putStrLn "'activate' signal triggered" mainGUI mkmenu s = do m <- menuNew mapM_ (mkitem m) [("Quit",mainQuit)] return m where mkitem menu (label,act) = do i <- menuItemNewWithLabel label menuShellAppend menu i on i menuItemActivated act gtk-0.15.9/demo/treelist/0000755000000000000000000000000007346545000013343 5ustar0000000000000000gtk-0.15.9/demo/treelist/Completion.hs0000644000000000000000000000512507346545000016013 0ustar0000000000000000-- Demo to show off entry completion. import Graphics.UI.Gtk import Data.Char import Data.List data ColorDesc = ColorDesc { cdColor :: Color, cdName :: String } deriving Show compareCol :: ColumnId ColorDesc String compareCol = makeColumnIdString 0 invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b) --Color (65535-r) (65535-g) (65535-b) parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name)) where s1 = dropWhile isSpace s (s2,s3) = span isDigit s1 s4 = dropWhile isSpace s3 (s5,s6) = span isDigit s4 s7 = dropWhile isSpace s6 (s8,s9) = span isDigit s7 n1 = read ('0':s2) n2 = read ('0':s5) n3 = read ('0':s8) c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3) name = dropWhile isSpace s9 upperToSpace [] = [] upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs | otherwise = x:upperToSpace xs main = do initGUI window <- windowNew contents <- readFile "rgb.txt" let killDups [] = [] killDups [x] = [x] killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs) | otherwise = x:killDups (y:xs) cols = killDups $ map parseColor (drop 1 (lines contents)) store <- listStoreNew cols customStoreSetColumn store compareCol cdName entry <- entryNew completion <- entryCompletionNew entrySetCompletion entry completion set completion [entryCompletionModel := Just store] cell <- cellRendererTextNew set cell [cellTextBackgroundSet := True, cellTextForegroundSet := True] cellLayoutPackStart completion cell True cellLayoutSetAttributes completion cell store (\cd -> [cellText := cdName cd, cellTextBackgroundColor := cdColor cd, cellTextForegroundColor := invertColor (cdColor cd)]) entryCompletionSetMatchFunc completion (matchFunc store) on completion matchSelected $ \model iter -> do color <- treeModelGetValue model iter compareCol entrySetText entry color return True set window [containerChild := entry] widgetShowAll window on window objectDestroy mainQuit mainGUI matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool matchFunc model str iter = do --putStrLn ("iter is "++show iter) tp <- treeModelGetPath model iter r <- case tp of (i:_) -> do row <- listStoreGetValue model i return $ any (isPrefixOf (map toLower str)) (words (map toLower (cdName row))) otherwise -> return False return r gtk-0.15.9/demo/treelist/DirList.hs0000644000000000000000000000421407346545000015252 0ustar0000000000000000{-# OPTIONS -cpp #-} -- Test file for the ListView widget. module Main(main) where import Graphics.UI.Gtk import Graphics.UI.Gtk.ModelView as New import Control.Exception import System.Directory import System.IO import System.Locale import Data.Time data FileInfo = FileInfo { fName :: String, fSize :: Integer, fTime :: UTCTime } main = do initGUI win <- windowNew on win objectDestroy mainQuit curDir <- getCurrentDirectory files <- getDirectoryContents curDir fInfos <- (flip mapM) files $ \f -> do s <- handle (\e -> #if __GLASGOW_HASKELL__>=610 case e :: SomeException of e -> #endif return 0) $ do h <- openFile f ReadMode s <- hFileSize h hClose h return s t <- getModificationTime f return FileInfo { fName = f , fSize = s , fTime = t } store <- New.listStoreNew fInfos tv <- New.treeViewNewWithModel store containerAdd win tv tvc <- New.treeViewColumnNew set tvc [ New.treeViewColumnTitle := "File name" , New.treeViewColumnResizable := True ] New.treeViewAppendColumn tv tvc name <- New.cellRendererTextNew New.treeViewColumnPackStart tvc name True New.cellLayoutSetAttributes tvc name store $ \FileInfo { fName = name } -> [ New.cellText := name ] tvc <- New.treeViewColumnNew set tvc [ New.treeViewColumnTitle := "Size" , New.treeViewColumnResizable := True ] New.treeViewAppendColumn tv tvc size <- New.cellRendererTextNew New.treeViewColumnPackStart tvc size True New.cellLayoutSetAttributes tvc size store $ \FileInfo { fSize = size } -> [ New.cellText := show size ] tvc <- New.treeViewColumnNew set tvc [ New.treeViewColumnTitle := "Modification time" , New.treeViewColumnResizable := True ] New.treeViewAppendColumn tv tvc time <- New.cellRendererTextNew New.treeViewColumnPackStart tvc time True New.cellLayoutSetAttributes tvc time store $ \FileInfo { fTime = time } -> [ New.cellText :=> return (formatTime defaultTimeLocale "%D %T" time) ] widgetShowAll win mainGUI gtk-0.15.9/demo/treelist/FilterDemo.hs0000644000000000000000000000435607346545000015741 0ustar0000000000000000-- a demo that shows how to create a normal tree view and a tree view in -- which only a chosen subset of rows are shown (namely those with upper case letters) module Main ( main ) where import Graphics.UI.Gtk import Data.List import Data.Char import Debug.Trace -- | Define a virtual column of the model that determines the visibility of a row in -- the model. visCol :: ColumnId String Bool visCol = makeColumnIdBool 0 main = do initGUI win <- windowNew on win objectDestroy mainQuit content <- readFile "FilterDemo.hs" -- create a view that shows all lines model <- listStoreNew (lines content) viewAll <- treeViewNewWithModel model col <- treeViewColumnNew ren <- cellRendererTextNew cellLayoutPackStart col ren True cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ] treeViewAppendColumn viewAll col -- create a view that only shows lines with upper case characters fModel <- treeModelFilterNew model [] -- create a virtual column 'visCol' that contains @True@ if a certain row has -- upper case letters. Then set this column to determine the visibility of a row. customStoreSetColumn model visCol (any isUpper) treeModelFilterSetVisibleColumn fModel visCol {- -- this is an alternative way to determine the visibility of a row. In this case, -- it is not necessary to create the column 'visCol'. treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do row <- treeModelGetRow model iter return (any isUpper row) -} -- note: it is important to insert the model into the view after the visibility -- row or the visibility function have been set. Otherwise, the view is filled -- first and setting a new visibility column/function will not update the view. viewFew <- treeViewNewWithModel fModel col <- treeViewColumnNew ren <- cellRendererTextNew cellLayoutPackStart col ren True cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ] treeViewAppendColumn viewFew col box <- vBoxNew False 0 swAll <- scrolledWindowNew Nothing Nothing containerAdd swAll viewAll boxPackStart box swAll PackGrow 4 swFew <- scrolledWindowNew Nothing Nothing containerAdd swFew viewFew boxPackEnd box swFew PackGrow 4 containerAdd win box widgetShowAll win mainGUI gtk-0.15.9/demo/treelist/ListDND.hs0000644000000000000000000002135007346545000015141 0ustar0000000000000000module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.Gdk.EventM import System.Glib.GObject ( toGObject ) import System.FilePath import Control.Concurrent.MVar import Control.Monad ( liftM ) import Control.Monad.Trans ( liftIO ) import Data.Maybe ( fromMaybe ) import Data.List ( findIndex ) roomStrCol :: ColumnId String String roomStrCol = makeColumnIdString 1 -- Define a string column and an image column on the store holding the -- computer types. compPicCol :: ColumnId CompType Pixbuf compPicCol = makeColumnIdPixbuf 1 compStrCol :: ColumnId CompType String compStrCol = makeColumnIdString 2 data Computer = Computer { name :: String, addr :: (Int, Int, Int, Int), roomStore :: ListStore String, roomSel :: Int, cType :: CompType } data CompType = MacBookPro | MacBook | Printer | MacPro | Xserve | IMac deriving (Enum, Bounded, Show) showCT :: CompType -> String showCT ct = case show ct of 'I':xs -> 'i':xs xs -> xs main = do initGUI win <- windowNew on win objectDestroy mainQuit -- create a tag that we use as selection, target and selection type compTypeTag <- atomNew "_CompType" let pNames = map ("resListDND" ) ["laptop.png","laptopSmall.png","printer.png", "tower.png","server.png","desktop.png"] pics <- mapM pixbufNewFromFile pNames smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48 True) pNames [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew [["Paul (Home)","John (Home)","Fred (Home)"], ["N12","S112", "S113", "S114"], ["Server Room Upstairs", "Server Room Downstairs"]] -- define extractor function for the string column treeModelSetColumn noRoom roomStrCol id treeModelSetColumn publicRoom roomStrCol id treeModelSetColumn restrictedRoom roomStrCol id let genRoomStore MacBookPro = noRoom genRoomStore MacBook = noRoom genRoomStore Printer = publicRoom genRoomStore MacPro = publicRoom genRoomStore Xserve = restrictedRoom genRoomStore IMac = publicRoom -- the initial computer list - it's a coincidence that there's -- one computer of each type content <- listStoreNewDND (map (\t -> Computer { name = showCT t, addr = (192,168,0,fromEnum t+1), roomStore = genRoomStore t, roomSel = 0, cType = t}) [minBound :: CompType .. maxBound]) (Just listStoreDefaultDragSourceIface) (Just DragDestIface { treeDragDestRowDropPossible = \store path@(i:_) -> do mCT <- selectionDataGet compTypeTag case mCT :: Maybe [Int] of Just [ct] -> return True Nothing -> (treeDragDestRowDropPossible listStoreDefaultDragDestIface) store path _ -> return False, treeDragDestDragDataReceived = \store path@(i:_) -> do mCT <- selectionDataGet compTypeTag case mCT of Just [ct] -> do let t = toEnum ct liftIO $ listStoreInsert store i Computer { name = showCT t, addr = (192,168,0,254), roomStore = genRoomStore t, roomSel = 0, cType = t } return True Nothing -> (treeDragDestDragDataReceived listStoreDefaultDragDestIface) store path }) -- the area with the possible computer types compTypes <- listStoreNewDND [minBound :: CompType .. maxBound] (Just DragSourceIface { treeDragSourceRowDraggable = \store (i:_) -> return True, treeDragSourceDragDataGet = \store (i:_) -> do ty <- selectionDataGetTarget ct <- liftIO $ listStoreGetValue store i selectionDataSet compTypeTag [fromEnum ct] return True, treeDragSourceDragDataDelete = \store path -> return True }) Nothing -- define extractor functions for the two column treeModelSetColumn compTypes compPicCol $ \t -> pics !! fromEnum t treeModelSetColumn compTypes compStrCol showCT -- create an icon view of all the computer types typesView <- iconViewNew set typesView [iconViewModel := Just compTypes, iconViewPixbufColumn := compPicCol, iconViewTextColumn := compStrCol, iconViewColumns := 6] -- create an editable list of computers inventory <- treeViewNewWithModel content tyCol <- treeViewColumnNew treeViewColumnSetTitle tyCol "Type" picRen <- cellRendererPixbufNew treeViewColumnPackStart tyCol picRen False cellLayoutSetAttributes tyCol picRen content (\Computer { cType = t} -> [cellPixbuf := smallPics !! fromEnum t]) tyRen <- cellRendererTextNew treeViewColumnPackStart tyCol tyRen False cellLayoutSetAttributes tyCol tyRen content (\Computer { cType = t} -> [cellText := showCT t]) treeViewAppendColumn inventory tyCol nameCol <- treeViewColumnNew treeViewColumnSetTitle nameCol "Name" treeViewColumnSetResizable nameCol True treeViewColumnSetMinWidth nameCol 100 nameRen <- cellRendererTextNew set nameRen [ cellTextEditable := True, cellTextEditableSet := True, cellTextEllipsize := EllipsizeEnd, cellTextEllipsizeSet := True] treeViewColumnPackStart nameCol nameRen True cellLayoutSetAttributes nameCol nameRen content (\Computer { name = n } -> [cellText := n]) treeViewAppendColumn inventory nameCol on nameRen edited $ \[i] str -> do val <- listStoreGetValue content i listStoreSetValue content i val { name = str } addrCol <- treeViewColumnNew treeViewColumnSetTitle addrCol "Address" oct1 <- cellRendererTextNew dot1 <- cellRendererTextNew oct2 <- cellRendererTextNew dot2 <- cellRendererTextNew oct3 <- cellRendererTextNew dot3 <- cellRendererTextNew oct4 <- cellRendererTextNew mapM_ (uncurry (cellLayoutPackStart addrCol)) [(oct1, True), (dot1, False), (oct2, True), (dot2, False), (oct3, True), (dot3, False), (oct4, True)] mapM_ (\d -> set d [cellText := ".", cellTextWidthChars := 0]) [dot1, dot2, dot3] mapM_ (\o -> set o [cellXAlign := 1.0, cellTextWidthChars := 3]) [oct1, oct2, oct3, oct4] cellLayoutSetAttributes addrCol oct1 content (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1]) cellLayoutSetAttributes addrCol oct2 content (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2]) cellLayoutSetAttributes addrCol oct3 content (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3]) cellLayoutSetAttributes addrCol oct4 content (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4]) treeViewAppendColumn inventory addrCol roomCol <- treeViewColumnNew treeViewColumnSetTitle roomCol "Room" treeViewColumnSetResizable roomCol True treeViewColumnSetSizing roomCol TreeViewColumnAutosize roomRen <- cellRendererComboNew set roomRen [ cellTextEditable := True, cellTextEditableSet := True, cellComboHasEntry := True ] treeViewColumnPackStart roomCol roomRen True cellLayoutSetAttributes roomCol roomRen content (\Computer { roomStore = t, roomSel = idx } -> [cellText :=> listStoreGetValue t idx, cellComboTextModel := (t, roomStrCol)]) on roomRen edited $ \[i] str -> do row@Computer { roomStore = t } <- listStoreGetValue content i elems <- listStoreToList t idx <- case (findIndex ((==) str) elems) of Just idx -> return idx Nothing -> listStoreAppend t str listStoreSetValue content i row { roomSel = idx } treeViewAppendColumn inventory roomCol -- make typesView a drag source for compTypeTag values tl <- targetListNew targetListAdd tl compTypeTag [TargetSameApp] 0 iconViewEnableModelDragSource typesView [Button1] tl [ActionCopy] -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler in -- the DND source handler is not called unless the IconView is also -- set to be a DND destination. Bugzilla 550528 tl <- targetListNew iconViewEnableModelDragDest typesView tl [] -- make the inventory widget a drag destination for compTypeTag values tl <- targetListNew targetListAdd tl compTypeTag [TargetSameApp] 0 targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 treeViewEnableModelDragDest inventory tl [ActionMove] tl <- targetListNew targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 treeViewEnableModelDragSource inventory [Button1] tl [ActionMove] -- Install drag and drop for permuting rows. This is now done above using -- the explicit target 'targetTreeModelRow'. Calling the function below -- will set a completely new 'TargetList' thereby removing our own -- 'compTypeTag' from the inventory widget's target list. --treeViewSetReorderable inventory True -- arrange the widgets v <- vPanedNew panedAdd1 v typesView panedAdd2 v inventory containerAdd win v widgetShowAll win mainGUI gtk-0.15.9/demo/treelist/ListDemo.hs0000644000000000000000000000376607346545000015433 0ustar0000000000000000module Main where import Control.Monad.IO.Class import Graphics.UI.Gtk import System.Glib.Signals (on) import Data.List ( isPrefixOf ) import Data.Char ( toLower ) data Phone = Phone { name :: String, number :: Int, marked :: Bool } main = do initGUI win <- windowNew on win objectDestroy mainQuit -- create a new list model model <- listStoreNew [Phone { name = "Foo", number = 12345, marked = False } ,Phone { name = "Bar", number = 67890, marked = True } ,Phone { name = "Baz", number = 39496, marked = False }] view <- treeViewNewWithModel model treeViewSetHeadersVisible view True -- add a couple columns col1 <- treeViewColumnNew col2 <- treeViewColumnNew col3 <- treeViewColumnNew treeViewColumnSetTitle col1 "String column" treeViewColumnSetTitle col2 "Int column" treeViewColumnSetTitle col3 "Bool column" renderer1 <- cellRendererTextNew renderer2 <- cellRendererTextNew renderer3 <- cellRendererToggleNew cellLayoutPackStart col1 renderer1 True cellLayoutPackStart col2 renderer2 True cellLayoutPackStart col3 renderer3 True cellLayoutSetAttributes col1 renderer1 model $ \row -> [ cellText := name row ] cellLayoutSetAttributes col2 renderer2 model $ \row -> [ cellText := show (number row) ] cellLayoutSetAttributes col3 renderer3 model $ \row -> [ cellToggleActive := marked row ] treeViewAppendColumn view col1 treeViewAppendColumn view col2 treeViewAppendColumn view col3 -- update the model when the toggle buttons are activated on renderer3 cellToggled $ \pathStr -> do let (i:_) = stringToTreePath pathStr val <- listStoreGetValue model i listStoreSetValue model i val { marked = not (marked val) } -- enable interactive search treeViewSetEnableSearch view True treeViewSetSearchEqualFunc view $ Just $ \str iter -> do (i:_) <- treeModelGetPath model iter row <- listStoreGetValue model i return (map toLower str `isPrefixOf` map toLower (name row)) containerAdd win view widgetShowAll win mainGUI gtk-0.15.9/demo/treelist/ListTest.glade0000644000000000000000000024371207346545000016125 0ustar0000000000000000 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 100 0 10 1 10 1 True List Test GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False True False True False False GDK_WINDOW_TYPE_HINT_NORMAL GDK_GRAVITY_NORTH_WEST True True False 0 True True GTK_POLICY_ALWAYS GTK_POLICY_ALWAYS GTK_SHADOW_IN GTK_CORNER_TOP_LEFT True True True False False True False False False 0 True True True False 0 8 True False 12 True True True 0 2 True 3 2 False 2 18 True True 1 0 True GTK_UPDATE_ALWAYS True False adjustment1 1 2 1 2 True True GTK_RELIEF_NORMAL True False False True 1 2 2 3 fill True String value: False False GTK_JUSTIFY_LEFT False False 1 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 1 0 1 True Number value: False False GTK_JUSTIFY_LEFT False False 1 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 1 1 2 True Boolean value: False False GTK_JUSTIFY_LEFT False False 1 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 1 2 3 True True True True 0 True * False 1 2 0 1 expand|shrink|fill True <b>Value</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True True 0 4 True False 2 True True 0 True True insert True GTK_RELIEF_NORMAL True 0 True True True new entry at False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment2 4 False False 0 True True True True 0 True True prepend True GTK_RELIEF_NORMAL True 0 True True True new entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False 0 True True True True 0 True True append True GTK_RELIEF_NORMAL True 0 True True True new entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False 0 True True True True 0 True True update True GTK_RELIEF_NORMAL True 0 True True True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment3 0 False False 0 True True True <b>Insert and Update</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True True 0 True False 2 4 True True 0 54 True True delete True GTK_RELIEF_NORMAL True 0 False False True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment4 0 False False True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False 0 True True 4 True True 0 True True clear True GTK_RELIEF_NORMAL True 0 False True True all False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False 0 True True True <b>Delete</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True False 0 4 True False 2 True True 0 54 True True move True GTK_RELIEF_NORMAL True 0 False False True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment5 0 True False True before False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment6 0 True False 0 False False True True 0 54 True True move True GTK_RELIEF_NORMAL True 0 False False True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment7 0 True False True after False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment8 0 True False 0 False False True <b>Move</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True False 0 4 True True 0 54 True True swap True GTK_RELIEF_NORMAL True 0 False False True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment9 0 False False True with False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True 1 0 False GTK_UPDATE_ALWAYS False False adjustment10 0 False False True <b>Swap</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True False 0 True <b>Reorder</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False 0 False False 0 False True gtk-0.15.9/demo/treelist/ListTest.hs0000644000000000000000000000674007346545000015461 0ustar0000000000000000module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.ModelView as New data Phone = Phone { name :: String, number :: Int, marked :: Bool } main = do initGUI gui <- builderNew builderAddFromFile gui "ListTest.glade" win <- builderGetObject gui castToWindow "window" on win objectDestroy mainQuit view <- builderGetObject gui castToTreeView "view" stringValue <- builderGetObject gui castToEntry "stringValue" intValue <- builderGetObject gui castToSpinButton "intValue" boolValue <- builderGetObject gui castToCheckButton "boolValue" insertButton <- builderGetObject gui castToButton "insert" prependButton <- builderGetObject gui castToButton "prepend" appendButton <- builderGetObject gui castToButton "append" updateButton <- builderGetObject gui castToButton "update" newIndex <- builderGetObject gui castToSpinButton "newIndex" updateIndex <- builderGetObject gui castToSpinButton "updateIndex" removeButton <- builderGetObject gui castToButton "remove" clearButton <- builderGetObject gui castToButton "clear" removeIndex <- builderGetObject gui castToSpinButton "removeIndex" -- create a new list store store <- storeImpl New.treeViewSetModel view store setupView view store let getValues = do name <- entryGetText stringValue number <- spinButtonGetValue intValue marked <- toggleButtonGetActive boolValue return Phone { name = name, number = floor number, marked = marked } let onClicked obj act = on obj buttonActivated $ act onClicked prependButton $ getValues >>= New.listStorePrepend store onClicked appendButton $ getValues >>= New.listStoreAppend store >> return () onClicked insertButton $ do value <- getValues index <- fmap floor $ spinButtonGetValue newIndex New.listStoreInsert store index value onClicked updateButton $ do value <- getValues index <- fmap floor $ spinButtonGetValue updateIndex New.listStoreSetValue store index value onClicked removeButton $ do index <- fmap floor $ spinButtonGetValue removeIndex New.listStoreRemove store index onClicked clearButton $ New.listStoreClear store New.treeViewSetReorderable view True -- containerAdd win view widgetShowAll win mainGUI setupView view model = do New.treeViewSetHeadersVisible view True -- add a couple columns renderer1 <- New.cellRendererTextNew col1 <- New.treeViewColumnNew New.treeViewColumnPackStart col1 renderer1 True New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] New.treeViewColumnSetTitle col1 "String column" New.treeViewAppendColumn view col1 renderer2 <- New.cellRendererTextNew col2 <- New.treeViewColumnNew New.treeViewColumnPackStart col2 renderer2 True New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] New.treeViewColumnSetTitle col2 "Int column" New.treeViewAppendColumn view col2 renderer3 <- New.cellRendererToggleNew col3 <- New.treeViewColumnNew New.treeViewColumnPackStart col3 renderer3 True New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] New.treeViewColumnSetTitle col3 "Check box column" New.treeViewAppendColumn view col3 storeImpl = New.listStoreNew [Phone { name = "Foo", number = 12345, marked = False } ,Phone { name = "Bar", number = 67890, marked = True } ,Phone { name = "Baz", number = 39496, marked = False }] gtk-0.15.9/demo/treelist/ListText.hs0000644000000000000000000000472407346545000015466 0ustar0000000000000000import Graphics.UI.Gtk import Data.Char import Data.List import Data.Maybe data RowInfo = RowInfo { rowString :: String, rowCase :: Maybe Bool } mkCase Nothing str = str mkCase (Just False) str = map toLower str mkCase (Just True) str = map toUpper str advCase Nothing = Just False advCase (Just False) = Just True advCase (Just True) = Nothing main :: IO () main = do unsafeInitGUIForThreadedRTS win <- windowNew win `on` objectDestroy $ mainQuit content <- readFile "ListText.hs" model <- listStoreNew (map (\r -> RowInfo r Nothing) (lines content)) view <- treeViewNewWithModel model -- add a column showing the index col <- treeViewColumnNew treeViewAppendColumn view col cell <- cellRendererTextNew cellLayoutPackStart col cell True cellLayoutSetAttributeFunc col cell model $ \(TreeIter _ n _ _) -> set cell [cellText := show n] set col [treeViewColumnTitle := "line", treeViewColumnReorderable := True ] -- add a column showing the line in the file col <- treeViewColumnNew treeViewAppendColumn view col set col [treeViewColumnTitle := "line in file", treeViewColumnReorderable := True ] cell <- cellRendererTextNew cellLayoutPackStart col cell True cellLayoutSetAttributes col cell model $ \row -> [cellText := mkCase (rowCase row) (rowString row)] -- add a column showing if it is forced to a specific case col <- treeViewColumnNew treeViewAppendColumn view col set col [treeViewColumnTitle := "case", treeViewColumnReorderable := True ] cell <- cellRendererToggleNew cellLayoutPackStart col cell True cellLayoutSetAttributes col cell model $ \row -> [cellToggleActive := fromMaybe False (rowCase row), cellToggleInconsistent := rowCase row==Nothing] cell `on` cellToggled $ \tpStr -> do let [i] = stringToTreePath tpStr row@RowInfo { rowCase = c } <- listStoreGetValue model i listStoreSetValue model i row { rowCase = advCase c } -- to annoy the user: don't allow any columns to be dropped at the far right treeViewSetColumnDragFunction view $ Just $ \_ rCol _ -> do return (rCol /= Nothing) treeViewSetSearchEqualFunc view $ Just $ \str (TreeIter _ n _ _) -> do row <- listStoreGetValue model (fromIntegral n) return (map toLower str `isPrefixOf` map toLower (filter isAlphaNum (rowString row))) swin <- scrolledWindowNew Nothing Nothing set swin [ containerChild := view ] set win [ containerChild := swin ] widgetShowAll win mainGUI gtk-0.15.9/demo/treelist/Makefile0000644000000000000000000000133707346545000015007 0ustar0000000000000000 PROGS = listdemo treedemo listtest treetest dirlist treesort completion \ listdnd filterdemo listtext SOURCES = ListDemo.hs TreeDemo.hs ListTest.hs TreeTest.hs DirList.hs \ TreeSort.hs Completion.hs ListDND.hs FilterDemo.hs ListText.hs all : $(PROGS) listdemo : ListDemo.hs $(HC_RULE) treedemo : TreeDemo.hs $(HC_RULE) listtest : ListTest.hs $(HC_RULE) treetest : TreeTest.hs $(HC_RULE) dirlist : DirList.hs $(HC_RULE) treesort : TreeSort.hs $(HC_RULE) completion : Completion.hs $(HC_RULE) listdnd : ListDND.hs $(HC_RULE) filterdemo : FilterDemo.hs $(HC_RULE) listtext : ListText.hs $(HC_RULE) HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc gtk-0.15.9/demo/treelist/TreeDemo.hs0000644000000000000000000000444107346545000015406 0ustar0000000000000000module Main where import Control.Monad.IO.Class import Graphics.UI.Gtk import Graphics.UI.Gtk.ModelView as New import qualified Data.Tree as Tree data Phone = Phone { name :: String, number :: Int, marked :: Bool } main = do initGUI win <- windowNew on win objectDestroy mainQuit -- create a new tree model model <- storeImpl view <- New.treeViewNewWithModel model New.treeViewSetHeadersVisible view True -- add three columns col1 <- New.treeViewColumnNew col2 <- New.treeViewColumnNew col3 <- New.treeViewColumnNew New.treeViewColumnSetTitle col1 "String column" New.treeViewColumnSetTitle col2 "Int column" New.treeViewColumnSetTitle col3 "Bool column" renderer1 <- New.cellRendererTextNew renderer2 <- New.cellRendererTextNew renderer3 <- New.cellRendererToggleNew New.cellLayoutPackStart col1 renderer1 True New.cellLayoutPackStart col2 renderer2 True New.cellLayoutPackStart col3 renderer3 True New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] New.treeViewAppendColumn view col1 New.treeViewAppendColumn view col2 New.treeViewAppendColumn view col3 containerAdd win view widgetShowAll win mainGUI storeImpl = New.treeStoreNew [Tree.Node { Tree.rootLabel = Phone { name = "Foo", number = 1, marked = False }, Tree.subForest = [leafNode Phone { name = "Bar", number = 11, marked = True } ,leafNode Phone { name = "Baz", number = 12, marked = False }] }, Tree.Node { Tree.rootLabel = Phone { name = "Foo", number = 2, marked = False }, Tree.subForest = [leafNode Phone { name = "Bar", number = 21, marked = True } ,leafNode Phone { name = "Baz", number = 22, marked = False }] }, Tree.Node { Tree.rootLabel = Phone { name = "Foo", number = 3, marked = False }, Tree.subForest = [leafNode Phone { name = "Bar", number = 31, marked = True } ,leafNode Phone { name = "Baz", number = 32, marked = False }] }] where leafNode a = Tree.Node { Tree.rootLabel = a, Tree.subForest = [] } gtk-0.15.9/demo/treelist/TreeSort.hs0000644000000000000000000000644707346545000015461 0ustar0000000000000000import Graphics.UI.Gtk import Graphics.UI.Gtk.ModelView as New import Data.Tree main = do initGUI win <- windowNew -- Create a tree model with some unsorted data. rawmodel <- New.treeStoreNew [Node ("zoo",8) [], Node ("foo",5) [], Node ("bar",20) [], Node ("baz",2) []] -- Create a sorting proxy model, that is, a model that permutates the -- rows of a different model such that they appear to be sorted. model <- New.treeModelSortNewWithModel rawmodel -- Define two sorting functions, one being the default sorting function and -- the other one being the sorting function for the 'SortColumnId' 2. -- 'SortColumnId's are arbitrary positive numbers, i.e., we could have chosen -- any other unique number. New.treeSortableSetDefaultSortFunc model $ Just $ \iter1 iter2 -> do (t1,_) <- New.treeModelGetRow rawmodel iter1 (t2,_) <- New.treeModelGetRow rawmodel iter2 return (compare t1 t2) New.treeSortableSetSortFunc model 2 $ \iter1 iter2 -> do (_,n1) <- New.treeModelGetRow rawmodel iter1 (_,n2) <- New.treeModelGetRow rawmodel iter2 return (compare n1 n2) -- Create the view. view <- New.treeViewNewWithModel model -- Create and insert two columns, one with the heading Name, one with the -- heading Number. Associate the 'SortColumnId' 2 with the latter column such -- that clicking on the Number header will sort the rows by the numbers. col <- New.treeViewColumnNew New.treeViewColumnSetTitle col "Name" rend <- New.cellRendererTextNew New.cellLayoutPackStart col rend True New.cellLayoutSetAttributeFunc col rend model $ \iter -> do cIter <- New.treeModelSortConvertIterToChildIter model iter (n,_) <- New.treeModelGetRow rawmodel cIter set rend [New.cellText := n] New.treeViewAppendColumn view col col' <- New.treeViewColumnNew New.treeViewColumnSetTitle col' "Number" rend <- New.cellRendererTextNew New.cellLayoutPackStart col' rend True New.cellLayoutSetAttributeFunc col' rend model $ \iter -> do cIter <- New.treeModelSortConvertIterToChildIter model iter (_,c) <- New.treeModelGetRow rawmodel cIter set rend [New.cellText := show c] New.treeViewAppendColumn view col' New.treeViewColumnSetSortColumnId col' 2 -- Create a button that shows information on the current state of the sorting -- settings. button <- buttonNewWithLabel "Dump Info" on button buttonActivated $ do sId <- New.treeViewColumnGetSortColumnId col putStrLn ("tvc1 sort id is "++show sId) sId <- New.treeViewColumnGetSortColumnId col' putStrLn ("tvc2 sort id is "++show sId) sId <- New.treeSortableGetSortColumnId model putStrLn ("sort id is "++show sId) -- Show all entries of the proxy model let recurse Nothing = return () recurse (Just iter) = do cIter <- New.treeModelSortConvertIterToChildIter model iter row <- New.treeModelGetRow rawmodel cIter putStrLn ("iter "++show cIter++": "++show row) mIter <- New.treeModelIterNext model iter recurse mIter mIter <- New.treeModelGetIterFirst model recurse mIter -- Put it all together. vBox <- vBoxNew False 3 -- boxPackStartDefaults vBox view boxPackStart vBox view PackRepel 0 boxPackEnd vBox button PackNatural 0 containerAdd win vBox widgetShowAll win on win objectDestroy mainQuit mainGUI gtk-0.15.9/demo/treelist/TreeTest.glade0000644000000000000000000016204407346545000016107 0ustar0000000000000000 100 0 10 1 10 1 True Tree Test GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False True False True False False GDK_WINDOW_TYPE_HINT_NORMAL GDK_GRAVITY_NORTH_WEST True False True False 0 True True GTK_POLICY_ALWAYS GTK_POLICY_ALWAYS GTK_SHADOW_IN GTK_CORNER_TOP_LEFT True True True False False True False False False 0 True True 8 True False 12 True True True 0 2 True 3 2 False 4 18 True True 1 0 True GTK_UPDATE_ALWAYS True False adjustment1 1 2 1 2 True True GTK_RELIEF_NORMAL True False False True 1 2 2 3 fill True True True True 0 True * False 1 2 0 1 expand|shrink|fill True Number value: False False GTK_JUSTIFY_LEFT False False 1 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 1 1 2 True String value: False False GTK_JUSTIFY_LEFT False False 1 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 1 0 1 True Boolean value: False False GTK_JUSTIFY_LEFT False False 1 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 1 2 3 True <b>Value</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True True 0 True 2 3 False 4 2 True True insert True GTK_RELIEF_NORMAL True 0 1 0 1 fill True new entry at False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 1 2 0 1 fill True True True True 0 True * False 10 2 3 0 1 True True update True GTK_RELIEF_NORMAL True 0 1 1 2 fill True entry at False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 1 2 1 2 fill True True True True 0 True * False 10 2 3 1 2 True <b>Insert and Update</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True True 0 True 2 3 False 4 2 54 True True delete True GTK_RELIEF_NORMAL True 0 1 0 1 fill True True clear True GTK_RELIEF_NORMAL True 0 1 1 2 fill True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 1 2 0 1 fill True all False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 1 2 1 2 fill True True True True 0 True * False 10 2 3 0 1 True <b>Delete</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True False 0 True 2 5 False 4 2 54 True True move True GTK_RELIEF_NORMAL True 0 1 0 1 fill 54 True True move True GTK_RELIEF_NORMAL True 0 1 1 2 fill True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 1 2 0 1 fill True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 1 2 1 2 fill True before False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 3 4 0 1 fill True after False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 3 4 1 2 fill True True True True 0 True * False 10 2 3 0 1 True True True True 0 True * False 10 4 5 0 1 True True True True 0 True * False 10 2 3 1 2 True True True True 0 True * False 10 4 5 1 2 True <b>Move</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True False 0 4 True False 2 54 True True swap True GTK_RELIEF_NORMAL True 0 False False True entry False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True True True 0 True * False 10 0 True True True with False False GTK_JUSTIFY_LEFT False False 0 0.5 4 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False True True True True True 0 True * False 10 0 True True True <b>Swap</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False True True False 0 True <b>Reorder</b> False True GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 PANGO_ELLIPSIZE_NONE -1 False 0 0 False False 0 False True gtk-0.15.9/demo/treelist/TreeTest.hs0000644000000000000000000000756207346545000015450 0ustar0000000000000000module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.ModelView as New import qualified Data.Tree as Tree data Phone = Phone { name :: String, number :: Int, marked :: Bool } main = do initGUI gui <- builderNew builderAddFromFile gui "TreeTest.glade" win <- builderGetObject gui castToWindow "window" on win objectDestroy mainQuit view <- builderGetObject gui castToTreeView "view" stringValue <- builderGetObject gui castToEntry "stringValue" intValue <- builderGetObject gui castToSpinButton "intValue" boolValue <- builderGetObject gui castToCheckButton "boolValue" insertButton <- builderGetObject gui castToButton "insert" updateButton <- builderGetObject gui castToButton "update" newPath <- builderGetObject gui castToEntry "newPath" updatePath <- builderGetObject gui castToEntry "updatePath" removeButton <- builderGetObject gui castToButton "remove" clearButton <- builderGetObject gui castToButton "clear" removePath <- builderGetObject gui castToEntry "removePath" -- create a new list store store <- storeImpl New.treeViewSetModel view store setupView view store let getValues = do name <- entryGetText stringValue number <- spinButtonGetValue intValue marked <- toggleButtonGetActive boolValue return Phone { name = name, number = floor number, marked = marked } on insertButton buttonActivated $ do value <- getValues path <- fmap read $ get newPath entryText New.treeStoreInsert store (init path) (last path) value on updateButton buttonActivated $ do value <- getValues path <- fmap read $ get updatePath entryText New.treeStoreSetValue store path value on removeButton buttonActivated $ do path <- fmap read $ get removePath entryText New.treeStoreRemove store path return () on clearButton buttonActivated $ New.treeStoreClear store New.treeViewSetReorderable view True widgetShowAll win mainGUI setupView view model = do New.treeViewSetHeadersVisible view True -- add three columns col1 <- New.treeViewColumnNew col2 <- New.treeViewColumnNew col3 <- New.treeViewColumnNew New.treeViewColumnSetTitle col1 "String column" New.treeViewColumnSetTitle col2 "Int column" New.treeViewColumnSetTitle col3 "Bool column" renderer1 <- New.cellRendererTextNew renderer2 <- New.cellRendererTextNew renderer3 <- New.cellRendererToggleNew New.cellLayoutPackStart col1 renderer1 True New.cellLayoutPackStart col2 renderer2 True New.cellLayoutPackStart col3 renderer3 True New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := name row ] New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := show (number row) ] New.cellLayoutSetAttributes col3 renderer3 model $ \row -> [ New.cellToggleActive := marked row ] New.treeViewAppendColumn view col1 New.treeViewAppendColumn view col2 New.treeViewAppendColumn view col3 storeImpl = New.treeStoreNew [Tree.Node { Tree.rootLabel = Phone { name = "Foo", number = 1, marked = False }, Tree.subForest = [leafNode Phone { name = "Bar", number = 11, marked = True } ,leafNode Phone { name = "Baz", number = 12, marked = False }] }, Tree.Node { Tree.rootLabel = Phone { name = "Foo", number = 2, marked = False }, Tree.subForest = [leafNode Phone { name = "Bar", number = 21, marked = True } ,leafNode Phone { name = "Baz", number = 22, marked = False }] }, Tree.Node { Tree.rootLabel = Phone { name = "Foo", number = 3, marked = False }, Tree.subForest = [leafNode Phone { name = "Bar", number = 31, marked = True } ,leafNode Phone { name = "Baz", number = 32, marked = False }] }] where leafNode a = Tree.Node { Tree.rootLabel = a, Tree.subForest = [] } gtk-0.15.9/demo/treelist/resListDND/0000755000000000000000000000000007346545000015316 5ustar0000000000000000gtk-0.15.9/demo/treelist/resListDND/desktop.png0000644000000000000000000001761607346545000017510 0ustar0000000000000000‰PNG  IHDRTbÎHôqRiCCPICC Profilexœ•—y8”íÛÇÏ{ ccì[ÙE$»=Kö%R †aÆÌR!)”,EÑFѦ´‘Vª‡H¶E‘ì¥%˼ zŸ÷x~¿ã=ÿ:¯ë8—ëºû󽎀_ÌŸF£  <‚Iwµ1'lóö!`:NàCÀú2hfÎÎð¯6Ý@›º?F™×ž§ßmÊõºo0Jž=óïy€£oóö@Ô@(xÙß B˾;ífÒ˜H†øxP£»»Z —¼ìW.`Ù¯\t`0éàˆ ’#0c&D#§D"#0— €ZN%à«@9Fgà‡@}›·aùÈÛÓ´Å8íïí>P^ ¼õ÷žÜ=€¢£¿÷&]D¤™´Q ¬9{‹5©€ÉXÌb±æ‹X¬Å lïª)Qôè•ï… ÿm½|çcCPˆÄs›Ê{WáÏÈÌ:.|Bä„hžXU²`MÔé:B”lÑÚ rÍ {K”ZUö©^[×®ž´þºF׆CZ·7~Ð9¢[¡×kaøÀhÀ8Çä‰éˆY®ù3‹¯VùÖµ6¶çì^ÚOo-rlrjqnqiu]p¿êñֳݫc[§zû-ß÷;ºwöø}Øõ1xŸØOú4<2D¦< ÿñ•:Nûù>Á˜bNEýˆžÞ=3;÷sÏBüÂÞÅý* o“¨d¶ƒèöC‡1©œi\éÜGxŽb3xá2ù²ðÙü9ÇOå 牜=%–/^ qZòÌš³Rç¤ÏËŠd/¬½(W,_¢pIé²Òå«*×T¯–R®«ÝP/Ó¸©ykÃí w´îj—ëTèVLß‹®Ô»¯ÿÀð¡Ñ£M7=1~²Tµ¿ÚôéægfÏÍÿ²¨A×$×Z½°®³©·}iÛÀÝþʾѡɱ×|¬Å¹Õåµk›@[ö··îí"y^oëòy'ñ®à½o·oÏŽÒÎ}ôëÝÕ'ÛWô) ?ð3q@a d0h(x8dDeäêhèXØÊWõ¯7Æ#¾Q¿Ó&6LÜž¤O1~0§u¦+f¢gcæbÆÎÎ?\س¿d¼ô„Å@äP8Ô7¶ô5öŽxL0§;—·6V‰W 'Ê'†ãPTÒvÙ)ÊË/“h–”Ö• &œ”}!‡È+D*ÞRWQV¥¬{¨Î¶ÞL#K³WKecŠv‡®ªM¿ÆPÔ(fÓ+Sêægæò{,[­¥mb¶<¶³ßà@Úz±ÕçbããVìþÆ“Ûkó¶Hï3>µÛÇwÈìtò‹ÛUä_0L&™m Þrž\Ú6.±ŽjI ‰Œ§g2Š˜åQuÑïvÄLDZíá'ìUÛ§³s‚}¢SÒö»’I))ÌCôà © iÒSdMÏÈ?v*3/++ûtNöñÜ's/ç]:yãÔåüke§yt¶æÜ«ó­…mEmÚ.¾+î/¼Ôwùó•ñ«ß¯—~½>qc¼lôæØ­ÁÛ½wúîv•·VÔß«®¼w¿ìÁé‡Ù‡?Ù^e_½é©ê3gsÏ?þõ²ænmÎ z[½îKÉ—¬†®WwÓš|šåšZî´î}mÕ†kë~sþmhûÆöÅŽÆÎœ¿wt©tM¾{ð>©Û¾G¨§çÕŒ^£>tßËOÇûw~Vú<6ð`0qÈnXx¸{äâ(eLgléKý×ìñíßä¿}¿3?i3%0Õù£xš:c0Ë6ûb.ëçöy¹ù/ ‹ K¶,  1¨86#¶è½ì¦ìU‰˜ƒœÖœ5\)܇xÒ°vØÞ£¸£|x'|3¦@¶`ŽPŽ°»ð‘\Ñ\±“âù’kNKùJuKŸ“9O(”-\[(wAþ¢B±b‰Ò%åË*WTɪ#뮪•ª__C£Lóæ†[Z·7ÞѾ«S¡[¡W¡£?kðÀðÑÃMŒ›ì3Y2­Ú\möÔü™ÅsËd+´Uu­Í‹-u¶õv/íÓ°¯¶6:695;gºà]Z]_»µ¹¿ñh÷ÌõñêØÖéý·O×ö_Iß÷;ºw~ðû¸ë£a€l@_à'b?ésPI°â²‚„Ž„]£¨QÆþ—ŠLþR‘ÊXýع¸Ÿ{æãö.î[ÚÏJ„$Ô/%ÁƤr¦Ö§Ù¥óÁÅfðãËÄgñÿÒ‘<Ñ“b+Z²æO-)ê»xQ®X¾Dñ’⪚”ª]W¿±þ-ÙX®]¡sO¯Rï¾þƒ‡FŒozbReò‡ŽXÕZ¿°®³©ßòÒ¶ÁþUtÓÚfÇçVç×.m{ߪ¶{vxu&ui¼óyŸÒ³ñCj¯Nß‘~â€Ñ`Ö0y4ô eœú=mÊgúØ\ú¢+‹°üöpèä®ðÌp+HY ä rÀ™ÀÝPìÒ€2¦bg¼ú~x‚õ`ÞÀ€L¸ ³±GbËH2ˆâCÙ QQ lÆl‰lµl hY´7ºýƒÝšý {û8‡ G!ÇFã‹ỷá4àLæå2ä¢rUs«s'pWòàxyþÆ a#°C¼V¼x{qþ¸g|l|A|cx|.~‘?•BÀP XPO°Xp\ÈOhF˜,\!²Nä…hF쪸‚ønñ)‰3’6’“kÎKÉKÅK#Òå2¡YB—ìñµk×&ÈñÉ5Ëg)x(J(ö)]S¶P¾¢b®Ê¯Ú»îŽÚ!ußõ5°ƒšm(ÒJÚHÔ¶ÑQÓÔ]ÐÐÏ3ÀTÞ4*ÜtÜø°É~ÓÝ›#Í(æd‹Ë«0ëæ–=¶ÉvÇì ®l­t¬wzïüÝã&í®ïáæIóÊØvûÅgÒWl‡ÉÎ ¿Ì]ý‡E‰6¤Ø R²X¨sX¥&E5£%F>gp0í£²cäc©qâ¹÷úì+ÝÏJtOFôM¹wX052­õ艌¹L¿¬ÚãùyŒ“ŸòÝ jÎÞ8¯Pxæ‚h þRÆÜÕc×óʤn^¼­^nYÑZéÿûcÑ'¥ÕæÏ™5|µ¥uv iêM­-Ñmµoi’uï»;?¤õšö—‡d†»¾xŽ‹|ë˜ÈŸò››+ŸßÏc±Ü *` Û N@%ô DñC2*d¥ŠòCå£Þ°ñ±me;ÂÖˆæE;¡O ß±ØÉì7Ùg9,8ŽqüQÀDažs p9+¹x¸|¹np£¹wrßåáæ ä©Â ciØF^UÞ£¼c8\/•¯¿‘ÇÍÿNÀZà– A0[pIˆ!ôE8TxD„"2!Ê‹GÄHHH\•4¬]ã¹fX*AZ\ºBÆEf„"«([·6BNTî‰| Vá©b„’ŒÒkåTs•EÕ‡ëâÕŒÕfÔ«ÖÖp×”ÕßP¥•µ1TÛRGZg^÷­Þ}ý3‰†ÁF^›Œ5LdM6£ÍØÌ&Ì¿[Œ[ŽZ XOÚŒnùa‡²rݺÁÑÄÉÉÙÕ%Ì5Ö­Àý¶Ç+Ïw^ ÞB>Û}#wœÚYã7èÏ BÌ'U} Q!“BóÂÞ†KFxP hCteF4³>Zj7#æeœÜžŒø‘}Þûëu“Š“f8œ›&–^pT'£)“”õ3çè ½ÜÏ'Ï懞ö8«rž½pì³âòK§®¤\ ¼î[f}KÿŽvùú{ê÷•*‰6L¾<ÚÿUâ[ÐÄÙ©幈ùŠ%„ÅÀƒ˜ƒ7dÂMx½Êþ*÷ËÔ£ùÐÞèìÖìù+¼/a|9e8“9G¹Ü¹ª¹Õ¹Oóàxyf°Ø!^"Î÷‰/ˆo ÏÀ/ò§ ˆ ê ¾òšÎüÅ´£øÔ ÏÎÒˆtù Ë.Ë$¯p­bþ'ÿ ^á÷µAµáÍßìþ&÷ß¹ýOÔ÷’ÅBÿImt×?¹Mºú'¹G´~“›Ë±ÊîƒUz/æ¬ò[*°JðÊU†X¦øi×*Çõà i¯þjÌmjm‰~-ÕVû–Ö~³#¥³®+ú½bwX凴^Ó¾CŸúK?O´ É ‡ØŽ*a¾x~-Oùü}Ë„ê$Ïäש–w¦sgÜgÆf“çÌ*ý˜ß¿ ¶pv‘1yqfé"+ÅXž—€Û‚J¡Ò –ÿe¸ûÿZ8%jµ°d¦­;@KÝÚÌ ?"ÀÑ EÃÊmÅ×"[Û.ç"v4¦³;ˆ >q!î^€@è¡þvÎ+~BÅÑD "ÉÒj%÷"=ÊÕä»aT{WÀ ¤Õ^ýŒh·Õøi¢¿¥=¬@qÄ…X8.Ç£Ö‚X€% ¨@*Ð õtð‡ ÀG @ Ð `‚?DA €dˆ„( HÀXÉ è` þ@‡` úJ‡ÿÛÇúäÿA"PýÈIôðÛAÑ'©±†ž!š×4‡5€°mÿ«# "~UZî°ºF+¢µÐ:hs´1Úm´ZÔÑÚh}´Úm„ÖA4ÝûUÕâ× ¿*ö‚ÿqVu C4€a0t÷#'ý΃åY€pÚ  jvOÂ?ÿ+&)† `A¥ÅÒÉÁ!L‚F!,¨á´(&‰®F°\¯FÐÒÔÔøt-f§M\ÂV÷IDATxœí]klÇ}ÿÍÞÞÞ‹<ŠY±¬WÝÊLmGOZeÙ1§-”O KµÒÀ®æ‹ƒÀ°ƒ6P$ê@.îj^0‚€"5PX •raS¦T»f$Û­CK–MQI‘<ÞíÎäÃÞìÍÎÍÌÎé– íò,övwfvæ·ÿ×ÌìÎKXÂþ´ŽHÇ7RÎb33Åõ&$Á¯;õç?+$ªÀ„½¸Q$ê®4Htd„cqû¬A$“¢A"EØ^~¬$VGAH`€sÿý÷wìÝ¿ÿ+Ÿ¿ãŽ­¹œ× Œ±Ï"™!¬øÓïž{÷ìÑ_üâß^yå• 5âDÇ ’PQ"]îãO<ñõ}ì=´pÕ_¼Øqïvô-ï}ñĉ=333`!©öTRÆÉÌðvìÚÕûòþùXoOÏxûí·11q”ÒjÂïŽã T*bëÖ­ß÷«ß:øí}ÿøÒK'Tø¥µ&ç•%”KgDêòîî¾å½}k`dd^>›6-\k &''1ôŸCعs'¼¬çyž× ÀCCÕ„|ÅÔÞQ”%ª|n~~¦@eW®^Á­·Þº°-Y$èêêB¥Zo{­ZÍ( Ô\Í‘€fB¹çvê³µj-Ë/²Ä(ì³Ïó0??˜¯Vs%4‹xÄCbØAF—àôð0Þ…_­¶SïlŸS<]^ÐehŠÒåkw¬_/>ø`tÚ!$º yàdf£âT6T´£n@õ„ž›o¾©»œ™ñX÷›ósr:ÑYRJ•åÈùyº ›6Å( 7ß÷eÉT†º°)"•4´^|:PI—é<€ˆ(R—‘8™\áò9Ñ!raŒ‰¥ýô*‘Ê#ÄY¸ÞD¢R­%2D)”IÒ‘(?Œèš¹.¢ i Q©|¼ ¤Ó#JRaÕoY*ùu›‡`’PÓyKiÁä”R!”RÞ[–~^n”J¥E˜Ì†IõMyÒX Ö‚ʉÑõ¬L=.4IÏ£Ry1½lXÝù$ ‘T+Bo$þ´Uq:©TIŠ¨¤î°$1€QFí °“PKFuªÉÕ>)îš|^&#əʲQ÷V`E( ~÷º‰4pµ³Å4¦ÐHõ ´€¢}4í·€¡QØd° ­å*¢u×[õÞò5“=®+ÚE‚VÂF;B ïò7¬S-S(Ä={+ùmC¥V¼ºMÙ­¢m•ç•cEñ|T†Ác‹¿u6O—Δ¾âän*GP𞢠R ›lœeÒ垎­ µI'‡Qbzۇ釤­òÊ —®â­ª˜ÊùÈeËåµj™LŒˆ±¡Ñàˆ‡VOÃÓÉ’dÚ$yù¤úÆÊ^L*/CQ8’<¯*Ÿ*lLyT×T¦& ×d甘qX«‘Î<üÕ”ÞÖŽÉåØzs±N7êÍùˆ-Ú’P†øˆPt^ã\T×´ek$O—Ð(«Ò›4¢¤êå[Q7ñš*\ž®wÄÓêî«òòª1Ô4ÈlGøà€|Sƒ£à{iÕ¥3™‰‰ku×¢cUÏmAG4Ð=uùšxœ¤’&)×ý¶1¼Ž6yb $Ü,ѶʛHMR¤+·U‡eÓIÐåÑyyJiKoÉØyy]†¥‘Dß2©¹,ñº8Õä`’" ¹~JÒ™:>Õ!§¤ªH«êeÙ—ó›ÆVM¦Æ¤9iaAúòiÛF6é’ÊK2'7= ê#Q¦°ÄÔèÄA_MžvLˆŽP•—omõ”’ìR«yZ•.b$)4@¾ÙPc©vXðYO•ä%¥•ëÒÉáé2™“4Ñvjã厩Ç#ÿ¶ééî ‡¤:˜LA»°Tùú J‘T1•êÙŽD©Î«Â'©1=pѱ¶ÕÛn1_¡Å®§âšÁîñ½ÍÛ"&›§K«º¿¨â¦º)¡"ýMízÂÐ0ÝÓ×5T%5íØ]Uyª’´‘ÚðÎþ™ˆóñ*•Jt\ç!aU• 3ÒÙéÙÙÙ™™éb©Ô¹e`+Þxýud2î‚/å0==]-•JP­Î#—˃QŠ¹J¥ÚQ*y yo~Ïm÷n cÕùù â‹X/@ –Kßzë­ñSC§þýK_~h ÜsOÊÕWãð‹/¾·¬«ëŽG}4Ã(ƒOüèÈ‘ùeÝÝcû÷ïÿƒ›R‰:†‡‡O ŸCƒP&mdA(èPرcÇûÿìÀ¾m÷l»¯ÜÑQf7ay ?èOò“ /~„Õ«WçÞݲySvÏž=·é¾mJ•Jeöô›#ÃGŽ9:tâĘ0  `Õ¢Š¨– â„暯ï»î¼ûîÕËÊånJi–RšE‹Ji†ÂXø-%aŒ9¬ñ ߶nݺ|ðÁ™ÞÞÞ×[Æ!Œðß@‰©¢­3‘«J ææç&ÏŽœý?„Ä͸VßW’Z…¤ú*B£Å’é!”Ö"Âð]Ô¿¥ç¶¬¤˜ŽßƒçÏÖÏ9ù|>÷Õ¯}íW­\Ù½bÅŠr­VÛÚÓÓóûSÓÓïúµÚéñññ©ÆÆ&~úã¿„/núhØ´Z½q\j´áÜøõ7 à:BÉäËcTå²u„:‰ËÕ[@Hn®~ÞEãË\[ð´œÈˆÄ 6,ü‰Ç·oÙ´eÃïÝ~ûݽ==]@ó}âþ“ññ+ï¿÷Þ[o¼ñÆ™—þá¥ÿzÿÝ÷§ÐX „¢ÙyØ’*¦¯!”N¾çÒ{#¡ü'”oBBÅð3†2teŠËy›7oîyþùçÿt``à+„ˆD¢yŸˆÚâÇd“““WO ýëwž}öççÏŸŸDc9 îDø‡F6¤ò4Rê#Nl lM 5Àï {ñ{ñ¤²ø9ñ!dŠÅbñg/ÿì/¶ ì-—Ë="‰:RU]Nydbbâ“S§N½|àÀ#hH‘hçš$J‚x?ñ¡$®Ûd’.ÕÊbVߌ ×xº,B)ÏìÝ»wí³Ï=÷ýuk×Þë8á3á{ $ÑqœH £–*úä2¡|;þü¯<ø“'O~ŒP¢8©ÜÞÉf@¶ÅV&D»ü¤È=^h Ùä›F&ä…^Øþä“OþÝçV¬¸K'‰2¹ðÚk¯áÌ™3X¿~}L‚U#\Œ1tww¯Ûµk×ÅrñÌÐÉ¡Ð ’ÛX¹Î¾¡-ü·2îl…P‘Lñ·L¬ÎÄÈ<|øð÷ìÙó÷·p²8y*{IÁÇŒ±±1<õÔS8vìúûû±fÍí 8˜Ïç{¾p×êîî~íøñãÑ T$JÜ›6+2{/-‹½N:ùÓæjEdžyæ™;wïÞýƒ|>ßiy?Àìì,V®\‰£GÂó<ÌÍ͵’Åb±wß¾}‡{ì±u¨›4V± 6i›5™@ú«+Šqe@n÷îÝŸûÞ÷¿÷ó¾Þ¾Ï;ŽƒL&Çq¢MvH":55…«W¯¢P(€R ×uÑ×ק æƒÉADÇA€RŠK—. 8pà‰sçÎ}‚0ŽäË­‰?5Ò÷þ<ÌÊ¿úê«Óßß¿_$Q&Te7¸=5½z#Î ‰ÄŠäž>}úŸ~øáCƒs„¦†$Ú Äø5 ÿÜ_=·íÁüK×u3bH$;$‘DÕç96ÓrX%ŸëêêZ?5;{ììÈÈ4ûÔÐJO' b/Ëÿ£/ýñ·\×õÄ·ÄðFVW N¢Í,¦ª.™bº\.×ñè#|uS„†Måv5¤)¡±^Õw}÷Ë;wÜ÷M®Ò*©Ô©7O£‚ØË*¯Û‚ @GGÇíAœ¾ µãiiI¨(€ì† ›v%ÍhŠDpbQÊuÁ½lSë÷vB|QÀT—>Në…[±‹éÈ.ïëÛÉ&/â„$_ž˜ŸD&ƒŒè Ìó0Æ¢W·úJhÀ8Á²®e12E’o[µê>?D|\‚B±è -•–Ç{ú駸g`àϹ'šùߌ¡Ï#“É ›ÍÂób¡€B¡€R±ˆÎÎN”Ëe”ŠEäóyäêé\×…ëºÈ8™F´P•ñÚµk(‹1ÛÊ5Àuݾñ+ãÿ1úÎ(_S™ù)š–ÊÇ–^½ví¼r\ÈCµÖ´Ò.€fGr9‰qP©± ‡Ì–Íw¡y(2µOS壓R¡p W1ß÷›x¨Ã~]´¹²ÃQÙZUÀóø¾m¼¬R©ÐõRòm#mBÃQ÷B¡7jµ²ÙlD!]å2fff"S@ŽCàf\A…åàžò>;cð”†65PÆ@t•Ë1©äÒ͉îì(÷¡1À- CÛh—P±2üigr9¯Ç÷}¸®5Œ‚L&½ºS(P*•¢‚äÐÊQÅ/ðD‰æDú¾#Š…BÔÚ¶cJó³šhœ”11À–{1\êc‘<°…ê ÑÌpUá•TçE6ÂÐÞäÔÔØm+WFp¾ïG w]7"“ï9Z•PQRe5Iíô¥K—þ)ó"Ú ›Äø“/Gî:„\Û¸qãý¹\®CœŽnn]×w—{>\ªÅÑq"¹šs|xáÂÙC‡ýprrò:Â™Ì £Nm”¤IhôW£££³/^éééñ …B·çy%•–?xHz³Y=99uùòå‰ß|øá¥W~ùËÿ¹~ý:'Kæ,·@fm iÊEÄ7Nø['ü rˆÏ¤èBR‡C׳‡åªÌ¥9Wßfê{qä¾-¤å”ø !÷ôóhô‘yEçÑ/UÔM¯éXÞWÞ‹ó@œ(N¨øN’h;SsPiÊ!ª oŸBæ¯îDÿÓ³”šHeÒo‘y‚M|›D|ÄGãí¤ùzk¤-¡r£ªˆ¿(!vd2M/JèîÉ÷ºMžæDŠ³Ÿ¾T^[HsN)ÖŸGümñE Ûÿ·3ܲ7Ö‘+OóYY‘ìÔFš€ô{q4*-¾m¢“J•Ê·B¨îþòk3òK ©÷iÏzêî!˜DfÒy@M„LLÚ‚ôŽDÜ BmÑŠ •I[4Hs’®],¦‡»„%,a KX§¿æ¥ô ²… IEND®B`‚gtk-0.15.9/demo/treelist/resListDND/laptop.png0000644000000000000000000001675107346545000017335 0ustar0000000000000000‰PNG  IHDRƒ`>MÁJRiCCPICC Profilexœ•—y8”íÛÇÏ{ ccì[ÙE$»=Kö%R †aÆÌR!)”,EÑFѦ´‘Vª‡H¶E‘ì¥%˼ zŸ÷x~¿ã=ÿ:¯ë8—ëºû󽎀_ÌŸF£  <‚Iwµ1'lóö!`:NàCÀú2hfÎÎð¯6Ý@›º?F™×ž§ßmÊõºo0Jž=óïy€£oóö@Ô@(xÙß B˾;ífÒ˜H†øxP£»»Z —¼ìW.`Ù¯\t`0éàˆ ’#0c&D#§D"#0— €ZN%à«@9Fgà‡@}›·aùÈÛÓ´Å8íïí>P^ ¼õ÷žÜ=€¢£¿÷&]D¤™´Q ¬9{‹5©€ÉXÌb±æ‹X¬Å lïª)Qôè•ï… ÿm½|çcCPˆÄs›Ê{WáÏÈÌ:.|Bä„hžXU²`MÔé:B”lÑÚ rÍ {K”ZUö©^[×®ž´þºF׆CZ·7~Ð9¢[¡×kaøÀhÀ8Çä‰éˆY®ù3‹¯VùÖµ6¶çì^ÚOo-rlrjqnqiu]p¿êñֳݫc[§zû-ß÷;ºwöø}Øõ1xŸØOú4<2D¦< ÿñ•:Nûù>Á˜bNEýˆžÞ=3;÷sÏBüÂÞÅý* o“¨d¶ƒèöC‡1©œi\éÜGxŽb3xá2ù²ðÙü9ÇOå 牜=%–/^ qZòÌš³Rç¤ÏËŠd/¬½(W,_¢pIé²Òå«*×T¯–R®«ÝP/Ó¸©ykÃí w´îj—ëTèVLß‹®Ô»¯ÿÀð¡Ñ£M7=1~²Tµ¿ÚôéægfÏÍÿ²¨A×$×Z½°®³©·}iÛÀÝþʾѡɱ×|¬Å¹Õåµk›@[ö··îí"y^oëòy'ñ®à½o·oÏŽÒÎ}ôëÝÕ'ÛWô) ?ð3q@a d0h(x8dDeäêhèXØÊWõ¯7Æ#¾Q¿Ó&6LÜž¤O1~0§u¦+f¢gcæbÆÎÎ?\س¿d¼ô„Å@äP8Ô7¶ô5öŽxL0§;—·6V‰W 'Ê'†ãPTÒvÙ)ÊË/“h–”Ö• &œ”}!‡È+D*ÞRWQV¥¬{¨Î¶ÞL#K³WKecŠv‡®ªM¿ÆPÔ(fÓ+Sêægæò{,[­¥mb¶<¶³ßà@Úz±ÕçbããVìþÆ“Ûkó¶Hï3>µÛÇwÈìtò‹ÛUä_0L&™m Þrž\Ú6.±ŽjI ‰Œ§g2Š˜åQuÑïvÄLDZíá'ìUÛ§³s‚}¢SÒö»’I))ÌCôà © iÒSdMÏÈ?v*3/++ûtNöñÜ's/ç]:yãÔåüke§yt¶æÜ«ó­…mEmÚ.¾+î/¼Ôwùó•ñ«ß¯—~½>qc¼lôæØ­ÁÛ½wúîv•·VÔß«®¼w¿ìÁé‡Ù‡?Ù^e_½é©ê3gsÏ?þõ²ænmÎ z[½îKÉ—¬†®WwÓš|šåšZî´î}mÕ†kë~sþmhûÆöÅŽÆÎœ¿wt©tM¾{ð>©Û¾G¨§çÕŒ^£>tßËOÇûw~Vú<6ð`0qÈnXx¸{äâ(eLgléKý×ìñíßä¿}¿3?i3%0Õù£xš:c0Ë6ûb.ëçöy¹ù/ ‹ K¶,  1¨86#¶è½ì¦ìU‰˜ƒœÖœ5\)܇xÒ°vØÞ£¸£|x'|3¦@¶`ŽPŽ°»ð‘\Ñ\±“âù’kNKùJuKŸ“9O(”-\[(wAþ¢B±b‰Ò%åË*WTɪ#뮪•ª__C£Lóæ†[Z·7ÞѾ«S¡[¡W¡£?kðÀðÑÃMŒ›ì3Y2­Ú\möÔü™ÅsËd+´Uu­Í‹-u¶õv/íÓ°¯¶6:695;gºà]Z]_»µ¹¿ñh÷ÌõñêØÖéý·O×ö_Iß÷;ºw~ðû¸ë£a€l@_à'b?ésPI°â²‚„Ž„]£¨QÆþ—ŠLþR‘ÊXýع¸Ÿ{æãö.î[ÚÏJ„$Ô/%ÁƤr¦Ö§Ù¥óÁÅfðãËÄgñÿÒ‘<Ñ“b+Z²æO-)ê»xQ®X¾Dñ’⪚”ª]W¿±þ-ÙX®]¡sO¯Rï¾þƒ‡FŒozbReò‡ŽXÕZ¿°®³©ßòÒ¶ÁþUtÓÚfÇçVç×.m{ߪ¶{vxu&ui¼óyŸÒ³ñCj¯Nß‘~â€Ñ`Ö0y4ô eœú=mÊgúØ\ú¢+‹°üöpèä®ðÌp+HY ä rÀ™ÀÝPìÒ€2¦bg¼ú~x‚õ`ÞÀ€L¸ ³±GbËH2ˆâCÙ QQ lÆl‰lµl hY´7ºýƒÝšý {û8‡ G!ÇFã‹ỷá4àLæå2ä¢rUs«s'pWòàxyþÆ a#°C¼V¼x{qþ¸g|l|A|cx|.~‘?•BÀP XPO°Xp\ÈOhF˜,\!²Nä…hF쪸‚ønñ)‰3’6’“kÎKÉKÅK#Òå2¡YB—ìñµk×&ÈñÉ5Ëg)x(J(ö)]S¶P¾¢b®Ê¯Ú»îŽÚ!ußõ5°ƒšm(ÒJÚHÔ¶ÑQÓÔ]ÐÐÏ3ÀTÞ4*ÜtÜø°É~ÓÝ›#Í(æd‹Ë«0ëæ–=¶ÉvÇì ®l­t¬wzïüÝã&í®ïáæIóÊØvûÅgÒWl‡ÉÎ ¿Ì]ý‡E‰6¤Ø R²X¨sX¥&E5£%F>gp0í£²cäc©qâ¹÷úì+ÝÏJtOFôM¹wX052­õ艌¹L¿¬ÚãùyŒ“ŸòÝ jÎÞ8¯Pxæ‚h þRÆÜÕc×óʤn^¼­^nYÑZéÿûcÑ'¥ÕæÏ™5|µ¥uv iêM­-Ñmµoi’uï»;?¤õšö—‡d†»¾xŽ‹|ë˜ÈŸò››+ŸßÏc±Ü *` Û N@%ô DñC2*d¥ŠòCå£Þ°ñ±me;ÂÖˆæE;¡O ß±ØÉì7Ùg9,8ŽqüQÀDažs p9+¹x¸|¹np£¹wrßåáæ ä©Â ciØF^UÞ£¼c8\/•¯¿‘ÇÍÿNÀZà– A0[pIˆ!ôE8TxD„"2!Ê‹GÄHHH\•4¬]ã¹fX*AZ\ºBÆEf„"«([·6BNTî‰| Vá©b„’ŒÒkåTs•EÕ‡ëâÕŒÕfÔ«ÖÖp×”ÕßP¥•µ1TÛRGZg^÷­Þ}ý3‰†ÁF^›Œ5LdM6£ÍØÌ&Ì¿[Œ[ŽZ XOÚŒnùa‡²rݺÁÑÄÉÉÙÕ%Ì5Ö­Àý¶Ç+Ïw^ ÞB>Û}#wœÚYã7èÏ BÌ'U} Q!“BóÂÞ†KFxP hCteF4³>Zj7#æeœÜžŒø‘}Þûëu“Š“f8œ›&–^pT'£)“”õ3çè ½ÜÏ'Ï懞ö8«rž½pì³âòK§®¤\ ¼î[f}KÿŽvùú{ê÷•*‰6L¾<ÚÿUâ[ÐÄÙ©幈ùŠ%„ÅÀƒ˜ƒ7dÂMx½Êþ*÷ËÔ£ùÐÞèìÖìù+¼/a|9e8“9G¹Ü¹ª¹Õ¹Oóàxyf°Ø!^"Î÷‰/ˆo ÏÀ/ò§ ˆ ê ¾òšÎüÅ´£øÔ ÏÎÒˆtù Ë.Ë$¯p­bþ'ÿ ^á÷µAµáÍßìþ&÷ß¹ýOÔ÷’ÅBÿImt×?¹Mºú'¹G´~“›Ë±ÊîƒUz/æ¬ò[*°JðÊU†X¦øi×*Çõà i¯þjÌmjm‰~-ÕVû–Ö~³#¥³®+ú½bwX凴^Ó¾CŸúK?O´ É ‡ØŽ*a¾x~-Oùü}Ë„ê$Ïäש–w¦sgÜgÆf“çÌ*ý˜ß¿ ¶pv‘1yqfé"+ÅXž—€Û‚J¡Ò –ÿe¸ûÿZ8%jµ°d¦­;@KÝÚÌ ?"ÀÑ EÃÊmÅ×"[Û.ç"v4¦³;ˆ >q!î^€@è¡þvÎ+~BÅÑD "ÉÒj%÷"=ÊÕä»aT{WÀ ¤Õ^ýŒh·Õøi¢¿¥=¬@qÄ…X8.Ç£Ö‚X€% ¨@*Ð õtð‡ ÀG @ Ð `‚?DA €dˆ„( HÀXÉ è` þ@‡` úJ‡ÿÛÇúäÿA"PýÈIôðÛAÑ'©±†ž!š×4‡5€°mÿ«# "~UZî°ºF+¢µÐ:hs´1Úm´ZÔÑÚh}´Úm„ÖA4ÝûUÕâ× ¿*ö‚ÿqVu C4€a0t÷#'ý΃åY€pÚ  jvOÂ?ÿ+&)† `A¥ÅÒÉÁ!L‚F!,¨á´(&‰®F°\¯FÐÒÔÔøt-f§M\ÂVRIDATxœí][GþªgöâõãÄÆ­…È͉ÈDØB²x0É ¯ ~O¼ðøü¿aƒä ¤„]¬HE2v$_∠8 özõx/Ó]uê{¥i¢µVZë–!†RJ'I’©$Ñÿ}xÿÞê_Wÿƒ|~²â£)ª0ƒBÎsæ~ùë_]]Y9y*’N‹±¾¾þð™Åg~võOW¯Ø)’£¥CfHŠzsKKKû8øüÒÒR$™ubaaáÐáC_û>€[ER¿ø¶mˆ ª2CÀ\–e ºPsÝ.îÞ¹­hLû õЦ1—Z—û¨³ ºè÷0«|ÏÒ±Ûs:­µiZÚ³’ì»AšÎÿ£ê¶¯‰<²}§-t–•îðÆP°»»;`9#5¥*b˜Áf„€­õ" û`kko]}kð@Y–•®•RÈŠ‡qó€òÀ¹ßT·œ•g·ÇM¯.×&G—ªKÕãúaYŒ`òö<€—_yÐï÷ 3ì"g€>"QÕ›èèj­†Æ¢.Mœ;î¤rƒî~»e¨òíP]®×–›F­|›Q©~¸é¥gφeÒœÛ )†Þ±’Áv'çŠÏ £iš²«ÒÀ4MK÷¾'™pŠNh‚¸¶¸‰Œ• nj,¨2¾gVJ•¾ Ͳ.rfxŠ|^mW_¤*ªz €ÒZ'ÃÞúE:%-¸o·¬drݪ߄J$Ç 1*ÉGË~þ$I÷fò‡}´˜-Ë:(Çy¢Ýû*j–¦ƒNºo_»+Å7ðn5¸R5!û’ò¡ËxÔ½½òÍÄé鶛—/Ñ;ðWÕf€Û¨FYMĬ°XféYi›Üjå0Ô¦®-Ö -¥Ô`Âí•Ï1 ]ÃÖ@U5á^ç"VlŒÈ®¢&ì¶í¤Mwr}ýõµIIj"Ýþ…h„T#µ+©Šq$C ¾ÉˆY­€œyê`³©‰”´éÖõå¹×Ü3øhØR¥)ÔÈ ÃÁäôlˆ¸R+¾|n’C}¢êrmúʹ׶š°¯í<! Rjc6ƒ ©‘f—q¢Šu.Ñín·¿óRt]š.=*ß×y¹ie«_!}ïË“–«CMÄ´åÖ³W2%ÆݾÙn¡D’Øiv½¦UE’_Mu« ‰È‰z £ú Bû™Üçs'žjî'U>wº.Ôg3 ~UKEw¬š 0V2p–»Ô­~.SC³ jµb†ÒZk¾M&*zÈ© >Õä–áÔH˜XœA2A!7’c©IÝS¶Måh„ž‘+#‘PNÊH™q0ñ8§C’Dj+¸ \;.Zy”Š@R}ò•aøÌQÕ‚h$Î`PǾ‚t£H½£èºýðµÅÑ·ûAÙBºœÇ0[Þ„‰š Ò|†ž¤® n¿Z†’9=n—ñ B  d[ M½Íà3þ|ÛÏTšO­Ä2’oåºi”qèÞÇ¡œQé‹œúúm§ÍÔF•Ï> ò¨´Í`×ãVGlyNrÄ¡1ù±t›’K†5mtÓ(#ѾÑó„î³P+Tb†&™3B)V7• ”ç› ø '*„k˜[×ÀP<@jϸ®j©Z£Þ‘ôiZ]K;è4Žé’ogÐÀ>YlêKžÊ§V¼MSz@E"qBâßíËÌy±jBzhEâø¶ŽÍ}ÈõtiPíPû’$çâNö,èä–³¿ÝkÉ>„›ÏÝ»4¨r\ß8º¾:±ÒJÄ45›naK Bß½›Fm2qâצAµÅ¥Qt¹DHj™òMu ö£òùµ_2¸ù£tF'Cz:(&Ïî[ˆ‘8ºTš¯¿®ë"$ šf¤Æ·pÆ_U ÛmÃ|sÒBzpD"Áìz>wÖ…ÏŽJ‹IH”‰PÆb耩ërùl ©ñç{¦#”ë#U?òžyo‚{€ºàŽ€‘¾vE[$$q¸~KëqanªL¨=7¯nFiT2ØàlÐDVÙp²Ó(>)kÔ6½’¸–ƒ4ÆŒñ·«®’_ÕÝ“†…%Ï’(T¹¦6¬ÙÂ6ŠÖ*">æ­%_?8W‘“P!攪ÉqÊ4F·ø0Ö:—n!ÆŠ@R+QrVqšã!4*x_üðMZ¬Î映JÜ€ë+åJUFa†â £Ò V7Aœ]`oTI&óï)‰bNKsíû*#¥13‡[´¢Ôêw參›ÚPªÃX´õ½x› (º!cOR¦*ºÑ¸Í0RŠX™¡“ÅÒ­cª sÏV±»u#º¥e÷J]4tââôn™PLc‚HE § u¨“qÐèéhNüÅXý\üB"bcGUcUËŨ‹™±Yœžb‚Ðægprmpj¢Å(9IÝ»×ö…Ü3N2Hó$ q‚EMI .zÏ@Bn¸p'˜¨òv=.˜%Ù®®këx\¾ šÌØH›KC†›;éÔÊŒ@RyãD ë`”˜DÕü:Ѹšðˆá¾´I»‡’ò1Æm]}ª« ƒÐÖ±}OÑ´¯÷Ê ¬#R(qm÷‚€ þƒ¯rÙ8×/Æ5šs›Š6Æö©)LÌ›pÓ|œ$ék»iƒPjÌÕѽ@­áèÁ•`Uû¼Šàm}á4N`hô]K÷Ú-+ÕûãlKÊŒCC"-Bîã´ ‘·°©WÍbÝá5É­c ³À@Ã{îµ/-äJ¶Ž%.¦[nÜ­ã/›ZÙ³dHMT1Ò$n›”Vl™IF ›Â8ÌàJ2HN5‹*ï Ô…)‘̼„0®d4ÜíI…ö¼ÄÆtc&dÞǬ!–4PúåõÁh9òu\¼x±œ8RóƒjÁèa,_™f˜~f8¹r’J¶¥CT«J—)°µ½…‹¿x³"¹ãB)•!ÿ ì ÎÜHAù•A÷ûýÝ'Ož|15àñãÇ;>ÿüãqéĘÝóÈ ýË|çÔ+ß>yâÅ3iš.½~úôÊþååE­ubä}–eƒ6cqk=¸ž$ÜŸñ±û`òÆé—MߥC=sÔ8(5§¿wïÞÃÛ·oô`}ý£kkkðÀòGïŸBÃRª&rf0e>7ß¿þï›ï_¿rìر¯½öÚϳ~ÿY€FÚ*7ORÈ°s‡mí<É[]Ü™ _?múÝnI§3’7¨GïOÓtÄ%Ít( K Ì×wžëI¯wûòåË°e‘µ£¼‹¡J Á±¥ÂðÐr‰`$ÃÒÙ³gO~î¹/-.¾ÚétŽw:}J)¥µVZk¥~ãøq,//[Í„·ãB;ÛòæcŸã ¹v µÝï‹â»£ûççç¿ùüñã¿¿téÒÇJ³àKw™ÁVsæ?þôÓ­óß¹ž&fHœA³ËP×ÿ|ï=¬­­ ‚I)·‡ 5’N/;†7‹@šim<²Žñ Ø™@m¥•õèQ¥zy†vÓJìn·®JõŸòÉ€E§ðH,‚b — ]‹›ëë‡ÝgEœ\YÁ£(]ÿ­'FÒÒ,ÿnÜD¯×Ë´ïí=rk¦‘d BÐSÂ¥ýòK/aÿò2667 7þw‘Û¦x ”š°Bݺuk{uu5ʨ+w^f°…Þuð½/•2J)á²o¾>îîîâƃ¶M¹¯<ˆÃ‡ Ò|cC퓾¯Aõ“Ë£ Þ'››x¼±±ýwß}ˆ\Ú'Ög>›aGX]]ýìܹs׎=z:ÔA©_N³çææòN'†ªl8q;©\ß춹Wõm«ŸÊsÓÆñBl›ˆêχ~øÖÛo¿ýÃß wîMÀ¢‹<ʸÀWöíÛwðõÓ§š(õæºÝw³,ëxhLŒ‰]-U9BÊ?zžeËišþIòÁÎÎί­­]é÷û=ä‘É/Ç vŠOÉ£piàRX@Î ‹–<[|›à“WÜ´Ø3˜øA†|²Ÿx‚<øô…u½ƒÜ~(‰(JM‚iQÉèšN‘ÞEÎnìõ˵¹?[°µa†>rfxŠáäÛA§‘ùò1ƒ.*í"gS±¡™jõðà ;È%ÁnqÝŽv™Á>§  BFBìå!’8õZì ÜEi&Ûf³°t Ï;ø$0ôG Ñ>Ê›W-¦6C¤ÖwÌÁn Û¨Š 9dJ…³Û>0¶„>fpõŠ n)랪Óbòð-NÍ|Z´hÑ¢E‹-Z´hÑ¢FüW™JŠ¿œìIEND®B`‚gtk-0.15.9/demo/treelist/resListDND/laptopSmall.png0000644000000000000000000001705607346545000020325 0ustar0000000000000000‰PNG  IHDRs`.MÓRiCCPICC Profilexœ•—y8”íÛÇÏ{ ccì[ÙE$»=Kö%R †aÆÌR!)”,EÑFѦ´‘Vª‡H¶E‘ì¥%˼ zŸ÷x~¿ã=ÿ:¯ë8—ëºû󽎀_ÌŸF£  <‚Iwµ1'lóö!`:NàCÀú2hfÎÎð¯6Ý@›º?F™×ž§ßmÊõºo0Jž=óïy€£oóö@Ô@(xÙß B˾;ífÒ˜H†øxP£»»Z —¼ìW.`Ù¯\t`0éàˆ ’#0c&D#§D"#0— €ZN%à«@9Fgà‡@}›·aùÈÛÓ´Å8íïí>P^ ¼õ÷žÜ=€¢£¿÷&]D¤™´Q ¬9{‹5©€ÉXÌb±æ‹X¬Å lïª)Qôè•ï… ÿm½|çcCPˆÄs›Ê{WáÏÈÌ:.|Bä„hžXU²`MÔé:B”lÑÚ rÍ {K”ZUö©^[×®ž´þºF׆CZ·7~Ð9¢[¡×kaøÀhÀ8Çä‰éˆY®ù3‹¯VùÖµ6¶çì^ÚOo-rlrjqnqiu]p¿êñֳݫc[§zû-ß÷;ºwöø}Øõ1xŸØOú4<2D¦< ÿñ•:Nûù>Á˜bNEýˆžÞ=3;÷sÏBüÂÞÅý* o“¨d¶ƒèöC‡1©œi\éÜGxŽb3xá2ù²ðÙü9ÇOå 牜=%–/^ qZòÌš³Rç¤ÏËŠd/¬½(W,_¢pIé²Òå«*×T¯–R®«ÝP/Ó¸©ykÃí w´îj—ëTèVLß‹®Ô»¯ÿÀð¡Ñ£M7=1~²Tµ¿ÚôéægfÏÍÿ²¨A×$×Z½°®³©·}iÛÀÝþʾѡɱ×|¬Å¹Õåµk›@[ö··îí"y^oëòy'ñ®à½o·oÏŽÒÎ}ôëÝÕ'ÛWô) ?ð3q@a d0h(x8dDeäêhèXØÊWõ¯7Æ#¾Q¿Ó&6LÜž¤O1~0§u¦+f¢gcæbÆÎÎ?\س¿d¼ô„Å@äP8Ô7¶ô5öŽxL0§;—·6V‰W 'Ê'†ãPTÒvÙ)ÊË/“h–”Ö• &œ”}!‡È+D*ÞRWQV¥¬{¨Î¶ÞL#K³WKecŠv‡®ªM¿ÆPÔ(fÓ+Sêægæò{,[­¥mb¶<¶³ßà@Úz±ÕçbããVìþÆ“Ûkó¶Hï3>µÛÇwÈìtò‹ÛUä_0L&™m Þrž\Ú6.±ŽjI ‰Œ§g2Š˜åQuÑïvÄLDZíá'ìUÛ§³s‚}¢SÒö»’I))ÌCôà © iÒSdMÏÈ?v*3/++ûtNöñÜ's/ç]:yãÔåüke§yt¶æÜ«ó­…mEmÚ.¾+î/¼Ôwùó•ñ«ß¯—~½>qc¼lôæØ­ÁÛ½wúîv•·VÔß«®¼w¿ìÁé‡Ù‡?Ù^e_½é©ê3gsÏ?þõ²ænmÎ z[½îKÉ—¬†®WwÓš|šåšZî´î}mÕ†kë~sþmhûÆöÅŽÆÎœ¿wt©tM¾{ð>©Û¾G¨§çÕŒ^£>tßËOÇûw~Vú<6ð`0qÈnXx¸{äâ(eLgléKý×ìñíßä¿}¿3?i3%0Õù£xš:c0Ë6ûb.ëçöy¹ù/ ‹ K¶,  1¨86#¶è½ì¦ìU‰˜ƒœÖœ5\)܇xÒ°vØÞ£¸£|x'|3¦@¶`ŽPŽ°»ð‘\Ñ\±“âù’kNKùJuKŸ“9O(”-\[(wAþ¢B±b‰Ò%åË*WTɪ#뮪•ª__C£Lóæ†[Z·7ÞѾ«S¡[¡W¡£?kðÀðÑÃMŒ›ì3Y2­Ú\möÔü™ÅsËd+´Uu­Í‹-u¶õv/íÓ°¯¶6:695;gºà]Z]_»µ¹¿ñh÷ÌõñêØÖéý·O×ö_Iß÷;ºw~ðû¸ë£a€l@_à'b?ésPI°â²‚„Ž„]£¨QÆþ—ŠLþR‘ÊXýع¸Ÿ{æãö.î[ÚÏJ„$Ô/%ÁƤr¦Ö§Ù¥óÁÅfðãËÄgñÿÒ‘<Ñ“b+Z²æO-)ê»xQ®X¾Dñ’⪚”ª]W¿±þ-ÙX®]¡sO¯Rï¾þƒ‡FŒozbReò‡ŽXÕZ¿°®³©ßòÒ¶ÁþUtÓÚfÇçVç×.m{ߪ¶{vxu&ui¼óyŸÒ³ñCj¯Nß‘~â€Ñ`Ö0y4ô eœú=mÊgúØ\ú¢+‹°üöpèä®ðÌp+HY ä rÀ™ÀÝPìÒ€2¦bg¼ú~x‚õ`ÞÀ€L¸ ³±GbËH2ˆâCÙ QQ lÆl‰lµl hY´7ºýƒÝšý {û8‡ G!ÇFã‹ỷá4àLæå2ä¢rUs«s'pWòàxyþÆ a#°C¼V¼x{qþ¸g|l|A|cx|.~‘?•BÀP XPO°Xp\ÈOhF˜,\!²Nä…hF쪸‚ønñ)‰3’6’“kÎKÉKÅK#Òå2¡YB—ìñµk×&ÈñÉ5Ëg)x(J(ö)]S¶P¾¢b®Ê¯Ú»îŽÚ!ußõ5°ƒšm(ÒJÚHÔ¶ÑQÓÔ]ÐÐÏ3ÀTÞ4*ÜtÜø°É~ÓÝ›#Í(æd‹Ë«0ëæ–=¶ÉvÇì ®l­t¬wzïüÝã&í®ïáæIóÊØvûÅgÒWl‡ÉÎ ¿Ì]ý‡E‰6¤Ø R²X¨sX¥&E5£%F>gp0í£²cäc©qâ¹÷úì+ÝÏJtOFôM¹wX052­õ艌¹L¿¬ÚãùyŒ“ŸòÝ jÎÞ8¯Pxæ‚h þRÆÜÕc×óʤn^¼­^nYÑZéÿûcÑ'¥ÕæÏ™5|µ¥uv iêM­-Ñmµoi’uï»;?¤õšö—‡d†»¾xŽ‹|ë˜ÈŸò››+ŸßÏc±Ü *` Û N@%ô DñC2*d¥ŠòCå£Þ°ñ±me;ÂÖˆæE;¡O ß±ØÉì7Ùg9,8ŽqüQÀDažs p9+¹x¸|¹np£¹wrßåáæ ä©Â ciØF^UÞ£¼c8\/•¯¿‘ÇÍÿNÀZà– A0[pIˆ!ôE8TxD„"2!Ê‹GÄHHH\•4¬]ã¹fX*AZ\ºBÆEf„"«([·6BNTî‰| Vá©b„’ŒÒkåTs•EÕ‡ëâÕŒÕfÔ«ÖÖp×”ÕßP¥•µ1TÛRGZg^÷­Þ}ý3‰†ÁF^›Œ5LdM6£ÍØÌ&Ì¿[Œ[ŽZ XOÚŒnùa‡²rݺÁÑÄÉÉÙÕ%Ì5Ö­Àý¶Ç+Ïw^ ÞB>Û}#wœÚYã7èÏ BÌ'U} Q!“BóÂÞ†KFxP hCteF4³>Zj7#æeœÜžŒø‘}Þûëu“Š“f8œ›&–^pT'£)“”õ3çè ½ÜÏ'Ï懞ö8«rž½pì³âòK§®¤\ ¼î[f}KÿŽvùú{ê÷•*‰6L¾<ÚÿUâ[ÐÄÙ©幈ùŠ%„ÅÀƒ˜ƒ7dÂMx½Êþ*÷ËÔ£ùÐÞèìÖìù+¼/a|9e8“9G¹Ü¹ª¹Õ¹Oóàxyf°Ø!^"Î÷‰/ˆo ÏÀ/ò§ ˆ ê ¾òšÎüÅ´£øÔ ÏÎÒˆtù Ë.Ë$¯p­bþ'ÿ ^á÷µAµáÍßìþ&÷ß¹ýOÔ÷’ÅBÿImt×?¹Mºú'¹G´~“›Ë±ÊîƒUz/æ¬ò[*°JðÊU†X¦øi×*Çõà i¯þjÌmjm‰~-ÕVû–Ö~³#¥³®+ú½bwX凴^Ó¾CŸúK?O´ É ‡ØŽ*a¾x~-Oùü}Ë„ê$Ïäש–w¦sgÜgÆf“çÌ*ý˜ß¿ ¶pv‘1yqfé"+ÅXž—€Û‚J¡Ò –ÿe¸ûÿZ8%jµ°d¦­;@KÝÚÌ ?"ÀÑ EÃÊmÅ×"[Û.ç"v4¦³;ˆ >q!î^€@è¡þvÎ+~BÅÑD "ÉÒj%÷"=ÊÕä»aT{WÀ ¤Õ^ýŒh·Õøi¢¿¥=¬@qÄ…X8.Ç£Ö‚X€% ¨@*Ð õtð‡ ÀG @ Ð `‚?DA €dˆ„( HÀXÉ è` þ@‡` úJ‡ÿÛÇúäÿA"PýÈIôðÛAÑ'©±†ž!š×4‡5€°mÿ«# "~UZî°ºF+¢µÐ:hs´1Úm´ZÔÑÚh}´Úm„ÖA4ÝûUÕâ× ¿*ö‚ÿqVu C4€a0t÷#'ý΃åY€pÚ  jvOÂ?ÿ+&)† `A¥ÅÒÉÁ!L‚F!,¨á´(&‰®F°\¯FÐÒÔÔøt-f§M\ÂV—IDATxœí]MŒÝÔþ®ß{ó›IæÍLˆ ¨R’ª©TÉ¢¥‹ ºè6Y …P©Ê¦Ý J•X¥» Ô"Uˆ ± ]E*ªÔEY !U „ !Ù ”&d:¿/3¶o~ÇïøøÜkûÍÜd†¼Oql___Û÷óùιÇ~c`„Fa„€0;´­;v« lÔF´MíÝi Sl‘Эt>‘g´Ø2/Á Ëæ)€B©¬ÚCžH„ŒÀ@táw~<»oß4MMš¦&‰ãˆ*¦i:"•!Š"Ë—W——W^|ñÅ¿½û6‘HD6"tØŽnÑôÞÅ÷~~äðÃço,.¶âxsÈæîLD&ÂÜÜ>ýì³?|çèÑ_##3fSÒ¤½a,“dµ  µÐ]xøò•+­é=Ó0QcF†XÖZÀüûÒ%ÌÏÍ=`¢¿É ³HrY$»•ˆª«”@éã¸Ýét`ŒÁW7n MKý‡^ï&nÞ¼ èŒu°Ç{L0†Ì`a«–9–$I«ÝjÁƒ¹nwd™50>>VXO⸅ŒL²„Môã4ˆr›’iPŒZ£$I"j„ˆ¼rù ––þ‡4i$ù9¬çÔ-»®A=[¸\ Ûßfûÿl^Ù:êYË—©¢ÍëÛ~j/«OÇÔKóýxAÛ?xâ ŒÉLÓ4BfíþDÁe# ÍæÖÇqk\lüòËÿ "¶²y‡ç|™Ë8¯g­Í·ÑzÒ¿™h¯'Ëâ8Îë&IR˜óú|¢}x߇Öiy}}=þx™D$7œZVfIZÖÚ¡t•ˆ0ƨäÉz‰TÎ;œ—Iò´eêlÚ—ñz|’ûº&º!x»údvú“$´6†µLô K&“ ÉÌe ei.;Ý£Z^]r¤%JK“VØ„L²äµÕ5\»ö_Ü{ß}tm¤t›÷ë°–É絡ɦÏe})£Ir€á|ÙÕñ.‰å¤º¶s¸ÄÓzš¦ØØØLMOáÞéû\ý:4¶b™¡‘É—åœ,“§‘È;•ö“u\äpeˆã¸dUÒº4Bùœ¬æ´o’$N™eØR4(™u­Ž[œœ»–:~Ñg}’T—”R}P¹¿¬'§ÍMo†lçZf]Iå–AëTWʪ‹0á®@†—s Õ¤Ó%§DœÜÆeU“èC¦µHS?™¼ŒHÊA •UE¦Ò¤úä±®_äë$Éœ$’YW$½¡È2 hà ¸}%'ÑG” `d>žÔdN#Û7iV§]ÕW2»e!“û2Z'H+Ô«"V#S–kMç—´J9–7GÇÞa‹v»SfáÎÔжªà¥*ð‘ÊŽ×ʪ¬IF¸Dº+«ãºŽEÒ»+e–ò§œDé#‡‘RY.­E#Èå+ëȤ(ù†+uÚ ‰@P‘@)st÷º,RZ‡F¬6÷E‘r› `|¤»ÚÐȯ"=$‚Yf•ïãëJw¯&{²s4«ÍŠ´ú¼Ì·MÍ÷PªÁ `I®”M—o”r,ý˜ìD)År!%I¬ò¿.UçAÈ”w¦Ï2¨’4‹ª’Ä:~Q#ºi[Züü5Iæ× “~™Õ.pªYOݱžÌʸ†Z{>_)ÛŠ²ª©BH’Yîj ìpBøƒá*2]ﲆ&þÑ5äpê²>)÷üúC"˜Ït‘Ç;ω6™\QgÓlæG}7“o›ëºC"ŒÏ´iiH¡Ý±>ÉmJ¦Ö™®h´ŠÌ*´!‡,PÚ'4‚@šejVÛÔWjº–C#¨ÌjÃÍbª|/“( sY²¯ŒÎÙ—„9šeÞŽàœª+©Z$ꚤ¿“íú,’OšEú¢X  ø¦ ´FIp ókú¸%ÌSJÿ¤ !ªÈw‘­eçJŸ ”o@InI¥kçÛ¨mÚ·,šuÉ©‹€*«òY¯H—%K’«ˆÓdW’ ŸíZËäP•EiìÚf­Åææf¥kéR—Œàøæ¡ýfŸ™ÓtÒç¨ëñ€(ŽQ¥ü¹^áä"œ×áç«-»ͯݖ_•‘ÛB!Xhcc£ä{\þÑå#ëQ2r–7íC?]àçÔ ^´:@ùíBLZýsÇ0d&iÉZdÄÊ pùG.Í.’øÜe…²Ž´lIŽl‡Êe= MJyÙ®$Óö}¦Öé.«qù;I¾¸:’ê’J—er‰-\£â'9dý[` ò™Z¤Ê}¡äkÊëI˪Cf•\jþoã?;$p25™½ͺÞîöI®œ|/tñ„Ž«Éª/pñ4ÖÚ‘RŽ|Þkäæ39™Òʲªz\Ž}ÖçósÒâ|–)É©"s§ X4K>³Ê‡Õ{j~¯‰¤rIÔêKÔ,Ìçw nIÒ@Zœ”Bm<*É䑨|4ʼnåe.Ëääi–æ²D¹m§!h4ëòoÁœ,-`Ò‚£:ÏʹäðùNG Ë,¿! ýžšh„ùdÔEX©uY!a'ûE MÒD}8]•ÑѬ³n¦p¿£+ý ßÇ'©»íTËͺ~A%-Ój¤I¿GÃm-Õ~†Ö]2»[ô˜öÐYZ_•ôI'K³FÚÆQÇ?îf“Y"SR'{ÔÿÑ-Y(%8)ü/•Èm„¯‰„`2Ë}&P~’_eU)L]ãB‰Zý¯‚% ê$ †Vðe-V7bý:"¸eº†€;X‘ÛyT‡çLµ¬ÍB G (qfj¸oÓ|¤KfåDmdÙˆÌmBjË>³JRI6µm@u$z'’'ôǶM} $¯n$:"3Cð— ]Äþ>-k‘§¬»Û25¡ì¯H¹Ô| bä»3‹#¢d’@«§#™÷<ˆýû÷÷ÿêˆÍ`P†ìé ðKpŠrÂv1qív¨"AÈ¢é<û¾ü·Ã~¤&ŸìÿFû9ø‡ nÏ×z½ÞX´²‚ÍÑwÀ†ÂÚÚ’͘1ANµÉMÈäŸSŒDO=õÔÝsóó';"þI ä(l³–­‹‡Æ«~Œf0¦¤tž6,ÑÊù:-Çv¶¯1ùº1ÆdçÃÛÈë³zu;¶w"cîî¹çNž?þ/([eËÌ­@ëÇgŸþùßNNNÎtgga­û'@ù±k I¯ýü-bŽ£e¹Î÷•Ûe?ž„o¸£%)xâ_îïJc°´´dž~úé3Ÿ|úé‡}ûíPü¾IŠšZ÷ãaQ¿ñ€ÎÄÄÄÌŸ_ýw÷<øØþ……übø…úò§®uº8>—ÛŠVR^—møÊ\Ç.•¨‚1Nq’L;zô¡ .üceeeÙ÷Àˆ@‹dÖ €HVé;Uão½õÖo¾uÿý?šŸŸo|ò#èØ·w/ößu×·_~å•_bð¥>êsRE/ª,“4;·Ê7ß|óܱcÇ~177g:íL¥]O8€j¹*p‡XfS+ÛŠeR?´Ûmt»Ý=øàê… þ…ìc¨ƒO{áó™ú«$ŽÍWׯ.D"‘OõäËà¤)ó?¶_j-RË8£_7{·×ëN‚êXcLñ[…ò<)ša×aŒÁÔä$ŒæwåÍa óÅt>¬kƒ×‰L”¯X‹'Ÿ|ògòÉG/¿ôÒ?û—…O«)3×­Ä¿MÕ0ñ /ÚªWÑöååe˜v {öì)äl«ŽQº8‡µÒtýÚ5왚F«ÿ]P-È¢òHæ Äd:G×ß9øâ‹/>?{öì3ï¿ÿþUKVÜDF&÷§9\2›G­:gÎœyàìÙ³ìv»w;ê—P7ùí ´ý×z=ÌÎΖd’w,M­V«râõ9iXYZÆøø¸WÊ›H»6—Ë333ÝÃGŽ|ýµ×þŽâ7¨)*uÏ©íC‡Íœ;wîå………ozêÖ‚ö;Çfûoõ ê!Š¢Âm?¬?¬BU›Çy䇧N:‚, âÃuGÍg’ÄvŒ=óì³?=xðà÷¶rÒÛk±¸¸ÈÖ¡_–Vnóÿ¼ÕÉgu:[:Õí€1Çè7Þø¡ÈN‘ … ’dRôJ2;ö,..zï"íùcš¦¥GX¥ ˆ¦~ÜO Ÿ™Z›˜‰`“¾_Ï5{½VWW³úä( 3{öä_™•×§Ëq¬?¹Ÿc²i~5Š ~‘ŽÀ}¦P^ ¼õ÷žÜ=€¢£¿÷&]D¤™´Q ¬9{‹5©€ÉXÌb±æ‹X¬Å lïª)Qôè•ï… ÿm½|çcCPˆÄs›Ê{WáÏÈÌ:.|Bä„hžXU²`MÔé:B”lÑÚ rÍ {K”ZUö©^[×®ž´þºF׆CZ·7~Ð9¢[¡×kaøÀhÀ8Çä‰éˆY®ù3‹¯VùÖµ6¶çì^ÚOo-rlrjqnqiu]p¿êñֳݫc[§zû-ß÷;ºwöø}Øõ1xŸØOú4<2D¦< ÿñ•:Nûù>Á˜bNEýˆžÞ=3;÷sÏBüÂÞÅý* o“¨d¶ƒèöC‡1©œi\éÜGxŽb3xá2ù²ðÙü9ÇOå 牜=%–/^ qZòÌš³Rç¤ÏËŠd/¬½(W,_¢pIé²Òå«*×T¯–R®«ÝP/Ó¸©ykÃí w´îj—ëTèVLß‹®Ô»¯ÿÀð¡Ñ£M7=1~²Tµ¿ÚôéægfÏÍÿ²¨A×$×Z½°®³©·}iÛÀÝþʾѡɱ×|¬Å¹Õåµk›@[ö··îí"y^oëòy'ñ®à½o·oÏŽÒÎ}ôëÝÕ'ÛWô) ?ð3q@a d0h(x8dDeäêhèXØÊWõ¯7Æ#¾Q¿Ó&6LÜž¤O1~0§u¦+f¢gcæbÆÎÎ?\س¿d¼ô„Å@äP8Ô7¶ô5öŽxL0§;—·6V‰W 'Ê'†ãPTÒvÙ)ÊË/“h–”Ö• &œ”}!‡È+D*ÞRWQV¥¬{¨Î¶ÞL#K³WKecŠv‡®ªM¿ÆPÔ(fÓ+Sêægæò{,[­¥mb¶<¶³ßà@Úz±ÕçbããVìþÆ“Ûkó¶Hï3>µÛÇwÈìtò‹ÛUä_0L&™m Þrž\Ú6.±ŽjI ‰Œ§g2Š˜åQuÑïvÄLDZíá'ìUÛ§³s‚}¢SÒö»’I))ÌCôà © iÒSdMÏÈ?v*3/++ûtNöñÜ's/ç]:yãÔåüke§yt¶æÜ«ó­…mEmÚ.¾+î/¼Ôwùó•ñ«ß¯—~½>qc¼lôæØ­ÁÛ½wúîv•·VÔß«®¼w¿ìÁé‡Ù‡?Ù^e_½é©ê3gsÏ?þõ²ænmÎ z[½îKÉ—¬†®WwÓš|šåšZî´î}mÕ†kë~sþmhûÆöÅŽÆÎœ¿wt©tM¾{ð>©Û¾G¨§çÕŒ^£>tßËOÇûw~Vú<6ð`0qÈnXx¸{äâ(eLgléKý×ìñíßä¿}¿3?i3%0Õù£xš:c0Ë6ûb.ëçöy¹ù/ ‹ K¶,  1¨86#¶è½ì¦ìU‰˜ƒœÖœ5\)܇xÒ°vØÞ£¸£|x'|3¦@¶`ŽPŽ°»ð‘\Ñ\±“âù’kNKùJuKŸ“9O(”-\[(wAþ¢B±b‰Ò%åË*WTɪ#뮪•ª__C£Lóæ†[Z·7ÞѾ«S¡[¡W¡£?kðÀðÑÃMŒ›ì3Y2­Ú\möÔü™ÅsËd+´Uu­Í‹-u¶õv/íÓ°¯¶6:695;gºà]Z]_»µ¹¿ñh÷ÌõñêØÖéý·O×ö_Iß÷;ºw~ðû¸ë£a€l@_à'b?ésPI°â²‚„Ž„]£¨QÆþ—ŠLþR‘ÊXýع¸Ÿ{æãö.î[ÚÏJ„$Ô/%ÁƤr¦Ö§Ù¥óÁÅfðãËÄgñÿÒ‘<Ñ“b+Z²æO-)ê»xQ®X¾Dñ’⪚”ª]W¿±þ-ÙX®]¡sO¯Rï¾þƒ‡FŒozbReò‡ŽXÕZ¿°®³©ßòÒ¶ÁþUtÓÚfÇçVç×.m{ߪ¶{vxu&ui¼óyŸÒ³ñCj¯Nß‘~â€Ñ`Ö0y4ô eœú=mÊgúØ\ú¢+‹°üöpèä®ðÌp+HY ä rÀ™ÀÝPìÒ€2¦bg¼ú~x‚õ`ÞÀ€L¸ ³±GbËH2ˆâCÙ QQ lÆl‰lµl hY´7ºýƒÝšý {û8‡ G!ÇFã‹ỷá4àLæå2ä¢rUs«s'pWòàxyþÆ a#°C¼V¼x{qþ¸g|l|A|cx|.~‘?•BÀP XPO°Xp\ÈOhF˜,\!²Nä…hF쪸‚ønñ)‰3’6’“kÎKÉKÅK#Òå2¡YB—ìñµk×&ÈñÉ5Ëg)x(J(ö)]S¶P¾¢b®Ê¯Ú»îŽÚ!ußõ5°ƒšm(ÒJÚHÔ¶ÑQÓÔ]ÐÐÏ3ÀTÞ4*ÜtÜø°É~ÓÝ›#Í(æd‹Ë«0ëæ–=¶ÉvÇì ®l­t¬wzïüÝã&í®ïáæIóÊØvûÅgÒWl‡ÉÎ ¿Ì]ý‡E‰6¤Ø R²X¨sX¥&E5£%F>gp0í£²cäc©qâ¹÷úì+ÝÏJtOFôM¹wX052­õ艌¹L¿¬ÚãùyŒ“ŸòÝ jÎÞ8¯Pxæ‚h þRÆÜÕc×óʤn^¼­^nYÑZéÿûcÑ'¥ÕæÏ™5|µ¥uv iêM­-Ñmµoi’uï»;?¤õšö—‡d†»¾xŽ‹|ë˜ÈŸò››+ŸßÏc±Ü *` Û N@%ô DñC2*d¥ŠòCå£Þ°ñ±me;ÂÖˆæE;¡O ß±ØÉì7Ùg9,8ŽqüQÀDažs p9+¹x¸|¹np£¹wrßåáæ ä©Â ciØF^UÞ£¼c8\/•¯¿‘ÇÍÿNÀZà– A0[pIˆ!ôE8TxD„"2!Ê‹GÄHHH\•4¬]ã¹fX*AZ\ºBÆEf„"«([·6BNTî‰| Vá©b„’ŒÒkåTs•EÕ‡ëâÕŒÕfÔ«ÖÖp×”ÕßP¥•µ1TÛRGZg^÷­Þ}ý3‰†ÁF^›Œ5LdM6£ÍØÌ&Ì¿[Œ[ŽZ XOÚŒnùa‡²rݺÁÑÄÉÉÙÕ%Ì5Ö­Àý¶Ç+Ïw^ ÞB>Û}#wœÚYã7èÏ BÌ'U} Q!“BóÂÞ†KFxP hCteF4³>Zj7#æeœÜžŒø‘}Þûëu“Š“f8œ›&–^pT'£)“”õ3çè ½ÜÏ'Ï懞ö8«rž½pì³âòK§®¤\ ¼î[f}KÿŽvùú{ê÷•*‰6L¾<ÚÿUâ[ÐÄÙ©幈ùŠ%„ÅÀƒ˜ƒ7dÂMx½Êþ*÷ËÔ£ùÐÞèìÖìù+¼/a|9e8“9G¹Ü¹ª¹Õ¹Oóàxyf°Ø!^"Î÷‰/ˆo ÏÀ/ò§ ˆ ê ¾òšÎüÅ´£øÔ ÏÎÒˆtù Ë.Ë$¯p­bþ'ÿ ^á÷µAµáÍßìþ&÷ß¹ýOÔ÷’ÅBÿImt×?¹Mºú'¹G´~“›Ë±ÊîƒUz/æ¬ò[*°JðÊU†X¦øi×*Çõà i¯þjÌmjm‰~-ÕVû–Ö~³#¥³®+ú½bwX凴^Ó¾CŸúK?O´ É ‡ØŽ*a¾x~-Oùü}Ë„ê$Ïäש–w¦sgÜgÆf“çÌ*ý˜ß¿ ¶pv‘1yqfé"+ÅXž—€Û‚J¡Ò –ÿe¸ûÿZ8%jµ°d¦­;@KÝÚÌ ?"ÀÑ EÃÊmÅ×"[Û.ç"v4¦³;ˆ >q!î^€@è¡þvÎ+~BÅÑD "ÉÒj%÷"=ÊÕä»aT{WÀ ¤Õ^ýŒh·Õøi¢¿¥=¬@qÄ…X8.Ç£Ö‚X€% ¨@*Ð õtð‡ ÀG @ Ð `‚?DA €dˆ„( HÀXÉ è` þ@‡` úJ‡ÿÛÇúäÿA"PýÈIôðÛAÑ'©±†ž!š×4‡5€°mÿ«# "~UZî°ºF+¢µÐ:hs´1Úm´ZÔÑÚh}´Úm„ÖA4ÝûUÕâ× ¿*ö‚ÿqVu C4€a0t÷#'ý΃åY€pÚ  jvOÂ?ÿ+&)† `A¥ÅÒÉÁ!L‚F!,¨á´(&‰®F°\¯FÐÒÔÔøt-f§M\ÂV&IDATxœí]Ml$Çuþªºç3äü‘Ë]ì.I/E®#š‰µ+!ˆ”À¤œl±}`#Ãq†Î äé’c r[ ÷bkKDKÜ…6Z²×»RHzÉ¥HîÎOOwWùÐS3ÕÍþv“Ã? 1=ÓÕÝÕß{õêÕ«W=ÀÎp†3+È1݇vï%îçÜ?Iðî&ïsÇï‰ É—É¥é7E:vÒä3ôIûâÓD‚P“º0ú¤SôÆ_«+_eŒQÆáœÎùIB'„pJ(g„‘¥¥¥Ÿ~ôÑGMX, !)ò ,í䧟úÊSôã¿ýñ?$t¿X°¶¶vðúë¯ßð,Ò;°ž%$E¾ >uãÆÓ4ßxøè¡Æy¢&ôÈ0MSUúÊk¯½vþwÞùkXÄkÝà }!ÄçÅ$X‚MÍÎÌþáµg®}ooïÏcHz㜼u:l!_ø›kÏ\û Y)ô)v·æ‹ Š6e˜†è\qš”{0Æä¯Y:}χ FÓ“ù‚ø4€´¦iiàüÐà ‚+ O¾09CM>`÷rR†atïÁ×|a>€R‹k?5 KTXPºŸ±!ioGa&ë™Óôî¯q7©I Ì­.&³ý¦Âî± ½Íè™ÆYOņÞì0› S°øIl,’„Í@äs_Í84_h½™Ç>Or„ ¶Q¬Ÿæ{™/s”š/Ç£NÙ!ðДS¦ù@±§¤5¿Γ!ßÙ2bôóDZ‘ ¿æ?Ñ䇟﹕¸•}bÉçHþáŽ*ÜãüŸæóãq5Bàq›Åc5;ÇѬýÈ—¹¹°O®æc¸:\7¢ù“jó>ôáv¦ù'‡'ÖێߦFÅ°Û|g/åüN[/¶ãt5ƒ:¿°ˆ“0fÚ4ß&argópV t…Â’ï¯q„"mB½*ÉDÅEZœäs;or†‹+‘ÇãvSñ;süæ‰ òe¢å‰d7ˆ2*¬Xx €ÊsÃJòí×êe`t7†>±rAy_žj Ìxó#_¥Rꫯ¾úÇ™LfÊ0 êLzß !Ô0Œ”aiMÓˆÉÌù^Ú°ôr=f§§§ŸO¥R-EQtUUuEQ B#„ô ö’®(eëëëï¿÷Þ{aO3ñìÅÃ/¤Ÿ6 ãÍ­­­ëÎùO/R³ÙlKQ•›µZÍÌd²ÊúúºïÃÛÀ_# (êù¨ÕjÈd2¨ÕjÆÕù«?Ú¯ïÏw:зœ˜˜øGoÂ"^wÔæP‚Èï™’—^zéwu]:“É*è:m!÷Éÿ}òÝ_þê—€wo¾k;¨ñâ°WÌí¤:¯G u·÷éèÕçž{n>—Ëù×ÏYίÈ¡O¼—©²nâqÙ~«2ãããßkµZ¹t:íC—)Š‚ÍÍM´Z-·Š†{"Dó†dE8J”³Ùl¢P(„¾o O?õôäòýå-XÚ/ÒN\MƒùNs“UUõ™l6{¨Ò~ ”Â0 T«U×c~ç…EXè„óœß Ã@.—‹:ðª,üÞŸ-ß_þ7Xä‹ pI5 Òü€Ì•+WÎe³Ù¯G!°ˆYXX€^*Ÿ€¢(‡Ê ¤ÓipÎm齊‚T*åyù»“P¿²Îg£”‚]×:ÕÀ,ÓÓ=ÞÖ¼¼4_ÎÜB@’­“|Û‚†îñt»Ý¾üù矻ï‹íìííðp?DD [ø ú!ØÚÞU‚M­ó:#…‘ ¬TCgî näËKwTj£Ñ¨lll¸ÞØÏìíï¡Ñh¸t`”)Ûq7BeÈì<ÆÃîînïaëÛí§Rè+¯3*ÐC·C&''óN§ Ûa¯ ;¡µ5D¤„…N»>èu!h·Û „ ÜEˆ‚|À'÷ÇÏÛ!h¡PÈÕëõqs§Wà×tÛZ;öyßý(×"„ Ýj÷Ævö¶qO»‡q>¹É9,o,£É076b¡Ô?Ùzd¿8€`›OÇÇ'Ǧ¦¦‰Wóó{XJ\žšö<>ì빚KŸ,¡þ'ûøò_â*ý*–ÏßEþÙÒÿ•ÁËÓ_·N"[›[iîhC™Q šÖ$·oßÈFSJAÂdÛ‰+ðfS”ÀÈ·5€îr4–êÝ,c=û¥V5½¶Ípûö­Þ=šìÚÛ‘÷‰¢(©v»öù†_ Š+YÖÍ B!¸<:ƒs› fTB°ýôG:2…LÏîsÎå`‚oÅ'S(¥ô¤S>’BXË®¢(àR’ªª¶NžsNx(ÂüF¸¡”’(Ä 8ÎTp 7ì±C-ÊœüÁ°L¨„M¾r‚R ÝÐCikÐð {ºÇ°Ýì‘ï«QcgJéñÛƒS B ÃЂKú“Fú ”Bo‡‹C‡²ùƒv†”R0“¡ÝnbÈLº/(¥Èçó00¹Š¢˜­N«ƒù;~äs`ŒñAÉ7 KK tîI#“Éâú³ÏFNq¤”v4M ¥ù6Ÿ èäSJ±¹¹9È©CMk£qP|1šÍf¨hb ÙágŠ¢ôda[¢(0ŒhSpÃÆx¤ùd  5êõº{âTäÔà7 çÜgœÄ )vèÏA)ÕͶ*Póu]7(¥=Í« ƒlØ@@"?¥Ôéã{v¼ä3Ƙ˜Éw­ ô»×þ鉼|ˆ1&<¼›ÒuÝP…3Æ\Ù šÕÿáÿ hµÚ±'pNÌx÷íþÂŒ hŸ¢„üÿ_àÊ•+øùÏÿ„¸·tßð¡:Üí| Í?T Ó骪ꌱ´¨`¨JPk.áå—ÿ|ð¶w¶166f+ãlÒ~;ͨ_Ùàzy_§TÃO~ò/˜ŸŸ<È÷ ºQ"k¾o¶r Ùi4†B]Q”CäÞsº–©ªÕ*ö÷÷0yn…Q{ú]”Iu·¤¦0ç9tÏOïÞLMM{Ú|_òAdÍ÷E ùš¦u¨Bujºw´A}Aµ:ŽF£ùù«Hgìyžƒ¦“8ËzžÛwJ)êõ:¦¦¦ðp}=ºã@Ú¿ö"¿×\Z­–Ù5;‡ ùÌçRBA)E©T‚®(‹PTåPëð:ß™^èÄ zùÅb ««+˜ššÆÆFtò9ç^f'ºŸ€Bô¨• „ X,Yɲ†Žb©Øû].ã<Çñ ž×Ôì¸ÕSF¹\ÂÊÊ ¦§§ðᇿˆL¾Ñ1óòÂ’ßQÕhó.„”ËVž£aZšDnØÎÜYö(é"Îs«Õq¬®®bnn„¸Û|¿±ŽišrPmàeAò‰A4¿\.[sšŒC¤—;ËxÞ~˜™™Áîn ¦iâüä…¢¢(f7f#´ß„¥ˆBë9ì-@öt ¬É.ç_W"ÌŽ ‹xq£N¹\Mëœ*­¬  R©„ ‹ÅÂììlùÞ½{5tû>X|hèó"÷“²0|C ~†X/¤)ìX}ÛÖìîË[€V*sõDýû¤ËåzqýññqubbbÖsÉ[ ý¾@lB ÂÜø&œ… )‹Oç…ä5Gr‹PèccÅìöö²ÙÜ©Ó|ÈçóX]]Å¥K— 2 û S¶ï/Û‰Ëéź›111‘­×÷Yu¼šü²–0=3óxuuõQ³ÙüRM¥(ú¶\„>‹ƒ£­L‘[# ·[ÛýûåÏ–/ÌÎÎ.øæQ*y˜˜˜øà7ßøWû`·ç¡BÆAˆËWS ¾F”ŒT­—íä9çŠ<*BôF¬†a´öööÃ"^¸™õî'Cßü Œ¸HX)yXò•ƒ%Œ,ÁÈ/Ì& vúì-Xä G£»‹y¤5SqE»d·T @ÚèÖtôGÄö÷mä÷  ÷Ñ@ß«!Ùw?’Éâ](¿ÎPþ+SQqß7pœ0œ^ˆk ÷Z±ÆÒÙñj¾ó-z}ÒEÀÍ÷E''ùâSx8r '¶ÿÆ›9Ö#ÿ­]bk#œó­ ‡ÝÊXÿ–; òŧlb_1D[±l^bq/e$I„áÃN<2çæ g8ÃÎp†3œü‘“M@:/×IEND®B`‚gtk-0.15.9/demo/treelist/resListDND/server.png0000644000000000000000000001446007346545000017337 0ustar0000000000000000‰PNG  IHDR« mŸˆRiCCPICC Profilexœ•—y8”íÛÇÏ{ ccì[ÙE$»=Kö%R †aÆÌR!)”,EÑFѦ´‘Vª‡H¶E‘ì¥%˼ zŸ÷x~¿ã=ÿ:¯ë8—ëºû󽎀_ÌŸF£  <‚Iwµ1'lóö!`:NàCÀú2hfÎÎð¯6Ý@›º?F™×ž§ßmÊõºo0Jž=óïy€£oóö@Ô@(xÙß B˾;ífÒ˜H†øxP£»»Z —¼ìW.`Ù¯\t`0éàˆ ’#0c&D#§D"#0— €ZN%à«@9Fgà‡@}›·aùÈÛÓ´Å8íïí>P^ ¼õ÷žÜ=€¢£¿÷&]D¤™´Q ¬9{‹5©€ÉXÌb±æ‹X¬Å lïª)Qôè•ï… ÿm½|çcCPˆÄs›Ê{WáÏÈÌ:.|Bä„hžXU²`MÔé:B”lÑÚ rÍ {K”ZUö©^[×®ž´þºF׆CZ·7~Ð9¢[¡×kaøÀhÀ8Çä‰éˆY®ù3‹¯VùÖµ6¶çì^ÚOo-rlrjqnqiu]p¿êñֳݫc[§zû-ß÷;ºwöø}Øõ1xŸØOú4<2D¦< ÿñ•:Nûù>Á˜bNEýˆžÞ=3;÷sÏBüÂÞÅý* o“¨d¶ƒèöC‡1©œi\éÜGxŽb3xá2ù²ðÙü9ÇOå 牜=%–/^ qZòÌš³Rç¤ÏËŠd/¬½(W,_¢pIé²Òå«*×T¯–R®«ÝP/Ó¸©ykÃí w´îj—ëTèVLß‹®Ô»¯ÿÀð¡Ñ£M7=1~²Tµ¿ÚôéægfÏÍÿ²¨A×$×Z½°®³©·}iÛÀÝþʾѡɱ×|¬Å¹Õåµk›@[ö··îí"y^oëòy'ñ®à½o·oÏŽÒÎ}ôëÝÕ'ÛWô) ?ð3q@a d0h(x8dDeäêhèXØÊWõ¯7Æ#¾Q¿Ó&6LÜž¤O1~0§u¦+f¢gcæbÆÎÎ?\س¿d¼ô„Å@äP8Ô7¶ô5öŽxL0§;—·6V‰W 'Ê'†ãPTÒvÙ)ÊË/“h–”Ö• &œ”}!‡È+D*ÞRWQV¥¬{¨Î¶ÞL#K³WKecŠv‡®ªM¿ÆPÔ(fÓ+Sêægæò{,[­¥mb¶<¶³ßà@Úz±ÕçbããVìþÆ“Ûkó¶Hï3>µÛÇwÈìtò‹ÛUä_0L&™m Þrž\Ú6.±ŽjI ‰Œ§g2Š˜åQuÑïvÄLDZíá'ìUÛ§³s‚}¢SÒö»’I))ÌCôà © iÒSdMÏÈ?v*3/++ûtNöñÜ's/ç]:yãÔåüke§yt¶æÜ«ó­…mEmÚ.¾+î/¼Ôwùó•ñ«ß¯—~½>qc¼lôæØ­ÁÛ½wúîv•·VÔß«®¼w¿ìÁé‡Ù‡?Ù^e_½é©ê3gsÏ?þõ²ænmÎ z[½îKÉ—¬†®WwÓš|šåšZî´î}mÕ†kë~sþmhûÆöÅŽÆÎœ¿wt©tM¾{ð>©Û¾G¨§çÕŒ^£>tßËOÇûw~Vú<6ð`0qÈnXx¸{äâ(eLgléKý×ìñíßä¿}¿3?i3%0Õù£xš:c0Ë6ûb.ëçöy¹ù/ ‹ K¶,  1¨86#¶è½ì¦ìU‰˜ƒœÖœ5\)܇xÒ°vØÞ£¸£|x'|3¦@¶`ŽPŽ°»ð‘\Ñ\±“âù’kNKùJuKŸ“9O(”-\[(wAþ¢B±b‰Ò%åË*WTɪ#뮪•ª__C£Lóæ†[Z·7ÞѾ«S¡[¡W¡£?kðÀðÑÃMŒ›ì3Y2­Ú\möÔü™ÅsËd+´Uu­Í‹-u¶õv/íÓ°¯¶6:695;gºà]Z]_»µ¹¿ñh÷ÌõñêØÖéý·O×ö_Iß÷;ºw~ðû¸ë£a€l@_à'b?ésPI°â²‚„Ž„]£¨QÆþ—ŠLþR‘ÊXýع¸Ÿ{æãö.î[ÚÏJ„$Ô/%ÁƤr¦Ö§Ù¥óÁÅfðãËÄgñÿÒ‘<Ñ“b+Z²æO-)ê»xQ®X¾Dñ’⪚”ª]W¿±þ-ÙX®]¡sO¯Rï¾þƒ‡FŒozbReò‡ŽXÕZ¿°®³©ßòÒ¶ÁþUtÓÚfÇçVç×.m{ߪ¶{vxu&ui¼óyŸÒ³ñCj¯Nß‘~â€Ñ`Ö0y4ô eœú=mÊgúØ\ú¢+‹°üöpèä®ðÌp+HY ä rÀ™ÀÝPìÒ€2¦bg¼ú~x‚õ`ÞÀ€L¸ ³±GbËH2ˆâCÙ QQ lÆl‰lµl hY´7ºýƒÝšý {û8‡ G!ÇFã‹ỷá4àLæå2ä¢rUs«s'pWòàxyþÆ a#°C¼V¼x{qþ¸g|l|A|cx|.~‘?•BÀP XPO°Xp\ÈOhF˜,\!²Nä…hF쪸‚ønñ)‰3’6’“kÎKÉKÅK#Òå2¡YB—ìñµk×&ÈñÉ5Ëg)x(J(ö)]S¶P¾¢b®Ê¯Ú»îŽÚ!ußõ5°ƒšm(ÒJÚHÔ¶ÑQÓÔ]ÐÐÏ3ÀTÞ4*ÜtÜø°É~ÓÝ›#Í(æd‹Ë«0ëæ–=¶ÉvÇì ®l­t¬wzïüÝã&í®ïáæIóÊØvûÅgÒWl‡ÉÎ ¿Ì]ý‡E‰6¤Ø R²X¨sX¥&E5£%F>gp0í£²cäc©qâ¹÷úì+ÝÏJtOFôM¹wX052­õ艌¹L¿¬ÚãùyŒ“ŸòÝ jÎÞ8¯Pxæ‚h þRÆÜÕc×óʤn^¼­^nYÑZéÿûcÑ'¥ÕæÏ™5|µ¥uv iêM­-Ñmµoi’uï»;?¤õšö—‡d†»¾xŽ‹|ë˜ÈŸò››+ŸßÏc±Ü *` Û N@%ô DñC2*d¥ŠòCå£Þ°ñ±me;ÂÖˆæE;¡O ß±ØÉì7Ùg9,8ŽqüQÀDažs p9+¹x¸|¹np£¹wrßåáæ ä©Â ciØF^UÞ£¼c8\/•¯¿‘ÇÍÿNÀZà– A0[pIˆ!ôE8TxD„"2!Ê‹GÄHHH\•4¬]ã¹fX*AZ\ºBÆEf„"«([·6BNTî‰| Vá©b„’ŒÒkåTs•EÕ‡ëâÕŒÕfÔ«ÖÖp×”ÕßP¥•µ1TÛRGZg^÷­Þ}ý3‰†ÁF^›Œ5LdM6£ÍØÌ&Ì¿[Œ[ŽZ XOÚŒnùa‡²rݺÁÑÄÉÉÙÕ%Ì5Ö­Àý¶Ç+Ïw^ ÞB>Û}#wœÚYã7èÏ BÌ'U} Q!“BóÂÞ†KFxP hCteF4³>Zj7#æeœÜžŒø‘}Þûëu“Š“f8œ›&–^pT'£)“”õ3çè ½ÜÏ'Ï懞ö8«rž½pì³âòK§®¤\ ¼î[f}KÿŽvùú{ê÷•*‰6L¾<ÚÿUâ[ÐÄÙ©幈ùŠ%„ÅÀƒ˜ƒ7dÂMx½Êþ*÷ËÔ£ùÐÞèìÖìù+¼/a|9e8“9G¹Ü¹ª¹Õ¹Oóàxyf°Ø!^"Î÷‰/ˆo ÏÀ/ò§ ˆ ê ¾òšÎüÅ´£øÔ ÏÎÒˆtù Ë.Ë$¯p­bþ'ÿ ^á÷µAµáÍßìþ&÷ß¹ýOÔ÷’ÅBÿImt×?¹Mºú'¹G´~“›Ë±ÊîƒUz/æ¬ò[*°JðÊU†X¦øi×*Çõà i¯þjÌmjm‰~-ÕVû–Ö~³#¥³®+ú½bwX凴^Ó¾CŸúK?O´ É ‡ØŽ*a¾x~-Oùü}Ë„ê$Ïäש–w¦sgÜgÆf“çÌ*ý˜ß¿ ¶pv‘1yqfé"+ÅXž—€Û‚J¡Ò –ÿe¸ûÿZ8%jµ°d¦­;@KÝÚÌ ?"ÀÑ EÃÊmÅ×"[Û.ç"v4¦³;ˆ >q!î^€@è¡þvÎ+~BÅÑD "ÉÒj%÷"=ÊÕä»aT{WÀ ¤Õ^ýŒh·Õøi¢¿¥=¬@qÄ…X8.Ç£Ö‚X€% ¨@*Ð õtð‡ ÀG @ Ð `‚?DA €dˆ„( HÀXÉ è` þ@‡` úJ‡ÿÛÇúäÿA"PýÈIôðÛAÑ'©±†ž!š×4‡5€°mÿ«# "~UZî°ºF+¢µÐ:hs´1Úm´ZÔÑÚh}´Úm„ÖA4ÝûUÕâ× ¿*ö‚ÿqVu C4€a0t÷#'ý΃åY€pÚ  jvOÂ?ÿ+&)† `A¥ÅÒÉÁ!L‚F!,¨á´(&‰®F°\¯FÐÒÔÔøt-f§M\ÂV ™IDATxœí›[lÕÇ眙ًw_ÁNœ„4($ —ÄT½ˆRPÛ—VÐ6TEíSßÚ‡¾õ‰—J}©Ô‡>Tê ¯U/H-&Q Q"ÈÅMìà;vlÇ×ìzgæÌéÃììŽ×»¾Ç6hÒÑž9{.ßìüç›ïœ3 uêÔ©SgukÜ®NóyZ+¨+ªä뢭³\j‰tÙâ]Jl2VOS5ÑÖ©³¦"?+SMj‰-§Dw÷‘t÷×ÿBtZʶ„T!ÄåžsÛöî}x@H@H¤$R†]A1ê\ŠbyIò²¨~Qº-¤”1#DÉÂr?Åcdmëe•“"Öú‹K»žý}WïßµkŠW9¨Þ X ƒ€ ªoÀÄú ‚rG¦Ø0 ]®˜r† A¨AS,B›{.|¼õ=û?3ÆAPð=ÿÊŸÿô‡?ŽŽŽúEóu1Õlµ0 îE`=ùµƒŸêN%Òd² ’V e),§+݈²,lËbîö4v2‰ö}ZÛîE ¸5~”B IggBÀ¡ë 'ÁÖ­ÛR¡”¤¿¯‡©©)„!èèÜÂŽ»BpaêŸìm<ÂLÞc|¦BàiÌô5,ËBJš<ßÃõ<²Ù,ÁÜ\™é©ÒI:ŽCSS3¶cSÈÏ119Qº0Í--¤R)¤”ìÙ»¯Öï7­57‡o06|ƒ½›wã-†1c o¿ùïò…±MÍ-X¶…[p™œ˜À×>˜ÐÆo>ó,×>å‰Ã‡çõï3^`Q:Ë‚R^kŸË—þ‡´,0‚íÛ·A1…u}ß/•i­Ã²ØwÚ÷ÑA€ö5¾öñ´FkÑÂNቮç¢}ƒ;ç?ýù/ÿÝk¿ýåÛlQ/[K¬‘`­£G_Ù3zkæATü qæò·ypß~°)ÓÎ…sgÁhöíK$ P(pàÀcLfð P˜Ë“J7pþã3¸^¡Ôç»ïã׿yeY4Ê-H)ñƒ«5…ç‡~ÆäsØ–Š<”/®ë26>N¡P@A>—cdx¸Ôw*Bû>JYxžËààu­Kß&‘Hà8‰ªç[[c£<ùè#¼üòïÙ{à±e·‹¸vµ”wœ¾¯C±º.#7nP(¸ƒùÉ¢ ßàɧsõúær’¹|'±üs_)Ú9›sŸy饗¿òúëé'ôª’rx°€Ê[?.TpdÒÙìzþ’.B)›±›cÜ·y½—ÎcÛŽ`dä&]÷tÒ嶓$‘Lp}hˆ-í \ÅvìR–íÐ×ÛK_o}½}l¿o'¢è¦Ï µÏÔlžáñ)†FƸ>tƒÁÁëÜ4íŒÉ{§‘ÛŸ \càÓ«µL½kd7ñêk¯¡,íûk>þI§¹p±‡m÷31:Œí8w}Ì9×kÜÔ²é! $g¤ÁTzÖx¬jé\.—R‰¥ ·‡[“¼yìÉdš†LK r·§9yò$™L˲H$™™æƒÞ§µµ)U©ç¿û^øþ‹ÅXW¢”…¡ÝÛ„m;ìîjcwWRÊR¸ dèÃã]À!ÆFobÛR |­ñ½²€”%I8I¤’hßgßCÏ{jضã8µ~·ª$S)Ž¾ò‹eׯä;G^(å…8N¥®çâ»:ˆæ%«OcS3s—Ξ¡££¥Ô¼Øõî`p ~ŠP¬~1Eƒ.|1±Ú€í¹®ƒò™ËM#2f&ÇÙ¶}ÊJs} !)ÅœRÆ’'ZRDIXÅI˜H)øTH„ ,!Ã:Êm œ…«ëÀãÔÿå©î§ˆ’À瘔 &\óÖß*Úcªö³çÏ}L[[;›7¯¨]­ñŒ §4‚0\5&¼†=ƒïûüëÌ«[Êc8þÖ1¾ñ­gŠq)# ØÆ„…åã «®ö÷aL9žÂ¿@åã ˜÷]ÃÅz ÐÅøÖs]&'oÑ™Ï128@*•djzŠMM-¸žë) x„"­z—,³*ß÷-›áéîCtÜÛÆÔÔžþˆ»ö`YîÏž #;°, ˲PJ¡”Â’¢(bUqYÔJ „TH!båa>³œç=çyÒŠcÏÏóI_/Ï>÷<#Sýt6ï O$vñ¥Ró×Üdß..Ö• vvf†]»àý»ñõM K¶‰DQS¬Æ Js†òuœ7k¯2Áê9žo?w„“W¸'»sÑ –1º(Æð3Xµ ÖíÙYN¿‚ñ‘Aº¤±1Kïå^.õö“T((¥š!,ŒYãå p´Ö–RŠÖ¶6Ž?A:Ó€Wå³}FWí¨6•K¶wŽÖš+³ï­jŸŸ—Ñü' zÖÛ úgÿ»ôÚD7‘”’L&Éã'èêê*ŠÞ·‡Ðq*ª¯çÕÀ()@V8}úO<ñ8=ç/’iÈÎkÔ<}e­d3ìî ”¢»ëèz›ÀŽæ•¯Ü-mùIqéj}íÊâ왳<øUÞ?õ!v"‰ž›±uh±„«åYK¡€1F¦2ŒÞšà­ÿœdb¶@Gç6Ä*{Å:_~:·î`&ðî{g´MCCcLÜA.*ª¥W­Ãm Ré M­÷²©©¥í—« åt°Ò0`õ ´æø¹ëëmŸ MpþÚøz›À;ç×5 ˆÓÔÚN[G©† RJ´ö–½ÆWK¬ÑB0:<2štlo±N2²€ë¿™)•bkKr½Í ¥!A{öî¯U.‡®–ä²wÓÖ’„mMö\ê¹R<\òÝ€jgP*`Ξ=ýYÚQ§”´jºÎÆDõYs8ã¼;;.µØÕÕ¶¦ãÕ¢ySšŽ–ìÒ×€[Z×Û„XJÜÜô;—/^&\_Õ,²{ c„(Ðu€4° È™¾øã沈[”Á¨þ+½Û”’açEÏZî0–‹"«×™—Õ«~c&''›š››'‹CÔ8½êí&3³³iÇq¼„ã,ú4Z˺ßÍ‚ÅÉ[c£­-míãËíÃ,¨Wù¢TÅ 3&^£"«¨©T2¿¹cëˆÀ㎎ô¾ñ·¿¾ LsÀ$0¸„ë­n¥}•—,Ú¹² Åš2Å”-–Ù„;Š…j«ÏºêÄ1±ÏèiízÒ0K(V—P¬9ÂÍŸ*b­\oŠ:Ô„êöU­}éb›±Wcíëb­§Ò5û±”'çeGÛ­ËÚÁŠ‹5ê0~½là0Ml=DºÔ˜k,‘lµµ'" K¨§¡Ps„ÚŠ<ªfbRäŠãb¼l´=¶úÛPŸJÖãbDl[j]“õú]¢q#-EOn—PSÑñ¢“¬jÛN•¡@¥€#±Æÿò²ÞñêFHÄF°e#‰µ2n©)?þ–±°˜X#âwCü%—úÿ±ê,‡¸ø"1Fqi¤«J±Vìb«Ü“UÊÖ[ ɃÀÆ°g#ÅÏÕÆŽ§ J¾&Ë[åDj#µÎ—eÿ£5ÎJWì×¹Sî4Ô©S§N:uêÔ©ó%áÿeFx“;õ;IEND®B`‚gtk-0.15.9/demo/treelist/resListDND/tower.png0000644000000000000000000002700107346545000017164 0ustar0000000000000000‰PNG  IHDR2_ªU”5RiCCPICC Profilexœ•—y8”íÛÇÏ{ ccì[ÙE$»=Kö%R †aÆÌR!)”,EÑFѦ´‘Vª‡H¶E‘ì¥%˼ zŸ÷x~¿ã=ÿ:¯ë8—ëºû󽎀_ÌŸF£  <‚Iwµ1'lóö!`:NàCÀú2hfÎÎð¯6Ý@›º?F™×ž§ßmÊõºo0Jž=óïy€£oóö@Ô@(xÙß B˾;ífÒ˜H†øxP£»»Z —¼ìW.`Ù¯\t`0éàˆ ’#0c&D#§D"#0— €ZN%à«@9Fgà‡@}›·aùÈÛÓ´Å8íïí>P^ ¼õ÷žÜ=€¢£¿÷&]D¤™´Q ¬9{‹5©€ÉXÌb±æ‹X¬Å lïª)Qôè•ï… ÿm½|çcCPˆÄs›Ê{WáÏÈÌ:.|Bä„hžXU²`MÔé:B”lÑÚ rÍ {K”ZUö©^[×®ž´þºF׆CZ·7~Ð9¢[¡×kaøÀhÀ8Çä‰éˆY®ù3‹¯VùÖµ6¶çì^ÚOo-rlrjqnqiu]p¿êñֳݫc[§zû-ß÷;ºwöø}Øõ1xŸØOú4<2D¦< ÿñ•:Nûù>Á˜bNEýˆžÞ=3;÷sÏBüÂÞÅý* o“¨d¶ƒèöC‡1©œi\éÜGxŽb3xá2ù²ðÙü9ÇOå 牜=%–/^ qZòÌš³Rç¤ÏËŠd/¬½(W,_¢pIé²Òå«*×T¯–R®«ÝP/Ó¸©ykÃí w´îj—ëTèVLß‹®Ô»¯ÿÀð¡Ñ£M7=1~²Tµ¿ÚôéægfÏÍÿ²¨A×$×Z½°®³©·}iÛÀÝþʾѡɱ×|¬Å¹Õåµk›@[ö··îí"y^oëòy'ñ®à½o·oÏŽÒÎ}ôëÝÕ'ÛWô) ?ð3q@a d0h(x8dDeäêhèXØÊWõ¯7Æ#¾Q¿Ó&6LÜž¤O1~0§u¦+f¢gcæbÆÎÎ?\س¿d¼ô„Å@äP8Ô7¶ô5öŽxL0§;—·6V‰W 'Ê'†ãPTÒvÙ)ÊË/“h–”Ö• &œ”}!‡È+D*ÞRWQV¥¬{¨Î¶ÞL#K³WKecŠv‡®ªM¿ÆPÔ(fÓ+Sêægæò{,[­¥mb¶<¶³ßà@Úz±ÕçbããVìþÆ“Ûkó¶Hï3>µÛÇwÈìtò‹ÛUä_0L&™m Þrž\Ú6.±ŽjI ‰Œ§g2Š˜åQuÑïvÄLDZíá'ìUÛ§³s‚}¢SÒö»’I))ÌCôà © iÒSdMÏÈ?v*3/++ûtNöñÜ's/ç]:yãÔåüke§yt¶æÜ«ó­…mEmÚ.¾+î/¼Ôwùó•ñ«ß¯—~½>qc¼lôæØ­ÁÛ½wúîv•·VÔß«®¼w¿ìÁé‡Ù‡?Ù^e_½é©ê3gsÏ?þõ²ænmÎ z[½îKÉ—¬†®WwÓš|šåšZî´î}mÕ†kë~sþmhûÆöÅŽÆÎœ¿wt©tM¾{ð>©Û¾G¨§çÕŒ^£>tßËOÇûw~Vú<6ð`0qÈnXx¸{äâ(eLgléKý×ìñíßä¿}¿3?i3%0Õù£xš:c0Ë6ûb.ëçöy¹ù/ ‹ K¶,  1¨86#¶è½ì¦ìU‰˜ƒœÖœ5\)܇xÒ°vØÞ£¸£|x'|3¦@¶`ŽPŽ°»ð‘\Ñ\±“âù’kNKùJuKŸ“9O(”-\[(wAþ¢B±b‰Ò%åË*WTɪ#뮪•ª__C£Lóæ†[Z·7ÞѾ«S¡[¡W¡£?kðÀðÑÃMŒ›ì3Y2­Ú\möÔü™ÅsËd+´Uu­Í‹-u¶õv/íÓ°¯¶6:695;gºà]Z]_»µ¹¿ñh÷ÌõñêØÖéý·O×ö_Iß÷;ºw~ðû¸ë£a€l@_à'b?ésPI°â²‚„Ž„]£¨QÆþ—ŠLþR‘ÊXýع¸Ÿ{æãö.î[ÚÏJ„$Ô/%ÁƤr¦Ö§Ù¥óÁÅfðãËÄgñÿÒ‘<Ñ“b+Z²æO-)ê»xQ®X¾Dñ’⪚”ª]W¿±þ-ÙX®]¡sO¯Rï¾þƒ‡FŒozbReò‡ŽXÕZ¿°®³©ßòÒ¶ÁþUtÓÚfÇçVç×.m{ߪ¶{vxu&ui¼óyŸÒ³ñCj¯Nß‘~â€Ñ`Ö0y4ô eœú=mÊgúØ\ú¢+‹°üöpèä®ðÌp+HY ä rÀ™ÀÝPìÒ€2¦bg¼ú~x‚õ`ÞÀ€L¸ ³±GbËH2ˆâCÙ QQ lÆl‰lµl hY´7ºýƒÝšý {û8‡ G!ÇFã‹ỷá4àLæå2ä¢rUs«s'pWòàxyþÆ a#°C¼V¼x{qþ¸g|l|A|cx|.~‘?•BÀP XPO°Xp\ÈOhF˜,\!²Nä…hF쪸‚ønñ)‰3’6’“kÎKÉKÅK#Òå2¡YB—ìñµk×&ÈñÉ5Ëg)x(J(ö)]S¶P¾¢b®Ê¯Ú»îŽÚ!ußõ5°ƒšm(ÒJÚHÔ¶ÑQÓÔ]ÐÐÏ3ÀTÞ4*ÜtÜø°É~ÓÝ›#Í(æd‹Ë«0ëæ–=¶ÉvÇì ®l­t¬wzïüÝã&í®ïáæIóÊØvûÅgÒWl‡ÉÎ ¿Ì]ý‡E‰6¤Ø R²X¨sX¥&E5£%F>gp0í£²cäc©qâ¹÷úì+ÝÏJtOFôM¹wX052­õ艌¹L¿¬ÚãùyŒ“ŸòÝ jÎÞ8¯Pxæ‚h þRÆÜÕc×óʤn^¼­^nYÑZéÿûcÑ'¥ÕæÏ™5|µ¥uv iêM­-Ñmµoi’uï»;?¤õšö—‡d†»¾xŽ‹|ë˜ÈŸò››+ŸßÏc±Ü *` Û N@%ô DñC2*d¥ŠòCå£Þ°ñ±me;ÂÖˆæE;¡O ß±ØÉì7Ùg9,8ŽqüQÀDažs p9+¹x¸|¹np£¹wrßåáæ ä©Â ciØF^UÞ£¼c8\/•¯¿‘ÇÍÿNÀZà– A0[pIˆ!ôE8TxD„"2!Ê‹GÄHHH\•4¬]ã¹fX*AZ\ºBÆEf„"«([·6BNTî‰| Vá©b„’ŒÒkåTs•EÕ‡ëâÕŒÕfÔ«ÖÖp×”ÕßP¥•µ1TÛRGZg^÷­Þ}ý3‰†ÁF^›Œ5LdM6£ÍØÌ&Ì¿[Œ[ŽZ XOÚŒnùa‡²rݺÁÑÄÉÉÙÕ%Ì5Ö­Àý¶Ç+Ïw^ ÞB>Û}#wœÚYã7èÏ BÌ'U} Q!“BóÂÞ†KFxP hCteF4³>Zj7#æeœÜžŒø‘}Þûëu“Š“f8œ›&–^pT'£)“”õ3çè ½ÜÏ'Ï懞ö8«rž½pì³âòK§®¤\ ¼î[f}KÿŽvùú{ê÷•*‰6L¾<ÚÿUâ[ÐÄÙ©幈ùŠ%„ÅÀƒ˜ƒ7dÂMx½Êþ*÷ËÔ£ùÐÞèìÖìù+¼/a|9e8“9G¹Ü¹ª¹Õ¹Oóàxyf°Ø!^"Î÷‰/ˆo ÏÀ/ò§ ˆ ê ¾òšÎüÅ´£øÔ ÏÎÒˆtù Ë.Ë$¯p­bþ'ÿ ^á÷µAµáÍßìþ&÷ß¹ýOÔ÷’ÅBÿImt×?¹Mºú'¹G´~“›Ë±ÊîƒUz/æ¬ò[*°JðÊU†X¦øi×*Çõà i¯þjÌmjm‰~-ÕVû–Ö~³#¥³®+ú½bwX凴^Ó¾CŸúK?O´ É ‡ØŽ*a¾x~-Oùü}Ë„ê$Ïäש–w¦sgÜgÆf“çÌ*ý˜ß¿ ¶pv‘1yqfé"+ÅXž—€Û‚J¡Ò –ÿe¸ûÿZ8%jµ°d¦­;@KÝÚÌ ?"ÀÑ EÃÊmÅ×"[Û.ç"v4¦³;ˆ >q!î^€@è¡þvÎ+~BÅÑD "ÉÒj%÷"=ÊÕä»aT{WÀ ¤Õ^ýŒh·Õøi¢¿¥=¬@qÄ…X8.Ç£Ö‚X€% ¨@*Ð õtð‡ ÀG @ Ð `‚?DA €dˆ„( HÀXÉ è` þ@‡` úJ‡ÿÛÇúäÿA"PýÈIôðÛAÑ'©±†ž!š×4‡5€°mÿ«# "~UZî°ºF+¢µÐ:hs´1Úm´ZÔÑÚh}´Úm„ÖA4ÝûUÕâ× ¿*ö‚ÿqVu C4€a0t÷#'ý΃åY€pÚ  jvOÂ?ÿ+&)† `A¥ÅÒÉÁ!L‚F!,¨á´(&‰®F°\¯FÐÒÔÔøt-f§M\ÂVjIDATxœíœyxTEÖÿ?÷öíÛ[:}d!¾ ‚¢"¢¼£ãö:ã8¸;ƒÛȨ¸ë¨ïèˆ ê ¸€È.(" €„a KYȾ‡ìéí.¿?:Á6˜Ìð>Ïïùýæû<•ª®Ô½]ß{ΩSU·NÃð„±mo®ë-ô ”/Š‹uHè–D¿ò/]û¯B÷Ëu@ëLþuç…t‘›v'Ñ•üI]jt' øÕûçÿ„ é"` ³Ó³ŸŸ;*&:ú¶¦¦†äŽöv›ªxU×1ˆ"FÙ„ÑhD6ÊM2F£ £Ñ„l’‘$ ÛƒWñàö¸ðº=(^¯Ûƒ¢x1™LMfÌ&³b6[ÊÜ^o拳ïûP;û¡ù•ÏKæBOUì$iÄg^úÛk²Éò¢x­õu5´µµàõxÐ4 ƒAÂl±`6w&‹³ÙŠ©³,Ë&\Î\.§/w:q¹œ8;ëxwzú–úN"J'µ'é®JÆ»fÎ[W[ýDPp˜ 9NgÛžææ³g<Ž¦!ŠF\í˜L&d““YF6Y0J&d‹O:n·ÛÛåBq»q»Ý8=.ƳŸ¦äL>=ôG®ºj"qqq‚®iþ*èÿQµºlÄHF£Á0(-ææf®ºúâãûè 4"œ¸¸Xì8FT¯‚l6ÑÖÚFPp0q±1„GFä°Ó'! £$‘š’‚Ç=™äÄ$&O¾–äÄD&Mº–ä¤$&OšL¿”~DFDpäðAQÕ´.Ûéê“_/ªZ]D@R5]˜óÌS„„„ðá¼wD¥‹?§±±‰õë×Q\|†;Ó9|ð ÙG³Ù±}ee¥¬ýz Í-­|¾ð ‰÷ß}›Ð°p^yåyRRRùóìÇ=f xø.³þð ÃGŒâ™§Ÿ¤¤¤]ÓÄN‰œsÎ\ÀØ»WȘ`¿ýÎß?þùç‹ïW5 ëבœ’‚ÃfAEŸuû,»3÷eºïº¦¡££¨ºšª¢¡£**º®£ªš®¡ªº¦c °‘s$›é7Î $8˜%_|~|éŠåK3wnß4Í@àíLç|ÊÅæZM÷IÄ Š¨ªŠ«ÃŨai¥‹Í7AÓtTMCUUTÕ×YEÓΕ»ÿOÕ4*ËJÑ4ƒø“¢¨¾ïïJÄÅT˧^ºÔ?ÊàÁCˆˆˆ¸(À×iEEQ¼ŠêKªÚY§žû_WÙ«úÚhüîî™<óôlJËÊÐAЕsÆÞÕ¯‰ˆ £ ÏÌyŽ††ÚZ[.H@×u_Çü:§(*J7]ÿëNPC'==§ç¼@|\èz÷Å\G­óÀ§†ÑÑѬ]»†1c.ãÔ©Óˆ‚€†:hhº†®j¨h¨ªŽ¦j躆¦ë躎¦ëhšî³!M÷µï¬÷}ÖqØÉHÿ‘´Aƒ~ò®=ÄEõÎo¼þ*×O»]´»6}¿ºúV2v塞¢šì£Ç)8SBQQyy§i8ÛDöÑ<ýû³0™¬ìÙµ›°Ðp~ܾ¤Äd¾ß²™!ƒ‡°iãFÍ—«Vððgñ÷æQQYÙ+"Ý']CœßÈeI}ú’”œÌñc9uÙGsŽU”NÀÅO£•JüÈϡÈá#Y³j%FIbÓÆ8ìر•úºZ²öï§øLy¹¹äääPQ^NæîÝ477±õ‡-¨ªÂºu_aµZY¹l)á‘,ütII)|4ï]ÒÒ1ï½¹ è?€ùó?"66Ù(w~ùygíÿ„ª–ÎgŸ}ÌýÂ?læùç_bõ—Ëxóoï²xѧÌ}ç}–.ùœ×^û+6¬¥¾¾®g]ëDŒÝ‡èèt¢¢¢E‘°°pŒ&!¡aX,6&“ t0[̘ÍVBBÃŒ2aaá¢@TT WU‰‰GQbãâP•˜Ø8¼ŠBLL&³è©|?×NÆüžI“'óÄãdäÈQØzÚ5 ‡ÑuØ´é;æ<û"GáÁ‡gQ˜ŸÏm·ßIUu©©hkkÃd6¡k:¯‡Aiƒ9ÛØÈ]wßCYI =þ$'óryå•7ÈÊ:À{ïÿŒé|ºh ßoÙÄKV±iãþ1ÿ3¶oÛŠ#(Ø'Š¤Ç©¬,ÇãñPUU‰Û颶¶šŽŽvêêhkk¥¡¡¦ÆFš››8ÛÐ@kk+õµµ8ÛÚ©­­ÆírS]]Õy ¯—òòR4U£¼¼ UQ(+/CS5**Jq»\=íZψøÉ:÷Ýÿ ó|ÄàÁCY½zQQ1lÛöF“‘ììô´4S^^FAa.·›ýû÷b´óݦ $$&³déçŒ5†æ½Ã”k¯ãÕW_à¶;îäÉ'á÷÷ÜÇcþßÝ=“9Ï<ÉŒ7Ú+"šýZ@ ø×wüöÑÅ‹–ÌÌÎÎ&Ðî ¹¥‘@G mmmجt8;0›ÍxÝ$£MWÑuQQT/FYÆítb1[iïh'À@kk+{ M„††QS[CTdÕ5ÕDEFQWWÇСCYµjEîâ/¾Xqp_Æà,¾p;>_âÁOñz¬Z›6mAgÇŽí8;\ìݳ›Æ³ 9tˆÊŠ rsSPOQa!'ŽçPUUÁ¡ƒY47ž%3s7.·‹;¶" °yÓF,V+Ö¯Ãä`ÝÚÕ„„„òÍÚ5:ùöÛoh¨oè•DzDDGçÙç^dÆuL»þödf0æ²qäÌ%19‰úúZìàö¸ §ªª‚ÓÈÉ9Êø W’ž¾¿º™µk×0sæ},üìcûÓlÞû7ž{áÞzëužyöy>œ÷.ÿaQ1Qè=ߌï¡Ñ¡ªºŠ+¯¸ Y6qÙeã°Yí 6³ÙLHH‚¢ ¢ª FY&88”›‘£Æ`µpùø H¢ÄĉWãU&O™JG[Ó®¿Ö–V¦M»¶¶®z=n·]ë9 è±D`îÛob °±xÑ'(ŠÊW_­¤±©‘-[6Q|¦ˆ½™{ÈÉÉæøñcìÞµ“²²R¾ûnÍÍͬ^µM‡Ï>[€=0yïÍ%6.ž7Þx…ñÂsO3dèp^záú¥öç­7_£´¼üˆ®óöÜ÷9rø÷Þ÷¥%ÅÜtó­´¶¶2ñª«1™M¤¥ "66ŽˆÈH†‰Á 2yòTÏ6pûwRXÏCÏ"ëÀ~æ<÷"ßoÙÄ›o½Ëê/—óáß?fù²Å¼÷Á|Ö}½†¿¼þ&ñqqè½J§(š¦áp!Ë2&“G` f³»=³ÙŒ¦©½2V«{€ÙbÆŒÑ(„Q2ŒÁ ŠÁ` ¤[‚dèq·Îá—%¢ù$ò§ÇgÑ7!潃=ÀÎÒ%‹ðx¾ûvÕÕUìÍÜCnî òOŸb×ÎtêÙ°îk4Mcñ¢O æ½wÿFbR2/¿0‡Q£Fóøc3iòµÜwï]\wý úégŸÏlniæÈáC$$$RQQNDTõ 8qµ;1ÊFÐuEÁl±ÒÚÒBphµ5ÕÄÆÆQRRBRR2§Nå1hÈŽ9¨ї‘µ/—¿‚Ì=»wù²²ö3|ÄH¢"£X¾tqî’eË.¥ÑqRZZŒ¦©T”—áu»©ª®ÄÙÞA]} --M465ÒÐPG[k35µU¸œTVTàõz(++tJKÎ ‰Š‹ 0ÉF N#ËF ó‘M2E…ù;4]r ×#ºyõ%ÆO¸’¯¿ZÍ€ƒØ¾}+QÍ>„$)+-¥¹©‰Ž'…E…X,V²ì'.>Þ·¤2œU+—qåÄI,˜ÿ!3~u oþÏkÜu÷½¼ôâ³ÜsòÒsÜqçïxwî[T”Wô‹ôPµ>þdáÌÓ§Oáv»Ñç¨tA@×@|¯áD MU%Šª`4ñz$IBQ¼2nY–ñx<˜d·û§ÏF£EU1 è?€Õ«–ç.]¾tÅÁ}»/jé:¤¤ôgÛÖïAØ•±—ÛIÖ}Ô74pâØ1ÊËÊ(*ÌçÔ©STWU“säÍÍÍìÛ»EQHÿq;’$ñýæ8¬_÷Q‘Ѭþr9qq}ùrÕ2bcãX÷Õ—„††a0H½’H§(/øˆ[n»ƒû3™V«Õ«–ãQ6mú–††:öìΠ° ŸÇs8r8‹²ÒRvü¸•Ö–fÖ¯ûAY¾ôs‚!,øû<ú&$òö__cèмüü3Œ;žŸ{Š‘£ÇòÆk/Ò/µ?³¥8z  ŸD6¬_ˬYOb³YHzx::£;ýÀ¸Ë'ÐÒÚ‚ÉdB×u<IIÉÔ×ÕrÓ-·s¦¨{î}ˆœœ#üiö³dffðÊko±ý‡Í¼3o>7¬åý?fÃú¯yóíylþnS®Ö«ÙoçZ·USÐT/ß|½œ‚“GéèèÀãõâõzñz|§¼^ŠÇWçñzQ×ãË=Õ—«Š‚ÛíFUTÜn7º®û}v¡ªj¯$Ò#"š®só­wðÞ§¼²œiÓ¦1bäH–.YˆÛã!+kUÕUäç“{â8g›Î²+#AYÿÍW„†…ñÅâOé—ÚŸyïýÑc/çÕ—ŸeÊuÓyêO³¸ñW·ðÄ£1ýÆ›xnΟ˜0ñŽ^IäýÈM·ýöÑ>\03+k±1ñ9lôOöí?9VD}C6› ·ÛÝiì*š¦a”L¸ÜNl6ÍÍÍ„‡R__KDd••åÄõI¤äLÉÉ8}ú!/ï©ýQXp’#F³~ÝšÜU«–_?¢ãÛM?tðŠ¦°oß>*Ê˱Úlœ>I}m-ÅgŠ¨(/£²¢’â¢"êëk9}2—–æfrOäàtvp4ûªªrèà ¢À}{e‰}™»e£/— díˤ¹¹éûÍ÷öéaý׫©©©!++‹¼¼<¾Y·†°ðÊÊKEíí45žÅl±RX˜OLlØÏàÁÃÙöÃf®˜8‰¯¾\ÎŒ·ðÙ‚øíÝ÷óÞÛopÿƒòö_ÿÂ=÷ÏâÃys¹õö» ïÕ*ñw㤠{Ý´†—––ЧOáa\7u 11q¨ºL€=ˆˆh‚‚‚ '44 G`‘ÑجVbbã0™-ÄÅ÷Á`0Ð7! HL¨ôK€×ã!%u^¯—ä~©hª†Ãá /÷x݉ÇŽU–—s)vã5]gŲE$#¢AbÅÊ•‰È² ‹ÕŽl2nÄ`G40J2øNÄ™-ˆ¢‹ÕFTt,&ÙLl|_ ’‘>}“HLNAÑt“SÑuHLNEUu“úùcu¾¦ë)z,‘¿¾öaaá˜L&¦ßð_¤¥ ¥ÿ€lýá;*ËË8p “ÜãG9u2—}{2¨®®äûMp¹œ¬^õ&“™…@xDóæ¾Ar¿þ¼þòÓŒyÏ=õc.Ï scÈ°Q¼ùú TT”ûÞ×÷¿hìýÓ†Œ2eÚðñW\Éœll¬Y¹§ÛEC}ƒà IÄÄö!8$ »=øøDA mð0ÚZZwùD*+*˜|Ýœ>u‚›n¹“Ã÷ñÛ»`×ÎmÜ÷àcìØþ=÷Üÿ™{vpÇoî!,,œ¼Üãu'óNôÈØ{4ûÕtƒ$ÑÚÞ†ÇíÅérâr¹AhGQ:œNttMÅãñb$Ú;Ú T‚iïhGÕ4ÚÚ[Ñ5¶ÖVtZ[[Ж–fZZšÖ_½¦ë—x®¥û¶‚Þ}ëU ŒÕfçê)ÓIJÀeã®àà½xÝŠ NQSSÅÙ³õœÎ;Ž¦jìËÌÀnwðý¦ ÄÅ÷eõÊ/4d8 ?™Ç¸ W3oîkL½þ¿øŸ¿Ìaú¿æÍןgÒ”éüýý7©ªª€^ø‘_œ¢Ìøõo}í¯ï̬®ª¤¾¾–ÄÄ~TV”M}}º®£«ªïäçÕåŸÎ»tSUÓéŸ6ŒÍ¿F”Œìض—Ç;=;ilhàØá,ÊKK(È?ÉɼãÔTUräÐ>Z[ZØ“ñ#ª¦³mËzÌV¿ù’°HV/_Dlßú!I)øü“HHNeùŸƒø¿±‹¢i:[6®å¦[¸ISgÐÔÐÀè±W¢©)`wG||²ÉLÚà‘8NÆ]1‰ÚêJ¦N¿…üÓyÜzç½9¸—™>AÆß3ëɗغy=Ì~™íß˃<Ãþ=;innî•ü²Ñ|ïÕ€ªé˜-Vt]Çd¶ ²lB eÙ·¥ëeßáY6!"&³]×±X¬¨ª†Å€¦ªXmçî `µ i*› ­ÃoÞêjšÎ¸+&±jÉ‚ƒÃøî›Uˆ¢DÆŽ-´·µ’}h?•¥œ)8Å©¼êëk9°/¯âõ©”ÅÆ7k–ËÒE’”2ùóþ‡a#ÆñÎs¸lüUüí/O1zì•|ðö+ HÞùÀzÌã—ýÈô›þûѧž{}æÑCûHHN¡´ä ѱñÔVUAks#6»—³£$užËÒ0É&ÚÛ[±;‚h:[OXd4Õ•åÄÅ÷¥¤¨€¤ÔäŸ<΀´áä;Äàac8~4‹´!£8™›Í ¡£Ø¹}sîÖ-ë/Ý–©¦é”—ãv{©*/ÅítQS]³£ÚÚ*Z›9[_CccÍMgi¨¯¡¥¥™ÚÚ*œTU–ãêpQYV‚Ç£P^VŒªh”ž)DÓuŠÏ é:%yiq!ÎŽŽK=ûõ²œzãmü°ék’R²w×6Â"c8~4 “ÙJIq!n›¦Æ³ÔÕT£i:…ùy؃9r0“ØøDv¥o¦ÿ álÚ°’Qã®bõ²¹êÚ,þx.×͸…ÿx‹)ÓoaÙÂ?q*6»£WÆ~!Õ²à;.<ý¦;}ìϯÌ,/- É(^7F£ ÅëE2ð*¾S¡š®b$4]óÔ}§:AðÕ‰TUA4H¨ŠI2âõzen· ³ÙŒËåÂd¶àî\û¤oÛ˜»cëFÕjä'ÕúÙqÙ‹IDt]×õö¶6vý¸·ËIVf:­ÍM9¸›ººZrfQUQF~Þq΢äL>'sRUYƱì,êëk9|`7­-ÍسÛÍžô-¤oýI’Ù¾y-F£…í›×b0HdlÛHMU9^§Ç"¹g—ðyvSBRêXGPðˆ°ˆïÏ *¦§O#($Œò’"Lf õ5hšŽ³½¶¶@ ®¶‹5€²â‚Ã"9›ML\"Ge’”:˜ý»·‘6t Û¿eØè+ÙñÃ7 5Ý?n"uÐÜ.7ÅEùu õµÇ*ËK‹ð\vûIB£ë‘®ª×ëNŸ<€WU©ª,ÇãöPS]…¢xñx¼¨ªŠ(¶û.Ò5ÚÅöÎ-Q/Š×Cue9^E¥¬¬M‡’3… JœÂ`4S˜Ÿ‡$›(Ì?‰`(-.êëkQ»b«z¾çßXt]× ‡÷ïšír9%MÓd]×%]×}×ýü\î¿ ÝÏVAPAPATƒ3 ’äÎ׫ð=ÿ· 臆§oÛ´ß`Ð]s)á(Y¼ Iýú% ‚Ð5Aì"r^2S- PÍf³ùØð‘ã ³gVóS(]÷`ÇKAD´CG„ÅÄôy¶él½Ahç"Ab"Ò=2S1 NºîÆ£Æ]¾2÷è‘C…E§+UÕãk+HH0`ƒÁ7z$ßg $ƒEUAQ}1xªâ;Ü ª(º"0›MRbêÀÄ”ÔA£ÂÂ#o>”µG¶Øi¨©,æ§@1[ùÙ¼ju]¤z]žtc˜ü`ŠˆŒ)Žf&¤ôÿ_ ¨Ô4ßÃÝ“ñã–|#U™ó¢»ù§ ßm[6á3I2:/t“K Q WÆ(Ée_Y2ʘŒFDYÂëîz“åÆëñ•=7¯Uñ"Ë&Œ&²lÒQ¬n¨«:¼ô³¶à›¶ã“F× ÑÓIJ¹‘®°Ÿs±‹HgÙ?îÐÿÚÇ໇Q¨~ÉÓI ‹ˆ‡Ÿ/uÏá|ÆÞu3¥“˜î—_ˆÈ¿ ÿ°k„R:;îæçäΫZ3vÝôøÕuEŸõø`g/àO¤ë{»Öõð’~w¯ëF÷ï¢{Œº?ÿÐï.Iœ×Ÿ\È!úÿ<¿X»lÈ?¸ñR {xwW§»ˆø{÷󢧿ùàÿwÑX§úy’¿Q_tÒøKDüËþ?Z!^ Ý¿ŠîêÛÝŸ¯ÝÏðÿÌωüÿÁðÿ þnsöØþÓcIEND®B`‚gtk-0.15.9/demo/treelist/rgb.txt0000644000000000000000000004173307346545000014666 0ustar0000000000000000! $Xorg: rgb.txt,v 1.3 2000/08/17 19:54:00 cpqbld Exp $ 255 250 250 snow 248 248 255 ghost white 248 248 255 GhostWhite 245 245 245 white smoke 245 245 245 WhiteSmoke 220 220 220 gainsboro 255 250 240 floral white 255 250 240 FloralWhite 253 245 230 old lace 253 245 230 OldLace 250 240 230 linen 250 235 215 antique white 250 235 215 AntiqueWhite 255 239 213 papaya whip 255 239 213 PapayaWhip 255 235 205 blanched almond 255 235 205 BlanchedAlmond 255 228 196 bisque 255 218 185 peach puff 255 218 185 PeachPuff 255 222 173 navajo white 255 222 173 NavajoWhite 255 228 181 moccasin 255 248 220 cornsilk 255 255 240 ivory 255 250 205 lemon chiffon 255 250 205 LemonChiffon 255 245 238 seashell 240 255 240 honeydew 245 255 250 mint cream 245 255 250 MintCream 240 255 255 azure 240 248 255 alice blue 240 248 255 AliceBlue 230 230 250 lavender 255 240 245 lavender blush 255 240 245 LavenderBlush 255 228 225 misty rose 255 228 225 MistyRose 255 255 255 white 0 0 0 black 47 79 79 dark slate gray 47 79 79 DarkSlateGray 47 79 79 dark slate grey 47 79 79 DarkSlateGrey 105 105 105 dim gray 105 105 105 DimGray 105 105 105 dim grey 105 105 105 DimGrey 112 128 144 slate gray 112 128 144 SlateGray 112 128 144 slate grey 112 128 144 SlateGrey 119 136 153 light slate gray 119 136 153 LightSlateGray 119 136 153 light slate grey 119 136 153 LightSlateGrey 190 190 190 gray 190 190 190 grey 211 211 211 light grey 211 211 211 LightGrey 211 211 211 light gray 211 211 211 LightGray 25 25 112 midnight blue 25 25 112 MidnightBlue 0 0 128 navy 0 0 128 navy blue 0 0 128 NavyBlue 100 149 237 cornflower blue 100 149 237 CornflowerBlue 72 61 139 dark slate blue 72 61 139 DarkSlateBlue 106 90 205 slate blue 106 90 205 SlateBlue 123 104 238 medium slate blue 123 104 238 MediumSlateBlue 132 112 255 light slate blue 132 112 255 LightSlateBlue 0 0 205 medium blue 0 0 205 MediumBlue 65 105 225 royal blue 65 105 225 RoyalBlue 0 0 255 blue 30 144 255 dodger blue 30 144 255 DodgerBlue 0 191 255 deep sky blue 0 191 255 DeepSkyBlue 135 206 235 sky blue 135 206 235 SkyBlue 135 206 250 light sky blue 135 206 250 LightSkyBlue 70 130 180 steel blue 70 130 180 SteelBlue 176 196 222 light steel blue 176 196 222 LightSteelBlue 173 216 230 light blue 173 216 230 LightBlue 176 224 230 powder blue 176 224 230 PowderBlue 175 238 238 pale turquoise 175 238 238 PaleTurquoise 0 206 209 dark turquoise 0 206 209 DarkTurquoise 72 209 204 medium turquoise 72 209 204 MediumTurquoise 64 224 208 turquoise 0 255 255 cyan 224 255 255 light cyan 224 255 255 LightCyan 95 158 160 cadet blue 95 158 160 CadetBlue 102 205 170 medium aquamarine 102 205 170 MediumAquamarine 127 255 212 aquamarine 0 100 0 dark green 0 100 0 DarkGreen 85 107 47 dark olive green 85 107 47 DarkOliveGreen 143 188 143 dark sea green 143 188 143 DarkSeaGreen 46 139 87 sea green 46 139 87 SeaGreen 60 179 113 medium sea green 60 179 113 MediumSeaGreen 32 178 170 light sea green 32 178 170 LightSeaGreen 152 251 152 pale green 152 251 152 PaleGreen 0 255 127 spring green 0 255 127 SpringGreen 124 252 0 lawn green 124 252 0 LawnGreen 0 255 0 green 127 255 0 chartreuse 0 250 154 medium spring green 0 250 154 MediumSpringGreen 173 255 47 green yellow 173 255 47 GreenYellow 50 205 50 lime green 50 205 50 LimeGreen 154 205 50 yellow green 154 205 50 YellowGreen 34 139 34 forest green 34 139 34 ForestGreen 107 142 35 olive drab 107 142 35 OliveDrab 189 183 107 dark khaki 189 183 107 DarkKhaki 240 230 140 khaki 238 232 170 pale goldenrod 238 232 170 PaleGoldenrod 250 250 210 light goldenrod yellow 250 250 210 LightGoldenrodYellow 255 255 224 light yellow 255 255 224 LightYellow 255 255 0 yellow 255 215 0 gold 238 221 130 light goldenrod 238 221 130 LightGoldenrod 218 165 32 goldenrod 184 134 11 dark goldenrod 184 134 11 DarkGoldenrod 188 143 143 rosy brown 188 143 143 RosyBrown 205 92 92 indian red 205 92 92 IndianRed 139 69 19 saddle brown 139 69 19 SaddleBrown 160 82 45 sienna 205 133 63 peru 222 184 135 burlywood 245 245 220 beige 245 222 179 wheat 244 164 96 sandy brown 244 164 96 SandyBrown 210 180 140 tan 210 105 30 chocolate 178 34 34 firebrick 165 42 42 brown 233 150 122 dark salmon 233 150 122 DarkSalmon 250 128 114 salmon 255 160 122 light salmon 255 160 122 LightSalmon 255 165 0 orange 255 140 0 dark orange 255 140 0 DarkOrange 255 127 80 coral 240 128 128 light coral 240 128 128 LightCoral 255 99 71 tomato 255 69 0 orange red 255 69 0 OrangeRed 255 0 0 red 255 105 180 hot pink 255 105 180 HotPink 255 20 147 deep pink 255 20 147 DeepPink 255 192 203 pink 255 182 193 light pink 255 182 193 LightPink 219 112 147 pale violet red 219 112 147 PaleVioletRed 176 48 96 maroon 199 21 133 medium violet red 199 21 133 MediumVioletRed 208 32 144 violet red 208 32 144 VioletRed 255 0 255 magenta 238 130 238 violet 221 160 221 plum 218 112 214 orchid 186 85 211 medium orchid 186 85 211 MediumOrchid 153 50 204 dark orchid 153 50 204 DarkOrchid 148 0 211 dark violet 148 0 211 DarkViolet 138 43 226 blue violet 138 43 226 BlueViolet 160 32 240 purple 147 112 219 medium purple 147 112 219 MediumPurple 216 191 216 thistle 255 250 250 snow1 238 233 233 snow2 205 201 201 snow3 139 137 137 snow4 255 245 238 seashell1 238 229 222 seashell2 205 197 191 seashell3 139 134 130 seashell4 255 239 219 AntiqueWhite1 238 223 204 AntiqueWhite2 205 192 176 AntiqueWhite3 139 131 120 AntiqueWhite4 255 228 196 bisque1 238 213 183 bisque2 205 183 158 bisque3 139 125 107 bisque4 255 218 185 PeachPuff1 238 203 173 PeachPuff2 205 175 149 PeachPuff3 139 119 101 PeachPuff4 255 222 173 NavajoWhite1 238 207 161 NavajoWhite2 205 179 139 NavajoWhite3 139 121 94 NavajoWhite4 255 250 205 LemonChiffon1 238 233 191 LemonChiffon2 205 201 165 LemonChiffon3 139 137 112 LemonChiffon4 255 248 220 cornsilk1 238 232 205 cornsilk2 205 200 177 cornsilk3 139 136 120 cornsilk4 255 255 240 ivory1 238 238 224 ivory2 205 205 193 ivory3 139 139 131 ivory4 240 255 240 honeydew1 224 238 224 honeydew2 193 205 193 honeydew3 131 139 131 honeydew4 255 240 245 LavenderBlush1 238 224 229 LavenderBlush2 205 193 197 LavenderBlush3 139 131 134 LavenderBlush4 255 228 225 MistyRose1 238 213 210 MistyRose2 205 183 181 MistyRose3 139 125 123 MistyRose4 240 255 255 azure1 224 238 238 azure2 193 205 205 azure3 131 139 139 azure4 131 111 255 SlateBlue1 122 103 238 SlateBlue2 105 89 205 SlateBlue3 71 60 139 SlateBlue4 72 118 255 RoyalBlue1 67 110 238 RoyalBlue2 58 95 205 RoyalBlue3 39 64 139 RoyalBlue4 0 0 255 blue1 0 0 238 blue2 0 0 205 blue3 0 0 139 blue4 30 144 255 DodgerBlue1 28 134 238 DodgerBlue2 24 116 205 DodgerBlue3 16 78 139 DodgerBlue4 99 184 255 SteelBlue1 92 172 238 SteelBlue2 79 148 205 SteelBlue3 54 100 139 SteelBlue4 0 191 255 DeepSkyBlue1 0 178 238 DeepSkyBlue2 0 154 205 DeepSkyBlue3 0 104 139 DeepSkyBlue4 135 206 255 SkyBlue1 126 192 238 SkyBlue2 108 166 205 SkyBlue3 74 112 139 SkyBlue4 176 226 255 LightSkyBlue1 164 211 238 LightSkyBlue2 141 182 205 LightSkyBlue3 96 123 139 LightSkyBlue4 198 226 255 SlateGray1 185 211 238 SlateGray2 159 182 205 SlateGray3 108 123 139 SlateGray4 202 225 255 LightSteelBlue1 188 210 238 LightSteelBlue2 162 181 205 LightSteelBlue3 110 123 139 LightSteelBlue4 191 239 255 LightBlue1 178 223 238 LightBlue2 154 192 205 LightBlue3 104 131 139 LightBlue4 224 255 255 LightCyan1 209 238 238 LightCyan2 180 205 205 LightCyan3 122 139 139 LightCyan4 187 255 255 PaleTurquoise1 174 238 238 PaleTurquoise2 150 205 205 PaleTurquoise3 102 139 139 PaleTurquoise4 152 245 255 CadetBlue1 142 229 238 CadetBlue2 122 197 205 CadetBlue3 83 134 139 CadetBlue4 0 245 255 turquoise1 0 229 238 turquoise2 0 197 205 turquoise3 0 134 139 turquoise4 0 255 255 cyan1 0 238 238 cyan2 0 205 205 cyan3 0 139 139 cyan4 151 255 255 DarkSlateGray1 141 238 238 DarkSlateGray2 121 205 205 DarkSlateGray3 82 139 139 DarkSlateGray4 127 255 212 aquamarine1 118 238 198 aquamarine2 102 205 170 aquamarine3 69 139 116 aquamarine4 193 255 193 DarkSeaGreen1 180 238 180 DarkSeaGreen2 155 205 155 DarkSeaGreen3 105 139 105 DarkSeaGreen4 84 255 159 SeaGreen1 78 238 148 SeaGreen2 67 205 128 SeaGreen3 46 139 87 SeaGreen4 154 255 154 PaleGreen1 144 238 144 PaleGreen2 124 205 124 PaleGreen3 84 139 84 PaleGreen4 0 255 127 SpringGreen1 0 238 118 SpringGreen2 0 205 102 SpringGreen3 0 139 69 SpringGreen4 0 255 0 green1 0 238 0 green2 0 205 0 green3 0 139 0 green4 127 255 0 chartreuse1 118 238 0 chartreuse2 102 205 0 chartreuse3 69 139 0 chartreuse4 192 255 62 OliveDrab1 179 238 58 OliveDrab2 154 205 50 OliveDrab3 105 139 34 OliveDrab4 202 255 112 DarkOliveGreen1 188 238 104 DarkOliveGreen2 162 205 90 DarkOliveGreen3 110 139 61 DarkOliveGreen4 255 246 143 khaki1 238 230 133 khaki2 205 198 115 khaki3 139 134 78 khaki4 255 236 139 LightGoldenrod1 238 220 130 LightGoldenrod2 205 190 112 LightGoldenrod3 139 129 76 LightGoldenrod4 255 255 224 LightYellow1 238 238 209 LightYellow2 205 205 180 LightYellow3 139 139 122 LightYellow4 255 255 0 yellow1 238 238 0 yellow2 205 205 0 yellow3 139 139 0 yellow4 255 215 0 gold1 238 201 0 gold2 205 173 0 gold3 139 117 0 gold4 255 193 37 goldenrod1 238 180 34 goldenrod2 205 155 29 goldenrod3 139 105 20 goldenrod4 255 185 15 DarkGoldenrod1 238 173 14 DarkGoldenrod2 205 149 12 DarkGoldenrod3 139 101 8 DarkGoldenrod4 255 193 193 RosyBrown1 238 180 180 RosyBrown2 205 155 155 RosyBrown3 139 105 105 RosyBrown4 255 106 106 IndianRed1 238 99 99 IndianRed2 205 85 85 IndianRed3 139 58 58 IndianRed4 255 130 71 sienna1 238 121 66 sienna2 205 104 57 sienna3 139 71 38 sienna4 255 211 155 burlywood1 238 197 145 burlywood2 205 170 125 burlywood3 139 115 85 burlywood4 255 231 186 wheat1 238 216 174 wheat2 205 186 150 wheat3 139 126 102 wheat4 255 165 79 tan1 238 154 73 tan2 205 133 63 tan3 139 90 43 tan4 255 127 36 chocolate1 238 118 33 chocolate2 205 102 29 chocolate3 139 69 19 chocolate4 255 48 48 firebrick1 238 44 44 firebrick2 205 38 38 firebrick3 139 26 26 firebrick4 255 64 64 brown1 238 59 59 brown2 205 51 51 brown3 139 35 35 brown4 255 140 105 salmon1 238 130 98 salmon2 205 112 84 salmon3 139 76 57 salmon4 255 160 122 LightSalmon1 238 149 114 LightSalmon2 205 129 98 LightSalmon3 139 87 66 LightSalmon4 255 165 0 orange1 238 154 0 orange2 205 133 0 orange3 139 90 0 orange4 255 127 0 DarkOrange1 238 118 0 DarkOrange2 205 102 0 DarkOrange3 139 69 0 DarkOrange4 255 114 86 coral1 238 106 80 coral2 205 91 69 coral3 139 62 47 coral4 255 99 71 tomato1 238 92 66 tomato2 205 79 57 tomato3 139 54 38 tomato4 255 69 0 OrangeRed1 238 64 0 OrangeRed2 205 55 0 OrangeRed3 139 37 0 OrangeRed4 255 0 0 red1 238 0 0 red2 205 0 0 red3 139 0 0 red4 255 20 147 DeepPink1 238 18 137 DeepPink2 205 16 118 DeepPink3 139 10 80 DeepPink4 255 110 180 HotPink1 238 106 167 HotPink2 205 96 144 HotPink3 139 58 98 HotPink4 255 181 197 pink1 238 169 184 pink2 205 145 158 pink3 139 99 108 pink4 255 174 185 LightPink1 238 162 173 LightPink2 205 140 149 LightPink3 139 95 101 LightPink4 255 130 171 PaleVioletRed1 238 121 159 PaleVioletRed2 205 104 137 PaleVioletRed3 139 71 93 PaleVioletRed4 255 52 179 maroon1 238 48 167 maroon2 205 41 144 maroon3 139 28 98 maroon4 255 62 150 VioletRed1 238 58 140 VioletRed2 205 50 120 VioletRed3 139 34 82 VioletRed4 255 0 255 magenta1 238 0 238 magenta2 205 0 205 magenta3 139 0 139 magenta4 255 131 250 orchid1 238 122 233 orchid2 205 105 201 orchid3 139 71 137 orchid4 255 187 255 plum1 238 174 238 plum2 205 150 205 plum3 139 102 139 plum4 224 102 255 MediumOrchid1 209 95 238 MediumOrchid2 180 82 205 MediumOrchid3 122 55 139 MediumOrchid4 191 62 255 DarkOrchid1 178 58 238 DarkOrchid2 154 50 205 DarkOrchid3 104 34 139 DarkOrchid4 155 48 255 purple1 145 44 238 purple2 125 38 205 purple3 85 26 139 purple4 171 130 255 MediumPurple1 159 121 238 MediumPurple2 137 104 205 MediumPurple3 93 71 139 MediumPurple4 255 225 255 thistle1 238 210 238 thistle2 205 181 205 thistle3 139 123 139 thistle4 0 0 0 gray0 0 0 0 grey0 3 3 3 gray1 3 3 3 grey1 5 5 5 gray2 5 5 5 grey2 8 8 8 gray3 8 8 8 grey3 10 10 10 gray4 10 10 10 grey4 13 13 13 gray5 13 13 13 grey5 15 15 15 gray6 15 15 15 grey6 18 18 18 gray7 18 18 18 grey7 20 20 20 gray8 20 20 20 grey8 23 23 23 gray9 23 23 23 grey9 26 26 26 gray10 26 26 26 grey10 28 28 28 gray11 28 28 28 grey11 31 31 31 gray12 31 31 31 grey12 33 33 33 gray13 33 33 33 grey13 36 36 36 gray14 36 36 36 grey14 38 38 38 gray15 38 38 38 grey15 41 41 41 gray16 41 41 41 grey16 43 43 43 gray17 43 43 43 grey17 46 46 46 gray18 46 46 46 grey18 48 48 48 gray19 48 48 48 grey19 51 51 51 gray20 51 51 51 grey20 54 54 54 gray21 54 54 54 grey21 56 56 56 gray22 56 56 56 grey22 59 59 59 gray23 59 59 59 grey23 61 61 61 gray24 61 61 61 grey24 64 64 64 gray25 64 64 64 grey25 66 66 66 gray26 66 66 66 grey26 69 69 69 gray27 69 69 69 grey27 71 71 71 gray28 71 71 71 grey28 74 74 74 gray29 74 74 74 grey29 77 77 77 gray30 77 77 77 grey30 79 79 79 gray31 79 79 79 grey31 82 82 82 gray32 82 82 82 grey32 84 84 84 gray33 84 84 84 grey33 87 87 87 gray34 87 87 87 grey34 89 89 89 gray35 89 89 89 grey35 92 92 92 gray36 92 92 92 grey36 94 94 94 gray37 94 94 94 grey37 97 97 97 gray38 97 97 97 grey38 99 99 99 gray39 99 99 99 grey39 102 102 102 gray40 102 102 102 grey40 105 105 105 gray41 105 105 105 grey41 107 107 107 gray42 107 107 107 grey42 110 110 110 gray43 110 110 110 grey43 112 112 112 gray44 112 112 112 grey44 115 115 115 gray45 115 115 115 grey45 117 117 117 gray46 117 117 117 grey46 120 120 120 gray47 120 120 120 grey47 122 122 122 gray48 122 122 122 grey48 125 125 125 gray49 125 125 125 grey49 127 127 127 gray50 127 127 127 grey50 130 130 130 gray51 130 130 130 grey51 133 133 133 gray52 133 133 133 grey52 135 135 135 gray53 135 135 135 grey53 138 138 138 gray54 138 138 138 grey54 140 140 140 gray55 140 140 140 grey55 143 143 143 gray56 143 143 143 grey56 145 145 145 gray57 145 145 145 grey57 148 148 148 gray58 148 148 148 grey58 150 150 150 gray59 150 150 150 grey59 153 153 153 gray60 153 153 153 grey60 156 156 156 gray61 156 156 156 grey61 158 158 158 gray62 158 158 158 grey62 161 161 161 gray63 161 161 161 grey63 163 163 163 gray64 163 163 163 grey64 166 166 166 gray65 166 166 166 grey65 168 168 168 gray66 168 168 168 grey66 171 171 171 gray67 171 171 171 grey67 173 173 173 gray68 173 173 173 grey68 176 176 176 gray69 176 176 176 grey69 179 179 179 gray70 179 179 179 grey70 181 181 181 gray71 181 181 181 grey71 184 184 184 gray72 184 184 184 grey72 186 186 186 gray73 186 186 186 grey73 189 189 189 gray74 189 189 189 grey74 191 191 191 gray75 191 191 191 grey75 194 194 194 gray76 194 194 194 grey76 196 196 196 gray77 196 196 196 grey77 199 199 199 gray78 199 199 199 grey78 201 201 201 gray79 201 201 201 grey79 204 204 204 gray80 204 204 204 grey80 207 207 207 gray81 207 207 207 grey81 209 209 209 gray82 209 209 209 grey82 212 212 212 gray83 212 212 212 grey83 214 214 214 gray84 214 214 214 grey84 217 217 217 gray85 217 217 217 grey85 219 219 219 gray86 219 219 219 grey86 222 222 222 gray87 222 222 222 grey87 224 224 224 gray88 224 224 224 grey88 227 227 227 gray89 227 227 227 grey89 229 229 229 gray90 229 229 229 grey90 232 232 232 gray91 232 232 232 grey91 235 235 235 gray92 235 235 235 grey92 237 237 237 gray93 237 237 237 grey93 240 240 240 gray94 240 240 240 grey94 242 242 242 gray95 242 242 242 grey95 245 245 245 gray96 245 245 245 grey96 247 247 247 gray97 247 247 247 grey97 250 250 250 gray98 250 250 250 grey98 252 252 252 gray99 252 252 252 grey99 255 255 255 gray100 255 255 255 grey100 169 169 169 dark grey 169 169 169 DarkGrey 169 169 169 dark gray 169 169 169 DarkGray 0 0 139 dark blue 0 0 139 DarkBlue 0 139 139 dark cyan 0 139 139 DarkCyan 139 0 139 dark magenta 139 0 139 DarkMagenta 139 0 0 dark red 139 0 0 DarkRed 144 238 144 light green 144 238 144 LightGreen gtk-0.15.9/demo/unicode/0000755000000000000000000000000007346545000013136 5ustar0000000000000000gtk-0.15.9/demo/unicode/Arabic.hs0000644000000000000000000000246207346545000014657 0ustar0000000000000000-- Example of an international dialog box. import Graphics.UI.Gtk import Control.Applicative import Prelude import Data.Char import qualified Data.Text as T import Data.Text (Text) main :: IO () main = do initGUI dia <- dialogNew dialogAddButton dia stockYes ResponseYes dialogAddButton dia stockNo ResponseNo contain <- castToBox <$> dialogGetContentArea dia theText <- labelNew (Nothing :: Maybe Text) labelSetMarkup theText (T.pack arabic) boxPackStart contain theText PackNatural 0 widgetShowAll dia res <- dialogRun dia case res of ResponseNo -> yell _ -> return () arabic :: String arabic = markSpan [FontSize (SizePoint 36)] $ --"Is Haskell a "++markSpan [FontForeground "red"] "fantastic"++" language?"++ -- Do you find Haskell a fantastic language? (language has a grammatical -- mistake in it) map chr [0x647,0x644,32,0x62A,0x62C,0x62F,0x646,32]++ markSpan [FontForeground "red"] (map chr [0x647,0x622,0x633,0x643,0x622,0x644])++ map chr [32,0x644,0x63A,0x62A,32,0x645,0x62F,0x647,0x634,0x62A,0x61F] yell :: IO () yell = do dia <- dialogNew dialogAddButton dia stockOk ResponseOk contain <- castToBox <$> dialogGetContentArea dia msg <- labelNew (Just "This is not an option.") boxPackStart contain msg PackNatural 0 widgetShow msg dialogRun dia return () gtk-0.15.9/demo/unicode/Makefile0000644000000000000000000000024007346545000014572 0ustar0000000000000000 PROG = arabic SOURCES = Arabic.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc gtk-0.15.9/gtk.cabal0000644000000000000000000004101207346545000012333 0ustar0000000000000000cabal-version: 2.2 Name: gtk Version: 0.15.9 License: LGPL-2.1-only License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team Author: Axel Simon, Duncan Coutts and many others Maintainer: gtk2hs-users@lists.sourceforge.net Build-Type: Custom Stability: provisional homepage: http://projects.haskell.org/gtk2hs/ bug-reports: https://github.com/gtk2hs/gtk2hs/issues Synopsis: Binding to the Gtk+ graphical user interface library. Description: This is the core library of the Gtk2Hs suite of libraries for Haskell based on Gtk+. Gtk+ is an extensive and mature multi-platform toolkit for creating graphical user interfaces. Category: Graphics Tested-With: GHC == 9.10.1, GHC == 9.8.2, GHC == 9.6.6, GHC == 9.4.8, GHC == 9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 Extra-Source-Files: hsgtk.h Graphics/UI/Gtk/ModelView/Gtk2HsStore.h Graphics/UI/Gtk/General/hsgthread.h template-hsc-gtk2hs.h marshal.list hierarchy.list x-Types-File: Graphics/UI/Gtk/Types.chs x-Types-ModName: Graphics.UI.Gtk.Types x-Types-Forward: *System.Glib.GObject Graphics.UI.Gtk.General.Threading x-Types-Destructor: objectUnrefFromMainloop Data-Dir: demo Data-Files: actionMenu/ActionMenu.hs actionMenu/Makefile buttonbox/ButtonBox.hs buttonbox/Makefile carsim/CarSim.hs carsim/Makefile concurrent/Makefile concurrent/Progress.hs concurrent/ProgressThreadedRTS.hs embedded/Embedded.hs embedded/Makefile embedded/MPlayer.hs embedded/Notes.txt embedded/Uzbl.hs fastdraw/FastDraw.hs fastdraw/Makefile filechooser/FileChooserDemo.glade filechooser/FileChooserDemo.hs filechooser/Makefile fonts/Fonts.hs fonts/Makefile graphic/Drawing.hs graphic/Makefile gtkbuilder/GtkBuilderTest.hs gtkbuilder/Makefile gtkbuilder/simple.ui hello/Makefile hello/World.hs inputmethod/Layout.hs inputmethod/Makefile menu/ComboDemo.hs menu/Makefile menu/MenuDemo.hs notebook/Notebook.hs notebook/Makefile statusicon/Makefile statusicon/StatusIcon.hs treelist/Completion.hs treelist/DirList.hs treelist/FilterDemo.hs treelist/ListDemo.hs treelist/ListDND.hs treelist/ListTest.glade treelist/ListTest.hs treelist/ListText.hs treelist/Makefile treelist/rgb.txt treelist/TreeDemo.hs treelist/TreeSort.hs treelist/TreeTest.glade treelist/TreeTest.hs treelist/resListDND/desktop.png treelist/resListDND/laptop.png treelist/resListDND/laptopSmall.png treelist/resListDND/printer.png treelist/resListDND/server.png treelist/resListDND/tower.png unicode/Arabic.hs unicode/Makefile demos.txt Source-Repository head type: git location: https://github.com/gtk2hs/gtk2hs subdir: gtk Flag deprecated Description: Include definitions in this library that are considered obsolete. Default: True Manual: True Flag have-gio Description: Depend on GIO package, thereby enabling certain features. Default: True Flag have-quartz-gtk Description: Assume that the installed GTK is the version for OS X backend by Quartz, and hence does not provide gdk_x11_drawable_get_xid Default: False Flag fmode-binary Description: Set the default file translation mode for file I/O operations to _O_BINARY. Some GTK libraries open image files without specifying binary mode. If you have trouble loading gtk in ghci, then it may help to turn this option off. Default: True custom-setup setup-depends: base >= 4.6 && < 5, Cabal >= 2.2 && < 3.13, gtk2hs-buildtools >= 0.13.2.0 && < 0.14 Library build-depends: base >= 4 && < 5, array < 0.6, bytestring < 0.13, containers < 0.8, mtl < 2.4, text >= 0.11.0.6 && < 2.2, glib >= 0.13.0.0 && < 0.14, pango >= 0.13.0.0 && < 0.14, cairo >= 0.13.0.0 && < 0.14 if flag(have-gio) build-depends: gio >= 0.13.0 && < 0.14 cpp-options: -DHAVE_GIO if flag(have-quartz-gtk) cpp-options: -DHAVE_QUARTZ_GTK exposed-modules: Graphics.UI.Gtk Graphics.UI.GtkInternals Graphics.UI.Gtk.Abstract.Bin Graphics.UI.Gtk.Abstract.Box Graphics.UI.Gtk.Abstract.ButtonBox Graphics.UI.Gtk.Abstract.Container Graphics.UI.Gtk.Abstract.IMContext Graphics.UI.Gtk.Abstract.Misc Graphics.UI.Gtk.Abstract.Object Graphics.UI.Gtk.Abstract.Paned Graphics.UI.Gtk.Abstract.Range Graphics.UI.Gtk.Abstract.Scale Graphics.UI.Gtk.Abstract.Scrollbar Graphics.UI.Gtk.Abstract.Separator Graphics.UI.Gtk.Abstract.Widget Graphics.UI.Gtk.ActionMenuToolbar.Action Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup Graphics.UI.Gtk.ActionMenuToolbar.RadioAction Graphics.UI.Gtk.ActionMenuToolbar.RecentAction Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction Graphics.UI.Gtk.ActionMenuToolbar.UIManager Graphics.UI.Gtk.Builder Graphics.UI.Gtk.Buttons.Button Graphics.UI.Gtk.Buttons.CheckButton Graphics.UI.Gtk.Buttons.RadioButton Graphics.UI.Gtk.Buttons.ToggleButton Graphics.UI.Gtk.Buttons.LinkButton Graphics.UI.Gtk.Buttons.ScaleButton Graphics.UI.Gtk.Buttons.VolumeButton Graphics.UI.Gtk.Cairo Graphics.UI.Gtk.Display.AccelLabel Graphics.UI.Gtk.Display.Image Graphics.UI.Gtk.Display.Label Graphics.UI.Gtk.Display.ProgressBar Graphics.UI.Gtk.Display.Spinner Graphics.UI.Gtk.Display.Statusbar Graphics.UI.Gtk.Display.StatusIcon Graphics.UI.Gtk.Display.InfoBar Graphics.UI.Gtk.Embedding.Embedding Graphics.UI.Gtk.Embedding.Plug Graphics.UI.Gtk.Embedding.Socket Graphics.UI.Gtk.Embedding.Types Graphics.UI.Gtk.Entry.Editable Graphics.UI.Gtk.Entry.Entry Graphics.UI.Gtk.Entry.EntryBuffer Graphics.UI.Gtk.Entry.EntryCompletion Graphics.UI.Gtk.Entry.HScale Graphics.UI.Gtk.Entry.SpinButton Graphics.UI.Gtk.Entry.VScale Graphics.UI.Gtk.Gdk.AppLaunchContext Graphics.UI.Gtk.Gdk.Cursor Graphics.UI.Gtk.Gdk.Keymap Graphics.UI.Gtk.Gdk.Display Graphics.UI.Gtk.Gdk.DisplayManager Graphics.UI.Gtk.Gdk.Drawable Graphics.UI.Gtk.Gdk.DrawWindow Graphics.UI.Gtk.Gdk.EventM Graphics.UI.Gtk.Gdk.Events Graphics.UI.Gtk.Gdk.GC Graphics.UI.Gtk.Gdk.Gdk Graphics.UI.Gtk.Gdk.Keys Graphics.UI.Gtk.Gdk.Pixbuf Graphics.UI.Gtk.Gdk.PixbufAnimation Graphics.UI.Gtk.Gdk.Pixmap Graphics.UI.Gtk.Gdk.Region Graphics.UI.Gtk.Gdk.Screen Graphics.UI.Gtk.General.Clipboard Graphics.UI.Gtk.General.Drag Graphics.UI.Gtk.General.General Graphics.UI.Gtk.General.IconFactory Graphics.UI.Gtk.General.IconTheme Graphics.UI.Gtk.General.RcStyle Graphics.UI.Gtk.General.Selection Graphics.UI.Gtk.General.Settings Graphics.UI.Gtk.General.StockItems Graphics.UI.Gtk.General.Style Graphics.UI.Gtk.Layout.Alignment Graphics.UI.Gtk.Layout.AspectFrame Graphics.UI.Gtk.Layout.Expander Graphics.UI.Gtk.Layout.Fixed Graphics.UI.Gtk.Layout.HBox Graphics.UI.Gtk.Layout.HButtonBox Graphics.UI.Gtk.Layout.HPaned Graphics.UI.Gtk.Layout.Layout Graphics.UI.Gtk.Layout.Notebook Graphics.UI.Gtk.Layout.Table Graphics.UI.Gtk.Layout.VBox Graphics.UI.Gtk.Layout.VButtonBox Graphics.UI.Gtk.Layout.VPaned Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem Graphics.UI.Gtk.MenuComboToolbar.Combo Graphics.UI.Gtk.MenuComboToolbar.ComboBox Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem Graphics.UI.Gtk.MenuComboToolbar.Menu Graphics.UI.Gtk.MenuComboToolbar.MenuBar Graphics.UI.Gtk.MenuComboToolbar.MenuItem Graphics.UI.Gtk.MenuComboToolbar.MenuShell Graphics.UI.Gtk.MenuComboToolbar.MenuToolButton Graphics.UI.Gtk.MenuComboToolbar.OptionMenu Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem Graphics.UI.Gtk.MenuComboToolbar.RadioToolButton Graphics.UI.Gtk.MenuComboToolbar.SeparatorMenuItem Graphics.UI.Gtk.MenuComboToolbar.SeparatorToolItem Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem Graphics.UI.Gtk.MenuComboToolbar.ToggleToolButton Graphics.UI.Gtk.MenuComboToolbar.Toolbar Graphics.UI.Gtk.MenuComboToolbar.ToolButton Graphics.UI.Gtk.MenuComboToolbar.ToolItem Graphics.UI.Gtk.MenuComboToolbar.ToolItemGroup Graphics.UI.Gtk.MenuComboToolbar.ToolPalette Graphics.UI.Gtk.Misc.Accessible Graphics.UI.Gtk.Misc.Adjustment Graphics.UI.Gtk.Misc.Arrow Graphics.UI.Gtk.Misc.Calendar Graphics.UI.Gtk.Misc.DrawingArea Graphics.UI.Gtk.Misc.EventBox Graphics.UI.Gtk.Misc.HandleBox Graphics.UI.Gtk.Misc.IMMulticontext Graphics.UI.Gtk.Misc.IMContextSimple Graphics.UI.Gtk.Misc.SizeGroup Graphics.UI.Gtk.Misc.Tooltip Graphics.UI.Gtk.Misc.Tooltips Graphics.UI.Gtk.Misc.Viewport Graphics.UI.Gtk.ModelView Graphics.UI.Gtk.ModelView.CellEditable Graphics.UI.Gtk.ModelView.CellLayout Graphics.UI.Gtk.ModelView.CellRenderer Graphics.UI.Gtk.ModelView.CellRendererSpinner Graphics.UI.Gtk.ModelView.CellRendererCombo Graphics.UI.Gtk.ModelView.CellRendererPixbuf Graphics.UI.Gtk.ModelView.CellRendererProgress Graphics.UI.Gtk.ModelView.CellRendererText Graphics.UI.Gtk.ModelView.CellRendererAccel Graphics.UI.Gtk.ModelView.CellRendererSpin Graphics.UI.Gtk.ModelView.CellRendererToggle Graphics.UI.Gtk.ModelView.CellView Graphics.UI.Gtk.ModelView.CustomStore Graphics.UI.Gtk.ModelView.IconView Graphics.UI.Gtk.ModelView.ListStore Graphics.UI.Gtk.ModelView.TreeDrag Graphics.UI.Gtk.ModelView.TreeModel Graphics.UI.Gtk.ModelView.TreeModelFilter Graphics.UI.Gtk.ModelView.TreeModelSort Graphics.UI.Gtk.ModelView.TreeRowReference Graphics.UI.Gtk.ModelView.TreeSelection Graphics.UI.Gtk.ModelView.TreeSortable Graphics.UI.Gtk.ModelView.TreeStore Graphics.UI.Gtk.ModelView.TreeView Graphics.UI.Gtk.ModelView.TreeViewColumn Graphics.UI.Gtk.Multiline.TextBuffer Graphics.UI.Gtk.Multiline.TextIter Graphics.UI.Gtk.Multiline.TextMark Graphics.UI.Gtk.Multiline.TextTag Graphics.UI.Gtk.Multiline.TextTagTable Graphics.UI.Gtk.Multiline.TextView Graphics.UI.Gtk.Ornaments.Frame Graphics.UI.Gtk.Ornaments.HSeparator Graphics.UI.Gtk.Ornaments.VSeparator Graphics.UI.Gtk.Printing.PaperSize Graphics.UI.Gtk.Printing.PageSetup Graphics.UI.Gtk.Printing.PrintContext Graphics.UI.Gtk.Printing.PrintOperation Graphics.UI.Gtk.Printing.PrintSettings Graphics.UI.Gtk.Recent.RecentChooserMenu Graphics.UI.Gtk.Recent.RecentChooserWidget Graphics.UI.Gtk.Recent.RecentFilter Graphics.UI.Gtk.Recent.RecentManager Graphics.UI.Gtk.Recent.RecentInfo Graphics.UI.Gtk.Recent.RecentChooser Graphics.UI.Gtk.Scrolling.HScrollbar Graphics.UI.Gtk.Scrolling.ScrolledWindow Graphics.UI.Gtk.Scrolling.VScrollbar Graphics.UI.Gtk.Selectors.ColorButton Graphics.UI.Gtk.Selectors.ColorSelection Graphics.UI.Gtk.Selectors.ColorSelectionDialog Graphics.UI.Gtk.Selectors.FileChooser Graphics.UI.Gtk.Selectors.FileChooserButton Graphics.UI.Gtk.Selectors.FileChooserDialog Graphics.UI.Gtk.Selectors.FileChooserWidget Graphics.UI.Gtk.Selectors.FileFilter Graphics.UI.Gtk.Selectors.FileSelection Graphics.UI.Gtk.Selectors.FontButton Graphics.UI.Gtk.Selectors.FontSelection Graphics.UI.Gtk.Selectors.FontSelectionDialog Graphics.UI.Gtk.Selectors.HSV Graphics.UI.Gtk.Special.Ruler Graphics.UI.Gtk.Special.HRuler Graphics.UI.Gtk.Special.VRuler Graphics.UI.Gtk.Windows.AboutDialog Graphics.UI.Gtk.Windows.Assistant Graphics.UI.Gtk.Windows.Dialog Graphics.UI.Gtk.Windows.Invisible Graphics.UI.Gtk.Windows.MessageDialog Graphics.UI.Gtk.Windows.Window Graphics.UI.Gtk.Windows.OffscreenWindow Graphics.UI.Gtk.Windows.WindowGroup Graphics.UI.Gtk.General.Enums other-modules: Graphics.UI.Gtk.Gdk.Enums Graphics.UI.Gtk.Gdk.PixbufData Graphics.UI.Gtk.General.Structs Graphics.UI.Gtk.ModelView.Types Graphics.UI.Gtk.ModelView.Sequence Graphics.UI.Gtk.Multiline.Types Graphics.UI.Gtk.Abstract.ContainerChildProperties Graphics.UI.Gtk.General.DNDTypes Graphics.UI.Gtk.General.Threading Graphics.UI.Gtk.Types Graphics.UI.Gtk.Signals autogen-modules: Graphics.UI.Gtk.Types Graphics.UI.Gtk.Signals default-language: Haskell98 default-extensions: ForeignFunctionInterface c-sources: Graphics/UI/Gtk/ModelView/Gtk2HsStore.c Graphics/UI/Gtk/General/hsgthread.c -- Due to http://hackage.haskell.org/trac/ghc/ticket/781 -- we need to compile the hsgthread.c module with -fPIC to ensure that a global -- variable in GLib that holds the address for the mutex lock and unlock functions -- is accessed correctly. This bug only exists on x86-64 platforms. if arch(x86_64) cc-options: -fPIC x-Signals-File: Graphics/UI/Gtk/Signals.chs x-Signals-Modname: Graphics.UI.Gtk.Signals x-Signals-Types: marshal.list -- the following field is only needed because the gtk package may have callbacks that -- take 'Widget's as arguments which, in turn, need gObjectUnrefFromMainloop which -- needs to be imported from this module: x-Signals-Import: Graphics.UI.Gtk.General.Threading include-dirs: . cpp-options: -U__BLOCKS__ -DGLIB_DISABLE_DEPRECATION_WARNINGS if os(darwin) || os(freebsd) cpp-options: -D_Nullable= -D_Nonnull= -D_Noreturn= -D__attribute__(x)= if !flag(deprecated) cpp-options: -DDISABLE_DEPRECATED else x-Types-Tag: deprecated if os(windows) cpp-options: -DWIN32 cc-options: -fno-exceptions extra-libraries: kernel32 if os(windows) cpp-options: -D__USE_MINGW_ANSI_STDIO=1 x-c2hs-Header: hsgtk.h x-Types-Hierarchy: hierarchy.list if os(windows) || flag(have-quartz-gtk) x-Types-Tag: default else x-Types-Tag: default plugNsocket cpp-options: -DHAVE_PLUG_AND_SOCKET if os(windows) && flag(fmode-binary) cc-options: -DGTK2HS_SET_FMODE_BINARY pkgconfig-depends: gthread-2.0, gtk+-2.0 gtk-0.15.9/hierarchy.list0000644000000000000000000004277707346545000013460 0ustar0000000000000000# This list is the result of a copy-and-paste from the GtkObject hierarchy # html documentation. Deprecated widgets are uncommented. Some additional # object have been defined at the end of the copied list. # The Gtk prefix of every object is removed, the other prefixes are # kept. The indentation implies the object hierarchy. In case the # type query function cannot be derived from the name or the type name # is different, an alternative name and type query function can be # specified by appending 'as typename, '. In case this # function is not specified, the is converted to # gtk__get_type where is where each upperscore # letter is converted to an underscore and lowerletter. The underscore # is omitted if an upperscore letter preceded: GtkHButtonBox -> # gtk_hbutton_box_get_type. The generation of a type can be # conditional by appending 'if '. Such types are only produces if # --tag= is given on the command line of TypeGenerator. # Before these conditions, two additional properties may be given: # * noDestr : ignores the destructor given by the --destructor # command line argument and uses 'objectUnref' # * noEq : do not make this type an instance of Eq; used # if a different equality instance is manually # defined later GObject AtkObject GtkAccessible if gtk-2.22 GdkKeymap if gtk-2.2 GdkDisplayManager if gtk-2.2 GdkAppLaunchContext if gtk-2.14 GtkPrintSettings if gtk-2.10 GtkPrintOperation if gtk-2.10 GtkPrintOperationPreview if gtk-2.10 GtkPageSetup if gtk-2.10 GtkPrintContext if gtk-2.10 GtkRecentChooser if gtk-2.10 GtkRecentManager if gtk-2.10 GdkDrawable GdkWindow as DrawWindow, gdk_window_object_get_type # GdkDrawableImplX11 # GdkWindowImplX11 GdkPixmap GdkGLPixmap if gtkglext GdkGLWindow if gtkglext GdkColormap GdkScreen if gtk-2.2 GdkDisplay if gtk-2.2 GdkVisual GdkDevice GtkSettings GtkTextBuffer GtkSourceBuffer if sourceview GtkSourceBuffer if gtksourceview2 GtkTextTag GtkSourceTag if sourceview GtkTextTagTable GtkSourceTagTable if sourceview GtkStyle GtkRcStyle GdkDragContext GdkPixbuf noDestr GdkPixbufAnimation noDestr GdkPixbufSimpleAnim noDestr GdkPixbufAnimationIter noDestr GtkTextChildAnchor GtkTextMark GtkSourceMarker if sourceview GtkSourceMark if gtksourceview2 GtkObject GtkRecentFilter if gtk-2.10 GtkWidget GtkHSV as HSV, gtk_hsv_get_type if gtk-2.14 GtkMisc GtkLabel GtkAccelLabel GtkTipsQuery if deprecated GtkArrow GtkImage GtkContainer GtkToolPalette if gtk-2.20 GtkToolItemGroup if gtk-2.20 WebKitWebView as WebView, webkit_web_view_get_type if webkit GtkBin GtkAlignment GtkFrame GtkAspectFrame GtkButton GtkScaleButton if gtk-2.12 GtkVolumeButton if gtk-2.12 GtkLinkButton if gtk-2.10 GtkToggleButton GtkCheckButton GtkRadioButton GtkColorButton if gtk-2.4 GtkFontButton if gtk-2.4 GtkOptionMenu if deprecated GtkItem GtkMenuItem GtkCheckMenuItem GtkRadioMenuItem GtkTearoffMenuItem GtkImageMenuItem GtkSeparatorMenuItem GtkListItem if deprecated # GtkTreeItem GtkWindow GtkAssistant if gtk-2.10 GtkOffscreenWindow if gtk-2.20 GtkDialog GtkAboutDialog if gtk-2.6 GtkColorSelectionDialog GtkFileSelection GtkFileChooserDialog if gtk-2.4 GtkFontSelectionDialog GtkInputDialog GtkMessageDialog GtkEventBox GtkHandleBox GtkScrolledWindow GtkViewport GtkExpander if gtk-2.4 GtkComboBox if gtk-2.4 GtkComboBoxEntry if gtk-2.4 GtkToolItem if gtk-2.4 GtkToolButton if gtk-2.4 GtkMenuToolButton if gtk-2.6 GtkToggleToolButton if gtk-2.4 GtkRadioToolButton if gtk-2.4 GtkSeparatorToolItem if gtk-2.4 GtkMozEmbed if mozembed VteTerminal as Terminal if vte GtkBox GtkButtonBox GtkHButtonBox GtkVButtonBox GtkVBox GtkRecentChooserWidget if gtk-2.10 GtkColorSelection GtkFontSelection GtkFileChooserWidget if gtk-2.4 GtkHBox GtkInfoBar if gtk-2.18 GtkCombo if deprecated GtkFileChooserButton if gtk-2.6 GtkStatusbar GtkCList if deprecated GtkCTree if deprecated GtkFixed GtkPaned GtkHPaned GtkVPaned GtkIconView if gtk-2.6 GtkLayout GtkList if deprecated GtkMenuShell GtkMenu GtkRecentChooserMenu if gtk-2.10 GtkMenuBar GtkNotebook # GtkPacker GtkTable GtkTextView GtkSourceView if sourceview GtkSourceView if gtksourceview2 GtkToolbar GtkTreeView GtkCalendar GtkCellView if gtk-2.6 GtkDrawingArea GtkSpinner if gtk-2.20 GtkEntry GtkSpinButton GtkRuler GtkHRuler GtkVRuler GtkRange GtkScale GtkHScale GtkVScale GtkScrollbar GtkHScrollbar GtkVScrollbar GtkSeparator GtkHSeparator GtkVSeparator GtkInvisible # GtkOldEditable # GtkText GtkPreview if deprecated # Progress is deprecated, ProgressBar contains everything necessary # GtkProgress GtkProgressBar GtkAdjustment GtkIMContext GtkIMMulticontext GtkIMContextSimple GtkItemFactory if deprecated GtkTooltips # These object were added by hand because they do not show up in the hierarchy # chart. # These are derived from GtkObject: GtkTreeViewColumn GtkCellRenderer GtkCellRendererSpinner if gtk-2.20 GtkCellRendererPixbuf GtkCellRendererText GtkCellRendererAccel if gtk-2.10 GtkCellRendererSpin if gtk-2.10 GtkCellRendererCombo if gtk-2.6 GtkCellRendererToggle GtkCellRendererProgress if gtk-2.6 GtkFileFilter if gtk-2.4 GtkBuilder if gtk-2.12 # These are actually interfaces, but all objects that implement it are at # least GObjects. GtkCellLayout if gtk-2.4 GtkTreeSortable if gtk-2.4 GtkTooltip if gtk-2.12 # These are derived from GObject: GtkStatusIcon if gtk-2.10 GtkTreeSelection GtkTreeModel GtkTreeStore GtkListStore GtkTreeModelSort GtkTreeModelFilter if gtk-2.4 GtkIconFactory GtkIconTheme GtkSizeGroup GtkClipboard if gtk-2.2 GtkAccelGroup GtkAccelMap if gtk-2.4 GtkEntryCompletion if gtk-2.4 GtkEntryBuffer if gtk-2.18 GtkAction if gtk-2.4 GtkRecentAction if gtk-2.12 GtkToggleAction if gtk-2.4 GtkRadioAction if gtk-2.4 GtkActionGroup if gtk-2.4 GtkUIManager if gtk-2.4 GtkWindowGroup GtkSourceLanguage if sourceview GtkSourceLanguage if gtksourceview2 GtkSourceLanguagesManager if sourceview GtkSourceLanguageManager if gtksourceview2 GladeXML as GladeXML, glade_xml_get_type if libglade GConfClient as GConf if gconf # These ones are actually interfaces, but interface implementations are GObjects GtkCellEditable GtkEditable GtkSourceStyle as SourceStyleObject if gtksourceview2 GtkSourceStyleScheme if sourceview GtkSourceStyleScheme if gtksourceview2 GtkSourceStyleSchemeManager if gtksourceview2 GtkFileChooser if gtk-2.4 ## This now became a GObject in version 2: GdkGC as GC, gdk_gc_get_type ## These are Pango structures PangoContext as PangoContext, pango_context_get_type if pango PangoLayout as PangoLayoutRaw, pango_layout_get_type if pango PangoFont as Font, pango_font_get_type if pango PangoFontFamily as FontFamily, pango_font_family_get_type if pango PangoFontFace as FontFace, pango_font_face_get_type if pango PangoFontMap as FontMap, pango_font_face_get_type if pango PangoFontset as FontSet, pango_fontset_get_type if pango ## This type is only available for PANGO_ENABLE_BACKEND compiled source ## PangoFontsetSimple as FontSetSimple, pango_fontset_simple_get_type ## GtkGlExt classes GdkGLContext if gtkglext GdkGLConfig if gtkglext GdkGLDrawable if gtkglext ## GnomeVFS classes GnomeVFSVolume as Volume, gnome_vfs_volume_get_type if gnomevfs GnomeVFSDrive as Drive, gnome_vfs_drive_get_type if gnomevfs GnomeVFSVolumeMonitor as VolumeMonitor, gnome_vfs_volume_monitor_get_type if gnomevfs ## GIO classes # Note on all the "as" clauses: the prefix G is unfortunate since it leads # to two consecutive upper case letters which are not translated with an # underscore each (e.g. GConf -> gconf, GtkHButtonBox -> gtk_hbutton_box). # GUnixMountMonitor as UnixMountMonitor, g_unix_mount_monitor_get_type if gio GOutputStream as OutputStream, g_output_stream_get_type if gio GFilterOutputStream as FilterOutputStream, g_filter_output_stream_get_type if gio GDataOutputStream as DataOutputStream, g_data_output_stream_get_type if gio GBufferedOutputStream as BufferedOutputStream, g_buffered_output_stream_get_type if gio # GUnixOutputStream as UnixOutputStream, g_unix_output_stream_get_type if gio GFileOutputStream as FileOutputStream, g_file_output_stream_get_type if gio GMemoryOutputStream as MemoryOutputStream, g_memory_output_stream_get_type if gio GInputStream as InputStream, g_input_stream_get_type if gio # GUnixInputStream as UnixInputStream, g_unix_input_stream_get_type if gio GMemoryInputStream as MemoryInputStream, g_memory_input_stream_get_type if gio GFilterInputStream as FilterInputStream, g_filter_input_stream_get_type if gio GBufferedInputStream as BufferedInputStream, g_buffered_input_stream_get_type if gio GDataInputStream as DataInputStream, g_data_input_stream_get_type if gio GFileInputStream as FileInputStream, g_file_input_stream_get_type if gio # GDesktopAppInfo as DesktopAppInfo, g_desktop_app_info_get_type if gio GFileMonitor as FileMonitor, g_file_monitor_get_type if gio GVfs as Vfs, g_vfs_get_type if gio GMountOperation as MountOperation, g_mount_operation_get_type if gio GThemedIcon as ThemedIcon, g_themed_icon_get_type if gio GEmblem as Emblem, g_emblem_get_type if gio GEmblemedIcon as EmblemedIcon, g_emblemed_icon_get_type if gio GFileEnumerator as FileEnumerator, g_file_enumerator_get_type if gio GFilenameCompleter as FilenameCompleter, g_filename_completer_get_type if gio GFileIcon as FileIcon, g_file_icon_get_type if gio GVolumeMonitor as VolumeMonitor, g_volume_monitor_get_type if gio GCancellable as Cancellable, g_cancellable_get_type if gio GSimpleAsyncResult as SimpleAsyncResult, g_async_result_get_type if gio GFileInfo as FileInfo, g_file_info_get_type if gio GAppLaunchContext as AppLaunchContext, g_app_launch_context_get_type if gio ## these are actually GInterfaces GIcon as Icon, g_icon_get_type if gio GSeekable as Seekable, g_seekable_get_type if gio GAppInfo as AppInfo, g_app_info_get_type if gio GVolume as Volume, g_volume_get_type if gio GAsyncResult as AsyncResult, g_async_result_get_type if gio GLoadableIcon as LoadableIcon, g_loadable_icon_get_type if gio GDrive as Drive, g_drive_get_type if gio GFile noEq as File, g_file_get_type if gio GMount as Mount, g_mount_get_type if gio ## GStreamer classes GstObject as Object, gst_object_get_type if gstreamer GstPad as Pad, gst_pad_get_type if gstreamer GstGhostPad as GhostPad, gst_ghost_pad_get_type if gstreamer GstPluginFeature as PluginFeature, gst_plugin_feature_get_type if gstreamer GstElementFactory as ElementFactory, gst_element_factory_get_type if gstreamer GstTypeFindFactory as TypeFindFactory, gst_type_find_factory_get_type if gstreamer GstIndexFactory as IndexFactory, gst_index_factory_get_type if gstreamer GstElement as Element, gst_element_get_type if gstreamer GstBin as Bin, gst_bin_get_type if gstreamer GstPipeline as Pipeline, gst_pipeline_get_type if gstreamer GstImplementsInterface as ImplementsInterface, gst_implements_interface_get_type if gstreamer GstTagSetter as TagSetter, gst_tag_setter_get_type if gstreamer GstBaseSrc as BaseSrc, gst_base_src_get_type if gstreamer GstPushSrc as PushSrc, gst_push_src_get_type if gstreamer GstBaseSink as BaseSink, gst_base_sink_get_type if gstreamer GstBaseTransform as BaseTransform, gst_base_transform_get_type if gstreamer GstPlugin as Plugin, gst_plugin_get_type if gstreamer GstRegistry as Registry, gst_registry_get_type if gstreamer GstBus as Bus, gst_bus_get_type if gstreamer GstClock as Clock, gst_clock_get_type if gstreamer GstAudioClock as AudioClock, gst_audio_clock_get_type if gstreamer GstSystemClock as SystemClock, gst_system_clock_get_type if gstreamer GstNetClientClock as NetClientClock, gst_net_client_clock_get_type if gstreamer GstIndex as Index, gst_index_get_type if gstreamer GstPadTemplate as PadTemplate, gst_pad_template_get_type if gstreamer GstTask as Task, gst_task_get_type if gstreamer GstXML as XML, gst_xml_get_type if gstreamer GstChildProxy as ChildProxy, gst_child_proxy_get_type if gstreamer GstCollectPads as CollectPads, gst_collect_pads_get_type if gstreamer ## these are actually GInterfaces GstURIHandler as URIHandler, gst_uri_handler_get_type if gstreamer GstAdapter as Adapter, gst_adapter_get_type if gstreamer GstController as Controller, gst_controller_get_type if gstreamer WebKitWebFrame as WebFrame, webkit_web_frame_get_type if webkit WebKitWebSettings as WebSettings, webkit_web_settings_get_type if webkit WebKitNetworkRequest as NetworkRequest, webkit_network_request_get_type if webkit WebKitNetworkResponse as NetworkResponse, webkit_network_response_get_type if webkit WebKitDownload as Download, webkit_download_get_type if webkit WebKitWebBackForwardList as WebBackForwardList, webkit_web_back_forward_list_get_type if webkit WebKitWebHistoryItem as WebHistoryItem, webkit_web_history_item_get_type if webkit WebKitWebInspector as WebInspector, webkit_web_inspector_get_type if webkit WebKitHitTestResult as HitTestResult, webkit_hit_test_result_get_type if webkit WebKitSecurityOrigin as SecurityOrigin, webkit_security_origin_get_type if webkit WebKitSoupAuthDialog as SoupAuthDialog, webkit_soup_auth_dialog_get_type if webkit WebKitWebDatabase as WebDatabase, webkit_web_database_get_type if webkit WebKitWebDataSource as WebDataSource, webkit_web_data_source_get_type if webkit WebKitWebNavigationAction as WebNavigationAction, webkit_web_navigation_action_get_type if webkit WebKitWebPolicyDecision as WebPolicyDecision, webkit_web_policy_decision_get_type if webkit WebKitWebResource as WebResource, webkit_web_resource_get_type if webkit WebKitWebWindowFeatures as WebWindowFeatures, webkit_web_window_features_get_type if webkit gtk-0.15.9/hsgtk.h0000644000000000000000000000315407346545000012060 0ustar0000000000000000#include /* these are necessary on Win32 to circumvent the structure size check */ #undef gtk_init_check #undef gtk_init #if GTK_MAJOR_VERSION >= 3 #include #endif #undef Bool #undef True #undef False #undef Button1 #undef Button2 #undef Button3 #undef Button4 #undef Button5 #undef Button1Mask #undef Button2Mask #undef Button3Mask #undef Button4Mask #undef Button5Mask #undef ShiftMask #undef LockMask #undef ControlMask #undef Mod1Mask #undef Mod2Mask #undef Mod3Mask #undef Mod4Mask #undef Mod5Mask #undef None #undef ParentRelative #undef CopyFromParent #undef PointerWindow #undef InputFocus #undef PointerRoot #undef AnyPropertyType #undef AnyKey #undef AnyButton #undef AllTemporary #undef CurrentTime #undef NoSymbol #undef NoEventMask #undef KeyPressMask #undef KeyReleaseMask #undef ButtonPressMask #undef ButtonReleaseMask #undef EnterWindowMask #undef LeaveWindowMask #undef PointerMotionMask #undef PointerMotionHintMask #undef Button1MotionMask #undef Button2MotionMask #undef Button3MotionMask #undef Button4MotionMask #undef Button5MotionMask #undef ButtonMotionMask #undef KeymapStateMask #undef ExposureMask #undef VisibilityChangeMask #undef StructureNotifyMask #undef ResizeRedirectMask #undef SubstructureNotifyMask #undef SubstructureRedirectMask #undef FocusChangeMask #undef PropertyChangeMask #undef ColormapChangeMask #undef OwnerGrabButtonMask #undef Status #undef Expose #undef Below #undef GrabSuccess #undef GrabAlreadyGrabbed #undef GrabInvalidTime #undef GrabNotViewable #undef GrabFrozen #undef OwnerChangeNewOwner #undef OwnerChangeDestroy #undef OwnerChangeClose #undef NULL gtk-0.15.9/marshal.list0000644000000000000000000001206207346545000013111 0ustar0000000000000000# see glib-genmarshal(1) for a detailed description of the file format, # possible parameter types are: # VOID indicates no return type, or no extra # parameters. if VOID is used as the parameter # list, no additional parameters may be present. # BOOLEAN for boolean types (gboolean) # CHAR for signed char types (gchar) # UCHAR for unsigned char types (guchar) # INT for signed integer types (gint) # UINT for unsigned integer types (guint) # LONG for signed long integer types (glong) # ULONG for unsigned long integer types (gulong) # ENUM for enumeration types (gint) # FLAGS for flag enumeration types (guint) # FLOAT for single-precision float types (gfloat) # DOUBLE for double-precision float types (gdouble) # GLIBSTRING for string types (gchar*) # BOXED for boxed (anonymous but reference counted) types (GBoxed*) # POINTER for anonymous pointer types (gpointer) # NONE deprecated alias for VOID # BOOL deprecated alias for BOOLEAN # # One discrepancy from Gtk+ is that for signals that may pass NULL for an object # reference, the Haskell signal should be passed a 'Maybe GObject'. # We therefore have two variants that are marshalled as a maybe type: # # OBJECT for GObject or derived types (GObject*) # MOBJECT for GObject or derived types (GObject*) that may be NULL # Furthermore, some objects needs to be destroyed synchronously from the main loop of # Gtk rather than during GC. These objects need to be marshalled using TOBJECT (for thread-safe # object). It doesn't hurt to use TOBJECT for an object that doesn't need it, except for the # some performance. As a rule of thumb, use TOBJECT for all libraries that build on package # 'gtk' and use OBJECT for all packages that only need packages 'glib', 'pango', 'cairo', # 'gio'. Again both variants exist. Note that the same names will be generated for OBJECT and # TOBJECT, so you have to remove the OBJECT handler if you need both. # # TOBJECT for GObject or derived types (GObject*) # MTOBJECT for GObject or derived types (GObject*) that may be NULL # If you add a new signal type, please check that it actually works! # If it is a Boxed type check that the reference counting is right. BOOLEAN:BOXED BOOLEAN:POINTER BOOLEAN:BOXED,BOXED BOOLEAN:ENUM BOOLEAN:ENUM,DOUBLE BOOLEAN:INT #BOOLEAN:ENUM,INT #BOOLEAN:TOBJECT,UINT,FLAGS #BOOLEAN:TOBJECT,INT,INT,UINT #BOOLEAN:TOBJECT,GLIBSTRING,GLIBSTRING,BOXED BOOLEAN:TOBJECT,BOXED #BOOLEAN:TOBJECT,BOXED,BOXED #BOOLEAN:TOBJECT,GLIBSTRING,GLIBSTRING BOOLEAN:INT,INT BOOLEAN:INT,INT,INT BOOLEAN:UINT BOOLEAN:VOID BOOLEAN:BOOLEAN #BOOLEAN:BOOLEAN,BOOLEAN,BOOLEAN ENUM:VOID ENUM:ENUM INT:POINTER VOID:BOOLEAN #VOID:ENUM VOID:INT #VOID:INT,BOOLEAN VOID:INT,INT VOID:VOID #VOID:GLIBSTRING,INT,POINTER #GLIBSTRING:DOUBLE VOID:DOUBLE #VOID:BOOLEAN,BOOLEAN,BOOLEAN VOID:BOXED VOID:BOXED,BOXED VOID:BOXED,BOXED,POINTER VOID:BOXED,TOBJECT #VOID:BOXED,GLIBSTRING,INT VOID:BOXED,UINT #VOID:BOXED,UINT,FLAGS #VOID:BOXED,UINT,UINT VOID:ENUM #VOID:ENUM,BOOLEAN #VOID:ENUM,ENUM #VOID:ENUM,FLOAT #VOID:ENUM,FLOAT,BOOLEAN VOID:ENUM,INT VOID:ENUM,INT,BOOLEAN #VOID:INT #VOID:INT,INT #VOID:INT,INT,BOXED #VOID:INT,INT,INT VOID:TOBJECT VOID:MTOBJECT #VOID:TOBJECT,BOOLEAN VOID:TOBJECT,BOXED,BOXED #VOID:TOBJECT,BOXED,UINT,UINT #VOID:TOBJECT,INT,INT #VOID:TOBJECT,INT,INT,BOXED,UINT,UINT VOID:TOBJECT,TOBJECT #VOID:TOBJECT,GLIBSTRING,GLIBSTRING #VOID:TOBJECT,UINT #VOID:TOBJECT,UINT,FLAGS VOID:POINTER #VOID:POINTER,INT #VOID:POINTER,BOOLEAN #VOID:POINTER,POINTER,POINTER VOID:POINTER,UINT VOID:GLIBSTRING # This is for the "edited" signal in CellRendererText: VOID:GLIBSTRING,GLIBSTRING #VOID:GLIBSTRING,INT,POINTER #VOID:GLIBSTRING,UINT,FLAGS #VOID:UINT,FLAGS,BOXED VOID:UINT,UINT VOID:UINT,GLIBSTRING #VOID:UINT,BOXED,UINT,FLAGS,FLAGS #VOID:UINT,TOBJECT,UINT,FLAGS,FLAGS # This marshaller is necessary to marshal a string with explicit length in a # callback "text-insert" in TextBuffer. VOID:BOXED,POINTER,INT # This one is needed in TextView: VOID:INT,BOOLEAN # This is for the "editing-started" in CellRenderer VOID:TOBJECT,GLIBSTRING # This is for GtkMozEmbed BOOLEAN:GLIBSTRING # This makes it possible to catch events on TextTags BOOLEAN:TOBJECT,POINTER,BOXED BOOLEAN:POINTER,BOXED,BOXED # This is onInsertText in Editable VOID:POINTER,INT,POINTER # For SelectionData VOID:POINTER,UINT,UINT VOID:TOBJECT,POINTER,UINT,UINT VOID:TOBJECT,INT,INT,POINTER,UINT,UINT BOOLEAN:TOBJECT,INT,INT,UINT VOID:TOBJECT,UINT BOOLEAN:TOBJECT,INT,INT,UINT # for GtkRange::change-value BOOLEAN:ENUM,DOUBLE # for Drag.dragFailed BOOLEAN:TOBJECT,ENUM # for TextBuffer NONE:BOXED,GLIBSTRING # for Notebook NONE:TOBJECT,INT BOOLEAN:ENUM,BOOLEAN NONE:BOXED,INT # for TextBuffer NONE:BOXED,GLIBSTRING # For queryTooltip BOOLEAN:TOBJECT,INT,INT,BOOLEAN,TOBJECT # For EntryBuffer NONE:INT,GLIBSTRING,INT # For CellRendererAccel NONE:GLIBSTRING,INT,ENUM,INT # For PrintOperation BOOLEAN:OBJECT NONE:OBJECT,INT,OBJECT NONE:OBJECT,OBJECT,OBJECT BOOLEAN:OBJECT,OBJECT,OBJECT VOID:ENUM,POINTER gtk-0.15.9/template-hsc-gtk2hs.h0000644000000000000000000000110607346545000014521 0ustar0000000000000000#ifndef _TEMPLATE_HSC_GTK2HS_H_ #define _TEMPLATE_HSC_GTK2HS_H_ #include #define hsc_gtk2hs_type(t) \ if ((t)(int)(t)1.4 == (t)1.4) \ printf ("%s%" G_GSIZE_FORMAT, \ (t)(-1) < (t)0 ? "Int" : "Word", \ sizeof (t) * 8); \ else \ printf ("%s", \ sizeof (t) > sizeof (double) ? "LDouble" : \ sizeof (t) == sizeof (double) ? "Double" : \ "Float"); #endif