more html stream work
Slava Pestov
parent
10d16e572d
commit
ab2b06b071
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: httpd
|
IN: httpd
|
||||||
USING: browser-responder cont-responder file-responder
|
USING: browser-responder cont-responder file-responder
|
||||||
help-responder kernel namespaces prettyprint ;
|
help-responder inspect-responder kernel namespaces prettyprint ;
|
||||||
|
|
||||||
#! Remove all existing responders, and create a blank
|
#! Remove all existing responders, and create a blank
|
||||||
#! responder table.
|
#! responder table.
|
||||||
|
|
@ -16,10 +16,7 @@ global [
|
||||||
] make-responder
|
] make-responder
|
||||||
|
|
||||||
! Online help browsing
|
! Online help browsing
|
||||||
[
|
"help" [ help-responder ] install-cont-responder
|
||||||
"help" "responder" set
|
|
||||||
[ help-responder ] "get" set
|
|
||||||
] make-responder
|
|
||||||
|
|
||||||
! Global variables
|
! Global variables
|
||||||
"inspector" [ inspect-responder ] install-cont-responder
|
"inspector" [ inspect-responder ] install-cont-responder
|
||||||
|
|
|
||||||
|
|
@ -1,9 +1,13 @@
|
||||||
! Copyright (C) 2006 Slava Pestov.
|
! Copyright (C) 2006 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: help-responder
|
IN: help-responder
|
||||||
USING: help html kernel sequences ;
|
USING: cont-responder hashtables help html kernel namespaces
|
||||||
|
sequences ;
|
||||||
|
|
||||||
: help-responder ( filename -- )
|
: help-responder ( filename -- )
|
||||||
dup empty? [ drop "handbook" ] when
|
[
|
||||||
dup article-title
|
"topic" "query" get hash
|
||||||
[ [ (help) ] with-html-stream ] html-document ;
|
dup empty? [ drop "handbook" ] when
|
||||||
|
dup article-title
|
||||||
|
[ [ (help) ] with-html-stream ] html-document
|
||||||
|
] show-final ;
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,9 @@
|
||||||
! Copyright (C) 2004, 2006 Slava Pestov.
|
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: html
|
IN: html
|
||||||
USING: generic hashtables help http inspector io
|
USING: cont-responder generic hashtables help http inspector io
|
||||||
kernel lists math namespaces sequences strings styles words xml ;
|
kernel lists live-updater math namespaces sequences strings
|
||||||
|
styles words xml ;
|
||||||
|
|
||||||
: hex-color, ( triplet -- )
|
: hex-color, ( triplet -- )
|
||||||
3 swap head
|
3 swap head
|
||||||
|
|
@ -60,7 +61,7 @@ kernel lists math namespaces sequences strings styles words xml ;
|
||||||
|
|
||||||
: padding-css, ( padding -- ) "padding: " % # "px; " % ;
|
: padding-css, ( padding -- ) "padding: " % # "px; " % ;
|
||||||
|
|
||||||
: pre-css, ( -- ) "white-space: pre; " % ;
|
: pre-css, ( -- ) "white-space: pre; font-family:monospace; " % ;
|
||||||
|
|
||||||
: div-css-style ( style -- str )
|
: div-css-style ( style -- str )
|
||||||
[
|
[
|
||||||
|
|
@ -104,7 +105,7 @@ GENERIC: browser-link-href ( presented -- href )
|
||||||
M: object browser-link-href drop f ;
|
M: object browser-link-href drop f ;
|
||||||
|
|
||||||
M: word browser-link-href
|
M: word browser-link-href
|
||||||
"/responder/browser" swap [
|
"/responder/browser/" swap [
|
||||||
dup word-vocabulary "vocab" set word-name "word" set
|
dup word-vocabulary "vocab" set word-name "word" set
|
||||||
] make-hash build-url ;
|
] make-hash build-url ;
|
||||||
|
|
||||||
|
|
@ -112,7 +113,7 @@ M: link browser-link-href
|
||||||
link-name [ \ f ] unless* dup word? [
|
link-name [ \ f ] unless* dup word? [
|
||||||
browser-link-href
|
browser-link-href
|
||||||
] [
|
] [
|
||||||
[ "/responder/help/" % url-encode % ] "" make
|
"/responder/help/" swap "topic" associate build-url
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: object-link-tag ( style quot -- )
|
: object-link-tag ( style quot -- )
|
||||||
|
|
@ -148,13 +149,36 @@ M: html-stream stream-format ( str style stream -- )
|
||||||
] object-link-tag
|
] object-link-tag
|
||||||
] with-stream* ;
|
] 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 -- )
|
M: html-stream with-nested-stream ( quot style stream -- )
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
stdio get <nested-stream> swap with-stream*
|
[
|
||||||
] div-tag
|
stdio get <nested-stream> swap with-stream*
|
||||||
] object-link-tag
|
] div-tag
|
||||||
|
] object-link-tag
|
||||||
|
] outliner-tag
|
||||||
] with-stream* ;
|
] with-stream* ;
|
||||||
|
|
||||||
M: html-stream stream-terpri [ <br/> ] with-stream* ;
|
M: html-stream stream-terpri [ <br/> ] with-stream* ;
|
||||||
|
|
@ -176,6 +200,7 @@ M: html-stream stream-terpri [ <br/> ] with-stream* ;
|
||||||
<head>
|
<head>
|
||||||
<title> write </title>
|
<title> write </title>
|
||||||
default-css
|
default-css
|
||||||
|
include-live-updater-js
|
||||||
</head>
|
</head>
|
||||||
<body>
|
<body>
|
||||||
<h1> write </h1>
|
<h1> write </h1>
|
||||||
|
|
|
||||||
|
|
@ -67,7 +67,7 @@ sequences strings ;
|
||||||
[
|
[
|
||||||
swap % dup hash-empty? [
|
swap % dup hash-empty? [
|
||||||
"?" %
|
"?" %
|
||||||
hash>alist
|
dup hash>alist
|
||||||
[ [ url-encode ] map "=" join ] map "&" join %
|
[ [ url-encode ] map "=" join ] map "&" join %
|
||||||
] unless drop
|
] unless drop
|
||||||
] "" make ;
|
] "" make ;
|
||||||
|
|
|
||||||
|
|
@ -15,4 +15,4 @@ M: general-t browser-link-href
|
||||||
append ;
|
append ;
|
||||||
|
|
||||||
: inspect-responder ( url -- )
|
: inspect-responder ( url -- )
|
||||||
drop [ global http-inspect ] show-final ;
|
[ global http-inspect ] show-final ;
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,158 @@
|
||||||
|
! 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 ;
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
/*
liveUpdater.js originally written by Avi Bryant, author of
Seaside (http://www.beta4.com/seaside2)
Modifed by Chris Double to add LiveUpdaterPost and use '
instead of " for the id.
*/
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 liveUpdaterPost(uriFunc)
{
var request = false;
var regex = /<(\w+).*?id='(\w+)'.*?>((.|\n)*)<\/\1>/;
if (window.XMLHttpRequest) {
request = new XMLHttpRequest();
}
function update(data)
{
if(request && request.readyState < 4)
request.abort();
if(!window.XMLHttpRequest)
request = new ActiveXObject("Microsoft.XMLHTTP");
request.onreadystatechange = processRequestChange;
request.open("POST", uriFunc());
request.send(data);
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)
{
var updater = liveUpdaterPost((function() { return uri; }));
var last = "";
var timeout = false;
function update()
{
if (last != document.getElementById(id).value)
updater("s=" + escape(document.getElementById(id).value));
}
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);
}
|
||||||
|
|
@ -6,10 +6,11 @@ USING: words kernel parser sequences io compiler ;
|
||||||
"xml"
|
"xml"
|
||||||
"http-common"
|
"http-common"
|
||||||
"html-tags"
|
"html-tags"
|
||||||
"html"
|
|
||||||
"responder"
|
"responder"
|
||||||
"httpd"
|
"httpd"
|
||||||
"cont-responder"
|
"cont-responder"
|
||||||
|
"live-updater"
|
||||||
|
"html"
|
||||||
"file-responder"
|
"file-responder"
|
||||||
"help-responder"
|
"help-responder"
|
||||||
"inspect-responder"
|
"inspect-responder"
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue