Backport of changes in 0.11.2, closes freeze in http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597837 --- gtk-0.11.0//Graphics/UI/Gtk/General/General.chs 2010-10-02 16:31:19.000000000 +0200 +++ gtk-0.11.2//Graphics/UI/Gtk/General/General.chs 2010-10-02 16:31:19.000000000 +0200 @@ -49,6 +49,7 @@ mainLevel, mainIteration, mainIterationDo, + mainDoEvent, -- * Grab widgets grabAdd, @@ -69,8 +70,9 @@ idleRemove, inputAdd, inputRemove, - IOCondition, - HandlerId + IOCondition(..), + HandlerId, + FD ) where import System.Environment (getProgName, getArgs) @@ -81,8 +83,14 @@ import System.Glib.FFI import System.Glib.UTFString -import System.Glib.MainLoop +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"#} @@ -121,7 +129,7 @@ -- -- -- * 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 on a single OS thread. +-- 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 @@ -130,7 +138,7 @@ initGUI :: IO [String] initGUI = do when rtsSupportsBoundThreads initialiseGThreads - threadsEnter + -- note: initizliseGThreads calls 'threadsEnter' prog <- getProgName args <- getArgs let allArgs = (prog:args) @@ -173,7 +181,7 @@ idleAdd (action >> return False) priorityDefault return () --- | Acquired the global Gtk lock. +-- | 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 @@ -243,6 +251,45 @@ 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) + -- | add a grab widget -- grabAdd :: WidgetClass wd => wd -> IO () @@ -260,3 +307,75 @@ -- 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) \ Kein Zeilenumbruch am Dateiende. --- gtk-0.11.0//Graphics/UI/Gtk/General/hsgthread.c 2010-10-02 16:31:19.000000000 +0200 +++ gtk-0.11.2//Graphics/UI/Gtk/General/hsgthread.c 2010-10-02 16:31:19.000000000 +0200 @@ -40,7 +40,7 @@ #if defined( WIN32 ) static CRITICAL_SECTION gtk2hs_finalizer_mutex; #else -static GStaticMutex gtk2hs_finalizer_mutex = G_STATIC_MUTEX_INIT; +static GStaticMutex gtk2hs_finalizer_mutex; #endif static GSource* gtk2hs_finalizer_source; static guint gtk2hs_finalizer_id; @@ -51,13 +51,24 @@ /* 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_static_mutex_init(>k2hs_finalizer_mutex); #endif g_thread_init(NULL); gdk_threads_init(); + + /* from here onwards, the Gdk lock is held */ + gdk_threads_enter(); + } } @@ -66,6 +77,12 @@ 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 @@ -75,7 +92,8 @@ } #ifdef DEBUG - printf("adding finalizer!\n"); + 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 @@ -84,8 +102,14 @@ 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); }; @@ -100,6 +124,10 @@ 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 @@ -113,8 +141,13 @@ 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 @@ -135,6 +168,9 @@ 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 @@ -142,6 +178,8 @@ #endif } + gdk_threads_leave(); + return FALSE; }