{
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;
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);
}
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;
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,
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
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)
{
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;
}
\f
-/* 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
(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))))
(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)))
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
(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"))
projects / mit-scheme.git / commitdiff