Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -4,42 +4,53 @@
 #  greater. See the accompanying file COPYING for details.
 # 
 #  This program is distributed WITHOUT ANY WARRANTY; without even the
 #  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 #  PURPOSE.
-
+#
+# Following needed on bluehost
+#
+# CSC_OPTIONS='-C "-fPIC"' make
+#
 include install.cfg
 
-SRCFILES    = stml.scm misc-stml.scm session.scm sqltbl.scm formdat.scm setup.scm stmlrun.scm keystore.scm html-filter.scm cookie.scm 
+SRCFILES    = stml.scm misc-stml.scm session.scm sqltbl.scm formdat.scm setup.scm keystore.scm html-filter.scm cookie.scm 
 MODULEFILES = $(wildcard modules/*/*-mod.scm)
 SOFILES     = $(MODULEFILES:%.scm=%.so)
 CFILES      = $(MODULEFILES:%.scm=%.c)
 OFILES      = $(SRCFILES:%.scm=%.o)
 TARGFILES   = $(notdir $(SOFILES))
 MODULES     = $(addprefix $(TARGDIR)/modules/,$(TARGFILES))
 
 install : $(TARGDIR)/stmlrun $(LOGDIR) $(MODULES)
+	chicken-install
 
 all : $(SOFILES)
 
 # stmlrun : stmlrun.scm formdat.scm  misc-stml.scm  session.scm stml.scm \
 #           setup.scm html-filter.scm requirements.scm keystore.scm \
 #           cookie.scm sqltbl.scm
 # 	csc stmlrun.scm
 
-$(TARGDIR)/stmlrun : stmlrun 
+$(TARGDIR)/stmlrun : stmlrun stml.so
 	install stmlrun $(TARGDIR)
 	chmod a+rx $(TARGDIR)/stmlrun
 
 $(TARGDIR)/modules :
 	mkdir -p $(TARGDIR)/modules
 
 $(MODULES) : $(SOFILES) $(TARGDIR)/modules
 	cp $< $@
 
-stmlrun : $(OFILES) stmlrun.scm requirements.scm
-	csc $(OFILES) -o stmlrun
+stmlrun : $(OFILES) stmlrun.scm requirements.scm stmlcommon.scm
+	csc $(OFILES) stmlrun.scm -o stmlrun
+
+stml.so : stmlmodule.so
+	cp stmlmodule.so stml.so
+
+stmlmodule.so : $(OFILES) stmlmodule.scm requirements.scm stmlcommon.scm
+	csc $(OFILES) -s stmlmodule.scm
 
 # logging currently relies on this
 #
 $(LOGDIR) :
 	mkdir -p $(LOGDIR)

Index: doc/howto.txt
==================================================================
--- doc/howto.txt
+++ doc/howto.txt
@@ -1,25 +1,35 @@
 Gotchas!
 =======
 
-1. All items for a page *must* be part of a list!
+All items for a page *must* be part of a list!
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
    OK:     (list (function1 param1)(function2 param2))
    NOT OK: (begin (function1 param1)(function2 param2))
 
 
 Various components
-==================
+~~~~~~~~~~~~~~~~~~
+
+The URL:
+
+http://the.domain.com/pagename/p1/p2/p3?param1=value1
+
+(s:get-page-params) => '("p1" "p2")
+
 
-======================================================================
-1. Create a link.
+Create a link.
+~~~~~~~~~~~~~~
 
 (s:null "[" (s:a name 'href 
                (s:link-to (string-append "location/" (string-intersperse p "/") ""))) "] ")))
 
-======================================================================
-2. Call current page with new param
+
+
+Call current page with new param
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 In view.scm:
 
  (s:center "[" (s:a 'href (s:link-to "polls"
                            'id
@@ -31,42 +41,46 @@
 In control.scm:
 
 (let ((poll-id (s:get-param 'id)))
  ;; do stuff based on poll-id
 
-======================================================================
-3. Call an action on a specific page
+
+Call an action on a specific page
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  (s:a 'href (s:link-to "polls" 'id (poll:poll 'get 'id) 
 			       'action "poll.edit")
             "Suggest changes to this poll")
 
  NOT TRUE! This calls fuction poll.edit (should be in control.scm). Parameter set is 'id to a poll num.
 
-======================================================================
-4. A complex link example
+
+A complex link example
+~~~~~~~~~~~~~~~~~~~~~~
 
 (s:a "Reply" 'href (s:link-to (s:current-page) 
 	           'action "discussion.reply" ;; <page>.<action>
 	           'reply_to (number->string (hash-table-ref row 'posts.id)) 
 	           'id (s:get "discussion.parent_object_id")) "reply")
 
 ;; use (s:get-param to get the 'id, or 'reply_to values
 
-======================================================================
-5. Get and set a session var
+
+Get and set a session var
+~~~~~~~~~~~~~~~~~~~~~~~~~
 
 (s:session-var-get "keyname")
 (s:session-var-set! "keyname" "value")
 
 5.1 Page local vars
 
 (s:set! key val)
 (s:get key)
 
-======================================================================
-6. make a selection drop down
+
+make a selection drop down
+~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 In view.scm: 
 
 (s:select '(("World" 0)("Country" 1)("State" 2)("Town/City" 3)) 'name 'scope)
 
@@ -73,12 +87,13 @@
 In control.scm:
 
 (let ((scope (s:get-input 'scope)))
   ....
 
-======================================================================
-7. Simple error reporting
+
+Simple error reporting
+~~~~~~~~~~~~~~~~~~~~~~
 
 In control.scm:
 (s:set-err "You must provide an email address")
 
 In view.scm:
@@ -85,12 +100,26 @@
 (s:get-err s:err-font)
 
 Or:
 (s:get-err (lambda (x)(s:err-font x (s:br))))
 
-======================================================================
-8. Misc useful stuff
+
+Sharing data between pages
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+NOTE: This data is *not* preserved between cgi calls.
+
+;; In first page called
+(s:shared-set! "somekey" somevalue)
+
+;; In a page called later
+(let ((dat (s:shared-get "somekey")))
+  ( .... ))
+
+
+Misc useful stuff
+~~~~~~~~~~~~~~~~~
 
   i. Lazy/safe string->number 
 
 (s:any->number val)
 
@@ -100,12 +129,13 @@
 
  iii. string to number for pgint
  
 (s:any->pgint val)
 
-======================================================================
-9. Forms and input
+
+Forms and input
+~~~~~~~~~~~~~~~
 
 (s:form 'action "login.login" 'method "post"
    (s:input-preserve 'type "text" 'name "email-address" 'size "16" 'maxlength "30")
    (s:input 'type "submit"   'name "form-name" 'value "login"))
 
@@ -112,8 +142,5 @@
 (s:get-input 'email-address)
 
 To preserve the input simply do a set of the value on the 'name field:
 (s:set! "email-address" "matt@kiatoa.com")
 
-======================================================================
-10. 
-

DELETED doc/stml-manual.odt
Index: doc/stml-manual.odt
==================================================================
--- doc/stml-manual.odt
+++ /dev/null
cannot compute difference between binary files

Index: formdat.scm
==================================================================
--- formdat.scm
+++ formdat.scm
@@ -33,11 +33,17 @@
 
 (define (formdat:initialize self)
   (formdat:formdat-set-data! self (make-hash-table)))
 
 (define (formdat:get self key)
-  (hash-table-ref/default (formdat:formdat-get-data self) key #f))
+  (hash-table-ref/default 
+   (formdat:formdat-get-data self)
+   (cond 
+    ((symbol? key) key)
+    ((string? key) (string->symbol key))
+    (else key))
+   #f))
 
 ;; change to convert data to list and append val if already exists
 ;; or is a list
 (define (formdat:set! self key val)
   (let ((prev-val (formdat:get self key))

Index: misc-stml.scm
==================================================================
--- misc-stml.scm
+++ misc-stml.scm
@@ -170,15 +170,16 @@
 		  (s:log res)
 		  (loop (read-line p)(cons (list l "<BR>") res)))))
 	  #t))))
 
 (define (s:validate-inputs)
-  (if (not (s:validate-uri))(begin (s:error-page "Bad URI" (let ((ref (get-environment-variable "HTTP_REFERER")))
-							     (if ref
-								 (list "referred from" ref)
-								 "")))
-				   (exit))))
+  (if (not (s:validate-uri))
+      (begin (s:error-page "Bad URI" (let ((ref (get-environment-variable "HTTP_REFERER")))
+				       (if ref
+					   (list "referred from" ref)
+					   "")))
+	     (exit))))
 
 ;; anything except a list is converted to a string!!!
 (define (s:any->string val)
   (cond
    ((string? val) val)

Index: requirements.scm.template
==================================================================
--- requirements.scm.template
+++ requirements.scm.template
@@ -1,11 +1,11 @@
 ;; choose your db interface as appropriate
 (require-extension sqlite3)
 (import (prefix sqlite3 sqlite3:))
 
-(require-extension postgresql)
-(import (prefix postgresql pg:))
+;; (require-extension postgresql)
+;; (import (prefix postgresql pg:))
 
 ;; (require-extension cgi-util)
 ;; (require-extension cookie)
 (use posix)
 ;; (require-extension proplist)

ADDED   rollup-pages.scm
Index: rollup-pages.scm
==================================================================
--- /dev/null
+++ rollup-pages.scm
@@ -0,0 +1,49 @@
+(use regex posix srfi-69 srfi-1)
+
+(define extract-rx (regexp "pages\\/(.*)_(view|ctrl).scm"))
+
+(define (print-page-wrapper lookup page)
+  (print "(define (pages:" page " session db shared)")
+  (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
+      (print "(include \"pages/" page "_ctrl.scm\")"))
+  (if (hash-table-ref/default lookup (conc page "_view") #f)
+      (print "(include \"pages/" page "_view.scm\")"))
+  (print ")\n"))
+
+(let* ((views  (glob "pages/*_view.scm"))
+       (ctrls  (glob "pages/*_ctrl.scm"))
+       (all    (append views ctrls))
+       (lookup (make-hash-table))
+       (pages  (delete-duplicates
+		(map (lambda (x)
+		       (let* ((res  (string-match extract-rx x))
+			      (page (cadr res))
+			      (type (caddr res)))
+			 (hash-table-set! lookup (conc page "_" type) #t)
+			 (cadr res)))
+		     all))))
+  (if (null? all)(begin (print "No page files matching pages/*_(view|ctrl).scm")(exit)))
+  (print "Pages: " pages)
+  ;; first the individual rollup wrappers (used by the dynamic load)
+  (for-each 
+   (lambda (page)
+     (let ((pagefile  (conc "pages/" page ".scm")))
+       (print "page " page " ")
+       (if (not (file-exists? pagefile))
+	   (begin
+	     (with-output-to-file pagefile
+	       (lambda ()
+		 (print-page-wrapper lookup page)))
+	     (print " created"))
+	   (print " already created"))))
+   pages)
+  ;; then the monolithic rollup wrapper (used in compiling the single-executable)
+  (with-output-to-file "all_pages.scm"
+    (lambda ()
+      (for-each
+       (lambda (page)
+	 (print-page-wrapper lookup page))
+       pages))))
+
+
+  

Index: session.scm
==================================================================
--- session.scm
+++ session.scm
@@ -24,11 +24,11 @@
 ;;  Concept of order num incremented with each page access
 ;;     if a branch is taken then a new session would need to be created
 ;;
 
 ;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
-(define (make-sdat)(make-vector 33))
+(define (make-sdat)(make-vector 34))
 (define (sdat-get-dbtype               vec)    (vector-ref  vec 0))
 (define (sdat-get-dbinit               vec)    (vector-ref  vec 1))
 (define (sdat-get-conn                 vec)    (vector-ref  vec 2))
 (define (sdat-get-pgconn               vec)    (vector-ref (vector-ref vec 2) 1))
 (define (sdat-get-params               vec)    (vector-ref  vec 3))
@@ -59,10 +59,15 @@
 (define (sdat-get-log-port             vec)    (vector-ref  vec 28))
 (define (sdat-get-logfile              vec)    (vector-ref  vec 29))
 (define (sdat-get-seen-pages           vec)    (vector-ref  vec 30))
 (define (sdat-get-page-dir-style       vec)    (vector-ref  vec 31))
 (define (sdat-get-debugmode            vec)    (vector-ref  vec 32))
+(define (sdat-get-shared-hash          vec)    (vector-ref  vec 33))
+
+(define (session:get-shared vec varname)
+  (hash-table-ref/default (vector-ref vec 33) varname #f))
+
 (define (sdat-set-dbtype!              vec val)(vector-set! vec 0 val))
 (define (sdat-set-dbinit!              vec val)(vector-set! vec 1 val))
 (define (sdat-set-conn!                vec val)(vector-set! vec 2 val))
 (define (sdat-set-params!              vec val)(vector-set! vec 3 val))
 (define (sdat-set-path-params!         vec val)(vector-set! vec 4 val))
@@ -92,45 +97,17 @@
 (define (sdat-set-log-port!            vec val)(vector-set! vec 28 val))
 (define (sdat-set-logfile!             vec val)(vector-set! vec 29 val))
 (define (sdat-set-seen-pages!          vec val)(vector-set! vec 30 val))
 (define (sdat-set-page-dir-style!      vec val)(vector-set! vec 31 val))
 (define (sdat-set-debugmode!           vec val)(vector-set! vec 32 val))
-
-;; (define-class <session> ()
-;;   (dbtype       ;; 'pg or 'sqlite3
-;;    dbinit
-;;    conn
-;;    params       ;; params from the key=val&key1=val2 string
-;;    path-params  ;; remaining params from the path
-;;    session-key
-;;    session-id
-;;    domain
-;;    toppage      ;; defaults to "index" - override in .stml.config if desired
-;;    page         ;; the page name - defaults to home
-;;    curr-page    ;; the current page being evaluated
-;;    content-type ;; the default content type is text/html, override to deliver other stuff
-;;    page-type    ;; use in conjunction with content-type to deliver other payloads
-;;    sroot
-;;    twikidir     ;; location for twikis - needs to be fully writable by web server
-;;    pagedat
-;;    alt-page-dat
-;;    pagevars     ;; session vars specific to this page
-;;    pagevars-before
-;;    sessionvars  ;; session vars visible to all pages
-;;    sessionvars-before
-;;    globalvars   ;; global vars visible to all sessions
-;;    globalvars-before
-;;    logpt
-;;    formdat
-;;    request-method
-;;    session-cookie
-;;    curr-err
-;;    log-port
-;;    logfile
-;;    seen-pages
-;;    page-dir-style  ;; #t = new style, #f = old style
-;;    debugmode))
+(define (sdat-set-shared-hash!         vec val)(vector-set! vec 33 val))
+
+(define (session:set-shared! vec varname val)
+  (hash-table-set! (vector-ref vec 33) varname val))
+
+;; The global session
+(define s:session (make-sdat))
 
 ;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
 (define (session:initialize self)
   (sdat-set-dbtype! self      'pg)
   (sdat-set-page! self        "home")        ;; these are defaults
@@ -180,11 +157,15 @@
     ;; (print "configdat: ")(pp configdat)
     (if debugmode
 	(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
 		     " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
     )
+  (sdat-set-shared-hash! self (make-hash-table))
   )
+
+;; Used for the strangely inconsistent handling of the config file. A better way is needed.
+;;
 ;;   (let ((dbtype (sdat-get-dbtype self)))
 ;;     (print "dbtype: " dbtype)
 ;;     (sdat-set-dbtype! self (eval dbtype))))
 
 (define (session:setup self)
@@ -193,10 +174,13 @@
 	(dbinit    (eval (sdat-get-dbinit self)))
 	(dbexists  #f))
     (let ((dbfname (alist-ref 'dbname dbinit)))
       (if debugmode (session:log self "session:setup dbfname=" dbfname ", dbtype=" dbtype ", dbinit=" dbinit))
       (if (eq? dbtype 'sqlite3)
+	  ;; The 'auto method will distribute dbs across the disk using hash
+	  ;; of user host and user. TODO
+	  ;; (if (eq? dbfname 'auto) ;; This is the auto assignment of a db based on hash of IP
 	  (let ((dbpath (pathname-directory dbfname)))  ;; do a couple sanity checks here to make setting up easier
 	    (if debugmode (session:log self "INFO: setting up for sqlite3 db access to " dbfname))
 	    (if (not (file-write-access? dbpath))
 		(session:log self "WARNING: Cannot write to " dbpath)
 		(if debugmode (session:log self "INFO: " dbpath " is writeable")))
@@ -205,10 +189,11 @@
 		  ;; (session:log self "setting dbexists to #t")
 		  (set! dbexists #t))))
 	  (if debugmode (session:log self "INFO: setting up for pg db access to account info " dbinit)))
       (if debugmode (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists)))
     (sdat-set-conn! self (dbi:open dbtype dbinit))
+    (set! *db* (sdat-get-conn self))
     (if (and (not dbexists)(eq? dbtype 'sqlite3))
  	(begin
 	  (print "WARNING: Setting up session db with sqlite3")
 	  (session:setup-db self)))
     (session:process-url-path self)
@@ -450,17 +435,17 @@
 
 ;; get session vars for a specified page
 ;;
 (define (session:get self page key)
   (let ((ht (session:get-page-hash self page)))
-    (hash-table-ref/default ht key #f)))
+    (hash-table-ref/default ht (s:any->string key) #f)))
 
 ;; delete a session var for a specified page
 ;;
 (define (session:del! self page key)
   (let ((ht (session:get-page-hash self page)))
-    (hash-table-delete! ht key)))
+    (hash-table-delete! ht (s:any->string key))))
 
 ;; get ALL keys for this page and store in the session pagevars hash
 ;;
 (define (session:get-vars self)
   (let ((session-id  (sdat-get-session-id self)))
@@ -604,93 +589,87 @@
 	((string? x) x)
 	(else '())))
      (port-map (lambda (s)
 		 (eval s e))
 	       (lambda ()(read p))))))
+
+(define (session:process-file f)
+  (let* ((p    (open-input-file f))
+	 (dat  (process-port p)))
+    (close-input-port p)
+    dat))
 
 ;; May 2011, putting all pages into one directory for the following reasons:
 ;;   1. want filename to reflect page name (emacs limitation)
 ;;   2. that's it! no other reason. could make it configurable ...
-(define (session:call-parts self page parts)
+;; page-dir-style is:
+;;  'stored   => stored in executable
+;;  'flat     => pages flat directory
+;;  'dir      => directory tree pages/<pagename>/{view,control}.scm
+;; parts:
+;;  'both     => load control and view (anything other than view or control
+;;  'view     => load view only
+;;  'control  => load control only
+(define (session:call-parts self page #!key (parts 'both))
   (sdat-set-curr-page! self page)
-  ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self))
-  (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
-	  (sdat-get-page-dir-style self))
-	 (dir     (string-append (sdat-get-sroot self) 
-				 (if dir-style 
-				     (conc "/pages/")
-				     (conc "/pages/" page))))
-	 (control (string-append dir (if dir-style 
-					 (conc page "_ctrl.scm")
-					 "/control.scm")))
-	 (view    (string-append dir (if dir-style 
-					 (conc page "_view.scm")
-					 "/view.scm")))
-	 (load-view    (and (file-exists? view)
-			    (or (eq? parts 'both)(eq? parts 'view))))
-	 (load-control (and (file-exists? control)
-			    (or (eq? parts 'both)(eq? parts 'control))))
-	 (view-dat   '()))
-    ;; (session:log self "dir-style: " dir-style)
- ;;   (sugar "/home/matt/kiatoa/stml/sugar.scm" ))
-    ;; (print "dir=" dir " control=" control " view=" view " load-view=" load-view " load=control=" load-control)
-    (if load-control
-	(begin
-	  (load control)
-	  (session:set-called! self page)))
-    ;; move this to where it gets exectuted only once
-    ;;
-    ;;(s:log "s:b yields " (s:b "blah"))
-    (if load-view
-	;; option one:
-	;;
-	;; (let ((inp (open-input-string 
-	;; 	    (files-read->string "/home/matt/kiatoa/stml/sugar.scm" 
-	;; 				view))))
-	;;   (map 
-	;;    (lambda (x)
-	;;      (cond
-	;;       ((list? x) x)
-	;;       ((string? x) x)
-	;;       (else '())))
-	;;    (port-map eval (lambda ()
-	;; 		 (read inp)))))
-	;;
-	;; option two:
-	;;
-	(let* (;; (inps (map open-input-file (list view))) ;; sugar view)))
-	       (p    (open-input-file view)) ;; (apply make-concatenated-port inps))
-	       (dat  (process-port p)))
-		;;(map 
-		;;      (lambda (x)
-		;;	(cond
-		;;	 ((list? x) x)
-		;;	 ((string? x) x)
-		;;	 (else '())))
-		;;      (port-map eval (lambda ()(read p))))))
-	  ;; (map close-input-port inps)
-	  (close-input-port p)
-	  dat)
-	(list "<p>Page not found " page " </p>"))))
-
-;;(define (session:call self page)
-;;  (session:call-parts self page 'both))
+  (let* ((dir-style    (sdat-get-page-dir-style self));; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
+	 (dir          (string-append (sdat-get-sroot self) 
+				      (if dir-style 
+					  (conc "/pages/")
+					  (conc "/pages/" page)))))
+    (case dir-style
+      ;; NB// Stored always loads both control and view
+      ((stored)
+       ((eval (string->symbol (conc "pages:" page))) 
+	self                         ;; the session
+	(sdat-get-conn self)         ;; the db connection
+	(sdat-get-shared-hash self)  ;; a shared hash table for passing data to/from page calls
+	))
+      ((flat)   
+       (let* ((so-file  (conc dir page ".so"))
+	      (scm-file (conc dir page ".scm"))
+	      (src-file (or (file-exists? so-file)
+			    (file-exists? scm-file))))
+	 (if src-file
+	     (begin
+	       (load src-file)
+	       ((eval (string->symbol (conc "pages:" page))) 
+		self                         ;; the session
+		(sdat-get-conn self)         ;; the db connection
+		(sdat-get-shared-hash self)  ;; a shared hash table for passing data to/from page calls
+		))
+	     (list "<p>Page not found " page " </p>"))))
+       ;; first the control
+       ;; (let ((control-file (conc "pages/" page "_ctrl.scm"))
+       ;;       (view-file    (conc "pages/" page "_view.scm")))
+       ;;   (if (and (file-exists? control-file)
+       ;;  	  (not (eq? parts 'view)))
+       ;;       (begin
+       ;;         (session:set-called! self page)
+       ;;         (load control-file)))
+       ;;   (if (file-exists? view-file)
+       ;;       (if (not (eq? parts 'control))
+       ;;  	 (session:process-file view-file))
+       ;;       (list "<p>Page not found " page " </p>")))
+      ((dir) "ERROR:  dir style not yet re-implemented")
+      (else
+       (list "ERROR: page-dir-style must be stored, dir or flat, got " dir-style)))))
 
 (define (session:call self page parts)
   (session:call-parts self page 'both))
 
-(define (session:load-model self model)
-  (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
-	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
-    (if (file-exists? model.so)
-	(load model.so)
-	(if (file-exists? model.scm)
-	    (load model.scm)
-	    (s:log "ERROR: model " model.scm " not found")))))
-
-(define (session:model-path self model)
-  (string-append (sdat-get-sroot self) "/models/" model ".scm"))
+;; (define (session:load-model self model)
+;;   (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
+;; 	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
+;;     (if (file-exists? model.so)
+;; 	(load model.so)
+;; 	(if (file-exists? model.scm)
+;; 	    (load model.scm)
+;; 	    (s:log "ERROR: model " model.scm " not found")))))
+
+;; (define (session:model-path self model)
+;;   (string-append (sdat-get-sroot self) "/models/" model ".scm"))
 
 (define (session:pp-formdat self)
   (let ((dat (formdat:all->strings (sdat-get-formdat self))))
     (string-intersperse dat "<br> ")))
 
@@ -751,10 +730,20 @@
 		(formdat:get formdat key)
 		(begin
 		  (session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
 		  #f))
 	    (session:log self "ERROR: bad key " key)))))
+
+;; This one will get the first value found regardless of form
+(define (session:get-input-keys self)
+  (let* ((formdat (sdat-get-formdat self)))
+    (if (not formdat) #f
+	(if (and (vector? formdat)(eq? (vector-length formdat) 1)(hash-table? (vector-ref formdat 0)))
+	    (formdat:keys formdat)
+	    (begin
+	      (session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
+	      #f)))))
 
 (define (session:run-actions self)
   (let* ((action    (session:get-param self 'action))
 	 (page      (sdat-get-page self)))
     ;; (print "action=" action " page=" page)

Index: setup.scm
==================================================================
--- setup.scm
+++ setup.scm
@@ -10,14 +10,10 @@
 (declare (unit setup))
 (declare (uses session))
 (require-extension srfi-69)
 (require-extension regex)
 
-;; 
-(define s:session (make-sdat))
-(session:initialize s:session)
-
 ;; use this for getting data from page to page when scope and evals
 ;; get in the way
 (define s:local-vars (make-hash-table))
 
 (define (s:local-set! k v)
@@ -24,17 +20,13 @@
   (hash-table-set! s:local-vars k v))
 
 (define (s:local-get k)
   (hash-table-ref/default s:local-vars k #f))
 
-(session:setup s:session)
-
 (define (s:log . msg)
   (apply session:log s:session msg))
 
-(session:get-vars s:session)
-
 (define (s:set-err . args)
   (sdat-set-curr-err! s:session args))
 
 ;; Usage: (s:get-err s:big)
 (define (s:get-err wrapperfunc)
@@ -93,18 +85,41 @@
 ;; utility to get all vars as hash table
 (define (s:session-get-sessionvars)
   (sdat-get-sessionvars s:session))
 
 ;; inputs
+;;
 (define (s:get-input key)
   (session:get-input s:session key))
 
+(define (s:get-input-keys)
+  (session:get-input-keys s:session))
+
 (define (s:load-model model)
   (session:load-model s:session model))
 
 (define (s:model-path model)
   (session:model-path s:session model))
+
+;; share data between pages calls. NOTE: This is not persistent
+;; between cgi calls. Use sessionvars for that.
+;;
+(define (s:shared-hash)
+  (sdat-get-shared-hash s:session))
+
+(define (s:shared-set! key val)
+  (hash-table-set! (sdat-get-shared-hash s:session) key val))
+
+;; What to return when no value for key?
+;;
+(define (s:shared-get key)
+  (hash-table-ref/default (sdat-get-shared-hash s:session) key #f))
+
+;; http://foo.bar.com/pagename/p1/p2 => '("p1" "p2")
+;;
+(define (s:get-page-params)
+  (sdat-get-page-params s:session))
 
 (define (s:db)
   (sdat-get-conn s:session))
 
 (define (s:never-called-page? page)

ADDED   stml.meta
Index: stml.meta
==================================================================
--- /dev/null
+++ stml.meta
@@ -0,0 +1,20 @@
+(
+; Your egg's license:
+(license "LGPL")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category misc)
+
+; A list of eggs mpeg3 depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+(needs srfi-69)
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "Primitive argument processor."))

Index: stml.scm
==================================================================
--- stml.scm
+++ stml.scm
@@ -64,10 +64,12 @@
 (define (s:code   . args) (s:common-tag "CODE"   args))
 (define (s:div    . args) (s:common-tag "DIV"    args))
 (define (s:h1     . args) (s:common-tag "H1"     args))
 (define (s:h2     . args) (s:common-tag "H2"     args))
 (define (s:h3     . args) (s:common-tag "H3"     args))
+(define (s:h4     . args) (s:common-tag "H4"     args))
+(define (s:h5     . args) (s:common-tag "H5"     args))
 (define (s:head   . args) (s:common-tag "HEAD"   args))
 (define (s:html   . args) (s:common-tag "HTML"   args))
 (define (s:i      . args) (s:common-tag "I"      args))
 (define (s:img    . args) (s:common-tag "IMG"    args))
 (define (s:input  . args) (s:common-tag "INPUT"  args))
@@ -87,10 +89,11 @@
 (define (s:dl     . args) (s:common-tag "DL"     args))
 (define (s:dt     . args) (s:common-tag "DT"     args))
 (define (s:dd     . args) (s:common-tag "DD"     args))
 (define (s:pre    . args) (s:common-tag "PRE"    args))
 (define (s:span   . args) (s:common-tag "SPAN"   args))
+(define (s:label  . args) (s:common-tag "LABEL"  args))
 
 (define (s:dblquote  . args)
   (let* ((inputs (s:extract args))
          (data   (caar inputs))
          (params (s:process-params (cadr inputs))))

ADDED   stml.setup
Index: stml.setup
==================================================================
--- /dev/null
+++ stml.setup
@@ -0,0 +1,18 @@
+;; Copyright 2007-2010, Matthew Welland.
+;;
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;;
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+;;;; margs.setup
+
+;; compile the code into a dynamically loadable shared object
+;; (will generate margs.so)
+;; (compile -s margs.scm)
+
+;; Install as extension library
+(install-extension 'stml "stml.so")
+

ADDED   stmlcommon.scm
Index: stmlcommon.scm
==================================================================
--- /dev/null
+++ stmlcommon.scm
@@ -0,0 +1,65 @@
+;; Copyright 2007-2011, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+;; (require-extension syntax-case)
+;; (declare (run-time-macros))
+
+(include "requirements.scm")
+(declare (uses cookie))
+(declare (uses html-filter))
+(declare (uses misc-stml))
+(declare (uses formdat))
+(declare (uses stml))
+(declare (uses session))
+(declare (uses setup)) ;; s:session gets created here
+(declare (uses sqltbl))
+(declare (uses keystore))
+
+(define (stml:cgi-session session)
+  (session:initialize session)
+  (session:setup session)
+  (session:get-vars session)
+
+  (sdat-set-log-port! session ;; (current-error-port))
+		      (open-output-file (sdat-get-logfile session) #:append))
+  (s:validate-inputs)
+  (session:run-actions session)
+  (sdat-set-pagedat! session
+		     (append (sdat-get-pagedat session)
+			     (s:call (sdat-get-toppage session))))
+  (if (eq? (sdat-get-page-type session) 'html) ;; default is html. 
+      (session:cgi-out session)
+      (session:alt-out session))
+  (session:save-vars session)
+  (session:close session))
+
+(define (stml:main proc)
+  (handle-exceptions
+   exn   
+   (begin
+     (print "Content-type: text/html")
+     (print "")
+     (print "<html> <head> <title>EXCEPTION</title> </head> <body>")
+     (print "   QUERY_STRING is: <b> " (get-environment-variable "QUERY_STRING") " </b> <br>")
+     (print "<pre>")
+     ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
+     (print-error-message exn)
+     (print-call-chain)
+     (print "</pre>")
+     (print "<table>")
+     (for-each (lambda (var)
+		 (print "<tr><td>" (car var) "</td><td>" (cdr var) "</td></tr>"))
+	       (get-environment-variables))
+     (print "</table>")
+     (print "</body></html>"))
+   
+   (if proc (proc s:session) (stml:cgi-session s:session))
+ ;; (raise-error)
+ ;; (exit)
+   ))

ADDED   stmlmodule.scm
Index: stmlmodule.scm
==================================================================
--- /dev/null
+++ stmlmodule.scm
@@ -0,0 +1,14 @@
+;; Copyright 2007-2011, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+;; (require-extension syntax-case)
+;; (declare (run-time-macros))
+
+(include "stmlcommon.scm")
+

Index: stmlrun.scm
==================================================================
--- stmlrun.scm
+++ stmlrun.scm
@@ -10,49 +10,9 @@
 ;;  PURPOSE.
 
 ;; (require-extension syntax-case)
 ;; (declare (run-time-macros))
 
-(handle-exceptions
- exn   
- (begin
-   (print "Content-type: text/html")
-   (print "")
-   (print "<html> <head> <title>EXCEPTION</title> </head> <body>")
-   (print "   QUERY_STRING is: <b> " (get-environment-variable "QUERY_STRING") " </b> <br>")
-   (print "<pre>")
-   ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
-   (print-error-message exn)
-   (print-call-chain)
-   (print "</pre>")
-   (print "<table>")
-   (for-each (lambda (var)
-	       (print "<tr><td>" (car var) "</td><td>" (cdr var) "</td></tr>"))
-	     (get-environment-variables))
-   (print "</table>")
-   (print "</body></html>"))
- (include "requirements.scm")
- (declare (uses cookie))
- (declare (uses html-filter))
- (declare (uses misc-stml))
- (declare (uses formdat))
- (declare (uses stml))
- (declare (uses session))
- (declare (uses setup)) ;; s:session gets created here
- (declare (uses sqltbl))
- (declare (uses keystore))
- 
- (sdat-set-log-port! s:session ;; (current-error-port))
- 		     (open-output-file (sdat-get-logfile s:session) #:append))
- (s:validate-inputs)
- (session:run-actions s:session)
- (sdat-set-pagedat! s:session
- 		    (append (sdat-get-pagedat s:session)
- 			    (s:call (sdat-get-toppage s:session))))
- (if (eq? (sdat-get-page-type s:session) 'html) ;; default is html. 
-     (session:cgi-out s:session)
-     (session:alt-out s:session))
- (session:save-vars s:session)
- (session:close s:session)
- ;; (raise-error)
- ;; (exit)
- )
+;; (include "stmlcommon.scm")
+(require-library stml)
+
+(stml:main #f)

Index: sugar.scm
==================================================================
--- sugar.scm
+++ sugar.scm
@@ -22,18 +22,83 @@
 ;; (define-syntax s:if-test
 ;;   (syntax-rules ()
 ;;     [(_ s x) (if   (string=? "yep" s)   x (list "s:if not"))]
 ;;     [(_ s x y) (if (string=? "yep" s) x y)]))
 
-
-(define-macro (s:if-param varname . dat)
-  (match dat
-	 (()    '())
-	 ((a)    `(if (s:get ,varname) ,a '()))
-	 ((a b)  `(if (s:get ,varname) ,a ,b))))
-
-(define-macro (s:if-sessionvar varname . dat)
-  (match dat
-	 (()    '())
-	 ((a)    `(if (s:session-var-get ,varname) ,a '()))
-	 ((a b)  `(if (s:session-var-get ,varname) ,a ,b))))
-
+;; Some of these routines use:
+;;
+;;     http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html
+;;
+;; Syntax for defining macros in a simple style similar to function definiton,
+;;  when there is a single pattern for the argument list and there are no keywords.
+;;
+;; (define-simple-syntax (name arg ...) body ...)
+;;
+
+(define-syntax define-simple-syntax
+  (syntax-rules ()
+    ((_ (name arg ...) body ...)
+     (define-syntax name (syntax-rules () ((name arg ...) (begin body ...)))))))
+
+;;======================================================================
+;; syntatic sugar items
+;;======================================================================
+
+;; We often seem to want to include stuff if a conditional is met
+;; otherwise not include it. This routine makes that slightly cleaner
+;; since using a pure if results in #<undefined> objects. (admittedly they 
+;; should be ignored but this is slightly cleaner I think). 
+;;
+;; NOTE: This has to be a macro or the true clause will be evaluated 
+;; whether "a" is true or false
+
+;; If a is true return b, else return '()
+(define-simple-syntax (s:if a b)
+  (if a b '()))
+
+
+;; Using the Simple-Syntax System
+;; 
+;; The syntax for defining macros in this system is similar to that for defining functions. In fact if the macro has a fixed number of arguments the syntax is identical. For example:
+;; 
+;;   ; Define a simple macro to add a value to a variable.
+;;   ;
+;;   (define-simple-syntax (+= variable value)
+;;     (set! variable (+ variable value)))
+;; 
+;;   ; Use it.
+;;   ;
+;;   (define v 2)
+;;   (+= v 7)
+;;   v ; => 9
+;; 
+;; For a fixed number of arguments followed by an unknown number of arguments we use ... after a single argument to represent the unknown number (possibly zero) of arguments. For example, let's revise our definition of += to allow zero or more values to be added:
+;; 
+;;   ; Define a simple macro to add a zero or more values to a variable
+;;   ;
+;;   (define-simple-syntax (+= variable value ...)
+;;     (set! variable (+ variable value ...)))
+;; 
+;;   ; Use it
+;;   ;
+;;   (define v 2)
+;;   (+= v 7)
+;;   v ; => 9
+;;   (+= v 3 4)
+;;   v ; => 16
+;;   (+= v)
+;;   v ; => 16
+;; 
+
+
+;; (define-macro (s:if-param varname . dat)
+;;   (match dat
+;; 	 (()    '())
+;; 	 ((a)    `(if (s:get ,varname) ,a '()))
+;; 	 ((a b)  `(if (s:get ,varname) ,a ,b))))
+;; 
+;; (define-macro (s:if-sessionvar varname . dat)
+;;   (match dat
+;; 	 (()    '())
+;; 	 ((a)    `(if (s:session-var-get ,varname) ,a '()))
+;; 	 ((a b)  `(if (s:session-var-get ,varname) ,a ,b))))
+;;