factor/contrib/httpd/live-updater.factor

! Copyright (C) 2004 Chris Double.
! 
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
! 
! 1. Redistributions of source code must retain the above copyright notice,
!    this list of conditions and the following disclaimer.
! 
! 2. Redistributions in binary form must reproduce the above copyright notice,
!    this list of conditions and the following disclaimer in the documentation
!    and/or other materials provided with the distribution.
! 
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! cont-responder code for display forms and anchors that use XMLHttpRequest
! and the 'liveUpdater.js' code.
IN: live-updater
USING: kernel io strings html cont-responder namespaces lists ;

: get-live-updater-js* ( stream -- string )
  #! Read all lines from the stream, creating a string of the result.
  dup stream-readln dup [ % "\n" % get-live-updater-js* ] [ drop stream-close ] if ;

: get-live-updater-js ( filename -- string )
  #! Return the liveUpdater javascript code as a string.
  "/contrib/httpd/liveUpdater.js" <resource-stream> contents ;

: live-updater-url ( -- url )
  #! Generate an URL to the liveUpdater.js code.
  t [
    [ get-live-updater-js write ] show        
  ] register-continuation id>url ;

: include-live-updater-js ( -- )
  #! Write out the HTML script to include the live updater
  #! javascript code.
  <script "JavaScript" =language live-updater-url =src script> 
    "" write
  </script> ;

: write-live-anchor-tag ( text -- id )
  #! Write out the HTML for the clickable anchor. This
  #! will have no actionable HREF assigned to it. Instead
  #! an onclick is set via DHTML later to make it run a
  #! quotation on the server. The randomly generated id
  #! for the anchor is returned.
  <a get-random-id dup =id "#" =href a>  
    swap write
  </a> ;  

: register-live-anchor-quot ( div-id div-quot -- kid )
  #! Register the 'quot' with the cont-responder so
  #! that when it is run it will produce an HTML
  #! fragment which is the output generated by calling 
  #! 'quot'. That HTML fragment will be wrapped in a 
  #! 'div' with the given id.  
  [
    "div-quot" set
    "div-id" set
  ] make-hash [ 
    [
      t "disable-initial-redirect?" set
      [ 
        <div "div-id" get =id div> "div-quot" get call </div>    
      ] show 
    ] bind 
  ] cons t swap register-continuation ;
  
: write-live-anchor-script ( div-id div-quot anchor-id -- )
  #! Write the javascript that will attach the onclick
  #! event handler to the anchor with the 'anchor-id'. The
  #! onclick, when clicked, will retrieve from the server
  #! the HTML generated by the output of 'div-quot' wrapped
  #! in a 'div' tag with the 'div-id'. That 'div' tag will
  #! replace whatever HTML DOM object currently has that same
  #! id.
  <script "JavaScript" =language script> 
    "document.getElementById('" write
    write
    "').onclick=liveUpdaterUri('" write
    register-live-anchor-quot id>url write
    "');" write
  </script> ;
  
: live-anchor ( id quot text -- )
  #! Write out the HTML for an anchor that when clicked
  #! will replace the DOM object on the current page with
  #! the given 'id' with the result of the output of calling
  #! 'quot'. 
  write-live-anchor-tag
  write-live-anchor-script ;

: write-live-search-tag ( -- id )
  #! Write out the HTML for the input box. This
  #! will have no actionable keydown assigned to it. Instead
  #! a keydown is set via DHTML later to make it run a
  #! quotation on the server. The randomly generated id
  #! for the input box is returned.
  <input get-random-id dup =id "text" =type input/> ;

: register-live-search-quot ( div-id div-quot -- kid )
  #! Register the 'quot' with the cont-responder so
  #! that when it is run it will produce an HTML
  #! fragment which is the output generated by calling 
  #! 'quot'. That HTML fragment will be wrapped in a 
  #! 'div' with the given id. The 'quot' is called with
  #! a string on top of the stack. This is the input string
  #! entered in the live search input box.
  [
    "div-quot" set
    "div-id" set
  ] make-hash [ 
    [
      t "disable-initial-redirect?" set
      #! Retrieve the search query value from the POST parameters.
      [ "s" get ] bind
      [ 
        #! Don't need the URL as the 'show' won't be resumed.
        drop
        <div "div-id" get =id div> "div-quot" get call </div>    
      ] show 
    ] bind 
  ] cons t swap register-continuation ;

: write-live-search-script ( div-id div-quot id-id -- )
  #! Write the javascript that will attach the keydown handler
  #! to the input box with the give id. Whenever a keydown is
  #! received the 'div-quot' will be executed on the server,
  #! with the input boxes text on top of the stack. The 
  #! output of the quot will be an HTML fragment, it is wrapped in
  #! a 'div' with the id 'div-id' and will 
  #! replace whatever HTML DOM object currently has that same
  #! id.
  <script "JavaScript" =language script> 
    "liveSearch('" write
    write
    "', '" write
    register-live-search-quot id>url write
    "');" write
  </script> ;

: live-search ( div-id div-quot -- )
  #! Write an input text field. The keydown of this
  #! text field will run 'div-quot' on the server with
  #! the value of the text field on the stack. The output
  #! of div-quot will replace the HTML DOM object with the
  #! given id.
  write-live-search-tag
  write-live-search-script ;