Add files via upload

4 files changed, 120 insertions, 39 deletions

diff --git a/README.md b/README.md
index 334aeab..da11bb2 100644
--- a/README.md
+++ b/README.md
@@ -8,6 +8,6 @@ No need to compile anything.  The demos are scripts, ready to run.
 To run the demos:
 
 
-chmod +x demo1 demo2 demo3
+chmod +x demo[1-4]
 
-./demo1 ; ./demo2 ; ./demo3
+./demo4
diff --git a/demo4 b/demo4
new file mode 100644
index 0000000..42bf654
--- /dev/null
+++ b/demo4
@@ -0,0 +1,25 @@
+#!/bin/bash
+sbcl --script << 'EOF' 2> >(sed '/^Backtrace/,$d;/^; /d')
+
+; Refer to the demostuff file for definitions and descriptions.
+
+(load "demostuff")
+
+(defun main ()
+  (gapp demo4
+    (window win demo4 "Demos Menu" 300 200)
+    (box h outerbox win)
+    (box v mainbox outerbox)
+    (mbutton button1 "Four Button Demo" mainbox (dodemo 1))
+    (mbutton button2 "Numerals Demo"    mainbox (dodemo 2))
+    (mbutton button3 "Dates Demo"       mainbox (dodemo 3))
+    (gtk_widget_show_all win))
+  (g_application_run demo4 0 nil)
+  (g_object_unref demo4))
+
+(defun dodemo (which)
+  (sb-ext:run-program (format nil "demo~d" which) nil))
+
+(main)
+
+EOF
diff --git a/demostuff b/demostuff
index aa66dda..6c3a540 100644
--- a/demostuff
+++ b/demostuff
@@ -16,6 +16,10 @@ and defines gapp, window, box, button, text, xtext, and xlabel.
             to establish, the initial label text on the button,
             the object the button is to be placed in, and the code
             to be executed when the button is pressed.
+  mbutton   Is like button, except the button label text will be
+            left-aligned instead of centered.  It's for use in a
+            column of buttons, such as a menu, where it might look
+            neater to not center the button labels.
   text      Establishes a text display object, which Gtk calls a
             label.  Its arguments are the name of the text object,
             the initial text, and what object to place the text
@@ -36,30 +40,60 @@ and defines gapp, window, box, button, text, xtext, and xlabel.
 ; of them default to having it not be an error.
 (sb-int:set-floating-point-modes :traps '(:overflow :invalid))
 
-; The following makes Gtk functions available, giving their names
-; and argument types.
-(loop as gfunc in
-  '((gtk_application_window_new (* t) (* t))
-    (gtk_window_set_title void (* t) c-string)
-    (gtk_window_set_default_size void (* t) int int)
-    (gtk_button_box_new (* t) int)
-    (gtk_container_add void (* t) (* t))
-    (gtk_label_new (* t) c-string)
-    (gtk_label_set_text void (* t) c-string)
-    (gtk_button_set_label void (* t) c-string)
-    (gtk_button_get_label c-string (* t))
-    (gtk_button_new_with_label (* t) c-string)
-    (gtk_widget_destroy (* t) (* t))
-    (gtk_application_new (* t) c-string int)
-    (g_application_run int (* t) int (* t))
-    (g_object_unref void (* t))
-    (g_signal_connect_data long
-      (* t) c-string (function void (* t) (* t)) (* t) (* t) int)
-    (gtk_widget_show_all void (* t)))
-  do (eval (nconc (list 'define-alien-routine (car gfunc) (cadr gfunc))
-                  (loop as argname in '(a b c d e f g h i j k l m)
-                        as argtype in (cddr gfunc)
-                        collect (list argname argtype)))))
+; gfunc makes a prototype for a gtk function.
+(defmacro gfunc (gtkname &rest types)
+  `(define-alien-routine ,gtkname ,(car types)
+     ,@(loop as argname in '(a b c d e f g h i j k l m)
+             as argtype in (cdr types)
+             collect (list argname argtype))))
+
+; gfunc above vs x_x etc below: gfunc is more general, but more
+; verbose.  x_x etc are for specific combinations of argument types.
+
+; x_x, v_xs, etc use gfunc to make prototypes for gtk functions.
+; The name, such as x_x, includes an underline, to indicate it's
+; for a gtk function, because underlines are practically a
+; trademark of gtk function names.  The letter before the underline
+; is the return value type, and the other letters are the argument
+; types:
+; v for void
+; x for void*
+; s for c-string
+; i for int
+; In the following, the g argument is the name of the gtk function.
+(defmacro x_x   (g) `(gfunc ,g (* t) (* t)))
+(defmacro v_x   (g) `(gfunc ,g void (* t)))
+(defmacro v_xx  (g) `(gfunc ,g void (* t) (* t)))
+(defmacro x_i   (g) `(gfunc ,g (* t) int))
+(defmacro v_xii (g) `(gfunc ,g void (* t) int int))
+(defmacro v_xs  (g) `(gfunc ,g void (* t) c-string))
+(defmacro x_s   (g) `(gfunc ,g (* t) c-string))
+(defmacro s_x   (g) `(gfunc ,g c-string (* t)))
+(defmacro i_xix (g) `(gfunc ,g int (* t) int (* t)))
+(defmacro x_si  (g) `(gfunc ,g (* t) c-string int))
+(defmacro v_xf  (g) `(gfunc ,g void (* t) float))
+
+; These make the prototypes for the gtk functions.  See above.
+(x_x   gtk_application_window_new)
+(v_xs  gtk_window_set_title)
+(v_xii gtk_window_set_default_size)
+(x_i   gtk_button_box_new)
+(x_i   gtk_size_group_new)
+(x_x   gtk_bin_get_child)
+(v_xf  gtk_label_set_xalign)
+(v_xx  gtk_container_add)
+(x_s   gtk_label_new)
+(v_xs  gtk_label_set_text)
+(v_xs  gtk_button_set_label)
+(s_x   gtk_button_get_label)
+(x_s   gtk_button_new_with_label)
+(x_x   gtk_widget_destroy)
+(x_si  gtk_application_new)
+(i_xix g_application_run)
+(v_x   g_object_unref)
+(v_x   gtk_widget_show_all)
+(gfunc g_signal_connect_data long
+  (* t) c-string (function void (* t) (* t)) (* t) (* t) int)
 
 ; callbackname makes a callback name from an object name.
 ; The eval-when makes it usable during macro expansions.
@@ -104,6 +138,15 @@ and defines gapp, window, box, button, text, xtext, and xlabel.
        (g_signal_connect_data ,abutton "clicked" ,cb nil nil 0)
        (gtk_container_add ,placement ,abutton))))
 
