1 patch for repository http://code.haskell.org/gtk2hs:
Sat May 8 18:39:08 CST 2010 Andy Stewart <lazycat.mana...@gmail.com> * Add module `IconTheme` to support GIO (get icon pixbuf for files).
New patches: [Add module `IconTheme` to support GIO (get icon pixbuf for files). Andy Stewart <lazycat.mana...@gmail.com>**20100508103908 Ignore-this: f038b0bb54a5b9b01b7b364542d771be ] { hunk ./gtk/Graphics/UI/Gtk.chs 46 -- * 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.Drag, hunk ./gtk/Graphics/UI/Gtk.chs 234 -- 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.Drag addfile ./gtk/Graphics/UI/Gtk/General/IconTheme.chs hunk ./gtk/Graphics/UI/Gtk/General/IconTheme.chs 1 +{-# 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-us...@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 selecetd 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(3) 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(3)., 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 ENABLE_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.Attributes +import System.Glib.Properties +import System.Glib.UTFString +import System.Glib.GList +import System.Glib.Flags +import System.Glib.GObject (constructNewGObject, makeNewGObject, Quark) +import System.Glib.GError (GErrorDomain, GErrorClass(..), propagateGError) +import Graphics.UI.Gtk.General.Structs (Rectangle, Point) +{#import Graphics.UI.Gtk.Types#} +{#import Graphics.UI.Gtk.Signals#} +#ifdef ENABLE_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 = + constructNewGObject 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 => self + -> [FilePath] -- ^ @path@ - list of directories that are searched for icon + -- themes + -> Int -- ^ @nElements@ - number of elements in @p...@. + -> IO () +iconThemeSetSearchPath self path nElements = + withUTFStringArray path $ \pathPtr -> + {# call gtk_icon_theme_set_search_path #} + (toIconTheme self) + pathPtr + (fromIntegral nElements) + +-- | Gets the current search path. See 'iconThemeSetSearchPath'. +-- +iconThemeGetSearchPath :: IconThemeClass self => self + -> IO ([FilePath], 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 <- readUTFStringArray0 pathPtr + nElements <- peek nElementsPtr + return (pathStr, fromIntegral nElements) + +-- | Appends a directory to the search path. See 'iconThemeSetSearchPath'. +-- +iconThemeAppendSearchPath :: IconThemeClass self => self + -> FilePath -- ^ @path@ - directory name to append to the icon path + -> IO () +iconThemeAppendSearchPath self path = + withUTFString path $ \pathPtr -> + {# call gtk_icon_theme_append_search_path #} + (toIconTheme self) + pathPtr + +-- | Prepends a directory to the search path. See 'iconThemeSetSearchPath'. +-- +iconThemePrependSearchPath :: IconThemeClass self => self + -> FilePath -- ^ @path@ - directory name to prepend to the icon path + -> IO () +iconThemePrependSearchPath self path = + withUTFString 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 => 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 => self + -> String -- ^ @iconName@ - the name of an icon + -> IO Bool -- ^ returns @True@ if @iconTheme@ includes an icon for + -- @iconn...@. +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 => 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 => 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 ENABLE_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 => 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 (makeNewGObject 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 => 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 => 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 => 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 => 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 :: + 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 + -- @iconn...@. + -> 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 :: 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 + -> Rectangle -- ^ @rectangle@ 'Rectangle' in which to store embedded + -- rectangle coordinates; coordinates are only stored when this function + -> IO Bool -- ^ returns 'True' if the icon has an embedded rectangle +iconInfoGetEmbeddedRect self rectangle = + liftM toBool $ + with rectangle $ \ rectanglePtr -> + {# call gtk_icon_info_get_embedded_rect #} + self + (castPtr rectanglePtr) + +-- | 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 :: 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 = + makeNewGObject 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 + hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 1 -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 6 #include <gtk/gtk.h> +#include <gdk/gdk.h> #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) Structures hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 127 -- | 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)} hunk ./gtk/gtk.cabal 109 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.StockItems hunk ./tools/hierarchyGen/hierarchy.list 195 GtkTreeModelSort GtkTreeModelFilter if gtk-2.4 GtkIconFactory + GtkIconTheme GtkSizeGroup GtkClipboard if gtk-2.2 GtkAccelGroup } Context: [Include the setup files in the distribution. axel.si...@in.tum.de**20100505075727 Ignore-this: d56ac4eb24866e5d917386b2df6ec28e ] [Make the bootstrap file ignore a package if it can't be built. axel.si...@in.tum.de**20100505075646 Ignore-this: d92362cd5d0ee8820c127a0367e4d498 ] [Fix documenation to Editable. axel.si...@in.tum.de**20100504135848 Ignore-this: d9494bc1fb323d50164f219423a5e17 ] [Fix textView signals (rename `setScrollAdjustments` to `setTextViewScrollAdjustments`) and fix signal docs. Andy Stewart <lazycat.mana...@gmail.com>**20100503140719 Ignore-this: 3fcfbfe8659c1f01d806990a6a59e0dc ] [Fix TextView signals. Andy Stewart <lazycat.mana...@gmail.com>**20100502110206 Ignore-this: 3cc1d9c7e1452e577264f2a287852a22 ] [Add bootstrap.sh. Andy Stewart <lazycat.mana...@gmail.com>**20100501220434 Ignore-this: bdcf47e2a0b99436967f6338c8f00141 ] [Fix cairo demo. Andy Stewart <lazycat.mana...@gmail.com>**20100501214046 Ignore-this: bb37935be21a3414d6540d39b74d57c6 ] [Fix scaling demo and move to `gtk2hs/glade/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501211752 Ignore-this: 26b0499662347edb6067e8f8397a406c ] [Move profileviewer demo to `gtk2hs/glade/demo.` Andy Stewart <lazycat.mana...@gmail.com>**20100501211335 Ignore-this: 80f20961b905bca023b4813e7b99f2db ] [Fix noughty demo and move to `gtk2hs/glade/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501211126 Ignore-this: 598b67397619be71313289a86c3f1dc6 ] [Move calc demo to `gtk2hs/glade/demo` and adjust glade demo. Andy Stewart <lazycat.mana...@gmail.com>**20100501210542 Ignore-this: 152abe8888a55ec4a2c106292a58b6cf ] [Fix carsim demo. Andy Stewart <lazycat.mana...@gmail.com>**20100501210132 Ignore-this: 1502949718304229aa7d6d82084eb442 ] [Remove warning for GtkInternal. Andy Stewart <lazycat.mana...@gmail.com>**20100501205623 Ignore-this: b1b60e69e87208431f7f287ae8174f26 ] [Axel, Gtk2HsSetup.hs can't works with pango, so i rollback your patche to make pango can compile pass. Please push new patches when you fix it. Andy Stewart <lazycat.mana...@gmail.com>**20100501180134 Ignore-this: db2796b94f08260401cff17b638ef6a4 ] [Move cairo demo to `gtk2hs/cairo/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501174106 Ignore-this: 59379042dbc12ed64d7c6fa67da613a6 ] [Move pango demo to `gtk2hs/pango/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501173621 Ignore-this: f93de2952148b90d739bf4e06f31fcaa ] [Move svg demo to `gtk2hs/svgcairo/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501173518 Ignore-this: da7867efa4d2c2c21fedd7a2335048e7 ] [Move soe demo to `gtk2hs/soegtk/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501173350 Ignore-this: f861db155bcb0b0f266ccbcac2770ef5 ] [Move opengl demo to `gtk/gtkglext/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501173231 Ignore-this: 5c11b627899153dfec86424037ad147e ] [Move gnomevfs demo to `gtk2hs/gnomevfs/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501173035 Ignore-this: 3c4019cd021cd9349e7a794f0c73bea6 ] [Move glade demo to `gtk2hs/glade/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501171808 Ignore-this: c3cc3e5a3fb50e9c97ea4d141e993151 ] [Move gconf demo to `gtk2hs/gconf/demo`. Andy Stewart <lazycat.mana...@gmail.com>**20100501171629 Ignore-this: b4011619e7e1096307d5fb9bf7212982 ] [Remove vte and webkit demo from main repo (those demos have exist in `gtk2hs/vte/demo` and `gtk2hs/webkit/demo`) Andy Stewart <lazycat.mana...@gmail.com>**20100501171314 Ignore-this: 1aa0f5ed4fc91b00ded2affad59061eb ] [Fix compile error of soegtk. Andy Stewart <lazycat.mana...@gmail.com>**20100501162122 Ignore-this: f6661f25cb9a067a24d7db7242dcab3a ] [Fix compile error of webkit. Andy Stewart <lazycat.mana...@gmail.com>**20100501162011 Ignore-this: 2f6fe99208c5e17d4fd906b2f70b18b9 ] [Fix compile error of vte. Andy Stewart <lazycat.mana...@gmail.com>**20100501161926 Ignore-this: b837e1f746a7f8779ec49758f9741c4c ] [Fix compile error of gtksourceview2. Andy Stewart <lazycat.mana...@gmail.com>**20100501161826 Ignore-this: d7f05977a77f1330d14915e5895b526c ] [Fix compile error of gnomevfs. Andy Stewart <lazycat.mana...@gmail.com>**20100501161739 Ignore-this: 8300370414f8840fcb7897e199025d75 ] [Fix compile error of gio. Andy Stewart <lazycat.mana...@gmail.com>**20100501161612 Ignore-this: 30af23f768bf3823c55db6db33fae8e9 ] [Fix compile error of gconf. Andy Stewart <lazycat.mana...@gmail.com>**20100501161504 Ignore-this: 67c9dc2b5c337476bf3fb5ef5aa3ceb4 ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501150933 Ignore-this: b4c2102781b831bd3b787bde35ffcda6 ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501150755 Ignore-this: cdc12e9af9b22e54ef4ac288dc8b9000 ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501150605 Ignore-this: 58710ee1f00cd1242057f1cbdcee94ff ] [Make SOE a really simple package, since it is. axel.si...@in.tum.de**20100501150526 Ignore-this: f35f2729f101b34f3e9d47b60ead6171 ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501150156 Ignore-this: 9e17194a9abf7cd0b31061249694edda ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501145457 Ignore-this: 90c6e9badb9b88a25c58a07e3dec6d11 ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501145419 Ignore-this: 6becb507b1606e949d0d13720d361850 ] [Replace Setup.hs by the default setup files. axel.si...@in.tum.de**20100501144608 Ignore-this: 43ea6510fb65dfbb2e76130cb274a364 ] [Install the standard setup files in gio. axel.si...@in.tum.de**20100501144140 Ignore-this: a21f5c4e5e0aecc52c967a31e90c2d37 ] [Fix the build infrastructure of gconf. axel.si...@in.tum.de**20100501143402 Ignore-this: c0f1e1e066e9a7f9f733a4b768d9196d ] [Expose module `System.Gnome.VFS` in gnomevfs.cabal Andy Stewart <lazycat.mana...@gmail.com>**20100428122845 Ignore-this: 70069732773614e4323d696cb887a2d1 ] [gnomevfs Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100530 Ignore-this: 5bbab11f5a0e5c0c790fd917659722c7 ] [webkit Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428101329 Ignore-this: 3b4d27f26dcfb80aec42923906938106 ] [vte Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428101229 Ignore-this: 2618acc76f647f454e6e1bf5f588e858 ] [svgcairo Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100832 Ignore-this: 5c55b0a69f3e7938712e3deb51091cac ] [soegtk Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100758 Ignore-this: ad606092c1d9afbef2a70b8e9b62cc38 ] [gtksource2 Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100657 Ignore-this: d9c8bd42bc893928d04b132a1a6c29ae ] [gtkglext Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100617 Ignore-this: 485ca74cc042b8751415c7e960650a23 ] [gconf Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100216 Ignore-this: 26854e53627320a7ef3a65f6823fcb60 ] [GIO Cabal package (Fix doc, add new functions: `fileHasParent` and `fileQueryFileType`) Andy Stewart <lazycat.mana...@gmail.com>**20100428095858 Ignore-this: 3b53dc9cd495f92e9a7652e14d1cb05b ] [glade Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100428100433 Ignore-this: c152a8f7de7a4622d2f8f5e6aa30b835 ] [Always build Plug and Socket, even on Windows. axel.si...@in.tum.de**20100501133611 Ignore-this: 3d318997a29c769d415238ad7bed881b ] [Seperate the standard setup functionality from that necessary for specific packages. axel.si...@in.tum.de**20100501133156 Ignore-this: 326634d72596f48f1e76ffd688c0f79f ] [Let the default Signal template import GtkInternals. axel.si...@in.tum.de**20100501133050 Ignore-this: 2f2e8944aa1cc5a5831cabd8c86f119c ] [Pick the right function to load a Pixbuf on Windows. axel.si...@in.tum.de**20100501132726 Ignore-this: 3e114b00529c96bedea2cb1214dd27b2 ] [Add `Emblem` and `EmblemedIcon` in hierarchy.list to support gio. Andy Stewart <lazycat.mana...@gmail.com>**20100430180426 Ignore-this: 9bb1953f8b0a82e895c7f723acf78def ] [Add new functions `readUTFStringArray0` for gio binding. Andy Stewart <lazycat.mana...@gmail.com>**20100430071318 Ignore-this: d8d756fca5e216862594e9957a178875 ] [Add callback `NONE:OBJECT,OBJECT,ENUM` for gio. Andy Stewart <lazycat.mana...@gmail.com>**20100430035445 Ignore-this: e594257b6d014dd1c92132e7c6ef399c ] [Add callback `NONE:STRING,STRING,STRING,ENUM` to support gio. Andy Stewart <lazycat.mana...@gmail.com>**20100429201243 Ignore-this: 9b38ae786b5b2866764a276ec5e40b00 ] [Add function `widgetGetAllocation` and fix version tag. Andy Stewart <lazycat.mana...@gmail.com>**20100428151304 Ignore-this: 74e831fd17d3f1bbd2761e2e778e4e4e ] [re-export `toNativeWindowId` and `fromNativeWindowId` to fix Embedded demos. Andy Stewart <lazycat.mana...@gmail.com>**20100428151139 Ignore-this: 6e49f7548a461e1da10c5e2a1ff385e6 ] [Fix cycle import problem, and expose `Threading` modules for use in Signals.chs Andy Stewart <lazycat.mana...@gmail.com>**20100428145100 Ignore-this: 5c350d915116b87c728b69942b461bd1 * Signal.chs.template : restore to "import Graphics.UI.Gtk.General.Threading". * GtkInternals.chs : remove Graphics.UI.Gtk.General.Threading, otherwise cycle import when compile gtk. * Threading.hs : Add nots that don't use this module in application. * gtk.cabal : expose Graphics.UI.Gtk.General.Threading ] [Adjust GtkInternal.chs and Signal.chs.template to support non-core packages. Andy Stewart <lazycat.mana...@gmail.com>**20100428094453 Ignore-this: bf2cfe48234ea434dbb108e780dad346 Becuase Signal.chs in non-core packages need import `Graphics.UI.Gtk.General.Threading`, so i add it in GtkInternal and change Signa.chs template. ] [Add new callback for gconf. Andy Stewart <lazycat.mana...@gmail.com>**20100425025913 Ignore-this: dd81d8a5dff016895855bd947114b893 ] [Call c2hs with the bare filename as its output. axel.si...@in.tum.de**20100423152501 Ignore-this: c9be4c390228577708614efa892a24b7 ] [Explicitly link in gthread which is required to find g_thread_init. axel.si...@in.tum.de**20100423145524 Ignore-this: 11729966fdc935ccc3605dc51102d1f4 ] [Move modules back to the not-exposed section and add them to the Internals module instead. axel.si...@in.tum.de**20100422153008 Ignore-this: 255f909810a01cc250790b1423643551 ] [Ensure all end-user types names are exposed through Gtk.hs and make low-level type names available through a new module. axel.si...@in.tum.de**20100422141222 Ignore-this: c8f2000df7eb6ceb0f67bfebd3286d9c ] [Move the pango C lib version stuff into the Setup.hs Duncan Coutts <dun...@haskell.org>**20100422001240 Ignore-this: 795b62cbd00a5a29c6e2373174f0f757 Rather than using flags in the .cabal file. Generate a .h file with the pango version number and include that in the local hspango.h. ] [Hack in Setup.hs for include dirs, avoiding worse hack in .cabal files Duncan Coutts <dun...@haskell.org>**20100422000751 Ignore-this: 1017665f67f060f7ad1a1dd663a9386d Ought to be fixed in Cabal lib ] [Minor tweaks to Setup.hs scripts Duncan Coutts <dun...@haskell.org>**20100421233554 Ignore-this: 5de7745bd7fc5d49d470f5a38ac8e5a9 ] [Add build-tools dependencies to .cabal files Duncan Coutts <dun...@haskell.org>**20100421233016 Ignore-this: 2ca87ca412766d96c688de06e93a29dd ] [Change the way the type tags are handled in the .cabal and Setup.hs files Duncan Coutts <dun...@haskell.org>**20100421211616 Ignore-this: bcbc507af8fb3a6103e505bc6361bd38 In particular it eliminates the need for users to specify -fgtk_x_y flags. ] [Add upper bounds on deps within gtk2hs packages Duncan Coutts <dun...@haskell.org>**20100421154805 Ignore-this: ddc073c270f471583edfcd7f5063dc83 This is only approximate, they may need to be tighter still. ] [Add upper bound on base version in .cabal files Duncan Coutts <dun...@haskell.org>**20100421154742 Ignore-this: 940b0938c956685b9996aa01b5a4e362 ] [Adjust hackage category of build tools Duncan Coutts <dun...@haskell.org>**20100421152105 Ignore-this: b0b2a6179fcff848c756d6e6d7ee4b5d ] [Add source repository info to package .cabal files Duncan Coutts <dun...@haskell.org>**20100421151640 Ignore-this: 9e55a05581df93c5642547ab964fc9be ] [Adjust URLs in .cabal files Duncan Coutts <dun...@haskell.org>**20100421151036 Ignore-this: 14fdbc10e96f0c07e85fcb37a8b92813 Use full http:// url for the homepage. Use the root of the gtk2hs trac for bug reports because that has the info on how report a bug. Remove the package-url field because it is deprecated and useless. ] [Fix license name/version in .cabal files for glib, pango, gtk and tools Duncan Coutts <dun...@haskell.org>**20100421150549 Ignore-this: 9e316a7f7ac55dbf2ff8d6f87d8dcdfd glib, pango and gtk are LGPL not GPL. Cabal now allows us to specify the license version, so specify that too. ] [Fix hierarchy.list typo and make Multiline.Types expose to support Sourceview2 Cabal package Andy Stewart <lazycat.mana...@gmail.com>**20100422075609 Ignore-this: a81b85782f8480c633ebcd882bd8a6ba ] [Fix gtk.cabal, make some modules expose to support WebKit Cabal package. Andy Stewart <lazycat.mana...@gmail.com>**20100422070445 Ignore-this: 4e1d125b2bf655f4a502aa73b9a6a9b6 ] [Fix WebKit name in hierarchy.list Andy Stewart <lazycat.mana...@gmail.com>**20100421213615 Ignore-this: 1f1d0daa69c2b9d08af7086ee6aad926 ] [Undo moving the Types file to the exposed modules. This can't build. axel.si...@in.tum.de**20100421133856 Ignore-this: 3fd910eb3ba8f76a41d68d595c8d053b ] [TAG 0.10.5 axel.si...@in.tum.de**20100421122640 Ignore-this: 2b933470cd14a19e695a4387c97c83e7 ] Patch bundle hash: 467a58698302f50a895581e52cdd75ae2b2e47b7
------------------------------------------------------------------------------
_______________________________________________ Gtk2hs-devel mailing list Gtk2hs-devel@lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/gtk2hs-devel