From: Matt Birkholz Date: Sat, 5 Jun 2010 06:29:12 +0000 (-0700) Subject: Merge with 9.0.1+FFI. X-Git-Tag: 20100708-Gtk~3 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b863d6605ac6d493f3043d640ba7ae075061e06b;p=mit-scheme.git Merge with 9.0.1+FFI. * doc/gtk/Makefile.in: Set TEXINFO_ROOT. * doc/gtk/gtk.texinfo: Fix name of shim, and example commandlines. * src/gtk/Clean.sh: No need to delete conses.png. Clean in ../lib, not ../lib/lib/. * src/gtk/Includes/gdkdrawable.cdecl: Punt reserved members. There is no need to account for all of them. The groveler will use sizeof. * src/gtk/Makefile-fragment: Punt the lib/lib stuff. The shims do not have to be in the same directory as the modules. No need to produce conses.png from conses.png.uu anymore. Separate syntaxing and compiling (and loading), in the .sf/.cbf/make way. * src/gtk/Tags.sh: Bloody Exuberant Ctags compatibility. * src/gtk/conses.png.uu, src/gtk/conses.png: Git can distribute conses.png. * src/gtk/: compile.scm, load.scm, gtk.sf, gtk.cbf, make.scm: Separate syntaxing and compiling (and loading), in the .sf/.cbf/make way. * src/microcode/configure.ac: Add prgtkio.so to new MODULE_BASES, not MODULE_TARGETS. * src/microcode/prgtkio.c: Re-styled -- mainly uncrushing the * operator. * src/sf/sf.pkg, src/sf/butils.scm: Added sf-with-dependencies. --- diff --git a/doc/gtk/Makefile.in b/doc/gtk/Makefile.in index 934f693b5..152a8b911 100644 --- a/doc/gtk/Makefile.in +++ b/doc/gtk/Makefile.in @@ -1,4 +1,3 @@ -# $Id: $ # doc/gtk/Makefile.in @SET_MAKE@ @@ -7,6 +6,7 @@ top_srcdir = @top_srcdir@ VPATH = @srcdir@ SOURCES = gtk.texinfo +TEXINFO_ROOT = gtk TARGET_ROOT = mit-scheme-gtk include $(top_srcdir)/make-common diff --git a/doc/gtk/gtk.texinfo b/doc/gtk/gtk.texinfo index b9bb9794a..4b2709694 100644 --- a/doc/gtk/gtk.texinfo +++ b/doc/gtk/gtk.texinfo @@ -8,7 +8,7 @@ @copying The users' manual for a Gtk interface for MIT/GNU Scheme. -Copyright @copyright{} 2008, 2009 Matthew Birkholz +Copyright @copyright{} 2008, 2009, 2010 Matthew Birkholz @quotation Permission is granted to copy, distribute and/or modify this document @@ -75,9 +75,9 @@ A program using the Gtk system does not call @code{gtk_init} nor signal handlers to them. The hello program is a simple example. (@xref{Hello World}.) -Very little of the GNOME toolkit API has been wrapped, and there is no -intention to wrap everything. The @file{gtk.so} (the shared object -shim) is intended to stay small and focused, and @emph{not} include +Very little of the GNOME toolkit API has been wrapped. +The @file{gtk-shim.so} +is intended to stay small and focused, and @emph{not} include every convenience function fancied by a C programmer. It does not wrap nor intern nor register a gc cleanup for every GObject pointer accessed by Scheme. To see what is available, refer to the @@ -240,7 +240,8 @@ command lines in the @file{src/gtk} directory of the source distribution. @smallexample - mit-scheme + ../microcode/scheme --library ../lib + (load-option 'FFI) (load-option 'Gtk) (ge '(gtk)) (load "hello") @@ -265,7 +266,7 @@ realize method, which calls out again to @code{gdk_window_new}. Enter these 3 lines to create this widget. @smallexample - mit-scheme + ../microcode/scheme --library ../lib (load-option 'GTK) (gtk-event-viewer) @end smallexample @@ -307,7 +308,7 @@ and an image. It also contains animated boxes that blink and follow the mouse. Enter these 3 lines to create this widget. @smallexample - mit-scheme + ../microcode/scheme --library ../lib (load-option 'Gtk) (scm-layout-demo) @end smallexample diff --git a/src/gtk/Clean.sh b/src/gtk/Clean.sh index 9bdc39309..bc498d58f 100755 --- a/src/gtk/Clean.sh +++ b/src/gtk/Clean.sh @@ -13,7 +13,7 @@ fi . ../etc/functions.sh maybe_rm gtk-shim.c gtk-const* gtk-types* -maybe_rm conses.png ../lib/conses.png -maybe_rm ../lib/lib/gtk-* ../lib/lib/prgtkio.so +maybe_rm ../lib/conses.png +maybe_rm ../lib/gtk-* ../lib/prgtkio.so # And, just because the maintainer- and c-clean targets nail this one anyway: maybe_rm scmwidget.c diff --git a/src/gtk/Includes/gdkdrawable.cdecl b/src/gtk/Includes/gdkdrawable.cdecl index 9cbd6e010..60777c2df 100644 --- a/src/gtk/Includes/gdkdrawable.cdecl +++ b/src/gtk/Includes/gdkdrawable.cdecl @@ -47,19 +47,7 @@ gtk-2.0/gdk/gdkdrawable.h |# (_copy_to_image (* mumble)) (draw_glyphs_transformed (* mumble)) (draw_trapezoids (* mumble)) - (ref_cairo_surface (* mumble)) - (_gdk_reserved4 (* mumble)) - (_gdk_reserved5 (* mumble)) - (_gdk_reserved6 (* mumble)) - (_gdk_reserved7 (* mumble)) - (_gdk_reserved9 (* mumble)) - (_gdk_reserved10 (* mumble)) - (_gdk_reserved11 (* mumble)) - (_gdk_reserved12 (* mumble)) - (_gdk_reserved13 (* mumble)) - (_gdk_reserved14 (* mumble)) - (_gdk_reserved15 (* mumble)) - (_gdk_reserved16 (* mumble))) + (ref_cairo_surface (* mumble))) (struct _GdkTrapezoid (y1 double) diff --git a/src/gtk/Makefile-fragment b/src/gtk/Makefile-fragment index f718e04bf..bba22b6b0 100644 --- a/src/gtk/Makefile-fragment +++ b/src/gtk/Makefile-fragment @@ -1,30 +1,26 @@ #-*-Makefile-*- -# $Id: $ # gtk/Makefile-fragment TARGET_DIR = $(AUXDIR)/gtk -generate: ../lib/lib/gtk-shim.so ../lib/lib/gtk-types.bin \ - ../lib/lib/gtk-const.bin ../lib/conses.png +generate: ../lib/gtk-shim.so ../lib/gtk-types.bin ../lib/gtk-const.bin \ + ../lib/conses.png -../lib/lib/gtk-shim.so: gtk-shim.so +../lib/gtk-shim.so: gtk-shim.so $(INSTALL_DATA) gtk-shim.so $@ -../lib/lib/gtk-types.bin: gtk-types.bin +../lib/gtk-types.bin: gtk-types.bin $(INSTALL_DATA) gtk-types.bin $@ -../lib/lib/gtk-const.bin: gtk-const.bin +../lib/gtk-const.bin: gtk-const.bin $(INSTALL_DATA) gtk-const.bin $@ ../lib/conses.png: conses.png $(INSTALL_DATA) conses.png $@ -conses.png: conses.png.uu - uudecode conses.png.uu - build: - echo '(load "compile")' \ - | ../microcode/scheme --compiler --library ../lib --batch-mode + echo '(load "gtk.sf")(load "gtk.cbf")' \ + | ../microcode/scheme --library ../lib --compiler --batch-mode install: rm -rf $(DESTDIR)$(TARGET_DIR) @@ -32,10 +28,10 @@ install: $(INSTALL_COM) *.com $(DESTDIR)$(TARGET_DIR)/. $(INSTALL_DATA) *.bci $(DESTDIR)$(TARGET_DIR)/. $(INSTALL_DATA) gtk-*.pkd $(DESTDIR)$(TARGET_DIR)/. - $(INSTALL_DATA) load.scm $(DESTDIR)$(TARGET_DIR)/. - $(INSTALL_DATA) gtk-shim.so $(DESTDIR)$(AUXDIR)/lib/. - $(INSTALL_DATA) gtk-types.bin $(DESTDIR)$(AUXDIR)/lib/. - $(INSTALL_DATA) gtk-const.bin $(DESTDIR)$(AUXDIR)/lib/. + $(INSTALL_DATA) make.scm $(DESTDIR)$(TARGET_DIR)/. + $(INSTALL_DATA) gtk-shim.so $(DESTDIR)$(AUXDIR)/. + $(INSTALL_DATA) gtk-types.bin $(DESTDIR)$(AUXDIR)/. + $(INSTALL_DATA) gtk-const.bin $(DESTDIR)$(AUXDIR)/. gtk-shim.so: gtk-shim.o scmwidget.o $(LINK_SHIM) $^ `pkg-config --libs gtk+-2.0` diff --git a/src/gtk/Tags.sh b/src/gtk/Tags.sh index 09b8e6698..817f5d724 100755 --- a/src/gtk/Tags.sh +++ b/src/gtk/Tags.sh @@ -5,5 +5,5 @@ # Utility to make TAGS file for the gtk build directory. # The working directory must be the build directory. -etags gtk-shim.h scmwidget.c.stay --language=scheme \ +etags gtk-shim.h scmwidget.c.stay --langmap=scheme:.cdecl \ `echo *.scm | sed 's/ gtk-const.scm//'` Includes/*.cdecl diff --git a/src/gtk/conses.png b/src/gtk/conses.png new file mode 100644 index 000000000..ac9622617 Binary files /dev/null and b/src/gtk/conses.png differ diff --git a/src/gtk/conses.png.uu b/src/gtk/conses.png.uu deleted file mode 100644 index 37d7a3879..000000000 --- a/src/gtk/conses.png.uu +++ /dev/null @@ -1,11 +0,0 @@ -begin-base64 660 conses.png -iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABmJLR0QA/wD/ -AP+gvaeTAAAACXBIWXMAAABIAAAASABGyWs+AAABEklEQVRYw+2X4Q6DMAiE -ucX3f+Xbj9laW6ilNLolIzFxWr4iwslAkjJpACAiEmKQ5M5xWb3nLGOzgAlq -Xd9PRIr79lotQR/GazZ1xQ4h9zYACwjkg/W62scR1HgGyHwg/S7vLcuA1wKb -iyhdQEnlcbWv3QUeBtiSXE8FIMQ4hEQrHDKLzahl1qDvq/BsNr/DtlP6SE1c -zEi82VED2EE1+dIxIP9tABYQgFCRUQzV+JjFdWB5APHX+usZuNlyEaZOoJy7 -YmXBmQGcOsAYQq5M04t0racXy6R4lrFWiicYsS+ZNRV7GF8zFasRu6diFdEb -ip+firfhldXI1Z2KHfafio9XYKSxW91K9+kQG4Gn/x0/bm8fAcEjKw488QAA -AABJRU5ErkJggg== -==== diff --git a/src/gtk/gtk.cbf b/src/gtk/gtk.cbf new file mode 100644 index 000000000..8d9862a01 --- /dev/null +++ b/src/gtk/gtk.cbf @@ -0,0 +1,6 @@ +#| -*-Scheme-*- + +Compile the Gtk system. |# + +(fluid-let ((compiler:coalescing-constant-warnings? #f)) + (compile-directory ".")) \ No newline at end of file diff --git a/src/gtk/compile.scm b/src/gtk/gtk.sf similarity index 86% rename from src/gtk/compile.scm rename to src/gtk/gtk.sf index ec3de31b7..124024416 100644 --- a/src/gtk/compile.scm +++ b/src/gtk/gtk.sf @@ -1,8 +1,6 @@ #| -*-Scheme-*- -$Id: $ - -Compile the GTK system. |# +Syntax the GTK system. |# (load-option 'CREF) (load-option 'SOS) @@ -35,8 +33,4 @@ Compile the GTK system. |# (sf+ "thread" '(gtk thread) '()) ;; Cross-check. - (cref/generate-constructors "gtk" 'ALL) - - ;; Compile. - (for-each compile-file (cons "thread" gtk-files)) - ))) \ No newline at end of file + (cref/generate-constructors "gtk" 'ALL)))) \ No newline at end of file diff --git a/src/gtk/load.scm b/src/gtk/make.scm similarity index 74% rename from src/gtk/load.scm rename to src/gtk/make.scm index 014bfb064..aadb41269 100644 --- a/src/gtk/load.scm +++ b/src/gtk/make.scm @@ -1,7 +1,5 @@ #| -*-Scheme-*- -$Id: $ - Load the Gtk option. |# (load-option 'SOS) diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac index a93eb376d..b9d8f20e1 100644 --- a/src/microcode/configure.ac +++ b/src/microcode/configure.ac @@ -795,7 +795,7 @@ if test ${with_gtk} = yes; then else if pkg-config --exists gtk+-2.0; then AC_MSG_RESULT([yes]) - MODULE_TARGETS="${MODULE_TARGETS} prgtkio.so" + MODULE_BASES="${MODULE_BASES} prgtkio" else AC_MSG_RESULT([no, ! pkg-config --exists gtk+-2.0]) fi diff --git a/src/microcode/prgtkio.c b/src/microcode/prgtkio.c index 3cb447e7d..8e50cc82e 100644 --- a/src/microcode/prgtkio.c +++ b/src/microcode/prgtkio.c @@ -1,8 +1,6 @@ /* -*-C-*- -$Id: $ - -Copyright (C) 2008, 2009 Matthew Birkholz +Copyright (C) 2008, 2009, 2010 Matthew Birkholz This file is part of MIT/GNU Scheme. @@ -44,50 +42,50 @@ struct _SchemeSource GSource source; /* This is in GSource, but is private(?). */ - GMainContext* main_context; + GMainContext * main_context; /* The main loop running in main_context (if any). */ - GMainLoop* main_loop; + GMainLoop * main_loop; /* The list of GPollFDs that have been added to the main_context. */ - GSList* gpollfds; + GSList * gpollfds; /* When to give up waiting. */ double time_limit; }; typedef struct _SchemeSource SchemeSource; -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); -SchemeSource* scheme_source_new (void); -void scheme_source_destroy (SchemeSource* source); -static void clear_registry (SchemeSource* source); -static void set_registry (SchemeSource* source, GSList* new, double time); +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); +SchemeSource * scheme_source_new (void); +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; +static SchemeSource * scheme_source; extern int cstack_depth; /* in pruxffi.c */ static SCHEME_OBJECT tracing_gtk_select; -static GSList* gtk_registry (select_registry_t registry); +static GSList * gtk_registry (select_registry_t registry); static int slice_counter = 0; -static GtkWidget* slice_window; -static GtkWidget* slice_label; -static GtkWidget* status_label; +static GtkWidget * slice_window; +static GtkWidget * slice_label; +static GtkWidget * status_label; static void open_slice_window (void); static void close_slice_window (void); -static gchar* gpollfds_string (GSList* gpollfds); +static gchar * gpollfds_string (GSList * gpollfds); static gboolean -scheme_source_prepare (GSource* source, gint* timeout) +scheme_source_prepare (GSource * source, gint * timeout) { /* Return TRUE when ready to dispatch (without a poll). Return FALSE and set `timeout' to do a poll/check before dispatching. */ - SchemeSource* src = (SchemeSource*)source; + SchemeSource * src = (SchemeSource *)source; double dtime = OS_real_time_clock (); int timeo = src->time_limit - dtime; if (timeo <= 0 @@ -123,11 +121,11 @@ scheme_source_prepare (GSource* source, gint* timeout) } static gboolean -scheme_source_check (GSource* source) +scheme_source_check (GSource * source) { /* Return TRUE when ready to dispatch (after the poll). */ - SchemeSource* src = (SchemeSource*)source; + SchemeSource * src = (SchemeSource *)source; double time = OS_real_time_clock (); if (time > src->time_limit || pending_io (src) @@ -152,16 +150,16 @@ scheme_source_check (GSource* source) } static int -pending_io (SchemeSource* src) +pending_io (SchemeSource * src) { - GSList* scan; + GSList * scan; if (tracing_gtk_select == SHARP_T) { scan = src->gpollfds; while (scan != NULL) { - GPollFD* gfd = scan->data; + GPollFD * gfd = scan->data; if (gfd->revents != 0) { outf_console (";scheme_source_check: i/o ready on %d\n", @@ -174,7 +172,7 @@ pending_io (SchemeSource* src) scan = src->gpollfds; while (scan != NULL) { - GPollFD* gfd = scan->data; + GPollFD * gfd = scan->data; if (gfd->revents != 0) return (TRUE); scan = scan->next; @@ -183,28 +181,29 @@ pending_io (SchemeSource* src) } static gboolean -scheme_source_dispatch (GSource* source, +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 mainloop event sources. */ - SchemeSource* src = (SchemeSource*)source; + SchemeSource * src = (SchemeSource *)source; slice_counter += 1; if (slice_window != NULL) { - gchar* fdstr, * text; + gchar * fdstr, * text; text = g_strdup_printf ("Scheme time-slice: %d\n", slice_counter); - gtk_label_set_text(GTK_LABEL(slice_label), text); + gtk_label_set_text (GTK_LABEL (slice_label), text); g_free (text); fdstr = gpollfds_string (src->gpollfds); text = g_strdup_printf ("Channels:%s", fdstr); - if (fdstr[0] != '\0') g_free (fdstr); - gtk_label_set_text(GTK_LABEL(status_label), text); + if (fdstr[0] != '\0') + g_free (fdstr); + gtk_label_set_text (GTK_LABEL (status_label), text); g_free (text); } if (tracing_gtk_select == SHARP_T) @@ -233,12 +232,12 @@ GSourceFuncs scheme_source_funcs = NULL }; -SchemeSource* +SchemeSource * scheme_source_new (void) { - GSource* source = g_source_new (&scheme_source_funcs, sizeof (SchemeSource)); - SchemeSource* src = (SchemeSource*)source; - GMainContext* context = g_main_context_default (); + 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; @@ -248,7 +247,7 @@ scheme_source_new (void) } void -scheme_source_destroy (SchemeSource* source) +scheme_source_destroy (SchemeSource * source) { clear_registry (source); if (source->main_loop != NULL) @@ -256,20 +255,20 @@ scheme_source_destroy (SchemeSource* source) g_main_loop_unref (source->main_loop); source->main_loop = NULL; } - g_source_destroy ((GSource*) source); + g_source_destroy ((GSource *) source); } static void -clear_registry (SchemeSource* source) +clear_registry (SchemeSource * source) { - GSList* gpollfds = source->gpollfds; + GSList * gpollfds = source->gpollfds; if (gpollfds != NULL) { - GMainContext* context = source->main_context; - GSList* scan = gpollfds; + GMainContext * context = source->main_context; + GSList * scan = gpollfds; while (scan != NULL) { - GPollFD* gfd = scan->data; + GPollFD * gfd = scan->data; g_main_context_remove_poll (context, gfd); g_free (gfd); scan->data = NULL; @@ -281,7 +280,7 @@ clear_registry (SchemeSource* source) } static void -set_registry (SchemeSource* source, GSList* new, double time) +set_registry (SchemeSource * source, GSList * new, double time) { /* Set the source's current gpollfds to match NEW. Warns if the registry is already set. */ @@ -292,10 +291,10 @@ set_registry (SchemeSource* source, GSList* new, double time) source->time_limit = time; source->gpollfds = new; { - GMainContext* context = source->main_context; + GMainContext * context = source->main_context; while (new != NULL) { - GPollFD* gfd = new->data; + GPollFD * gfd = new->data; g_main_context_add_poll (context, gfd, G_PRIORITY_DEFAULT); new = new->next; } @@ -355,12 +354,13 @@ DEFINE_PRIMITIVE ("RUN-GTK", Prim_run_gtk, 2, 2, 0) set_registry (scheme_source, gtk_registry (r), time); if (tracing_gtk_select == SHARP_T) { - GSList* gpollfds = scheme_source->gpollfds; - gchar* fdstr = gpollfds_string (gpollfds); + 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); + if (fdstr[0] != '\0') + g_free (fdstr); } POP_PRIMITIVE_FRAME (2); SET_EXP (SHARP_F); @@ -385,20 +385,20 @@ DEFINE_PRIMITIVE ("RUN-GTK", Prim_run_gtk, 2, 2, 0) | ((((revents) & G_IO_ERR) != 0) ? SELECT_MODE_ERROR : 0) \ | ((((revents) & G_IO_HUP) != 0) ? SELECT_MODE_HUP : 0)) -static GSList* +static GSList * gtk_registry (select_registry_t registry) { /* Construct Gtk's version of a select_registry_t. */ int len = OS_select_registry_length (registry); int i = 0; - GSList* list = NULL; + GSList * list = NULL; while (i < len) { int fd; unsigned int mode; - GPollFD* item = g_malloc (sizeof (GPollFD)); + GPollFD * item = g_malloc (sizeof (GPollFD)); OS_select_registry_entry (registry, i, (&fd), (&mode)); item->fd = fd; item->events = DECODE_MODE (mode) | G_IO_ERR | G_IO_HUP; @@ -409,19 +409,19 @@ gtk_registry (select_registry_t registry) return (list); } -static gchar* -gpollfds_string (GSList* gpollfds) +static gchar * +gpollfds_string (GSList * gpollfds) { /* Construct a string describing the fds and r/w flags in GPOLLFDS, e.g. " 0(r)" */ - gchar* string = ""; - GSList* scan = gpollfds; + gchar * string = ""; + GSList * scan = gpollfds; while (scan != NULL) { - GPollFD* gfd = scan->data; + GPollFD * gfd = scan->data; int mode = (gfd->events) & (~(G_IO_HUP|G_IO_ERR)); - gchar* next = g_strdup_printf ("%s %d(%s)", string, gfd->fd, + gchar * next = g_strdup_printf ("%s %d(%s)", string, gfd->fd, (mode == (G_IO_IN|G_IO_OUT) ? "rw" : mode == G_IO_IN ? "r" : mode == G_IO_OUT ? "w" : "?")); @@ -436,15 +436,15 @@ gpollfds_string (GSList* gpollfds) static void open_slice_window (void) { - slice_window = gtk_window_new(GTK_WINDOW_TOPLEVEL); - GtkWidget* vbox = gtk_vbox_new(FALSE, 5); - status_label = gtk_label_new("Channels:"); - slice_label = gtk_label_new("Scheme time-slice: 0"); - gtk_container_add(GTK_CONTAINER(slice_window), vbox); + slice_window = gtk_window_new (GTK_WINDOW_TOPLEVEL); + GtkWidget * vbox = gtk_vbox_new (FALSE, 5); + status_label = gtk_label_new ("Channels:"); + slice_label = gtk_label_new ("Scheme time-slice: 0"); + gtk_container_add (GTK_CONTAINER (slice_window), vbox); gtk_box_pack_start (GTK_BOX (vbox), status_label, FALSE, FALSE, 2); gtk_box_pack_end (GTK_BOX (vbox), slice_label, FALSE, FALSE, 2); - gtk_window_set_title(GTK_WINDOW(slice_window), "Scheme Time-Slice Counter"); - gtk_window_set_type_hint (GTK_WINDOW(slice_window), + gtk_window_set_title (GTK_WINDOW (slice_window), "Scheme Time-Slice Counter"); + gtk_window_set_type_hint (GTK_WINDOW (slice_window), GDK_WINDOW_TYPE_HINT_UTILITY); gtk_widget_show_all (slice_window); gtk_window_parse_geometry (GTK_WINDOW (slice_window), "250x50+0-40"); @@ -470,16 +470,16 @@ DEFINE_PRIMITIVE ("GTK-TIME-SLICE-WINDOW!", Prim_gtk_time_slice_window, 1, 1, 0) { PRIMITIVE_HEADER (1); { - SCHEME_OBJECT arg = ARG_REF(1); + SCHEME_OBJECT arg = (ARG_REF (1)); if (arg == SHARP_F) { if (slice_window != NULL) - close_slice_window(); + close_slice_window (); } else { if (slice_window == NULL) - open_slice_window(); + open_slice_window (); } PRIMITIVE_RETURN (arg); } @@ -496,7 +496,7 @@ DEFINE_PRIMITIVE ("GTK-SELECT-TRACE!", Prim_gtk_select_trace, 1, 1, 0) { PRIMITIVE_HEADER (1); { - SCHEME_OBJECT arg = ARG_REF(1); + SCHEME_OBJECT arg = (ARG_REF (1)); tracing_gtk_select = (arg == SHARP_F ? SHARP_F : SHARP_T); PRIMITIVE_RETURN (arg); } @@ -505,7 +505,7 @@ DEFINE_PRIMITIVE ("GTK-SELECT-TRACE!", Prim_gtk_select_trace, 1, 1, 0) #ifdef COMPILE_AS_MODULE -char* +char * dload_initialize_file (void) { scheme_source = NULL; diff --git a/src/sf/butils.scm b/src/sf/butils.scm index 6f89330e9..62285591c 100644 --- a/src/sf/butils.scm +++ b/src/sf/butils.scm @@ -99,4 +99,41 @@ USA. (write-string " is up to date"))))))) (if (pair? filename) (for-each kernel filename) - (kernel filename)))) \ No newline at end of file + (kernel filename)))) + +(define (sf-with-dependencies sources dependencies #!optional syntax-env) + (let ((env (if (default-object? syntax-env) + sf/default-syntax-table + syntax-env)) + (deps (map (lambda (dep) (pathname-default-type dep "bin")) + dependencies))) + (define (file-reasons file) + (append + (if (not (file-processed? file "scm" "bin")) + (list (pathname-default-type file "scm")) + '()) + (let* ((bin-file (pathname-new-type file "bin")) + (bin-time (file-modification-time bin-file))) + (if (not bin-time) + '() + (list-transform-positive deps + (lambda (dep) + (let ((dep-time (file-modification-time dep))) + (or (not dep-time) (< bin-time dep-time))))))))) + (for-each + (lambda (file) + (let ((reasons (file-reasons file))) + (if (not (null? reasons)) + (begin + (if (eq? sf:noisy? #t) + (begin + (write-string ";Processing ") + (write (enough-namestring file)) + (write-string " because of:") + (for-each (lambda (reason) + (write-char #\space) + (write (enough-namestring reason))) + reasons))) + (fluid-let ((sf/default-syntax-table env)) + (sf file)))))) + (if (pair? sources) sources (list sources))))) \ No newline at end of file diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg index 609a1e544..e6e065ca5 100644 --- a/src/sf/sf.pkg +++ b/src/sf/sf.pkg @@ -180,5 +180,6 @@ USA. compile-directory compile-directory? sf-conditionally + sf-with-dependencies sf-directory sf-directory?)) \ No newline at end of file