+; mbutton is like button, except that the button label text will be
+; left aligned instead of centered, to make it neater in a column of
+; buttons, such as for a menu.
+(defmacro mbutton (abutton buttonlabel placement &body body)
+  `(progn
+     (button ,abutton ,buttonlabel ,placement ,@body)
+     (let ((thelabel (gtk_bin_get_child ,abutton)))
+       (gtk_label_set_xalign thelabel 0.0))))
+
 ; text establishes a Gtk "label" object which is actually a text
 ; display object.  The arguments are, what text object to
 ; establish, the initial text to display, and what object to
diff --git a/intro b/intro
index 0d9ca00..6ce3ec9 100644
--- a/intro
+++ b/intro
@@ -1,13 +1,26 @@
-These demos demonstrate using Gtk directly from a higher level language.  None of the demos have any low level code in them.
-There is no need for any makefiles, C compilers, or any other low level stuff.  There is probably no need to install Gtk,
-because it's probably already used by your Linux.  Any high level language can be used if it has the right features.  Using
-sbcl is just one example of how to do this.
-
-When a demo script gets invoked, the code gets compiled into memory, by sbcl, with a very fast compiler, so there will be
-no object files, executable binaries, etc., unless those are desired.  The only requirement is to download or copy and
-paste the demos and demostuff and make each demo executable with "chmod +x demo".  Then run the demos with
-"./demo1 ; ./demo2 ; ./demo3".
-
-If there are error messages about not finding sbcl, it might be necessary to install that, or to add it to the path.
-Installing sbcl is easy, usually via the Linux distro.  In the rare circumstance that a particular Linux distro doesn't
-have sbcl, simply go to sbcl.org to download the sources or binary.
+These demos demonstrate using Gtk directly from a higher level language.
+None of the demos have any low level code in them.  There is no need for
+any makefiles, C compilers, or any other low level stuff.  There is
+probably no need to install Gtk, because it's probably already used by
+your Linux.
+
+To use a different high level language for these demos, it is of course
+necessary to edit them to change the language.  But they aren't very long
+and that might not take very long.  It's strongly advised to run the
+present demos first, and make some minor changes to them, to see the
+differences, to make sure to understand how they work, before starting to
+change them to a different language.
+
+When a demo script gets invoked, the code gets compiled into memory, with
+a very fast compiler, so there will be no object files, executable binaries,
+etc., unless those are desired.  The only requirement is to download or copy
+and paste the demos and demostuff and make each demo executable with
+"chmod +x demo[1-4]".  Then run the demos with "./demo4".
+
+If there are error messages about not finding sbcl, it might be necessary
+to install that, or to add it to the path.  Installing sbcl is easy, usually
+via the Linux distro.
+
+In the rare circumstance that a particular Linux distro doesn't have sbcl,
+you could install, via sbcl.org, either a binary version, or the sources to
+compile.