From: Matt Birkholz Date: Thu, 2 Jun 2011 03:57:03 +0000 (-0700) Subject: Call gdk_threads_enter/leave, and gtk_main. X-Git-Tag: 20110609-Gtk~7 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e80a5f9087b6a2ba93fb100d53af1cbd4364706f;p=mit-scheme.git Call gdk_threads_enter/leave, and gtk_main. --- diff --git a/src/gtk/gtk-shim.h b/src/gtk/gtk-shim.h index a96333f68..e6ec83ecf 100644 --- a/src/gtk/gtk-shim.h +++ b/src/gtk/gtk-shim.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (C) 2007, 2008, 2009 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz This file is part of MIT/GNU Scheme. @@ -48,8 +48,8 @@ struct _ScmWidget extern GtkWidget* scm_widget_new (void); -extern void gtk_main_plus (void); -extern void gtk_main_plus_quit (void); +extern gboolean start_gtk (int *argc, char ***argv); +extern void stop_gtk (void); extern void run_gtk (unsigned long registry, double time); extern gboolean gtk_time_slice_window_p (void); extern void gtk_time_slice_window (gboolean open_p); diff --git a/src/gtk/gtk.cdecl b/src/gtk/gtk.cdecl index eb82b476a..c00c17762 100644 --- a/src/gtk/gtk.cdecl +++ b/src/gtk/gtk.cdecl @@ -34,8 +34,8 @@ USA. ;;; GtkIO -(extern void gtk_main_plus) -(extern void gtk_main_plus_quit) +(extern gboolean start_gtk (argc_loc (* int)) (argv_loc (* (* (* char))))) +(extern void stop_gtk) (extern void run_gtk (registry ulong) (time double)) (extern gboolean gtk_time_slice_window_p) (extern void gtk_time_slice_window (open_p gboolean)) diff --git a/src/gtk/gtkio.c.stay b/src/gtk/gtkio.c.stay index fe816319c..d7ff9609b 100644 --- a/src/gtk/gtkio.c.stay +++ b/src/gtk/gtkio.c.stay @@ -39,12 +39,6 @@ struct _SchemeSource { GSource source; - /* This is in GSource, but is private(?). */ - GMainContext * main_context; - - /* The main loop running in main_context (if any). */ - GMainLoop * main_loop; - /* The list of GPollFDs that have been added to the main_context. */ GSList * gpollfds; @@ -57,8 +51,8 @@ static gboolean scheme_source_prepare (GSource * source, gint * timeout); static gboolean scheme_source_check (GSource * source); static int pending_io (SchemeSource * source); static gboolean scheme_source_dispatch (GSource * source, GSourceFunc callback, gpointer user_data); -static SchemeSource * scheme_source_new (void); -static void scheme_source_destroy (SchemeSource * source); +static void install_scheme_source (void); +static void destroy_scheme_source (void); static void clear_registry (SchemeSource * source); static void set_registry (SchemeSource * source, GSList * new, double time); @@ -178,13 +172,8 @@ pending_io (SchemeSource * src) } static gboolean -scheme_source_dispatch (GSource * source, - GSourceFunc callback, gpointer user_data) +do_scheme (GSource *source) { - /* Executes our "idle" task. Ignore the callback and user_data - arguments. Must return TRUE to stay on the list of mainloop - event sources. */ - SchemeSource * src = (SchemeSource *)source; slice_counter += 1; @@ -222,6 +211,26 @@ scheme_source_dispatch (GSource * source, return (TRUE); /* Not a once-only. */ } +static gboolean +scheme_source_dispatch (GSource * source, + GSourceFunc callback, gpointer user_data) +{ + /* Executes our "idle" task. Ignore the callback and user_data + arguments. Must return TRUE to stay on the list of event + sources. */ + + gboolean ret = FALSE; + + gdk_threads_enter (); + + if (!g_source_is_destroyed (source)) + ret = do_scheme (source); + + gdk_threads_leave (); + + return ret; +} + GSourceFuncs scheme_source_funcs = { scheme_source_prepare, @@ -232,30 +241,22 @@ GSourceFuncs scheme_source_funcs = NULL }; -static SchemeSource * -scheme_source_new (void) +static void +install_scheme_source (void) { - GSource * source = g_source_new (&scheme_source_funcs, sizeof (SchemeSource)); - SchemeSource * src = (SchemeSource *)source; - GMainContext * context = g_main_context_default (); - src->main_context = context; - src->main_loop = g_main_loop_new (context, FALSE); - src->gpollfds = NULL; - src->time_limit = 0.0; - g_source_attach (source, context); - return (src); + scheme_source = (SchemeSource *) + g_source_new (&scheme_source_funcs, sizeof (SchemeSource)); + scheme_source->gpollfds = NULL; + scheme_source->time_limit = 0.0; + g_source_attach ((GSource *) scheme_source, NULL); } static void -scheme_source_destroy (SchemeSource * source) +destroy_scheme_source (void) { - clear_registry (source); - if (source->main_loop != NULL) - { - g_main_loop_unref (source->main_loop); - source->main_loop = NULL; - } - g_source_destroy ((GSource *) source); + clear_registry (scheme_source); + g_source_destroy ((GSource *) scheme_source); + scheme_source = NULL; } static void @@ -264,7 +265,7 @@ clear_registry (SchemeSource * source) GSList * gpollfds = source->gpollfds; if (gpollfds != NULL) { - GMainContext * context = source->main_context; + GMainContext * context = g_source_get_context ((GSource *)source); GSList * scan = gpollfds; while (scan != NULL) { @@ -291,7 +292,7 @@ set_registry (SchemeSource * source, GSList * new, double time) source->time_limit = time; source->gpollfds = new; { - GMainContext * context = source->main_context; + GMainContext * context = g_source_get_context ((GSource *)source); while (new != NULL) { GPollFD * gfd = new->data; @@ -302,35 +303,55 @@ set_registry (SchemeSource * source, GSList * new, double time) } -/* Invoking main_loop_run. */ +/* Invoking gtk_main. */ + +extern SCM Scm_continue_start_gtk (void); +extern SCM Scm_continue_stop_gtk (void); +extern int cstack_depth; gboolean -gtk_main_plus (void) +start_gtk (int *argc, char ***argv) { - /* Runs a GMainLoop with scheme_source attached. Returns 1 when - successful. */ + /* Runs gtk_main with scheme_source attached. Returns TRUE when + successful. Returns FALSE when gtk_init_check failed, or + gtk_main is already running. */ if (scheme_source != NULL) return (FALSE); - scheme_source = scheme_source_new (); - g_main_loop_run (scheme_source->main_loop); - /* Heap may have been GCed! Luckily we don't need it. */ - scheme_source_destroy (scheme_source); - scheme_source = NULL; - return (TRUE); + g_thread_init (NULL); + gdk_threads_init (); + gdk_threads_enter (); + if (gtk_init_check (argc, argv)) { + gboolean ret = TRUE; + CalloutTrampIn tramp = &Scm_continue_start_gtk; + + /* Prep the machine for re-entry via scheme_source->dispatch(), + which should continue with the seemingly aborted application of + C-CALL-CONTINUE, which should call Scm_continue_start_gtk(). + That function expects one gboolean in the top CSTACK frame. */ + callout_unseal (tramp); + CSTACK_PUSH (gboolean, ret); + CSTACK_PUSH (int, cstack_depth); + CSTACK_PUSH (CalloutTrampIn, tramp); + + install_scheme_source (); + gtk_main (); + destroy_scheme_source (); + } + gdk_threads_leave (); + return TRUE; } -gboolean -gtk_main_plus_quit (void) +void +stop_gtk (void) { /* Returns TRUE when successful. */ if (scheme_source == NULL) - return (FALSE); - - g_main_loop_quit (scheme_source->main_loop); - return (TRUE); + return; + gtk_main_quit (); + /* NOTREACHED */ } void diff --git a/src/gtk/main.scm b/src/gtk/main.scm index 3d453f74a..82848c6c6 100644 --- a/src/gtk/main.scm +++ b/src/gtk/main.scm @@ -27,9 +27,9 @@ USA. (c-include "gtk") (define (gtk-start) + ;; Called from gtk/make.scm, from a (load-option 'Gtk). (set! hook/subprocess-wait nonblocking/subprocess-wait) - (gtk-init ((ucode-primitive scheme-program-name 0)) *unused-command-line*) - (gtk-main+)) + (start-gtk ((ucode-primitive scheme-program-name 0)) *unused-command-line*)) (define (initialize-package!) (let ((program-name ((ucode-primitive scheme-program-name 0)))) @@ -38,18 +38,17 @@ USA. (lambda (line) (processor (list->vector - (gtk-init program-name (vector->list line)))) - (gtk-main+)))))) + (start-gtk program-name (vector->list line))))))))) -(define (gtk-init name args) - ;; Call gtk_init_check. Signals an error if gtk_init_check returns 0. +(define (start-gtk name args) + ;; Call start_gtk. Signals an error if gtk_init_check returns 0. ;; Returns a list of unused ARGS. (let ((arg-count (guarantee-list-of-type->length args string? "list of commandline arguments (strings)" - 'GTK-INIT)) + 'START-GTK)) (vars-size (+ (C-sizeof "int") ;gtk_init_check return var (C-sizeof "* * char")))) ;gtk_init_check return var - (guarantee-string name 'GTK-INIT) + (guarantee-string name 'START-GTK) (let* ((words (cons name args)) (vector-size (* (C-sizeof "* char") (+ 1 arg-count))) @@ -70,8 +69,8 @@ USA. words) (C->= count-var "int" (+ 1 arg-count)) (C->= vector-var "* * char" vector) - (if (fix:zero? (C-call "gtk_init_check" count-var vector-var)) - (error "Could not initialize Gtk.") + (if (fix:zero? (C-call "start_gtk" count-var vector-var)) + (error "Could not start Gtk.") (let ((new-argc (C-> count-var "int"))) (C-> vector-var "* * char" vector-scan) (let ((new-args @@ -81,21 +80,15 @@ USA. (cons (c-peek-cstringp! vector-scan) args)) (reverse! args))))) (free bytes) + (create-gtk-thread) (cdr new-args))))))) -(define (gtk-main+) - ;; Establishes a GMainLoop in which scheme is an idle task. - (without-interrupts - (lambda () - (C-call "gtk_main_plus") - (create-gtk-thread)))) - -(define (gtk-main+-quit) - ;; Sortof does the opposite of gtk-main+. +(define (stop-gtk) + ;; Sortof does the opposite of gtk-start. (without-interrupts (lambda () (exit-gtk-thread) - (C-call "gtk_main_plus_quit")))) + (C-call "stop_gtk")))) (define (gtk-time-slice-window?) (C-call "gtk_time_slice_window_p")) diff --git a/src/gtk/make.scm b/src/gtk/make.scm index d8a882fe3..4514aaa05 100644 --- a/src/gtk/make.scm +++ b/src/gtk/make.scm @@ -6,5 +6,5 @@ Load the Gtk option. |# (with-loader-base-uri (system-library-uri "gtk/") (lambda () (load-package-set "gtk"))) -(add-subsystem-identification! "Gtk" '(0 2)) +(add-subsystem-identification! "Gtk" '(0 3)) ((access gtk-start (->environment '(gtk main)))) \ No newline at end of file