Commit a4c73a11 authored by Pietro Abate's avatar Pietro Abate

[r2005-01-06 15:51:35 by afrisch] review html output, prepare demo

Original author: afrisch
Date: 2005-01-06 15:51:38+00:00
parent 7b104e89
......@@ -150,6 +150,7 @@ OBJECTS = \
misc/serialize.cmo misc/custom.cmo \
misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/bool.cmo \
misc/pretty.cmo misc/ns.cmo misc/inttbl.cmo misc/imap.cmo \
misc/html.cmo \
\
types/sortedList.cmo types/boolean.cmo types/ident.cmo \
types/intervals.cmo types/chars.cmo types/atoms.cmo \
......@@ -215,7 +216,7 @@ VALIDATE_OBJECTS := $(shell for o in $(OBJECTS); do echo $$o; if [ "$$o" = "sche
CDUCE = $(OBJECTS) driver/run.cmo $(CQL_OBJECTS_RUN)
WEBIFACE = $(OBJECTS) driver/examples.cmo driver/webiface.cmo
EVALUATOR = $(OBJECTS) driver/examples.cmo driver/evaluator.cmo
EVALUATOR = $(OBJECTS) driver/evaluator.cmo
DTD2CDUCE = tools/dtd2cduce.cmo
ALL_OBJECTS = $(OBJECTS) $(NEW_SCHEMA_OBJS) \
......
......@@ -26,6 +26,8 @@ misc/inttbl.cmo: misc/inttbl.cmi
misc/inttbl.cmx: misc/inttbl.cmi
misc/imap.cmo: misc/imap.cmi
misc/imap.cmx: misc/imap.cmi
misc/html.cmo: misc/html.cmi
misc/html.cmx: misc/html.cmi
types/sortedList.cmo: misc/custom.cmo misc/serialize.cmi types/sortedList.cmi
types/sortedList.cmx: misc/custom.cmx misc/serialize.cmx types/sortedList.cmi
types/boolean.cmo: misc/custom.cmo types/sortedList.cmi types/boolean.cmi
......@@ -175,11 +177,11 @@ runtime/run_dispatch.cmx: types/atoms.cmx types/chars.cmx misc/encodings.cmx \
types/ident.cmx types/patterns.cmx types/types.cmx runtime/value.cmx \
runtime/run_dispatch.cmi
runtime/explain.cmo: types/atoms.cmi types/chars.cmi misc/encodings.cmi \
types/ident.cmo types/patterns.cmi types/types.cmi runtime/value.cmi \
runtime/explain.cmi
types/ident.cmo types/patterns.cmi runtime/run_dispatch.cmi \
types/types.cmi runtime/value.cmi runtime/explain.cmi
runtime/explain.cmx: types/atoms.cmx types/chars.cmx misc/encodings.cmx \
types/ident.cmx types/patterns.cmx types/types.cmx runtime/value.cmx \
runtime/explain.cmi
types/ident.cmx types/patterns.cmx runtime/run_dispatch.cmx \
types/types.cmx runtime/value.cmx runtime/explain.cmi
runtime/print_xml.cmo: types/atoms.cmi misc/encodings.cmi types/ident.cmo \
types/intervals.cmi parser/location.cmi misc/ns.cmi \
schema/schema_builtin.cmi types/sequence.cmi runtime/value.cmi \
......@@ -244,10 +246,12 @@ driver/cduce.cmx: parser/ast.cmx types/builtin.cmx types/builtin_defs.cmx \
types/patterns.cmx types/sample.cmx schema/schema_common.cmx \
misc/state.cmx typing/typer.cmx types/types.cmx parser/ulexer.cmx \
runtime/value.cmx driver/cduce.cmi
runtime/system.cmo: types/builtin_defs.cmi parser/location.cmi \
compile/operators.cmi runtime/value.cmi
runtime/system.cmx: types/builtin_defs.cmx parser/location.cmx \
compile/operators.cmx runtime/value.cmx
runtime/system.cmo: types/atoms.cmi types/builtin_defs.cmi types/ident.cmo \
parser/location.cmi compile/operators.cmi types/types.cmi \
runtime/value.cmi
runtime/system.cmx: types/atoms.cmx types/builtin_defs.cmx types/ident.cmx \
parser/location.cmx compile/operators.cmx types/types.cmx \
runtime/value.cmx
ocamliface/mltypes.cmo: ocamliface/asttypes.cmo driver/config.cmi \
types/ident.cmo driver/librarian.cmi parser/location.cmi types/types.cmi \
ocamliface/mltypes.cmi
......@@ -302,8 +306,8 @@ driver/webiface.cmo: driver/cduce.cmi driver/examples.cmo parser/location.cmi \
misc/state.cmi
driver/webiface.cmx: driver/cduce.cmx driver/examples.cmx parser/location.cmx \
misc/state.cmx
driver/evaluator.cmo: driver/cduce.cmi parser/location.cmi
driver/evaluator.cmx: driver/cduce.cmx parser/location.cmx
driver/evaluator.cmo: driver/cduce.cmi driver/config.cmi parser/location.cmi
driver/evaluator.cmx: driver/cduce.cmx driver/config.cmx parser/location.cmx
tools/validate.cmo: schema/schema_common.cmi schema/schema_parser.cmi \
schema/schema_types.cmi
tools/validate.cmx: schema/schema_common.cmx schema/schema_parser.cmx \
......@@ -371,7 +375,7 @@ types/externals.cmi: types/types.cmi
typing/typer.cmi: parser/ast.cmo misc/custom.cmo types/ident.cmo \
parser/location.cmi misc/ns.cmi types/patterns.cmi \
schema/schema_types.cmi typing/typed.cmo types/types.cmi
runtime/load_xml.cmi: runtime/value.cmi
runtime/load_xml.cmi: parser/url.cmi runtime/value.cmi
runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi
runtime/explain.cmi: types/types.cmi runtime/value.cmi
runtime/print_xml.cmi: misc/ns.cmi runtime/value.cmi
......
......@@ -19,6 +19,7 @@ let prefix filename suff =
let toplevel = ref false
let verbose = ref false
let silent = ref false
let typing_env = State.ref "Cduce.typing_env" Builtin.env
let compile_env = State.ref "Cduce.compile_env" Compile.empty_toplevel
......@@ -35,19 +36,16 @@ let rec is_abstraction = function
| _ -> false
let print_norm ppf d =
Location.protect ppf
(fun ppf -> Types.Print.print ppf ((*Types.normalize*) d))
Types.Print.print ppf ((*Types.normalize*) d)
let print_sample ppf s =
Location.protect ppf
(fun ppf -> Sample.print ppf s)
Sample.print ppf s
let print_protect ppf s =
Location.protect ppf (fun ppf -> Format.fprintf ppf "%s" s)
Format.fprintf ppf "%s" s
let print_value ppf v =
Location.protect ppf (fun ppf -> Value.print ppf v)
Value.print ppf v
let dump_value ppf x t v =
Format.fprintf ppf "@[val %a : @[%a = %a@]@]@."
......@@ -75,12 +73,14 @@ let directive_help ppf =
value of a given expression
#print_schema <name>;;
#print_type <name>;;
#silent;; turn off outputs from the toplevel
#verbose;; turn on outputs from the toplevel
"
let rec print_exn ppf = function
| Location (loc, w, exn) ->
Format.fprintf ppf "Error %a:@." Location.print_loc (loc,w);
Format.fprintf ppf "%a" Location.html_hilight (loc,w);
Location.html_hilight (loc,w);
print_exn ppf exn
| Value.CDuceExn v ->
Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@."
......@@ -123,7 +123,8 @@ let rec print_exn ppf = function
| Ulexer.Error (i,j,s) ->
let loc = Location.loc_of_pos (i,j), `Full in
Format.fprintf ppf "Error %a:@." Location.print_loc loc;
Format.fprintf ppf "%a%s" Location.html_hilight loc s
Location.html_hilight loc;
Format.fprintf ppf "%s" s
| Parser.Error s | Stream.Error s ->
Format.fprintf ppf "Parsing error: %a@." print_protect s
| Librarian.InconsistentCrc id ->
......@@ -196,10 +197,7 @@ let debug ppf tenv cenv = function
Format.fprintf ppf "[DEBUG:compile]@.";
let t = Typer.typ tenv t
and pl = List.map (Typer.pat tenv) pl in
Location.protect ppf
(fun ppf ->
Patterns.Compile.debug_compile ppf t pl
)
Patterns.Compile.debug_compile ppf t pl
(*
Patterns.demo_compile ppf (Types.descr t) (List.map Patterns.descr pl)
*)
......@@ -265,6 +263,10 @@ let directive ppf tenv cenv = function
| `Dump pexpr ->
Value.dump_xml ppf (eval_quiet tenv cenv pexpr);
flush_ppf ppf
| `Silent ->
silent := true
| `Verbose ->
silent := false
let print_id_opt ppf = function
| None -> Format.fprintf ppf "-"
......@@ -275,7 +277,8 @@ let print_value_opt ppf = function
| Some v -> Format.fprintf ppf " = %a" print_value v
let show ppf id t v =
Format.fprintf ppf "@[%a : @[%a%a@]@]@."
if !silent then ()
else Format.fprintf ppf "@[%a : @[%a%a@]@]@."
print_id_opt id
print_norm t
print_value_opt v
......
......@@ -36,17 +36,19 @@ let () =
ignore (Unix.alarm 10);
Sys.set_signal Sys.sigalrm
(Sys.Signal_handle (fun _ -> raise (Cduce.Escape Timeout)));
let ppf = Format.str_formatter
let v = Location.get_viewport () in
let ppf = Html.ppf v
and input = Stream.of_string src in
Format.pp_set_margin ppf 50;
Location.push_source (`String src);
Location.set_protected true;
Location.warning_ppf := ppf;
Config.init_all ();
let ok = Cduce.script ppf ppf input in
if ok then Format.fprintf ppf "@\nOk.@\n";
Format.flush_str_formatter ()
Html.get v
in
Location.set_viewport `Html;
Location.set_viewport (Html.create true);
let prog = Buffer.create 1024 in
(try while true do Buffer.add_string prog (read_line ()); Buffer.add_string prog "\n" done;
with End_of_file -> ());
......
......@@ -181,6 +181,7 @@ let save () =
| None -> ()
let main () =
Location.set_viewport (Html.create false);
match mode () with
| `Toplevel args ->
Config.inhibit "ocaml";
......
......@@ -253,15 +253,15 @@ let main (cgi : Netcgi.std_activation) =
in
let exec src =
let ppf = Format.str_formatter
let v = Location.get_viewport () in
let ppf = Html.ppf v
and input = Stream.of_string src in
Location.push_source (`String src);
Location.set_protected true;
Location.warning_ppf := ppf;
let ok = Cduce.script ppf ppf input in
if ok then Format.fprintf ppf "@\nOk.@\n";
let res = Format.flush_str_formatter () in
let res = Html.get v in
p "<div class=\"box\"><h2>Results</h2><pre>";
cut (cgi # output # output_char) 80 res; p "</pre></div>";
dialog (if !persistant then "" else src);
......@@ -279,7 +279,7 @@ let main (cgi : Netcgi.std_activation) =
dialog src
in
Location.set_viewport `Html;
Location.set_viewport (Html.create true);
load_state ();
store_state (); (* Just touch the file ... *)
html_header p;
......
type t = {
ppf : Format.formatter; buf : Buffer.t; html : bool;
mutable marker : int; mutable marks : (int * string) list
}
let create html =
let buf = Buffer.create 1024 in
{ ppf = Format.formatter_of_buffer buf;
buf = buf;
html = html;
marker = 0; marks = [] }
let ppf x = x.ppf
let mark x s =
if x.html then (
let m = x.marker in
x.marker <- m + 1;
x.marks <- (m, s) :: x.marks;
Format.pp_print_as x.ppf 0 ("\000" ^ (string_of_int m) ^ "\000")
)
let markup x s p =
if x.html then (
mark x ("<"^s^">");
p x.ppf;
mark x ("</"^s^">");
) else
p x.ppf
let get x =
Format.pp_print_flush x.ppf ();
let s = Buffer.contents x.buf in
Buffer.clear x.buf;
let rec aux i =
if i = String.length s then ()
else match s.[i] with
| '\000' ->
let j =
try String.index_from s (i+1) '\000'
with Not_found -> assert false in
let m = int_of_string (String.sub s (i+1) (j-i-1)) in
let m = List.assq m x.marks in
Buffer.add_string x.buf m;
aux (j+1)
| '<' ->
Buffer.add_string x.buf "&lt;";
aux (i+1)
| '&' ->
Buffer.add_string x.buf "&amp;";
aux (i+1)
| ('\000'..'\008' | '\011' | '\012' | '\013'..'\031' | '\127') as c ->
Buffer.add_string x.buf (Printf.sprintf "&#%i;" (Char.code c));
aux (i+1)
| c ->
Buffer.add_char x.buf c;
aux (i+1)
in
aux 0;
let s = Buffer.contents x.buf in
Buffer.clear x.buf;
x.marker <- 0;
x.marks <- [];
s
let is_html x = x.html
type t
val create: bool -> t
val ppf: t -> Format.formatter
val get: t -> string
val mark: t -> string -> unit
val markup: t -> string -> (Format.formatter -> unit) -> unit
val is_html: t -> bool
......@@ -35,6 +35,8 @@ and toplevel_directive =
| `Print_schema_type of Schema_types.component_kind * U.t * U.t
| `Print_type of U.t
| `Debug of debug_directive
| `Verbose
| `Silent
]
......
......@@ -5,8 +5,6 @@ type source = [ `None | `File of string | `Stream | `String of string ]
type loc = source * int * int
type precise = [ `Full | `Char of int ]
type viewport = [ `Html | `Text ]
let merge_loc ((s1,i1,j1) as loc1) ((s2,i2,j2) as loc2) =
if s1 = s2 then
if i1 = -1 then loc2 else if i2 = -1 then loc1 else
......@@ -26,8 +24,6 @@ let current_dir () =
| `File s -> Filename.dirname s
| _ -> ""
let warning_ppf = ref Format.std_formatter
exception Location of loc * precise * exn
exception Generic of string
......@@ -38,8 +34,11 @@ let raise_loc_generic loc s = raise (Location (loc, `Full, Generic s))
let noloc = (`None,-1,-1)
let nopos = (-1,-1)
let viewport = ref `Text
let set_viewport v = viewport := v
let viewport = ref None
let set_viewport v = viewport := Some v
let get_viewport () = match !viewport with
| None -> assert false
| Some x -> x
(* Note: this is incorrect. Directives #utf8,... should
not be recognized inside comments and strings !
......@@ -102,13 +101,14 @@ let extr s i j =
with e -> failwith (Printf.sprintf "Location.extr len=%i i=%i j=%i"
(String.length s) i j )
let dump_loc ppf ((src,i,j),w) =
match (src, !viewport) with
| (`String s, `Html) ->
let dump_loc ((src,i,j),w) =
let v = get_viewport () in
match (src, Html.is_html v) with
| (`String s, true) ->
if (i < 0) then
Format.fprintf ppf "<b>GHOST LOCATION</b>@\n"
Html.markup v "b" (fun ppf -> Format.fprintf ppf "GHOST LOCATION@.")
else
Format.fprintf ppf "<i>%s</i>@." (extr s i j)
Html.markup v "i" (fun ppf -> Format.fprintf ppf "%s" (extr s i j))
| _ -> ()
let rec beg_of_line s i =
......@@ -119,19 +119,24 @@ let rec end_of_line s i =
if (i >= String.length s) || (s.[i] = '\n') || (s.[i] = '\r')
then i else end_of_line s (i + 1)
let html_hilight ppf ((src,i,j),w) =
match (src, !viewport) with
| `String s, `Html ->
let html_hilight ((src,i,j),w) =
let v = get_viewport () in
match (src, Html.is_html v) with
| `String s, true ->
if (i < 0) then
Format.fprintf ppf "<b>GHOST LOCATION</b>@\n"
Html.markup v "b"
(fun ppf -> Format.fprintf ppf "GHOST LOCATION@.")
else
let i0 = beg_of_line s i in
let j0 = end_of_line s j in
Format.fprintf ppf
"<i>%s<font color=\"red\"><b>%s</b></font>%s</i>@."
(extr s i0 i)
(extr s i j)
(extr s j j0)
let i0 = beg_of_line s i in
let j0 = end_of_line s j in
Html.markup v "i"
(fun ppf ->
Format.fprintf ppf "%s" (extr s i0 i);
Html.mark v "<font color=\"red\"><b>";
Format.fprintf ppf "%s" (extr s i j);
Html.mark v "</b></font>";
Format.fprintf ppf "%s@." (extr s j j0);
)
| _ -> ()
......@@ -142,18 +147,20 @@ let mk_loc loc x = { loc = loc; descr = x }
let mknoloc x = { loc = noloc; descr = x }
let loc_of_pos (i,j) = (!source,i,j)
(*
let protect ppf f =
match !viewport with
| `Html ->
let b = Buffer.create 63 in
let ppf' = Format.formatter_of_buffer b in
Format.pp_set_margin ppf' (Format.pp_get_margin ppf ());
f ppf';
Format.pp_print_flush ppf' ();
let s = Buffer.contents b in
let s = Netencoding.Html.encode_from_latin1 s in
Format.fprintf ppf "@[%s@]" s
| _ -> f ppf
*)
let protected = ref false
......
......@@ -21,16 +21,16 @@ val pop_source: unit -> unit
val current_dir : unit -> string
val warning_ppf : Format.formatter ref
type viewport = [ `Html | `Text ]
val set_viewport: viewport -> unit
val set_viewport: Html.t -> unit
val get_viewport: unit -> Html.t
(*
val protect: Format.formatter -> (Format.formatter -> unit) -> unit
*)
val print_loc: Format.formatter -> loc * precise -> unit
val dump_loc: Format.formatter -> loc * precise -> unit
val html_hilight: Format.formatter -> loc * precise -> unit
val dump_loc: loc * precise -> unit
val html_hilight: loc * precise -> unit
type 'a located = { loc : loc; descr : 'a }
val mk: int * int -> 'a -> 'a located
......
......@@ -129,6 +129,8 @@ EXTEND
let e = exp loc (NamespaceIn (name, ns, e2)) in
[ mk loc (EvalStatement (exp loc e)) ]
| "debug"; d = debug_directive -> [ mk loc (Directive (`Debug d)) ]
| DIRECTIVE "#verbose" -> [ mk loc (Directive `Verbose) ]
| DIRECTIVE "#silent" -> [ mk loc (Directive `Silent) ]
| DIRECTIVE "#utf8" -> Ulexer.enc := Ulexing.Utf8; [ ]
| DIRECTIVE "#latin1" -> Ulexer.enc := Ulexing.Latin1; [ ]
| DIRECTIVE "#ascii" -> Ulexer.enc := Ulexing.Ascii; [ ]
......
......@@ -23,6 +23,7 @@ let load_url = ref no_load_url
let process s =
match start_with s "string://" with
| None ->
Location.protect_op "load_xml";
if is_url s then Url (!load_url s)
else Filename s
| Some s ->
......
......@@ -26,7 +26,7 @@ let load_expat s =
Expat.set_end_element_handler p Load_xml.end_element_handler;
Expat.set_character_data_handler p Load_xml.text_handler;
try
match Url.process s with
match s with
| Url.Url s -> Expat.parse p s
| Url.Filename s -> load_from_file p s
with Expat.Expat_error e ->
......
......@@ -21,7 +21,7 @@ let pxp_config =
let load_pxp s =
try
let src =
match Url.process s with
match s with
| Url.Url s -> from_string s
| Url.Filename s -> from_file s in
let mgr = create_entity_manager pxp_config src in
......
......@@ -91,7 +91,7 @@ let xml_parser = ref (fun s -> failwith "No XML parser available")
let load_xml s =
Location.protect_op "load_xml";
let s = Url.process s in
try
!xml_parser s;
match !stack with
......
......@@ -4,7 +4,7 @@ val load_html: string -> Value.t
(* To define and register a parser *)
val xml_parser: (string -> unit) ref
val xml_parser: (Url.url -> unit) ref
val start_element_handler : string -> (string * string) list -> unit
val end_element_handler : 'a -> unit
......
......@@ -1476,6 +1476,7 @@ struct
| AIgnore r -> Format.fprintf ppf "v -> %a@\n" print_ret r
let print_dispatcher ppf d =
(*
Format.fprintf ppf "Dispatcher %i accepts [%a]@\n"
d.id Types.Print.print (Types.normalize d.t);
let print_code code (t, arity, m) =
......@@ -1495,6 +1496,7 @@ struct
Format.fprintf ppf "@\n";
in
Array.iteri print_code d.codes;
*)
Format.fprintf ppf "let disp_%i = function@\n" d.id;
print_actions ppf (actions d);
Format.fprintf ppf "====================================@\n"
......
......@@ -11,10 +11,11 @@ open Ident
let debug_schema = false
let warning loc msg =
Format.fprintf !Location.warning_ppf "Warning %a:@\n%a%s@."
Location.print_loc (loc,`Full)
Location.html_hilight (loc,`Full)
msg
let v = Location.get_viewport () in
let ppf = Html.ppf v in
Format.fprintf ppf "Warning %a:@\n" Location.print_loc (loc,`Full);
Location.html_hilight (loc,`Full);
Format.fprintf ppf "%s@." msg
exception NonExhaustive of Types.descr
exception Constraint of Types.descr * Types.descr
......
......@@ -33,7 +33,15 @@ function submit(pr) {
if (xmlhttp.readyState==4) { show_result(pr,xmlhttp.responseText); }
}
show_result(pr,"Computing...");
xmlhttp.send(document.getElementById(pr+"edit").value);
xmlhttp.send("#silent\n"+compute_prefix(pr) + "#verbose\n"+document.getElementById(pr+"edit").value);
}
function compute_prefix(pr) {
var prefix = document.getElementById(pr+"prefix").value;
if (prefix == "") return "";
var r = compute_prefix(prefix) + document.getElementById(prefix+"def").value;
// alert("pr="+pr+" prefix="+prefix+" r="+r);
return(r + "\n");
}
function editable(pr,b) {
......
<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
<page name="demo" leftbar="false">
<!DOCTYPE page [
<!ENTITY leq "&#x2264;"> <!-- LESS_THAN OR EQUAL TO -->
]>
<page name="demo">
<title>CDuce demo</title>
<box title="Types, pattern matching" link="typpm">
<demo label="1"><include-verbatim file="funxml_types.cd"/><![CDATA[
let title(Book -> String) <book>[ <title>x _* ] -> x
let authors(Book -> [Author+]) <_>[ (x::Author|_)* ] -> x
]]>
</demo>
</box>
<box title="Printing functions" link="printfun">
<demo prefix="1"><![CDATA[
type FBook = Book -> String
type ABook = <book print=FBook>[ Title Subtitle? Author+ ]
type ABib = [ ABook* ]
(* Remark: ABook <= Book, ABib <= Bib *)
let set(<book>c : Book)(f : FBook) : ABook = <book print=f>c
let prepare(b : Bib) : ABib = map b with x -> set x title
let b : Bib =
[ <book>[ <title>"T" <subtitle>"S" <author>"A" ] ]
let ab = prepare b
]]>
</demo>
</box>
<!--
#silent
let b1 : Book = <book>[
<title>[ 'Object-Oriented Programming' ]
<subtitle>[ 'A Unified Foundation' ]
<author>[ 'Castagna' ] ]
let b2 : Book = <book>[
<title>[ 'Persistent Object Systems' ]
<author>[ 'Atkinson' ]
<author>[ 'Benzaken' ]
<author>[ 'Maier' ] ]
let v : Bib = [ b1 b2 ]
#verbose
let z = authors b1
]]>
</demo>
</box>
-->
<!--
<box title="XML elements" link="xml">
<p>XML elements.</p>
<demo><include-verbatim file="examples/xml.cd"/></demo>
......@@ -72,5 +124,6 @@
matching.</p>
<demo><include-verbatim file="examples/pm_compil.cd"/></demo>
</box>
-->
</page>
......@@ -5,6 +5,7 @@ type Subtitle = <subtitle>[ PCDATA ]
type Author = <author>[ PCDATA ]
let title(Book -> String) <book>[ <title>x _* ] -> x
let author(Book -> [Author+]) x -> x//Author
(* We annotate each book with a printing function for it *)
......
......@@ -373,7 +373,7 @@ title="Xhaskell"> The XHaskell language. </link>
<a href="http://www.ens.fr">
<img style="border:0"
src="img//symbENSmio.gif"
src="img/symbENSmio.gif"
alt="ENS" title="ENS"/>
</a>
......@@ -385,9 +385,14 @@ title="Xhaskell"> The XHaskell language. </link>
<a href="http://www.cnrs.fr">
<img style="border:0"
src="img//symbCNRSmio.gif"
src="img/symbCNRSmio.gif"
alt="CNRS" title="CNRS"/>
</a>
<a href="http://www.inria.fr">
<img style="border:0"
src="img/inria.gif"
alt="INRIA" title="INRIA"/>
</a>
</p>
<p>
<a href="mailto:Alain.Frisch@ens.fr">Webmaster</a> -
......
......@@ -54,7 +54,7 @@ type Content =
| <note title=?String> Content
| <footnotes>[]
| <xhtml>H:Flow
| <demo>String
| <demo label=?String prefix=?String>String
| InlineText
)* ]
......@@ -253,8 +253,10 @@ type PageO = Page | []
let button(title : String)(onclick : String) : H:Xinput =
<input type="submit" value=title onclick=onclick>[]
let demo(no : Int)(txt : String) : H:Flow =
let n = [ 'a' !(string_of no) '_' ] in
let demo(no : Int)(r : { label =? String; prefix =? String })(txt : String) : H:Flow =
let n = match r with { label } -> label | _ -> string_of no in
let n = [ 'a' !n '_' ] in
let prefix = match r with { prefix } -> [ 'a' !prefix '_' ] | _ -> "" in
[ !(if (no = 1) then [<script src="demo.js" type="text/javascript">" "]
else [])
<table style="width:100%">[
......@@ -267,6 +269,7 @@ let demo(no : Int)(txt : String) : H:Flow =
]
<td style="width:50%">[
<input id=(n@"def") type="hidden" value=txt>[]
<input id=(n@"prefix") type="hidden" value=prefix>[]
(button "Clear" ("clearres('"@n@"');"))
] ]
<tr>[
......@@ -414,7 +417,7 @@ match page with
| [] -> []
| n -> footnotes := []; [ <br>[] (meta n) ] )
| <xhtml>i -> i
| <demo>s -> demo_no := !demo_no + 1; demo !demo_no s
| <demo (r)>s -> demo_no := !demo_no + 1; demo !demo_no r s
| t -> text [ t ]
in
......@@ -425,8 +428,10 @@ match page with
let navig = transform items with <left>c -> [ c ] in
let left = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in
[
<td valign="top" align="left">[
<table cellpadding="0" cellspacing="15"
<span style="background:#ffffff;border: solid 2px black; cursor:e-resize;" onclick="javascript:var s=document.getElementById('leftbar').style; s.display=(s.display=='none'?'block':'none');">"*"
<table cellpadding="0" cellspacing="15" id="leftbar"
width="200"
style="font-size:80%; border: 1px dashed black;
background: #ffcd72"> (* altbg 9aa8ba *)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment