diff --git a/Graphics/UI/Gtk.chs b/Graphics/UI/Gtk.chs --- a/Graphics/UI/Gtk.chs +++ b/Graphics/UI/Gtk.chs @@ -279,7 +279,7 @@ 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)) +#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, @@ -555,7 +555,7 @@ 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)) +#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 diff --git a/Graphics/UI/Gtk/Cairo.chs b/Graphics/UI/Gtk/Cairo.chs --- a/Graphics/UI/Gtk/Cairo.chs +++ b/Graphics/UI/Gtk/Cairo.chs @@ -54,6 +54,7 @@ renderWithDrawable, region, #else + getClipRectangle, renderWithDrawWindow, #endif setSourceColor, @@ -128,6 +129,20 @@ 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 diff --git a/Graphics/UI/Gtk/Embedding/Embedding.hsc b/Graphics/UI/Gtk/Embedding/Embedding.hsc --- a/Graphics/UI/Gtk/Embedding/Embedding.hsc +++ b/Graphics/UI/Gtk/Embedding/Embedding.hsc @@ -35,6 +35,7 @@ #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. -- diff --git a/Graphics/UI/Gtk/Embedding/Plug.chs b/Graphics/UI/Gtk/Embedding/Plug.chs --- a/Graphics/UI/Gtk/Embedding/Plug.chs +++ b/Graphics/UI/Gtk/Embedding/Plug.chs @@ -48,7 +48,7 @@ -- | +----Plug -- @ -#if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) +#if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) -- * Types Plug, PlugClass, @@ -78,7 +78,7 @@ #endif ) where -#if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) +#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) @@ -88,6 +88,7 @@ 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 diff --git a/Graphics/UI/Gtk/Embedding/Socket.chs b/Graphics/UI/Gtk/Embedding/Socket.chs --- a/Graphics/UI/Gtk/Embedding/Socket.chs +++ b/Graphics/UI/Gtk/Embedding/Socket.chs @@ -82,7 +82,7 @@ -- | +----Socket -- @ -#if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) +#if (defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0))) || defined(GDK_WINDOWING_X11) -- * Types Socket, SocketClass, @@ -115,7 +115,7 @@ #endif ) where -#if defined(HAVE_PLUG_AND_SOCKET) && (!defined(WIN32) || GTK_CHECK_VERSION(2,8,0)) +#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) @@ -125,6 +125,7 @@ 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 diff --git a/Graphics/UI/Gtk/Embedding/Types.chs b/Graphics/UI/Gtk/Embedding/Types.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Embedding/Types.chs @@ -0,0 +1,128 @@ +{-# 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) +#if __GLASGOW_HASKELL__ >= 707 +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 diff --git a/Graphics/UI/Gtk/Gdk/DrawWindow.chs b/Graphics/UI/Gtk/Gdk/DrawWindow.chs --- a/Graphics/UI/Gtk/Gdk/DrawWindow.chs +++ b/Graphics/UI/Gtk/Gdk/DrawWindow.chs @@ -88,7 +88,7 @@ drawWindowGetPointerPos, drawWindowGetOrigin, drawWindowSetCursor, -#if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) +#if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) drawWindowForeignNew, #endif drawWindowGetDefaultRootWindow, @@ -595,7 +595,7 @@ self (fromMaybe (Cursor nullForeignPtr) cursor) -#if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) +#if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) -- | Get the handle to an exising 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. diff --git a/Graphics/UI/Gtk/General/Structs.hsc b/Graphics/UI/Gtk/General/Structs.hsc --- a/Graphics/UI/Gtk/General/Structs.hsc +++ b/Graphics/UI/Gtk/General/Structs.hsc @@ -597,7 +597,7 @@ #if !defined(WIN32) || GTK_CHECK_VERSION(2,8,0) -- | The identifer of a window of the underlying windowing system. -- -#if defined(GDK_NATIVE_WINDOW_POINTER) && !defined(HAVE_QUARTZ_GTK) +#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 @@ -608,7 +608,7 @@ fromNativeWindowId = castPtr . unNativeWindowId nativeWindowIdNone :: NativeWindowId nativeWindowIdNone = NativeWindowId nullPtr -#elif defined(HAVE_QUARTZ_GTK) || (defined(WIN32) && GTK_MAJOR_VERSION >= 3) +#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 @@ -639,26 +639,26 @@ #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) +#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(WIN32) +#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) +#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) +#if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) (\(Drawable drawable) -> #else (\(DrawWindow drawable) -> @@ -671,12 +671,12 @@ liftM unsafeCoerce $ #endif withForeignPtr drawable gdk_win32_drawable_get_handle -#elif !defined(HAVE_QUARTZ_GTK) && !defined(WIN32) +#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) +#if GTK_MAJOR_VERSION < 3 && !defined(HAVE_QUARTZ_GTK) && !defined(GDK_WINDOWING_QUARTZ) ) (toDrawable d) #else ) (toDrawWindow d) diff --git a/Graphics/UI/Gtk/ModelView/TreeView.chs b/Graphics/UI/Gtk/ModelView/TreeView.chs --- a/Graphics/UI/Gtk/ModelView/TreeView.chs +++ b/Graphics/UI/Gtk/ModelView/TreeView.chs @@ -606,32 +606,43 @@ -- | Scroll to a cell. -- --- * Scroll to a cell as specified by @path@ and @tvc@. --- The cell is aligned within the 'TreeView' widget as --- follows: horizontally by @hor@ from left (@0.0@) to --- right (@1.0@) and vertically by @ver@ from top --- (@0.0@) to buttom (@1.0@). +-- 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 - -> TreePath - -> TreeViewColumn + -> Maybe TreePath + -> Maybe TreeViewColumn -> Maybe (Float, Float) -> IO () -treeViewScrollToCell self path column (Just (ver,hor)) = - withTreePath path $ \path -> +treeViewScrollToCell self mbPath mbColumn (Just (rowAlign, colAlign)) = + maybeWithTreePath mbPath $ \path -> {# call tree_view_scroll_to_cell #} (toTreeView self) path - column + (maybe (TreeViewColumn nullForeignPtr) toTreeViewColumn mbColumn) 1 - (realToFrac ver) - (realToFrac hor) -treeViewScrollToCell self path column Nothing = - withTreePath path $ \path -> + (realToFrac rowAlign) + (realToFrac colAlign) +treeViewScrollToCell self mbPath mbColumn Nothing = + maybeWithTreePath mbPath $ \path -> {# call tree_view_scroll_to_cell #} (toTreeView self) path - column + (maybe (TreeViewColumn nullForeignPtr) toTreeViewColumn mbColumn) 0 0.0 0.0 diff --git a/Graphics/UI/Gtk/ModelView/Types.chs b/Graphics/UI/Gtk/ModelView/Types.chs --- a/Graphics/UI/Gtk/ModelView/Types.chs +++ b/Graphics/UI/Gtk/ModelView/Types.chs @@ -54,6 +54,7 @@ NativeTreePath(..), newTreePath, withTreePath, + maybeWithTreePath, peekTreePath, fromTreePath, stringToTreePath, @@ -200,6 +201,9 @@ 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 diff --git a/gtk.cabal b/gtk.cabal --- a/gtk.cabal +++ b/gtk.cabal @@ -1,5 +1,5 @@ Name: gtk -Version: 0.13.1 +Version: 0.13.2 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -192,6 +192,7 @@ 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 diff --git a/hierarchy.list b/hierarchy.list --- a/hierarchy.list +++ b/hierarchy.list @@ -113,7 +113,6 @@ GtkFontSelectionDialog GtkInputDialog GtkMessageDialog - GtkPlug if plugNsocket GtkEventBox GtkHandleBox GtkScrolledWindow @@ -158,7 +157,6 @@ GtkMenuBar GtkNotebook # GtkPacker - GtkSocket if plugNsocket GtkTable GtkTextView GtkSourceView if sourceview