From 85363d079ede31c2f14df04f7067a5a141a73e34 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 4 Jun 2010 23:29:12 -0700 Subject: [PATCH] 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. --- doc/gtk/Makefile.in | 2 +- doc/gtk/gtk.texinfo | 15 +-- src/gtk/Clean.sh | 4 +- src/gtk/Includes/gdkdrawable.cdecl | 14 +-- src/gtk/Makefile-fragment | 26 +++--- src/gtk/Tags.sh | 2 +- src/gtk/conses.png | Bin 0 -> 370 bytes src/gtk/conses.png.uu | 11 --- src/gtk/gtk.cbf | 6 ++ src/gtk/{compile.scm => gtk.sf} | 10 +- src/gtk/{load.scm => make.scm} | 2 - src/microcode/configure.ac | 2 +- src/microcode/prgtkio.c | 144 ++++++++++++++--------------- src/sf/butils.scm | 39 +++++++- src/sf/sf.pkg | 1 + 15 files changed, 144 insertions(+), 134 deletions(-) create mode 100644 src/gtk/conses.png delete mode 100644 src/gtk/conses.png.uu create mode 100644 src/gtk/gtk.cbf rename src/gtk/{compile.scm => gtk.sf} (86%) rename src/gtk/{load.scm => make.scm} (74%) 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 0000000000000000000000000000000000000000..ac9622617fda24216b5772fa660133ac3abfdfd6 GIT binary patch literal 370 zcmeAS@N?(olHy`uVBq!ia0vp^3LwnE1|*BCs=fdzwj^(N7l!{JxM1({$v_d#0*}aI zAngIhZYQ(t7#J9ZJY5_^A`ZWu{*bTPfTLyS(eL$7Z};Dfie9nQWS6S4VPVuhr9&qj zCK+WiC@2XfO?YyyFmms6o#f38oLRB={aw0#e~Z#}ls}ejR(h0A@w*uVH^-Caue)v? z7rauzcA`e%uiksz(+$^|W_N4EI(R-U+`9fQs~p>nNiqJc3P&tjT(o73y3ejiy|&=} z>JK?)`wwpm{^j8tbH-!O%|PZGj;22^87lnGWe^i+2$&eibM?oJqooOz3?HxmdM&x* zW|81BzXfx4C#4>o$vDUAfP~XJpUd4PYnO|kUQ#h_V_28E#76y@rlQpn@y4R71$Qq` z61^zhHGh8B_J>oip13-Altime_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 72c64bb22..8660c2bc7 100644 --- a/src/sf/sf.pkg +++ b/src/sf/sf.pkg @@ -179,5 +179,6 @@ USA. compile-directory compile-directory? sf-conditionally + sf-with-dependencies sf-directory sf-directory?)) \ No newline at end of file -- 2.25.1