! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: html
-USING: generic hashtables help http inspector io
-kernel lists math namespaces sequences strings styles words xml ;
+USING: cont-responder generic hashtables help http inspector io
+kernel lists live-updater math namespaces sequences strings
+styles words xml ;
: hex-color, ( triplet -- )
3 swap head
: padding-css, ( padding -- ) "padding: " % # "px; " % ;
-: pre-css, ( -- ) "white-space: pre; " % ;
+: pre-css, ( -- ) "white-space: pre; font-family:monospace; " % ;
: div-css-style ( style -- str )
[
M: object browser-link-href drop f ;
M: word browser-link-href
- "/responder/browser" swap [
+ "/responder/browser/" swap [
dup word-vocabulary "vocab" set word-name "word" set
] make-hash build-url ;
link-name [ \ f ] unless* dup word? [
browser-link-href
] [
- [ "/responder/help/" % url-encode % ] "" make
+ "/responder/help/" swap "topic" associate build-url
] if ;
: object-link-tag ( style quot -- )
] object-link-tag
] with-stream* ;
+: html-outliner ( caption contents -- )
+ <table>
+ <tr>
+ <td>
+ "replaceme" swap [
+ [ with-html-stream ] show-final
+ ] curry "+" live-anchor
+ </td>
+ <td>
+ call
+ </td>
+ </tr>
+ <tr>
+ <td> </td>
+ <td> <div "replaceme" =id div> </div>
+ </tr>
+ </table> ;
+
+: outliner-tag ( style quot -- )
+ outline pick hash [ html-outliner ] [ call ] if* ;
+
M: html-stream with-nested-stream ( quot style stream -- )
[
[
[
- stdio get <nested-stream> swap with-stream*
- ] div-tag
- ] object-link-tag
+ [
+ stdio get <nested-stream> swap with-stream*
+ ] div-tag
+ ] object-link-tag
+ ] outliner-tag
] with-stream* ;
M: html-stream stream-terpri [ <br/> ] with-stream* ;
<head>
<title> write </title>
default-css
+ include-live-updater-js
</head>
<body>
<h1> write </h1>
--- /dev/null
+! 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 ;
projects / factor.git / commitdiff