Refactorings of the cont-responder and sqlite code. The browser

responder now accepts 'word' and 'vocab' as query parameters. The
cont-responder takes the continuation id as a query parameter instead of
part of the url.

contrib/cont-responder/browser.factor

@@ -45,6 +45,7 @@ USE: errors
 USE: unparser
 USE: logging
 USE: listener
+USE: url-encoding
 
 : <browser> ( allow-edit? vocab word -- )
   #! An object for storing the current browser
@@ -187,6 +188,15 @@ USE: listener
     ] when*
   ] catch ;
 
+: browser-url ( vocab word -- url )
+  #! Given a vocabulary and word as strings, return a browser
+  #! URL which, when requested, will display the source to that
+  #! word.
+  [ 
+    ".?word=" , url-encode ,
+    "&vocab=" , url-encode ,
+  ] make-string ;
+
 : browse ( <browser> -- )
   #! Display a Smalltalk like browser for exploring/modifying words.
   [
@@ -216,12 +226,19 @@ USE: listener
       "vocabs" get 
       "words" get 
       "eval" get dup [ "vocabs" get swap eval-string ] [ drop ] ifte
+      [
+	"vocabs" get "words" get browser-url forward-to-url
+      ] show
     ] bind <browser>
   ] forever ;
 
 : browser-responder ( allow-edit? -- )
   #! Start the Smalltalk-like browser.
-  "browser" f <browser> browse ;
+  "query" get dup [
+    dup >r "vocab" swap assoc r> "word" swap assoc
+  ] [
+    drop "browser" f 
+  ] ifte <browser> browse ;
 
 "browser" [ f browser-responder ] install-cont-responder
 ! "browser-edit" [ t browser-responder ] install-cont-responder

contrib/cont-responder/cont-responder.factor

@@ -39,7 +39,7 @@ USE: logging
 USE: url-encoding
 USE: unparser
 USE: hashtables
-
+USE: parser
 USE: prettyprint
 USE: inspector
 
@@ -58,7 +58,7 @@ USE: inspector
 
 : get-random-id ( -- id ) 
   #! Generate a random id to use for continuation URL's
-  [ 16 [ random-digit unparse , ] times ] make-string ;
+  [ 32 [ random-digit unparse , ] times ] make-string str>number 36 >base ;
 
 : continuation-table ( -- <namespace> ) 
   #! Return the global table of continuations
@@ -127,6 +127,11 @@ USE: inspector
   #! Get the continuation item associated with the id.
   continuation-table [ get ] bind ;
 
+: id>url ( id -- string )
+  #! Convert the continuation id to an URL suitable for
+  #! embedding in an HREF or other HTML.
+  url-encode "?id=" swap cat2 ;
+
 DEFER: show 
 
 : expired-page-handler ( alist -- )
@@ -195,6 +200,15 @@ DEFER: show
   #! stream. Return the string on exit.
   1024 <string-output> dup >r swap with-stream r> stream>str ;
 
+: forward-to-url ( url -- )
+  #! When executed inside a 'show' call, this will force a
+  #! HTTP 302 to occur to instruct the browser to forward to
+  #! the request URL.
+  [ 
+    "HTTP/1.1 302 Document Moved\nLocation: " , ,
+    "\nContent-Length: 0\nContent-Type: text/plan\n\n" , 
+  ] make-string call-exit-continuation ;
+
 : redirect-to-here ( -- )
   #! Force a redirect to the client browser so that the browser
   #! goes to the current point in the code. This forces an URL
