[plt-scheme] send/suspend/dispatch and javascript?

From: Bob McCormick (bobm at adt.com)
Date: Tue Nov 30 18:43:24 EST 2004

You're my new hero!  :-)


On Nov 29, 2004, at 6:44 PM, Anton van Straaten wrote:

> Bob McCormick wrote:
>  > If anyone can tell me what I'm doing wrong I'd appreciate it.   I'm
>  > very new to Scheme.   I was going to re-writing some CGI's I've done
>  > previously in Perl as an exercise to learn Scheme, but maybe I've
> > bitten off more than I can chew.   :-)
>
> You're pretty close, so don't give up just yet.  The immediate problem 
> can
>  be fixed by moving the definitions of url-append/path and
>  send/suspend/dispatch to after the "(unit/sig () (import servlet^)" 
> line -
> that'll fix the dependency issue, although I'm not saying it's the best
>  solution, just expedient.  (send/suspend/dispatch is defined as part 
> of the
>  servlet^ interface, so that's why that works.)

O.K.   That makes sense now in retrospect.  I really should have seen 
that earlier.   I'm assuming that the long term solution would be to 
move send/suspend/dispatch into a module (or a unit/sig I guess) that 
imports servlet^?  The user would then import the new module or 
unit/sig?   I've skimmed a little bit of the documentation on modules 
and unit/sigs, but I'm sure I'll eventually need to read it in depth.


> After that, you'll run into some other problems.  Since I take it this 
> isn't
>  homework, and since send/suspend/dispatch really ought to be a drop-in
>  library routine, I've provided fixes for the other remaining issues 
> below.
>  If you want to work it out for yourself, don't read any further.  ;)

Definitely not homework.   :-)


> If there are any you don't understand, please ask.
>
> 1.  Change the definition of send/suspend/dispatch to eliminate the
>  contract, because that seems broken - I didn't investigate why.  The 
> revised
>  definition begins with the following two lines:
>
>   (define send/suspend/dispatch
>    (lambda (page-func)

Not sorry to see that go.  I don't understand the contract stuff yet 
anyway.

>
> 2.  In your require clause at the top, you'll need to specify these as 
> well:
>        (lib "url.ss" "net")
>        (lib "list.ss")
>       (lib "string.ss")
>     (You would have found this out once the earlier problems were 
> fixed)
>
> 3.  Fix typo: s-rul
>
> 4.  Add omitted (url-host url) as second argument to make-url in
>  url-append/path (check the paper).
>
> 5.  Fix your calls to page2 and page3 to pass the request parameter, 
> which
>  those functions expect.  For extra credit, you can abbreviate 
> expressions of
> the form "(lambda (x) (f x))" to just plain "f" (without the quotes); 
> if you
>  don't know what I mean, ignore it for now.
>
> 6.  page3 doesn't return a valid x-expr, so you'll get an error on 
> that page
>  until you fix it.
>
> Anton
>


Thanks for the detailed help Anton, I really appreciate it.
For anyone who's interested, here's the working version of the program:

(require (lib "unitsig.ss")
          (lib "servlet-sig.ss" "web-server")
          (lib "servlet-helpers.ss" "web-server")
          (lib "contract.ss")
          (lib "url.ss" "net")
          (lib "list.ss")
          (lib "string.ss")
          )

(unit/sig () (import servlet^)


(define send/suspend/dispatch
   (lambda (page-func)
     (let* ([embed-hash (make-hash-table)]
            [request (send/suspend
                      (lambda (k-url)
                        (page-func
                         (case-lambda
                           [() k-url]
                           [(embed-func)(let ([key (unique-hash-key 
embed-hash)])
                                          (hash-table-put! embed-hash 
key embed-func)
                                          (url-append/path k-url 
key))]))))]
            [path
             (post-servlet-path
              (url->string (request-uri request)))])
       (if (null? path)
           request
           ((hash-table-get
             embed-hash
             (string->number (car path))
             (lambda ()
               (lambda _
                 (send/back
                  `("text/plain"
                    "ERROR: Key was not found in "
                    "send/suspend/dispatch hash table")))))
            request)))))


(define unique-hash-key
   (lambda (ht)
     (let ([key (random 200000)])
       (let/ec exit
         (hash-table-get ht key (lambda () (exit key)))
         (unique-hash-key ht)))))

(define post-servlet-path
   (lambda (s-url)
     (let([result (regexp-match "\\.ss(/[^;#\\?]*)" s-url)])
       (if result
           (filter
            (lambda (s) (> (string-length s) 0))
            (regexp-split "/" (cadr result)))
           null))))


(define url-append/path
   (lambda (s-url rel-path)
     (let ([url (string->url s-url)])
       (url->string
        (make-url
         (url-scheme url)
         (url-host url)
         (url-port url)
         (format "~a/~a" (url-path url) rel-path)
         (url-params url)
         (url-query url)
         (url-fragment url))))))



   (define (page2 req)
     `(html (head (title "Page Two"))
            (body (h1 "Page Two"))))

   (define (page3 req)
     `(html (head) (body (div ((id "test")) "Bye"))))

   (send/suspend/dispatch
    (lambda (embed/url)
    `(html (head (title "Page One")(script ((src 
"../liveUpdater.js")(language "javascript")(type "text/javascript"))))
           (body (h1 "Page One")
                 (p (a ((href ,(embed/url page2))) "Page Two"))
                 (p (a ((href "#") (id "mylink")) "Page three") (script 
((type "text/javascript")) "document.getElementById('mylink').onclick=" 
,(string-append "liveUpdaterUri('" (embed/url page3) "')")))
                 (div ((id "test")) "hi")))
   )))


And here's the source to the liveUpdater.js file:


function liveUpdaterUri(uri)
{
     return liveUpdater(function() { return uri; });
}

function liveUpdater(uriFunc)
{
     var request = false;
     var regex = /<(\w+).*?id="(\w+)".*?>((.|\n)*)<\/\1>/;

     if (window.XMLHttpRequest) {
        	request = new XMLHttpRequest();
     }

     function update()
     {
         if(request && request.readyState < 4)
             request.abort();

         if(!window.XMLHttpRequest)
             request = new ActiveXObject("Microsoft.XMLHTTP");

         request.onreadystatechange = processRequestChange;
         request.open("GET", uriFunc());
         request.send(null);
         return false;
     }

     function processRequestChange()
     {
         if(request.readyState == 4)
         {
             var results = regex.exec(request.responseText);
             if(results)
                 document.getElementById(results[2]).innerHTML = 
results[3];
         }
     }

     return update;
}


function liveSearch(id, uri)
{
     function constructUri()
     {
         var separator = "?";
         if(uri.indexOf("?") >= 0)
             separator = "&";
         return uri + separator + "s=" + 
escape(document.getElementById(id).value);
     }

     var updater = liveUpdater(constructUri);
     var last = "";
     var timeout = false;

     function update()
     {
        if (last != document.getElementById(id).value)
             updater();
     }

     function start() {
	   if (timeout)
	       window.clearTimeout(timeout);
	
     	   timeout = window.setTimeout(update, 300);
     }

	
	if (navigator.userAgent.indexOf("Safari") > 0)
		document.getElementById(id).addEventListener("keydown",start,false);
     else if (navigator.product == "Gecko")
		document.getElementById(id).addEventListener("keypress",start,false);
     else
		document.getElementById(id).attachEvent("onkeydown",start);
}


Posted on the users mailing list.