@node Installation, Implementation Notes, API Reference, Top
@chapter Installation
-If you have a recent version of MIT-Scheme (with C/Unix FFI)
-installed, you can build the snapshot with
+If you have a recent version of MIT Scheme (with C/Unix FFI)
+installed, you can build and install the snapshot (in
+@file{$HOME/}) with these three commands.
@smallexample
- ./configure; make
+ ./configure --prefix=$HOME
+ make
+ make install
@end smallexample
-If your MIT-Scheme does not include the FFI, you will need to install
-a version that does, like this:
-
-@smallexample
-./configure --without-gtk
-make
-make install
-@end smallexample
-
-Depending on configuration options and file-system permissions, you
-may need super-user privileges to do the installation step.
+If your MIT Scheme does not include the FFI, you will need to install
+a version that does. Use the same three commands (above) and you will
+have built and installed the requisite MIT Scheme, in @file{$HOME}.
To verify your install, check that your @code{mit-scheme} command
-invokes a Scheme with the FFI. Execute the following command line.
+invokes a Scheme with FFI. If you used a configure option like
+@code{--prefix=$HOME}, you might use these commands:
@smallexample
- echo "(load-option 'FFI)" | mit-scheme --batch-mode
+ export MIT_SCHEME_EXE=$HOME/bin/mit-scheme
+ echo "(load-option 'FFI)" | $MIT_SCHEME_EXE --batch-mode
@end smallexample
-If that command completes without complaint, you are ready to
+If that command completes without complaint, you have a host for the
+Gtk system, which can now be built and installed like this:
@smallexample
- make clean; ./configure; make
+ export MIT_SCHEME_EXE=$HOME/bin/mit-scheme
+ (cd src && make && make install)
@end smallexample
-If this process falters, please feel free to contact the author.
+If you have trouble, please feel free to contact the author.
@node Implementation Notes, GNU Free Documentation License, Installation, Top
@chapter Implementation Notes
/* SchemeSource -- the custom GSource that runs Scheme in an idle task. */
-#include "scheme.h"
-#include "prims.h"
-#include "pruxffi.h"
-
#include "osio.h"
#include "osenv.h"
-#include "ux.h"
-#include "uxio.h"
-#include "uxproc.h"
-
+#include "osproc.h"
+#include "osscheme.h"
#include <glib.h>
#include <gtk/gtk.h>
+extern void Interpret (int pop_return_p);
+extern void abort_to_c (void);
+
struct _SchemeSource
{
GSource source;
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);
-SchemeSource * scheme_source_new (void);
-void scheme_source_destroy (SchemeSource * source);
+static SchemeSource * scheme_source_new (void);
+static void scheme_source_destroy (SchemeSource * source);
static void clear_registry (SchemeSource * source);
static void set_registry (SchemeSource * source, GSList * new, double time);
-static SchemeSource * scheme_source;
-extern int cstack_depth; /* in pruxffi.c */
-static SCHEME_OBJECT tracing_gtk_select;
+static SchemeSource * scheme_source = NULL;
+static gboolean tracing_gtk_select = 0;
static GSList * gtk_registry (select_registry_t registry);
static int slice_counter = 0;
-static GtkWidget * slice_window;
+static GtkWidget * slice_window = NULL;
static GtkWidget * slice_label;
static GtkWidget * status_label;
static void open_slice_window (void);
|| pending_interrupts_p ()
|| OS_process_any_status_change ())
{
- if (tracing_gtk_select == SHARP_T)
+ if (tracing_gtk_select)
{
if (timeo > 0)
{
return (TRUE); /* Ready for immediate dispatch. */
}
- if (tracing_gtk_select == SHARP_T)
+ if (tracing_gtk_select)
{
outf_console (";scheme_source_prepare: polling for %dmsec\n", timeo);
outf_flush_console ();
|| pending_interrupts_p ()
|| OS_process_any_status_change ())
{
- if (tracing_gtk_select == SHARP_T
+ if (tracing_gtk_select
&& (time > src->time_limit
|| pending_interrupts_p ()
|| OS_process_any_status_change ()))
{
GSList * scan;
- if (tracing_gtk_select == SHARP_T)
+ if (tracing_gtk_select)
{
scan = src->gpollfds;
while (scan != NULL)
gtk_label_set_text (GTK_LABEL (status_label), text);
g_free (text);
}
- if (tracing_gtk_select == SHARP_T)
+ if (tracing_gtk_select)
{
outf_console (";scheme_source_dispatch: running time slice %d\n",
slice_counter);
outf_flush_console ();
}
Interpret (1);
- if (tracing_gtk_select == SHARP_T)
+ if (tracing_gtk_select)
{
outf_console (";scheme_source_dispatch: finished time slice %d\n",
slice_counter);
NULL
};
-SchemeSource *
+static SchemeSource *
scheme_source_new (void)
{
GSource * source = g_source_new (&scheme_source_funcs, sizeof (SchemeSource));
return (src);
}
-void
+static void
scheme_source_destroy (SchemeSource * source)
{
clear_registry (source);
/* Invoking main_loop_run. */
-DEFINE_PRIMITIVE ("GTK-MAIN+", Prim_gtk_main_plus, 0, 0, 0)
+gboolean
+gtk_main_plus (void)
{
- /* Runs a GMainLoop with scheme_source attached. */
+ /* Runs a GMainLoop with scheme_source attached. Returns 1 when
+ successful. */
- PRIMITIVE_HEADER (0);
+ if (scheme_source != NULL)
+ return (FALSE);
- canonicalize_primitive_context ();
- {
- if (scheme_source != NULL)
- error_external_return ();
-
- 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;
- }
- PRIMITIVE_RETURN (SHARP_T);
+ 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);
}
-DEFINE_PRIMITIVE ("GTK-MAIN+-QUIT", Prim_gtk_main_plus_quit, 0, 0, 0)
+gboolean
+gtk_main_plus_quit (void)
{
- PRIMITIVE_HEADER (0);
+ /* Returns TRUE when successful. */
- canonicalize_primitive_context ();
- {
- if (scheme_source == NULL)
- error_external_return ();
+ if (scheme_source == NULL)
+ return (FALSE);
- g_main_loop_quit (scheme_source->main_loop);
- }
- PRIMITIVE_RETURN (SHARP_F);
+ g_main_loop_quit (scheme_source->main_loop);
+ return (TRUE);
}
-DEFINE_PRIMITIVE ("RUN-GTK", Prim_run_gtk, 2, 2, 0)
+void
+run_gtk (select_registry_t r, double time)
{
/* Return to the toolkit with the scheme_source set up to dispatch
to Scheme again when I/O is ready, or a certain TIME has passed.
Scheme is ready to run again immediately. If I/O is empty, the
simulated poll should not re-enter Scheme until TIME. */
- PRIMITIVE_HEADER (2);
- canonicalize_primitive_context ();
- {
- select_registry_t r = arg_select_registry (1);
- double time = arg_real_number (2);
- set_registry (scheme_source, gtk_registry (r), time);
- if (tracing_gtk_select == SHARP_T)
- {
- GSList * gpollfds = scheme_source->gpollfds;
- gchar * fdstr = gpollfds_string (gpollfds);
- outf_console (";run_gtk%s%s until %.1f\n",
- gpollfds == NULL ? "" : " waiting on", fdstr, time);
- outf_flush_console ();
- if (fdstr[0] != '\0')
- g_free (fdstr);
- }
- POP_PRIMITIVE_FRAME (2);
- SET_EXP (SHARP_F);
- PRIMITIVE_ABORT (PRIM_RETURN_TO_C);
- /*NOTREACHED*/
- PRIMITIVE_RETURN (UNSPECIFIC);
- }
+ set_registry (scheme_source, gtk_registry (r), time);
+ if (tracing_gtk_select)
+ {
+ GSList * gpollfds = scheme_source->gpollfds;
+ gchar * fdstr = gpollfds_string (gpollfds);
+ outf_console (";run_gtk%s%s until %.1f\n",
+ gpollfds == NULL ? "" : " waiting on", fdstr, time);
+ outf_flush_console ();
+ if (fdstr[0] != '\0')
+ g_free (fdstr);
+ }
+
+ /* The c-call primitive has arranged for c-call-continue to run (and
+ thus Scm_run_gtk_continue) when Scheme continues. */
+ abort_to_c ();
+ /*NOTREACHED*/
}
\f
slice_label = NULL;
}
-DEFINE_PRIMITIVE ("GTK-TIME-SLICE-WINDOW?", Prim_gtk_time_slice_window_p, 0,0,0)
+gboolean
+gtk_time_slice_window_p (void)
{
- PRIMITIVE_HEADER (0);
-
- PRIMITIVE_RETURN (slice_window == NULL ? SHARP_F : SHARP_T);
+ return (slice_window == NULL ? 0 : 1);
}
-DEFINE_PRIMITIVE ("GTK-TIME-SLICE-WINDOW!", Prim_gtk_time_slice_window, 1, 1, 0)
-{
- PRIMITIVE_HEADER (1);
- {
- SCHEME_OBJECT arg = (ARG_REF (1));
- if (arg == SHARP_F)
- {
- if (slice_window != NULL)
- close_slice_window ();
- }
- else
- {
- if (slice_window == NULL)
- open_slice_window ();
- }
- PRIMITIVE_RETURN (arg);
- }
-}
-
-DEFINE_PRIMITIVE ("GTK-SELECT-TRACE?", Prim_gtk_select_trace_p, 0, 0, 0)
+void
+gtk_time_slice_window (gboolean open_p)
{
- PRIMITIVE_HEADER (0);
-
- PRIMITIVE_RETURN (tracing_gtk_select);
+ if (!open_p)
+ {
+ if (slice_window != NULL)
+ close_slice_window ();
+ }
+ else
+ {
+ if (slice_window == NULL)
+ open_slice_window ();
+ }
}
-DEFINE_PRIMITIVE ("GTK-SELECT-TRACE!", Prim_gtk_select_trace, 1, 1, 0)
+gboolean
+gtk_select_trace_p (void)
{
- PRIMITIVE_HEADER (1);
- {
- SCHEME_OBJECT arg = (ARG_REF (1));
- tracing_gtk_select = (arg == SHARP_F ? SHARP_F : SHARP_T);
- PRIMITIVE_RETURN (arg);
- }
+ return (tracing_gtk_select);
}
-
-#ifdef COMPILE_AS_MODULE
-
-char *
-dload_initialize_file (void)
+void
+gtk_select_trace (gboolean trace_p)
{
- scheme_source = NULL;
- slice_window = NULL;
- tracing_gtk_select = SHARP_F;
-
- declare_primitive ("GTK-MAIN+", Prim_gtk_main_plus, 0, 0, 0);
- declare_primitive ("GTK-MAIN+-QUIT", Prim_gtk_main_plus_quit, 0, 0, 0);
- declare_primitive ("RUN-GTK", Prim_run_gtk, 2, 2, 0);
- declare_primitive ("GTK-TIME-SLICE-WINDOW?", Prim_gtk_time_slice_window_p, 0, 0, 0);
- declare_primitive ("GTK-TIME-SLICE-WINDOW!", Prim_gtk_time_slice_window, 1, 1, 0);
- declare_primitive ("GTK-SELECT-TRACE?", Prim_gtk_select_trace_p, 0, 0, 0);
- declare_primitive ("GTK-SELECT-TRACE!", Prim_gtk_select_trace, 1, 1, 0);
- return ("#prgtkio");
+ tracing_gtk_select = trace_p;
}
-
-#endif /* COMPILE_AS_MODULE */
projects / mit-scheme.git / commitdiff