@@ -208,7 +222,7 @@ DEFER: show
   ] [
     [ 
       t swap register-continuation 
-      [ "HTTP/1.1 302 Document Moved\nLocation: " , , "\n" , 
+      [ "HTTP/1.1 302 Document Moved\nLocation: " , id>url , "\n" , 
         "Content-Length: 0\nContent-Type: text/plain\n\n" , ] make-string
       call-exit-continuation 
     ] callcc1 drop 
@@ -226,7 +240,7 @@ DEFER: show
   store-callback-cc
   redirect-enabled? [ redirect-to-here ] when
   [ 
-    t swap register-continuation swap 
+    t swap register-continuation id>url swap 
     [ serving-html ] car swons with-string-stream
     call-exit-continuation 
   ] callcc1 
@@ -235,6 +249,8 @@ DEFER: show
 
 : cont-get-responder ( id-or-f -- ) 
   #! httpd responder that retrieves a continuation and calls it.
+  drop
+  "id" "query" get assoc
   dup f-or-"" [
     #! No continuation id given
     drop "root-continuation" get dup [
@@ -255,7 +271,9 @@ DEFER: show
   #! id and calls it with the POST data as a hashtable on the top
   #! of the stack.
   [ 
-    "response" get alist>hash swap resume-continuation 
+    drop
+    "response" get alist>hash 
+    "id" "query" get assoc resume-continuation 
   ] with-exit-continuation
   print drop ;
 
@@ -271,7 +289,7 @@ DEFER: show
   #! back to the most recent 'show' call (via the callback-cc).
   #! The text of the link will be the 'text' argument on the 
   #! stack.
-  <a href= callback-quot t swap register-continuation a> write </a> ;
+  <a href= callback-quot t swap register-continuation id>url a> write </a> ;
 
 : with-new-session ( quot -- )
   #! Each cont-responder is bound inside their own

contrib/cont-responder/cont-testing.factor

@@ -39,7 +39,7 @@
 ! eg.
 ! <cont-test-state> [ test-cont-responder ] test-cont-function
 !   => HTTP/1.1 302 Document Moved
-!      Location: 8506502852110820
+!      Location: ?id=8506502852110820
 !      Content-Length: 0
 !      Content-Type: text/plain
 !
@@ -48,12 +48,12 @@
 !      Content-Type: text/html
 !
 !      <html><head><title>Page one</title></head><body>
-!      <h1>Page one</h1><a href='5431597582800278'>Next</a>
+!      <h1>Page one</h1><a href='?id=5431597582800278'>Next</a>
 !      </body></html>
 !
 ! "5431597582800278" f test-cont-click
 !   => HTTP/1.1 302 Document Moved
-!      Location: 7944183606904129
+!      Location: ?id=7944183606904129
 !      Content-Length: 0
 !      Content-Type: text/plain
 !
@@ -63,14 +63,14 @@
 !
 !      <html><head><title>Enter your name</title></head>
 !      <body><h1>Enter your name</h1>
-!      <form method='post'action='8503790719833723'>
+!      <form method='post' action='?id=8503790719833723'>
 !      Name: <input type='text' name='name'size='20'>
 !      <input type='submit' value='Ok'>
 !      </form></body></html>
 !
-! "8503790719833723" [ [ "name" | "Chris" ] ] alist>hash test-cont-click
+! "8503790719833723" [ [[ "name" "Chris" ]] ] alist>hash test-cont-click
 !   => HTTP/1.1 302 Document Moved
-!      Location: 8879727708050260
+!      Location: ?id=8879727708050260
 !      Content-Length: 0
 !      Content-Type: text/plain
 !
@@ -80,7 +80,7 @@
 !
 !      <html><head><title>Hello Chris</title></head>
 !      <body><h1>Hello Chris</h1>
-!      <a href='0937854264503953'>Next</a>
+!      <a href='?id=0937854264503953'>Next</a>
 !      </body></html>
 ! 
 ! etc.

contrib/cont-responder/live-updater.factor

@@ -47,7 +47,7 @@ USE: lists
     [
       "js/liveUpdater.js" get-live-updater-js write
     ] show        
-  ] register-continuation ;
+  ] register-continuation id>url ;
 
 : include-live-updater-js ( -- )
   #! Write out the HTML script to include the live updater
@@ -96,7 +96,7 @@ USE: lists
     "document.getElementById('" write
     write
     "').onclick=liveUpdaterUri('" write
-    register-live-anchor-quot write
+    register-live-anchor-quot id>url write
     "');" write
   </script> ;
   
@@ -153,7 +153,7 @@ USE: lists
     "liveSearch('" write
     write
     "', '" write
-    register-live-search-quot write
+    register-live-search-quot id>url write
     "');" write
   </script> ;
 

contrib/cont-responder/todo-example.factor

@@ -107,7 +107,7 @@ USE: kernel
 
 : todo-stylesheet-url ( -- url )
   #! Generate an URL for the stylesheet.
-  t [ [ drop todo-stylesheet write ] show ] register-continuation ;
+  t [ [ drop todo-stylesheet write ] show ] register-continuation id>url ;
 
 : include-todo-stylesheet ( -- )  
   #! Generate HTML to include the todo stylesheet

contrib/cont-responder/tutorial.txt

@@ -331,10 +331,10 @@ sequence the page shows. Any Factor code can be called and the
 continuation based system will sequentially display each page. The
 back button, browser window cloning, etc will all continue to work.
 
-You'll notice the URL's in the browser have a number at the end of
+You'll notice the URL's in the browser have an 'id' query parameter with
-them. This is the 'continuation identifier' which is like a session id
+a number as its value. This is the 'continuation identifier' which is
-except that it identifies not just the data you have stored but your
+like a session id except that it identifies not just the data you have
-location within the responder as well.
+stored but your location within the responder as well.
 
 Forms and POST data
 ===================
@@ -603,7 +603,7 @@ calls the code we want to test and call the 'test-cont-function' word:
   <cont-test-state> [ subroutine-example1 ] test-cont-function
    => 
   HTTP/1.1 302 Document Moved
-  Location: 8209741119458310
+  Location: ?id=8209741119458310
   Content-Length: 0
   Content-Type: text/plain
 
@@ -628,9 +628,9 @@ state on the stack:
   Content-Type: text/html
   <html><head><title>Subroutine Example 1</title></head>
         <body><p>Please select:
-                 <ol><li><a href='7687398605200513'>Flow1</a></li>
+                 <ol><li><a href='?id=7687398605200513'>Flow1</a></li>
-                     <li><a href='7856272029924613'>Flow2</a></li>
+                     <li><a href='?id=7856272029924613'>Flow2</a></li>
-                     <li><a href='4909116160485714'>Flow3</a></li>
+                     <li><a href='?id=4909116160485714'>Flow3</a></li>
                  </ol>
               </p>
         </body>
@@ -645,7 +645,7 @@ written previously:
   <cont-test-state> [ post-example1 ] test-cont-function
     =>
   HTTP/1.1 302 Document Moved
-  Location: 5829759941409535
+  Location: ?id=5829759941409535
   Content-Length: 0
   Content-Type: text/plain
 
@@ -658,7 +658,7 @@ Again we skip past the forward:
 
   <html><head><title>Please enter your name</title></head>
         <body>
-          <form action='5456539333180428' method='post'>
+          <form action='?id=5456539333180428' method='post'>
             <p>Please enter your name:
                <input type='text'size='20'name='username'>
                <input type='submit'value='Ok'>

contrib/sqlite/sqlite.factor

@@ -28,10 +28,6 @@
 ! Not all functions have been wrapped yet. Only those directly involving
 ! executing SQL calls and obtaining results.
 !
-! TODO: Do I have to free stuctures like <sqlite3> and <char*>, etc
-!       or do they get freed on garbage collection?
-!       How do I do pointers to pointers? Use the 'indirect' trick?
-!
 IN: sqlite
 USE: kernel
 USE: alien
@@ -98,77 +94,58 @@ END-STRUCT
 : SQLITE_TRANSIENT   -1 ;
 
 : sqlite3_open ( filename sqlite3-indirect -- result )
-  "int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ; compiled
 
 : sqlite3_close ( db -- )
-  "int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ; compiled
 
 : sqlite3_prepare ( db sql sql-len sqlite3-stmt-indirect tail -- result )
-  "int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ; compiled
 
 : sqlite3_finalize ( stmt -- result ) 
-  "int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ; compiled
 
 : sqlite3_reset ( stmt -- result )
-  "int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ; compiled
 
 : sqlite3_step ( stmt -- result )
-  "int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ; compiled
 
 : sqlite3_bind_blob ( stmt index pointer len destructor -- result )
-  "int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ; compiled
 
 : sqlite3_bind_int ( stmt index int -- result )
-  "int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ; compiled
 
 : sqlite3_bind_null ( stmt index  -- result )
-  "int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_bind_text ( stmt index text len destructor -- result )
-  "int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_count ( stmt -- count )
-  "int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ; compiled
 
 : sqlite3_column_blob ( stmt col -- void* )
-  "void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_bytes ( stmt col -- int )
-  "int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_decltype ( stmt col -- string )
-  "char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_int ( stmt col -- int )
-  "int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_name ( stmt col -- string )
-  "char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_text ( stmt col -- string )
-  "char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
 
 : sqlite3_column_type ( stmt col -- int )
-  "int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ;
+  "int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
-
-\ sqlite3_open compile
-\ sqlite3_close compile
-\ sqlite3_prepare compile
-\ sqlite3_finalize compile
-\ sqlite3_reset compile
-\ sqlite3_bind_blob compile
-\ sqlite3_bind_int compile
-\ sqlite3_bind_null compile
-\ sqlite3_bind_text compile
-\ sqlite3_step compile
-\ sqlite3_column_count compile
-\ sqlite3_column_blob compile
-\ sqlite3_column_bytes compile
-\ sqlite3_column_decltype compile
-\ sqlite3_column_int compile
-\ sqlite3_column_name compile
-\ sqlite3_column_text compile
-\ sqlite3_column_type compile
 
 ! High level sqlite routines
 : sqlite-check-result ( result -- )
@@ -220,26 +197,32 @@ END-STRUCT
   #! from zero, as a string.
   sqlite3_column_text ;
 
-: (sqlite-each) 
+: step-complete? ( step-result -- bool )
-  "statement" get sqlite3_step dup SQLITE_ROW = [
+  #! Return true if the result of a sqlite3_step is
-    drop
+  #! such that the iteration has completed (ie. it is
-    "statement" get "quot" get call (sqlite-each)
+  #! SQLITE_DONE). Throw an error if an error occurs. 
+  dup SQLITE_ROW =  [
+    drop f
   ] [
     dup SQLITE_DONE = [
-      drop
+      drop t 
     ] [
       sqlite-check-result
     ] ifte
   ] ifte ;
 
 : sqlite-each ( statement quot -- )    
-  #! Excecute the SQL statement, and call the quotation for
+  #! Execute the SQL statement, and call the quotation for
   #! each row returned from executing the statement with the
   #! statement on the top of the stack.
-  #! TODO: Implement without named parameters
+  over sqlite3_step step-complete? [ 
-  <namespace> [
+    2drop
-    "quot" set
+  ] [
-    "statement" set
+    2dup 2slip sqlite-each
-    (sqlite-each)
+  ] ifte ;
-  ] bind ;
 
+! For comparison, here is the linrec implementation of sqlite-each
+! [ drop sqlite3_step step-complete? ]
+! [ 2drop ]
+! [ 2dup 2slip ]
+! [ ] linrec ; 

contrib/sqlite/test.factor

@@ -47,4 +47,9 @@ USE: prettyprint
   sqlite-finalize
   sqlite-close ;
 
+: run-test2 ( -- )
+  "test.db" sqlite-open
+  dup "select * from test" sqlite-prepare
+  dup [ show-people ] ;
+
 run-test