diff -Nru tyxml-3.5.0/CHANGES tyxml-4.1.0/CHANGES --- tyxml-3.5.0/CHANGES 2015-08-05 14:36:46.000000000 +0000 +++ tyxml-4.1.0/CHANGES 2017-03-03 16:33:22.000000000 +0000 @@ -1,3 +1,55 @@ +===== 4.1.0 ==== + +* Uses uutf 1.0 (contribution by Daniel Bunzli) + +===== 4.0.1 ==== + +* Fix handling of comments in the ppx. +* Fix printing of utf8 in attributes. +* Properly flush ppx errors. This bug was causing some blank error messages. +* Fix handling of whitespaces in
more content
"] +val my_paragraphs : [> Html_types.p ] Html.elt list +>> + +Note here that since ##p## expects a list of children (it's a <"]
+val my_div : [> Html_types.div ] Html.elt
+>>
+
+==@@id="let"@@ Let notation
+
+It is also possible to use the ppx with the ##let## notation:
+<some content|} ;;
+val content : [> Html_types.div ] Html.elt
+>>
+
+All the capabilities provided by the ppx are still available with this form. Additionally, the modifiers ##and## or ##rec## are available. It is also possible to create functions:
+<some content" ;;
+val make_content : string -> [> Html_types.div ] Html.elt
+>>
+
+==@@id="notes"@@ Notes
+
+=== Locations ===
+
+Due to the code transformations done by the ppx, proper locations are difficult to provide.
+Please report examples of badly located code on [[https://github.com/ocsigen/tyxml/issues|the bug tracker]].
+
+=== Composability ===
+
+Due to various reasons, some ##HTML## can not be composed properly using the ppx. For example, this will result in an error:
+
+<The title"]
+let my_head = [%html ""my_title""]
+>>
+
+You can, however, inline the title element inside the head element:
+
+<"my_title" "]
+>>
diff -Nru tyxml-3.5.0/examples/basic_website/home.css tyxml-4.1.0/examples/basic_website/home.css
--- tyxml-3.5.0/examples/basic_website/home.css 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website/home.css 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,11 @@
+#links_bar li {
+ margin:1em;
+ padding:0.4em;
+ font-size:large;
+ display:inline;
+ cursor:pointer;
+ border:none;
+ border-radius:0px;
+ transition:.2s linear;
+ text-align:center;
+}
diff -Nru tyxml-3.5.0/examples/basic_website/main.js tyxml-4.1.0/examples/basic_website/main.js
--- tyxml-3.5.0/examples/basic_website/main.js 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website/main.js 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,6 @@
+"use strict";
+
+
+var handle = document.getElementById("payload");
+
+console.log(handle);
diff -Nru tyxml-3.5.0/examples/basic_website/Makefile tyxml-4.1.0/examples/basic_website/Makefile
--- tyxml-3.5.0/examples/basic_website/Makefile 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website/Makefile 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,8 @@
+site_gen := make_site
+
+all:
+ ocamlfind ocamlc site_html.ml -package tyxml -short-paths -linkpkg -o ${site_gen}
+ ./${site_gen}
+
+clean:
+ rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
diff -Nru tyxml-3.5.0/examples/basic_website/.merlin tyxml-4.1.0/examples/basic_website/.merlin
--- tyxml-3.5.0/examples/basic_website/.merlin 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1 @@
+PKG tyxml
\ No newline at end of file
diff -Nru tyxml-3.5.0/examples/basic_website/Readme.md tyxml-4.1.0/examples/basic_website/Readme.md
--- tyxml-3.5.0/examples/basic_website/Readme.md 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website/Readme.md 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,12 @@
+This is a very simple website in pure tyxml. To generate the website, compile `site_html.ml` and then execute. This can be done with `make`.
+
+Content of this directory:
+- `site_html.ml`: Generates the Html.
+- `Makefile`: Simple rules to create the website. Uses ocamlbuild
+- `main.js` and `home.css` : auxiliary files for the website.
+- `.merlin`: An appropriate merlin file.
+- Readme.md : You are reading it
+
+This website is distributed under the [unlicense][], feel free to use it!
+
+[unlicense]: http://unlicense.org/
diff -Nru tyxml-3.5.0/examples/basic_website/site_html.ml tyxml-4.1.0/examples/basic_website/site_html.ml
--- tyxml-3.5.0/examples/basic_website/site_html.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website/site_html.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,64 @@
+open Tyxml.Html
+
+let this_title = title (pcdata "Your Cool Web Page")
+
+let image_box =
+ div ~a:[a_id "image_box"]
+ []
+
+let links_box =
+ ul ~a:[a_class ["links_bar"]; a_id "links_bar"]
+ [li ~a:[a_id "home_click"]
+ [pcdata "My Musings"];
+ li ~a:[a_id "about_click"]
+ [pcdata "About Me"];
+ li ~a:[a_id "blog_posts_click"]
+ [pcdata "Blog"];
+ li ~a:[a_id "hackathons_click"]
+ [pcdata "Hackathons"]]
+
+let common_footer =
+ footer ~a:[a_id "footer_box"]
+ [p [pcdata "This site was made with ";
+ a ~a:[a_href "http://ocaml.org"] [pcdata "OCaml"];
+ pcdata " and ";
+ a ~a:[a_href "https://www.gnu.org/software/emacs/"] [pcdata "emacs"]]]
+
+let home_content =
+ div
+ [h2
+ [pcdata "Hello Coder"]]
+
+let main_payload =
+ div ~a:[a_id "payload"]
+ [home_content]
+
+let common_nav =
+ nav [links_box]
+
+let content_box =
+ div ~a:[a_id "content_box"]
+ [common_nav;
+ main_payload;
+ common_footer]
+
+let main_script =
+ script ~a:[a_src (Xml.uri_of_string "main.js")] (pcdata "")
+
+let home_page_doc =
+ html (head this_title
+ [link ~rel:[`Stylesheet] ~href:"home.css" ();])
+ (body [image_box; content_box; main_script])
+
+(** The set of pages in your website. *)
+let pages = [("index.html", home_page_doc)]
+
+(** Small code to emit all the pages. *)
+let emit_page (name, page) =
+ Printf.printf "Generating: %s\n" name ;
+ let file_handle = open_out name in
+ let fmt = Format.formatter_of_out_channel file_handle in
+ pp () fmt page;
+ close_out file_handle
+
+let () = List.iter emit_page pages
diff -Nru tyxml-3.5.0/examples/basic_website_ppx/home.css tyxml-4.1.0/examples/basic_website_ppx/home.css
--- tyxml-3.5.0/examples/basic_website_ppx/home.css 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website_ppx/home.css 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,11 @@
+#links_bar li {
+ margin:1em;
+ padding:0.4em;
+ font-size:large;
+ display:inline;
+ cursor:pointer;
+ border:none;
+ border-radius:0px;
+ transition:.2s linear;
+ text-align:center;
+}
diff -Nru tyxml-3.5.0/examples/basic_website_ppx/main.js tyxml-4.1.0/examples/basic_website_ppx/main.js
--- tyxml-3.5.0/examples/basic_website_ppx/main.js 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website_ppx/main.js 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,6 @@
+"use strict";
+
+
+var handle = document.getElementById("payload");
+
+console.log(handle);
diff -Nru tyxml-3.5.0/examples/basic_website_ppx/Makefile tyxml-4.1.0/examples/basic_website_ppx/Makefile
--- tyxml-3.5.0/examples/basic_website_ppx/Makefile 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website_ppx/Makefile 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,8 @@
+site_gen := make_site
+
+all:
+ ocamlfind ocamlc site_html.ml -package tyxml.ppx -short-paths -linkpkg -o ${site_gen}
+ ./${site_gen}
+
+clean:
+ rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
diff -Nru tyxml-3.5.0/examples/basic_website_ppx/.merlin tyxml-4.1.0/examples/basic_website_ppx/.merlin
--- tyxml-3.5.0/examples/basic_website_ppx/.merlin 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website_ppx/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1 @@
+PKG tyxml.ppx
\ No newline at end of file
diff -Nru tyxml-3.5.0/examples/basic_website_ppx/Readme.md tyxml-4.1.0/examples/basic_website_ppx/Readme.md
--- tyxml-3.5.0/examples/basic_website_ppx/Readme.md 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website_ppx/Readme.md 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,13 @@
+This is a very simple website in pure tyxml using the ppx syntax extension.
+To generate the website, compile `site_html.ml` and then execute. This can be done with `make`.
+
+Content of this directory:
+- `site_html.ml`: Generates the Html.
+- `Makefile`: Simple rules to create the website. Uses ocamlbuild
+- `main.js` and `home.css` : auxiliary files for the website.
+- `.merlin`: An appropriate merlin file.
+- Readme.md : You are reading it
+
+This website is distributed under the [unlicense][], feel free to use it!
+
+[unlicense]: http://unlicense.org/
diff -Nru tyxml-3.5.0/examples/basic_website_ppx/site_html.ml tyxml-4.1.0/examples/basic_website_ppx/site_html.ml
--- tyxml-3.5.0/examples/basic_website_ppx/site_html.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/basic_website_ppx/site_html.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,69 @@
+open Tyxml
+
+let this_title = Html.pcdata "Your Cool Web Page"
+
+let image_box = [%html
+ ""
+]
+
+let links_box = [%html {|
+
+|}]
+
+let common_footer = [%html {|
+
+|}]
+
+let home_content = [%html
+ "Hello Coder
"
+]
+
+let main_payload = [%html
+ ""[home_content]""
+]
+
+let common_nav = Html.nav [links_box]
+
+let content_box = [%html
+ ""[
+ common_nav;
+ main_payload;
+ common_footer;
+ ]""
+]
+
+let main_script = [%html
+ ""
+]
+
+let home_page_doc = [%html
+ {|
+
+ |}this_title{|
+
+
+ |} [ image_box; content_box; main_script ] {|
+
+|}]
+
+(** The set of pages in your website. *)
+let pages = [("index.html", home_page_doc)]
+
+(** Small code to emit all the pages. *)
+let emit_page (name, page) =
+ Printf.printf "Generating: %s\n" name ;
+ let file_handle = open_out name in
+ let fmt = Format.formatter_of_out_channel file_handle in
+ Html.pp () fmt page;
+ close_out file_handle
+
+let () = List.iter emit_page pages
diff -Nru tyxml-3.5.0/examples/.gitignore tyxml-4.1.0/examples/.gitignore
--- tyxml-3.5.0/examples/.gitignore 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/.gitignore 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1 @@
+*.html
\ No newline at end of file
diff -Nru tyxml-3.5.0/examples/mini_website/Makefile tyxml-4.1.0/examples/mini_website/Makefile
--- tyxml-3.5.0/examples/mini_website/Makefile 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website/Makefile 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,8 @@
+site_gen := minihtml
+
+all:
+ ocamlfind ocamlc minihtml.ml -short-paths -package tyxml -linkpkg -o ${site_gen}
+ ./${site_gen}
+
+clean:
+ rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
diff -Nru tyxml-3.5.0/examples/mini_website/.merlin tyxml-4.1.0/examples/mini_website/.merlin
--- tyxml-3.5.0/examples/mini_website/.merlin 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1 @@
+PKG tyxml
\ No newline at end of file
diff -Nru tyxml-3.5.0/examples/mini_website/minihtml.ml tyxml-4.1.0/examples/mini_website/minihtml.ml
--- tyxml-3.5.0/examples/mini_website/minihtml.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website/minihtml.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,20 @@
+open Tyxml.Html
+
+let mycontent =
+ div ~a:[a_class ["content"]] [
+ h1 [pcdata "A fabulous title"] ;
+ pcdata "This is a fabulous content." ;
+ ]
+
+let mytitle = title (pcdata "A Fabulous Web Page")
+
+let mypage =
+ html
+ (head mytitle [])
+ (body [mycontent])
+
+let () =
+ let file = open_out "index.html" in
+ let fmt = Format.formatter_of_out_channel file in
+ pp () fmt mypage;
+ close_out file
diff -Nru tyxml-3.5.0/examples/mini_website/Readme.md tyxml-4.1.0/examples/mini_website/Readme.md
--- tyxml-3.5.0/examples/mini_website/Readme.md 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website/Readme.md 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,11 @@
+This is the minimal website in pure tyxml. To generate the website, compile `minihtml.ml` and then execute. This can be done with `make`.
+
+Content of this directory:
+- `minihtml.ml`: Generates the Html.
+- `Makefile`: Simple rules to create the website.
+- `.merlin`: An appropriate merlin file.
+- Readme.md : You are reading it
+
+This website is distributed under the [unlicense][], feel free to use it!
+
+[unlicense]: http://unlicense.org/
diff -Nru tyxml-3.5.0/examples/mini_website_ppx/Makefile tyxml-4.1.0/examples/mini_website_ppx/Makefile
--- tyxml-3.5.0/examples/mini_website_ppx/Makefile 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website_ppx/Makefile 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,8 @@
+site_gen := minihtml
+
+all:
+ ocamlfind ocamlc minihtml.ml -short-paths -package tyxml.ppx -linkpkg -o ${site_gen}
+ ./${site_gen}
+
+clean:
+ rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
diff -Nru tyxml-3.5.0/examples/mini_website_ppx/.merlin tyxml-4.1.0/examples/mini_website_ppx/.merlin
--- tyxml-3.5.0/examples/mini_website_ppx/.merlin 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website_ppx/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1 @@
+PKG tyxml.ppx
\ No newline at end of file
diff -Nru tyxml-3.5.0/examples/mini_website_ppx/minihtml.ml tyxml-4.1.0/examples/mini_website_ppx/minihtml.ml
--- tyxml-3.5.0/examples/mini_website_ppx/minihtml.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website_ppx/minihtml.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,26 @@
+open Tyxml
+
+let%html mycontent = {|
+
+ A fabulous title
+ This is a fabulous content.
+
+|}
+
+
+let mytitle = Html.pcdata "A Fabulous Web Page"
+
+let%html mypage =
+ {|
+
+ |}mytitle{|
+
+ "mycontent"
+
+ |}
+
+let () =
+ let file = open_out "index.html" in
+ let fmt = Format.formatter_of_out_channel file in
+ Html.pp () fmt mypage;
+ close_out file
diff -Nru tyxml-3.5.0/examples/mini_website_ppx/Readme.md tyxml-4.1.0/examples/mini_website_ppx/Readme.md
--- tyxml-3.5.0/examples/mini_website_ppx/Readme.md 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/mini_website_ppx/Readme.md 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,12 @@
+This is the minimal website in pure tyxml using the ppx syntax extension.
+To generate the website, compile `minihtml.ml` and then execute. This can be done with `make`.
+
+Content of this directory:
+- `minihtml.ml`: Generates the Html.
+- `Makefile`: Simple rules to create the website.
+- `.merlin`: An appropriate merlin file.
+- Readme.md : You are reading it
+
+This website is distributed under the [unlicense][], feel free to use it!
+
+[unlicense]: http://unlicense.org/
diff -Nru tyxml-3.5.0/examples/UNLICENSE.md tyxml-4.1.0/examples/UNLICENSE.md
--- tyxml-3.5.0/examples/UNLICENSE.md 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/examples/UNLICENSE.md 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,24 @@
+This is free and unencumbered software released into the public domain.
+
+Anyone is free to copy, modify, publish, use, compile, sell, or
+distribute this software, either in source code form or as a compiled
+binary, for any purpose, commercial or non-commercial, and by any
+means.
+
+In jurisdictions that recognize copyright laws, the author or authors
+of this software dedicate any and all copyright interest in the
+software to the public domain. We make this dedication for the benefit
+of the public at large and to the detriment of our heirs and
+successors. We intend this dedication to be an overt act of
+relinquishment in perpetuity of all present and future rights to this
+software under copyright law.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+For more information, please refer to http://unlicense.org/
diff -Nru tyxml-3.5.0/.gitignore tyxml-4.1.0/.gitignore
--- tyxml-3.5.0/.gitignore 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/.gitignore 2017-03-03 16:33:22.000000000 +0000
@@ -11,3 +11,4 @@
setup-dev.exe
*.byte
*.native
+_tests
diff -Nru tyxml-3.5.0/implem/META tyxml-4.1.0/implem/META
--- tyxml-3.5.0/implem/META 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/META 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,90 @@
+# OASIS_START
+# DO NOT EDIT (digest: 8bf3e741d5984dad87597458dc9ca5aa)
+version = "4.1.0"
+description = "Statically correct HTML and SVG documents"
+requires = "tyxml.functor re uutf"
+archive(byte) = "tyxml.cma"
+archive(byte, plugin) = "tyxml.cma"
+archive(native) = "tyxml.cmxa"
+archive(native, plugin) = "tyxml.cmxs"
+archive(byte,toploop) += "tyxml_top.cma"
+exists_if = "tyxml.cma"
+package "top" (
+ version = "4.1.0"
+ description = "Toplevel printers for HTML, SVG and XML"
+ requires = "tyxml"
+ archive(byte) = "tyxml_top.cma"
+ archive(byte, plugin) = "tyxml_top.cma"
+ archive(native) = "tyxml_top.cmxa"
+ archive(native, plugin) = "tyxml_top.cmxs"
+ exists_if = "tyxml_top.cma"
+)
+
+package "tools" (
+ version = "4.1.0"
+ description = "Statically correct HTML and SVG documents"
+ requires = "bytes"
+ archive(byte) = "tyxml_tools.cma"
+ archive(byte, plugin) = "tyxml_tools.cma"
+ archive(native) = "tyxml_tools.cmxa"
+ archive(native, plugin) = "tyxml_tools.cmxs"
+ exists_if = "tyxml_tools.cma"
+)
+
+package "syntax" (
+ version = "4.1.0"
+ description = "HTML and SVG syntax extension"
+ requires = "bytes camlp4"
+ archive(syntax, preprocessor) = "pa_tyxml.cma"
+ archive(syntax, toploop) = "pa_tyxml.cma"
+ archive(syntax, preprocessor, native) = "pa_tyxml.cmxa"
+ archive(syntax, preprocessor, native, plugin) = "pa_tyxml.cmxs"
+ requires(toploop) = "tyxml"
+ exists_if = "pa_tyxml.cma"
+)
+
+package "ppx" (
+ version = "4.1.0"
+ description = "HTML and SVG syntax extension (ppx)"
+ requires = "tyxml"
+ archive(byte) = "ppx.cma"
+ archive(byte, plugin) = "ppx.cma"
+ archive(native) = "ppx.cmxa"
+ archive(native, plugin) = "ppx.cmxs"
+ ppx = "ppx_tyxml"
+ exists_if = "ppx.cma"
+ package "internal" (
+ version = "4.1.0"
+ description = "HTML and SVG ppx library"
+ requires = "re.str ppx_tools.metaquot markup tyxml.tools"
+ archive(byte) = "ppx_internal.cma"
+ archive(byte, plugin) = "ppx_internal.cma"
+ archive(native) = "ppx_internal.cmxa"
+ archive(native, plugin) = "ppx_internal.cmxs"
+ exists_if = "ppx_internal.cma"
+ )
+)
+
+package "parser" (
+ version = "4.1.0"
+ description = "Simple XML parser"
+ requires = "bytes camlp4.lib"
+ archive(byte) = "tymlx_p.cma"
+ archive(byte, plugin) = "tymlx_p.cma"
+ archive(native) = "tymlx_p.cmxa"
+ archive(native, plugin) = "tymlx_p.cmxs"
+ exists_if = "tymlx_p.cma"
+)
+
+package "functor" (
+ version = "4.1.0"
+ description = "Statically correct HTML and SVG documents (Functor version)"
+ requires = "uchar uutf re"
+ archive(byte) = "tyxml_f.cma"
+ archive(byte, plugin) = "tyxml_f.cma"
+ archive(native) = "tyxml_f.cmxa"
+ archive(native, plugin) = "tyxml_f.cmxs"
+ exists_if = "tyxml_f.cma"
+)
+# OASIS_STOP
+
diff -Nru tyxml-3.5.0/implem/top/.merlin tyxml-4.1.0/implem/top/.merlin
--- tyxml-3.5.0/implem/top/.merlin 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/top/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,2 @@
+PKG compiler-libs.toplevel
+REC
\ No newline at end of file
diff -Nru tyxml-3.5.0/implem/top/tyxml_top.ml tyxml-4.1.0/implem/top/tyxml_top.ml
--- tyxml-3.5.0/implem/top/tyxml_top.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/top/tyxml_top.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,25 @@
+let file = {|
+let _xml_pp = Tyxml.Xml.pp () ;;
+#install_printer _xml_pp ;;
+
+let _svg_pp = Tyxml.Svg.pp () ;;
+#install_printer _svg_pp ;;
+let _svg_pp_elt fmt x = Tyxml.Svg.pp_elt () fmt x ;;
+#install_printer _svg_pp_elt ;;
+
+let _html_pp = Tyxml.Html.pp () ;;
+#install_printer _html_pp ;;
+let _html_pp_elt fmt x = Tyxml.Html.pp_elt () fmt x ;;
+#install_printer _html_pp_elt ;;
+|}
+
+let eval_string
+ ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
+ let lexbuf = Lexing.from_string str in
+ let phrases = !Toploop.parse_use_file lexbuf in
+ let f phrase =
+ ignore (Toploop.execute_phrase print_outcome err_formatter phrase)
+ in
+ List.iter f phrases
+
+let () = ignore (eval_string file)
diff -Nru tyxml-3.5.0/implem/top/tyxml_top.mldylib tyxml-4.1.0/implem/top/tyxml_top.mldylib
--- tyxml-3.5.0/implem/top/tyxml_top.mldylib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/top/tyxml_top.mldylib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 9985bb6292efdb2ccd3212f66f8621c5)
+Tyxml_top
+# OASIS_STOP
diff -Nru tyxml-3.5.0/implem/top/tyxml_top.mllib tyxml-4.1.0/implem/top/tyxml_top.mllib
--- tyxml-3.5.0/implem/top/tyxml_top.mllib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/top/tyxml_top.mllib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 9985bb6292efdb2ccd3212f66f8621c5)
+Tyxml_top
+# OASIS_STOP
diff -Nru tyxml-3.5.0/implem/tyxml_html.ml tyxml-4.1.0/implem/tyxml_html.ml
--- tyxml-3.5.0/implem/tyxml_html.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml_html.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,25 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+module M = Html_f.Make(Tyxml_xml)(Tyxml_svg)
+module P = Xml_print.Make_typed_fmt(Tyxml_xml)(M)
+module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
+
+include M
+include P
diff -Nru tyxml-3.5.0/implem/tyxml_html.mli tyxml-4.1.0/implem/tyxml_html.mli
--- tyxml-3.5.0/implem/tyxml_html.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml_html.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,51 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Typesafe constructors and printers for Html documents.
+
+ @see W3C Recommendation *)
+
+(** Concrete implementation of Html typesafe constructors.
+ See {!modtype:Html_sigs.T}.
+*)
+include Html_sigs.Make(Tyxml_xml)(Tyxml_svg).T
+ with module Xml.W = Xml_wrap.NoWrap
+
+(** {2 Printers} *)
+
+(** [pp ()] is a {!Format} printer for Html documents.
+
+ It can be used in combination with ["%a"]. For example, to get a string:
+ {[let s = Format.asprintf "%a" (Tyxml.Html.pp ()) my_html]}
+*)
+val pp:
+ ?encode:(string -> string) -> ?advert:string -> unit -> Format.formatter -> doc -> unit
+
+(** [pp_elt ()] is a {!Format} printer for Html elements. *)
+val pp_elt :
+ ?encode:(string -> string) -> unit -> Format.formatter -> 'a elt -> unit
+
+(** Parametrized stream printer for Html documents.
+ @deprecated Use {!pp} instead.
+*)
+module Make_printer(O : Xml_sigs.Output) :
+ Xml_sigs.Typed_printer with type out := O.out
+ and type 'a elt := 'a elt
+ and type doc := doc
+ [@@ocaml.deprecated "Use Html.pp instead."]
diff -Nru tyxml-3.5.0/implem/tyxml.ml tyxml-4.1.0/implem/tyxml.ml
--- tyxml-3.5.0/implem/tyxml.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,26 @@
+(** Typed implementation for HTML, SVG and XML
+
+ This is the natural implementation of the TyXML combinators
+ based on an XML data-structure.
+ {%
+ Other implementations are available, see <> for details. %}
+*)
+
+(** Typesafe constructors and printers for HTML documents.
+
+ @see W3C Recommendation *)
+module Html = Tyxml_html
+
+(** Typesafe constructors and printers for Svg documents.
+
+ @see W3C Recommendation *)
+module Svg = Tyxml_svg
+
+
+(** Basic functions for construction and manipulation of XML tree. *)
+module Xml = Tyxml_xml
+
+(** Deprecated alias for {!Html}.
+ @deprecated "Use Html" *)
+module Html5 = Tyxml_html
+ [@@ocaml.deprecated "Use Tyxml.Html"]
diff -Nru tyxml-3.5.0/implem/tyxml.mldylib tyxml-4.1.0/implem/tyxml.mldylib
--- tyxml-3.5.0/implem/tyxml.mldylib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml.mldylib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,7 @@
+# OASIS_START
+# DO NOT EDIT (digest: 0ad0ea7a03e5bb86e515b481bcbc79ed)
+Tyxml_xml
+Tyxml_svg
+Tyxml_html
+Tyxml
+# OASIS_STOP
diff -Nru tyxml-3.5.0/implem/tyxml.mllib tyxml-4.1.0/implem/tyxml.mllib
--- tyxml-3.5.0/implem/tyxml.mllib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml.mllib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,7 @@
+# OASIS_START
+# DO NOT EDIT (digest: 0ad0ea7a03e5bb86e515b481bcbc79ed)
+Tyxml_xml
+Tyxml_svg
+Tyxml_html
+Tyxml
+# OASIS_STOP
diff -Nru tyxml-3.5.0/implem/tyxml_svg.ml tyxml-4.1.0/implem/tyxml_svg.ml
--- tyxml-3.5.0/implem/tyxml_svg.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml_svg.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,25 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+module M = Svg_f.Make(Tyxml_xml)
+module P = Xml_print.Make_typed_fmt(Tyxml_xml)(M)
+module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
+
+include M
+include P
diff -Nru tyxml-3.5.0/implem/tyxml_svg.mli tyxml-4.1.0/implem/tyxml_svg.mli
--- tyxml-3.5.0/implem/tyxml_svg.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml_svg.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,51 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Typesafe constructors and printers for Svg documents.
+
+ @see W3C Recommendation *)
+
+(** Concrete implementation of Svg typesafe constructors.
+ See {!modtype:Svg_sigs.T}.
+*)
+include Svg_sigs.Make(Tyxml_xml).T
+ with module Xml.W = Xml_wrap.NoWrap
+
+(** {2 Printers} *)
+
+(** [pp ()] is a {!Format} printer for Svg documents.
+
+ It can be used in combination with ["%a"]. For example, to get a string:
+ {[let s = Format.asprintf "%a" (Tyxml.Svg.pp ()) my_svg]}
+*)
+val pp:
+ ?encode:(string -> string) -> ?advert:string -> unit -> Format.formatter -> doc -> unit
+
+(** [pp_elt ()] is a {!Format} printer for Svg elements. *)
+val pp_elt :
+ ?encode:(string -> string) -> unit -> Format.formatter -> 'a elt -> unit
+
+(** Parametrized stream printer for Svg documents.
+ @deprecated Use {!pp} instead.
+*)
+module Make_printer(O : Xml_sigs.Output) :
+ Xml_sigs.Typed_printer with type out := O.out
+ and type 'a elt := 'a elt
+ and type doc := doc
+ [@@ocaml.deprecated "Use Svg.pp instead."]
diff -Nru tyxml-3.5.0/implem/tyxml_xml.ml tyxml-4.1.0/implem/tyxml_xml.ml
--- tyxml-3.5.0/implem/tyxml_xml.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml_xml.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,114 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2004 Thorsten Ohl
+ * Copyright (C) 2007 Gabriel Kerneis
+ * Copyright (C) 2010 Cecile Herbelin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+
+module M = struct
+
+ module W = Xml_wrap.NoWrap
+
+ type 'a wrap = 'a
+ type 'a list_wrap = 'a list
+
+ type uri = string
+ let uri_of_string s = s
+ let string_of_uri s = s
+
+ type separator = Space | Comma
+
+ (** Attributes *)
+
+ type aname = string
+ type acontent =
+ | AFloat of float
+ | AInt of int
+ | AStr of string
+ | AStrL of separator * string list
+ type attrib = aname * acontent
+
+ type event_handler = string
+ type mouse_event_handler = string
+ type keyboard_event_handler = string
+
+ let acontent (_, a) = a
+ let aname (name, _) = name
+
+ let float_attrib name value = name, AFloat value
+ let int_attrib name value = name, AInt value
+ let string_attrib name value = name, AStr value
+ let space_sep_attrib name values = name, AStrL (Space, values)
+ let comma_sep_attrib name values = name, AStrL (Comma, values)
+ let event_handler_attrib name value = name, AStr value
+ let mouse_event_handler_attrib name value = name, AStr value
+ let keyboard_event_handler_attrib name value = name, AStr value
+ let uri_attrib name value = name, AStr value
+ let uris_attrib name values = name, AStrL (Space, values)
+
+
+ (** Element *)
+
+ type ename = string
+ type econtent =
+ | Empty
+ | Comment of string
+ | EncodedPCDATA of string
+ | PCDATA of string
+ | Entity of string
+ | Leaf of ename * attrib list
+ | Node of ename * attrib list * econtent list
+
+ type elt = econtent
+
+ let content elt = elt
+
+ let empty () = Empty
+
+ let comment c = Comment c
+
+ let pcdata d = PCDATA d
+ let encodedpcdata d = EncodedPCDATA d
+ let entity e = Entity e
+
+ (* For security reasons, we do not allow "]]>" inside CDATA
+ (as this string is to be considered as the end of the cdata)
+ *)
+ let re_end_cdata = Re.(compile @@ str "]]>")
+ let encoded_cdata s1 s2 s =
+ encodedpcdata
+ (Printf.sprintf "\n%s\n%s\n%s\n"
+ s1
+ (Re.replace_string ~all:true re_end_cdata ~by:"" s)
+ s2 )
+
+ let cdata = encoded_cdata ""
+ let cdata_script = encoded_cdata "//"
+ let cdata_style = encoded_cdata "/* */"
+
+ let leaf ?(a=[]) name = Leaf (name, a)
+ let node ?(a=[]) name children = Node (name, a, children)
+
+end
+
+include M
+include Xml_print.Make_simple(M)(struct let emptytags = [] end)
+include Xml_iter.Make(M)
+include Xml_print.Make_fmt(M)(struct let emptytags = [] end)
+
+let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]
diff -Nru tyxml-3.5.0/implem/tyxml_xml.mli tyxml-4.1.0/implem/tyxml_xml.mli
--- tyxml-3.5.0/implem/tyxml_xml.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/implem/tyxml_xml.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,85 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2004 Thorsten Ohl
+ * Copyright (C) 2007 Gabriel Kerneis
+ * Copyright (C) 2010 Cecile Herbelin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Basic functions for construction and manipulation of XML tree. *)
+
+include Xml_sigs.Iterable
+ with type uri = string
+ and type event_handler = string
+ and type mouse_event_handler = string
+ and type keyboard_event_handler = string
+
+
+val pp : ?encode:(string -> string) -> unit -> Format.formatter -> elt -> unit
+
+
+(** {2 Iterators} *)
+
+val amap : (ename -> attrib list -> attrib list) -> elt -> elt
+(** Recursively edit attributes for the element and all its children. *)
+
+val amap1 : (ename -> attrib list -> attrib list) -> elt -> elt
+(** Edit attributes only for one element. *)
+
+(** The following can safely be exported by higher level libraries,
+ because removing an attribute from a element is always legal. *)
+
+val rm_attrib : (aname -> bool) -> attrib list -> attrib list
+val rm_attrib_from_list : (aname -> bool) -> (string -> bool) -> attrib list -> attrib list
+
+val map_int_attrib :
+ (aname -> bool) -> (int -> int) -> attrib list -> attrib list
+val map_string_attrib :
+ (aname -> bool) -> (string -> string) -> attrib list -> attrib list
+val map_string_attrib_in_list :
+ (aname -> bool) -> (string -> string) -> attrib list -> attrib list
+
+(** Exporting the following by higher level libraries would drive
+ a hole through a type system, because they allow to add {e any}
+ attribute to {e any} element. *)
+
+val add_int_attrib : aname -> int -> attrib list -> attrib list
+val add_string_attrib : aname -> string -> attrib list -> attrib list
+val add_comma_sep_attrib : aname -> string -> attrib list -> attrib list
+val add_space_sep_attrib : aname -> string -> attrib list -> attrib list
+
+val fold : (unit -> 'a) -> (string -> 'a) -> (string -> 'a) -> (string -> 'a) ->
+ (string -> 'a) -> (ename -> attrib list -> 'a) ->
+ (ename -> attrib list -> 'a list -> 'a) ->
+ elt -> 'a
+
+val all_entities : elt -> string list
+
+val translate :
+ (ename -> attrib list -> elt) ->
+ (ename -> attrib list -> elt list -> elt) ->
+ ('state -> ename -> attrib list -> elt list) ->
+ ('state -> ename -> attrib list -> elt list -> elt list) ->
+ (ename -> attrib list -> 'state -> 'state) -> 'state -> elt -> elt
+
+(** {2 Deprecated printers} *)
+
+val print_list:
+ output:(string -> unit) -> ?encode:(string -> string) -> elt list -> unit
+ [@@ocaml.deprecated "Use Xml.pp instead."]
+
+val print : Format.formatter -> elt -> unit
+ [@@ocaml.deprecated "Use Xml.pp instead."]
diff -Nru tyxml-3.5.0/lib/html5_f.ml tyxml-4.1.0/lib/html5_f.ml
--- tyxml-3.5.0/lib/html5_f.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/html5_f.ml 1970-01-01 00:00:00.000000000 +0000
@@ -1,1075 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2004 by Thorsten Ohl
- * Copyright (C) 2007 by Vincent Balat, Gabriel Kerneis
- * Copyright (C) 2010 by Cecile Herbelin
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(* TODO :
- - MathML and SVG
- - forbid construction like that noscript (a [a []])
- by playing on interactive_without*
-*)
-
-(* IDEAS:
- The [a_] prefix would have to be maintained and the
- only advantage are a potentially better mapping of the XHTML modularization
- to O'Caml modules. *)
-
-open Html5_types
-
-module MakeWrapped
- (W : Xml_wrap.T)
- (Xml : Xml_sigs.Wrapped with type 'a wrap = 'a W.t
- and type 'a list_wrap = 'a W.tlist)
- (Svg : Svg_sigs.T with module Xml := Xml
- and type 'a list_wrap = 'a W.tlist)= struct
-
- module Xml = Xml
-
- module Info = struct
- let content_type = "text/html"
- let alternative_content_types = ["application/xhtml+xml";"application/xml";"text/xml"]
- let version = "HTML5-draft"
- let standard = "http://www.w3.org/TR/html5/"
- let namespace = "http://www.w3.org/1999/xhtml"
- let doctype =
- Xml_print.compose_doctype "html" []
- let emptytags =
- [ "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img";
- "input"; "keygen"; "link"; "meta"; "param"; "source"; "wbr" ]
- end
-
- type 'a wrap = 'a W.t
- type 'a list_wrap = 'a W.tlist
-
- type uri = Xml.uri
- let string_of_uri = Xml.string_of_uri
- let uri_of_string = Xml.uri_of_string
-
- type 'a attrib = Xml.attrib
-
- let to_xmlattribs x = x
- let to_attrib x = x
-
- (* VB *)
- let float_attrib = Xml.float_attrib
-
- let int_attrib = Xml.int_attrib
-
- let string_attrib = Xml.string_attrib
-
- let uri_attrib a s = Xml.uri_attrib a s
-
- let space_sep_attrib = Xml.space_sep_attrib
-
- let comma_sep_attrib = Xml.comma_sep_attrib
-
- let user_attrib f name v = Xml.string_attrib name (W.fmap f v)
-
- let bool_attrib = user_attrib string_of_bool
-
- (* space-separated *)
- let length_to_string = function
- | `Pixels p -> string_of_int p
- | `Percent p -> (string_of_int p) ^ "%"
-
- let length_attrib name x =
- user_attrib length_to_string name x
-
- let multilength_to_string = function
- | `Pixels p -> string_of_int p
- | `Percent p -> (string_of_int p) ^ "%"
- | `Relative 1 -> "*"
- | `Relative i -> (string_of_int i) ^ "*"
-
- let multilength_attrib name x =
- user_attrib multilength_to_string name x
-
- let multilength_to_string m =
- String.concat ", " (List.map multilength_to_string m)
-
- let multilengths_attrib name x =
- user_attrib multilength_to_string name x
-
- let linktype_to_string =
- function
- | `Alternate -> "alternate"
- | `Archives -> "archives"
- | `Author -> "author"
- | `Bookmark -> "bookmark"
- | `External -> "external"
- | `First -> "first"
- | `Help -> "help"
- | `Icon -> "icon"
- | `Index -> "index"
- | `Last -> "last"
- | `License -> "license"
- | `Next -> "next"
- | `Nofollow -> "nofollow"
- | `Noreferrer -> "noreferrer"
- | `Pingback -> "pingback"
- | `Prefetch -> "prefetch"
- | `Prev -> "prev"
- | `Search -> "search"
- | `Stylesheet -> "stylesheet"
- | `Sidebar -> "sidebar"
- | `Tag -> "tag"
- | `Up -> "up"
- | `Other t -> t
-
- let linktypes_to_string l =
- String.concat " " (List.map linktype_to_string l)
-
- let linktypes_attrib name linktypes =
- user_attrib linktypes_to_string name linktypes
-
- let mediadesc_to_string =
- function
- | `All -> "all"
- | `Aural -> "aural"
- | `Braille -> "braille"
- | `Embossed -> "embossed"
- | `Handheld -> "handheld"
- | `Print -> "print"
- | `Projection -> "projection"
- | `Screen -> "screen"
- | `Speech -> "speech"
- | `TTY -> "tty"
- | `TV -> "tv"
- | `Raw_mediadesc s -> s
-
- let mediadescs_to_string mediadescs =
- String.concat ", " (List.map mediadesc_to_string mediadescs)
-
- let mediadesc_attrib name mediadescs =
- user_attrib mediadescs_to_string name mediadescs
-
- (* Core: *)
- let a_class = space_sep_attrib "class"
-
- let a_id = string_attrib "id"
-
- let a_user_data name = string_attrib ("data-" ^ name)
-
- let a_title = string_attrib "title"
-
- (* I18N: *)
- let a_xml_lang = string_attrib "xml:lang"
- let a_lang = string_attrib "lang"
-
- (* Style: *)
- let a_style = string_attrib "style"
-
- let a_property = string_attrib "property"
-
- (* Events: *)
- let a_onabort = Xml.event_handler_attrib "onabort"
- let a_onafterprint = Xml.event_handler_attrib "onafterprint"
- let a_onbeforeprint = Xml.event_handler_attrib "onbeforeprint"
- let a_onbeforeunload = Xml.event_handler_attrib "onbeforeunload"
- let a_onblur = Xml.event_handler_attrib "onblur"
- let a_oncanplay = Xml.event_handler_attrib "oncanplay"
- let a_oncanplaythrough = Xml.event_handler_attrib "oncanplaythrough"
- let a_onchange = Xml.event_handler_attrib "onchange"
- let a_ondurationchange = Xml.event_handler_attrib "ondurationchange"
- let a_onemptied = Xml.event_handler_attrib "onemptied"
- let a_onended = Xml.event_handler_attrib "onended"
- let a_onerror = Xml.event_handler_attrib "onerror"
- let a_onfocus = Xml.event_handler_attrib "onfocus"
- let a_onformchange = Xml.event_handler_attrib "onformchange"
- let a_onforminput = Xml.event_handler_attrib "onforminput"
- let a_onhashchange = Xml.event_handler_attrib "onhashchange"
- let a_oninput = Xml.event_handler_attrib "oninput"
- let a_oninvalid = Xml.event_handler_attrib "oninvalid"
- let a_onoffline = Xml.event_handler_attrib "onoffline"
- let a_ononline = Xml.event_handler_attrib "ononline"
- let a_onpause = Xml.event_handler_attrib "onpause"
- let a_onplay = Xml.event_handler_attrib "onplay"
- let a_onplaying = Xml.event_handler_attrib "onplaying"
- let a_onpagehide = Xml.event_handler_attrib "onpagehide"
- let a_onpageshow = Xml.event_handler_attrib "onpageshow"
- let a_onpopstate = Xml.event_handler_attrib "onpopstate"
- let a_onprogress = Xml.event_handler_attrib "onprogress"
- let a_onratechange = Xml.event_handler_attrib "onratechange"
- let a_onreadystatechange = Xml.event_handler_attrib "onreadystatechange"
- let a_onredo = Xml.event_handler_attrib "onredo"
- let a_onresize = Xml.event_handler_attrib "onresize"
- let a_onscroll = Xml.event_handler_attrib "onscroll"
- let a_onseeked = Xml.event_handler_attrib "onseeked"
- let a_onseeking = Xml.event_handler_attrib "onseeking"
- let a_onselect = Xml.event_handler_attrib "onselect"
- let a_onshow = Xml.event_handler_attrib "onshow"
- let a_onstalled = Xml.event_handler_attrib "onstalled"
- let a_onstorage = Xml.event_handler_attrib "onstorage"
- let a_onsubmit = Xml.event_handler_attrib "onsubmit"
- let a_onsuspend = Xml.event_handler_attrib "onsuspend"
- let a_ontimeupdate = Xml.event_handler_attrib "ontimeupdate"
- let a_onundo = Xml.event_handler_attrib "onundo"
- let a_onunload = Xml.event_handler_attrib "onunload"
- let a_onvolumechange = Xml.event_handler_attrib "onvolumechange"
- let a_onwaiting = Xml.event_handler_attrib "onwaiting"
- let a_onload = Xml.event_handler_attrib "onload"
- let a_onloadeddata = Xml.event_handler_attrib "onloadeddata"
- let a_onloadedmetadata = Xml.event_handler_attrib ""
- let a_onloadstart = Xml.event_handler_attrib "onloadstart"
- let a_onmessage = Xml.event_handler_attrib "onmessage"
- let a_onmousewheel = Xml.event_handler_attrib "onmousewheel"
-
- (** Javascript mouse events *)
- let a_onclick = Xml.mouse_event_handler_attrib "onclick"
- let a_oncontextmenu = Xml.mouse_event_handler_attrib "oncontextmenu"
- let a_ondblclick = Xml.mouse_event_handler_attrib "ondblclick"
- let a_ondrag = Xml.mouse_event_handler_attrib "ondrag"
- let a_ondragend = Xml.mouse_event_handler_attrib "ondragend"
- let a_ondragenter = Xml.mouse_event_handler_attrib "ondragenter"
- let a_ondragleave = Xml.mouse_event_handler_attrib "ondragleave"
- let a_ondragover = Xml.mouse_event_handler_attrib "ondragover"
- let a_ondragstart = Xml.mouse_event_handler_attrib "ondragstart"
- let a_ondrop = Xml.mouse_event_handler_attrib "ondrop"
- let a_onmousedown = Xml.mouse_event_handler_attrib "onmousedown"
- let a_onmouseup = Xml.mouse_event_handler_attrib "onmouseup"
- let a_onmouseover = Xml.mouse_event_handler_attrib "onmouseover"
- let a_onmousemove = Xml.mouse_event_handler_attrib "onmousemove"
- let a_onmouseout = Xml.mouse_event_handler_attrib "onmouseout"
-
- (** Javascript keyboard events *)
- let a_onkeypress = Xml.keyboard_event_handler_attrib "onkeypress"
- let a_onkeydown = Xml.keyboard_event_handler_attrib "onkeydown"
- let a_onkeyup = Xml.keyboard_event_handler_attrib "onkeyup"
-
- (* Other Attributes *)
- let a_version = string_attrib "version"
-
- let a_xmlns x =
- let f = function
- | `W3_org_1999_xhtml -> "http://www.w3.org/1999/xhtml"
- in user_attrib f "xmlns" x
-
- let a_manifest = uri_attrib "manifest"
-
- let a_cite = uri_attrib "cite"
-
- let a_xml_space x =
- let f = function
- | `Preserve -> "preserve"
- | `Default -> "default"
- in user_attrib f "xml:space" x
-
- let a_accesskey c =
- user_attrib (String.make 1) "accesskey" c
-
- let a_charset = string_attrib "charset"
-
- let a_accept_charset = space_sep_attrib "accept-charset"
-
- let a_accept = space_sep_attrib "accept"
-
- let a_href = uri_attrib "href"
-
- let a_hreflang = string_attrib "hreflang"
-
- let a_download file =
- let f = function
- | None -> ""
- | Some s -> s
- in user_attrib f "download" file
-
- let a_rel = linktypes_attrib "rel"
-
- let a_tabindex = int_attrib "tabindex"
-
- let a_mime_type = string_attrib "type"
-
- let a_alt = string_attrib "alt"
-
- let a_height p = int_attrib "height" p
-
- let a_src = uri_attrib "src"
-
- let a_width p = int_attrib "width" p
-
- let a_for = string_attrib "for"
-
- let a_for_list = space_sep_attrib "for"
-
- let a_selected x =
- let f = function | `Selected -> "selected"
- in user_attrib f "selected" x
-
- let a_text_value = string_attrib "value"
-
- let a_int_value = int_attrib "value"
-
- let a_value = string_attrib "value"
-
- let a_float_value = float_attrib "value"
-
- let a_action = uri_attrib "action"
-
- let a_method m =
- let f = function
- | `Get -> "GET"
- | `Post -> "POST"
- | `Put -> "PUT"
- | `Delete -> "DELETE"
- in user_attrib f "method" m
-
- let a_enctype = string_attrib "enctype"
-
- let a_checked x =
- let f = function
- | `Checked -> "checked"
- in user_attrib f "checked" x
-
- let a_disabled x =
- let f = function
- | `Disabled -> "disabled"
- in user_attrib f "disabled" x
-
- let a_readonly x =
- let f = function
- | `ReadOnly -> "readonly"
- in user_attrib f "readonly" x
-
- let a_maxlength = int_attrib "maxlength"
-
- let a_name = string_attrib "name"
-
- let a_autocomplete ac =
- let f = function
- | `On -> "on"
- | `Off -> "off"
- in user_attrib f "autocomplete" ac
-
- let a_async x =
- let f = function
- | `Async -> "async"
- in user_attrib f "async" x
-
- let a_autofocus x =
- let f = function
- | `Autofocus -> "autofocus"
- in user_attrib f "autofocus" x
-
- let a_autoplay x =
- let f = function
- | `Autoplay -> "autoplay"
- in user_attrib f "autoplay" x
-
- let a_muted x =
- let f = function
- | `Muted -> "muted"
- in user_attrib f "muted" x
-
- let a_crossorigin x =
- let f = function
- | `Anonymous -> "anonymous"
- | `Use_credentials -> "use-credentials"
- in user_attrib f "crossorigin" x
-
- let a_mediagroup = string_attrib "mediagroup"
-
- let a_challenge = string_attrib "challenge"
-
- let a_contenteditable ce =
- bool_attrib "contenteditable" ce
-
- let a_contextmenu = string_attrib "contextmenu"
-
- let a_controls x =
- let f = function
- | `Controls -> "controls"
- in user_attrib f "controls" x
-
- let a_dir d =
- let f = function
- | `Ltr -> "ltr"
- | `Rtl -> "rtl"
- in user_attrib f "dir" d
-
- let a_draggable d =
- bool_attrib "draggable" d
-
- let a_form = string_attrib "form"
-
- let a_formaction = uri_attrib "formaction"
-
- let a_formenctype = string_attrib "formenctype"
-
- let a_formmethod m =
- let f = function
- | `Get -> "GET"
- | `Post -> "POST"
- | `Put -> "PUT"
- | `Delete -> "DELETE"
- in user_attrib f "method" m
-
- let a_formnovalidate x =
- let f = function
- | `Formnovalidate -> "formnovalidate"
- in user_attrib f "formnovalidate" x
-
- let a_formtarget = string_attrib "formtarget"
-
- let a_hidden x =
- let f = function
- | `Hidden -> "hidden"
- in user_attrib f "hidden" x
-
- let a_high = float_attrib "high"
-
- let a_icon = uri_attrib "icon"
-
- let a_ismap x =
- let f = function
- | `Ismap -> "ismap"
- in user_attrib f "ismap" x
-
- let a_keytype = string_attrib "keytype"
-
- let a_list = string_attrib "list"
-
- let a_loop x =
- let f = function
- | `Loop -> "loop"
- in user_attrib f "loop" x
-
- let a_low = float_attrib "low"
-
- let a_max = float_attrib "max"
-
- let a_input_max = float_attrib "max"
-
- let a_min = float_attrib "min"
-
- let a_input_min = float_attrib "min"
-
- let a_novalidate x =
- let f = function
- | `Novalidate -> "novalidate"
- in user_attrib f "novalidate" x
-
- let a_open x =
- let f = function
- | `Open -> "open"
- in user_attrib f "open" x
-
- let a_optimum = float_attrib "optimum"
-
- let a_pattern = string_attrib "pattern"
-
- let a_placeholder = string_attrib "placeholder"
-
- let a_poster = uri_attrib "poster"
-
- let a_preload pl =
- let f = function
- | `None -> "none"
- | `Metadata -> "metadata"
- | `Audio -> "audio"
- in user_attrib f "preload" pl
-
- let a_pubdate x =
- let f = function
- | `Pubdate -> "pubdate"
- in user_attrib f "pubdate" x
-
- let a_radiogroup = string_attrib "radiogroup"
-
- let a_required x =
- let f = function
- | `Required -> "required"
- in user_attrib f "required" x
-
- let a_reversed x =
- let f = function
- | `Reversed -> "reserved"
- in user_attrib f "reserved" x
-
- let a_sandbox sb =
- let rec aux sb =
- match sb with
- | `AllowSameOrigin :: a -> "allow-same-origin" :: (aux a)
- | `AllowForms :: a -> "allow-forms" :: (aux a)
- | `AllowScript :: a -> "allow-script" :: (aux a)
- | `AllowPointerLock :: a -> "allow-pointer-lock" :: (aux a)
- | `AllowPopups :: a -> "allow-popups" :: (aux a)
- | `AllowTopNavigation :: a -> "allow-top-navigation" :: (aux a)
- | [] -> []
- in space_sep_attrib "sandbox" (W.fmap aux sb)
-
- let a_spellcheck sc =
- bool_attrib "spellcheck" sc
-
- let a_scoped x =
- let f = function
- | `Scoped -> "scoped"
- in user_attrib f "scoped" x
-
- let a_seamless x =
- let f = function
- | `Seamless -> "seamless"
- in user_attrib f "seamless" x
-
- let a_sizes sizes =
- let f = function
- | `Sizes sizes ->
- let buf = Buffer.create 17 in
- let size_fmt (w, h) =
- Buffer.add_string buf (string_of_int w);
- Buffer.add_char buf 'x';
- Buffer.add_string buf (string_of_int h)
- in
- let rec sizes_fmt = function
- | [] -> ()
- | x :: [] ->
- size_fmt x
- | x :: xs ->
- size_fmt x;
- Buffer.add_char buf ' ';
- sizes_fmt xs
- in
- sizes_fmt sizes;
- Buffer.contents buf
- | `Any -> "any"
- in user_attrib f "sizes" sizes
-
- let a_span = int_attrib "span"
-
- (*let a_srcdoc*)
- let a_srclang = string_attrib "xml:lang"
-
- let a_start = int_attrib "start"
-
- let a_step step =
- let f = function
- | None -> "any"
- | Some f -> string_of_float f
- in user_attrib f "step" step
-
- let a_wrap w =
- let f = function
- | `Soft -> "soft"
- | `Hard -> "hard"
- in user_attrib f "wrap" w
-
- let a_size = int_attrib "size"
-
- let a_input_type it =
- let f = function
- | `Url -> "url"
- | `Tel -> "tel"
- | `Text -> "text"
- | `Time -> "time"
- | `Search -> "search"
- | `Password -> "password"
- | `Checkbox -> "checkbox"
- | `Range -> "range"
- | `Radio -> "radio"
- | `Submit -> "submit"
- | `Reset -> "reset"
- | `Number -> "number"
- | `Month -> "month"
- | `Week -> "week"
- | `File -> "file"
- | `Email -> "email"
- | `Image -> "image"
- | `Date -> "date"
- | `Datetime -> "datetime"
- | `Datetime_local -> "datetime-local"
- | `Color -> "color"
- | `Button -> "button"
- | `Hidden -> "hidden"
- in user_attrib f "type" it
-
- let a_menu_type mt =
- let f = function
- | `Context -> "context"
- | `Toolbar -> "toolbar"
- in user_attrib f "type" mt
-
- let a_command_type ct =
- let f = function
- | `Command -> "command"
- | `Checkbox -> "checkbox"
- | `Radio -> "radio"
- in user_attrib f "type" ct
-
- let a_button_type bt =
- let f = function
- | `Button -> "button"
- | `Submit -> "submit"
- | `Reset -> "reset"
- in user_attrib f "type" bt
-
- let a_multiple x =
- let f = function
- | `Multiple -> "multiple"
- in user_attrib f "multiple" x
-
- let a_cols = int_attrib "cols"
-
- let a_rows = int_attrib "rows"
-
- let a_summary = string_attrib "summary"
-
- let a_align a =
- let f = function
- | `Left -> "left"
- | `Right -> "right"
- | `Justify -> "justify"
- | `Char -> "char"
- in user_attrib f "align" a
-
- let a_axis = string_attrib "axis"
-
- let a_colspan = int_attrib "colspan"
-
- let a_headers = space_sep_attrib "headers"
-
- let a_rowspan = int_attrib "rowspan"
-
- let a_scope s =
- let f = function
- | `Row -> "row"
- | `Col -> "col"
- | `Rowgroup -> "rowgroup"
- | `Colgroup -> "colgroup"
- in user_attrib f "scope" s
-
- let a_border = int_attrib "border"
-
- let a_cellpadding = length_attrib "cellpadding"
-
- let a_cellspacing = length_attrib "cellspacing"
-
- let a_datapagesize = string_attrib "datapagesize"
-
- let a_rules r =
- let f = function
- | `None -> "none"
- | `Groups -> "groups"
- | `Rows -> "rows"
- | `Cols -> "cols"
- | `All -> "all"
- in user_attrib f "rules" r
-
- let a_char c =
- user_attrib (String.make 1) "char" c
-
- let a_charoff = length_attrib "charoff"
-
- let a_data = uri_attrib "data"
-
- let a_codetype = string_attrib "codetype"
-
- let a_fs_rows mls = multilengths_attrib "rows" mls
-
- let a_fs_cols mls = multilengths_attrib "cols" mls
-
- let a_frameborder b =
- let f = function
- | `Zero -> "0"
- | `One -> "1"
- in user_attrib f "frameborder" b
-
- let a_marginheight = int_attrib "marginheight"
-
- let a_marginwidth = int_attrib "marginwidth"
-
- let a_scrolling s =
- let f = function
- | `Yes -> "yes"
- | `No -> "no"
- | `Auto -> "auto"
- in user_attrib f "scrolling" s
-
- let a_target = string_attrib "target"
-
- let a_content = string_attrib "content"
-
- let a_http_equiv = string_attrib "http-equiv"
-
- let a_media = mediadesc_attrib "media"
-
- type 'a elt = Xml.elt
-
- type html = [ | `Html ] elt
-
- type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
-
- type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
-
- type ('a, 'b, 'c) star =
- ?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
-
- let terminal tag ?a () = Xml.leaf ?a tag
-
- let unary tag ?a elt =
- Xml.node ?a tag (W.singleton elt)
-
- let star tag ?a elts = Xml.node ?a tag elts
-
- let plus tag ?a elt elts =
- Xml.node ?a tag (W.cons elt elts)
-
- let option_cons opt elts =
- match opt with
- | None -> elts
- | Some x -> W.cons x elts
-
- let body = star "body"
-
- let head = plus "head"
-
- let title = unary "title"
-
- let html ?a head body =
- let content = W.cons head (W.singleton body) in
- Xml.node ?a "html" content
-
- let footer = star "footer"
-
- let header = star "header"
-
- let section = star "section"
-
- let nav = star "nav"
-
- let pcdata = Xml.pcdata
-
- let entity = Xml.entity
-
- let space () = entity "nbsp"
-
- let cdata = Xml.cdata
-
- let cdata_script = Xml.cdata_script
-
- let cdata_style = Xml.cdata_style
-
- let h1 = star "h1"
-
- let h2 = star "h2"
-
- let h3 = star "h3"
-
- let h4 = star "h4"
-
- let h5 = star "h5"
-
- let h6 = star "h6"
-
- let hgroup = star "hgroup"
-
- let address = star "address"
-
- let blockquote = star "blockquote"
-
- let div = star "div"
-
- let p = star "p"
-
- let pre = star "pre"
-
- let abbr = star "abbr"
-
- let br = terminal "br"
-
- let cite = star "cite"
-
- let code = star "code"
-
- let dfn = star "dfn"
-
- let em = star "em"
-
- let kbd = star "kbd"
-
- let q = star "q"
-
- let samp = star "samp"
-
- let span = star "span"
-
- let strong = star "strong"
-
- let time = star "time"
-
- let var = star "var"
-
- let a = star "a"
-
- let dl = star "dl"
-
- let ol = star "ol"
-
- let ul = star "ul"
-
- let dd = star "dd"
-
- let dt = star "dt"
-
- let li = star "li"
-
- let hr = terminal "hr"
-
- let b = star "b"
-
- let i = star "i"
-
- let u = star "u"
-
- let small = star "small"
-
- let sub = star "sub"
-
- let sup = star "sup"
-
- let mark = star "mark"
-
- let rp = star "rp"
-
- let rt = star "rt"
-
- let ruby = star "ruby"
-
- let wbr = terminal "wbr"
-
- (* VB *)
- type shape = [ | `Rect | `Circle | `Poly | `Default ]
-
- let bdo ~dir ?(a = []) elts = Xml.node ~a: ((a_dir dir) :: a) "bdo" elts
-
- let a_datetime = string_attrib "datetime"
-
- let a_shape d =
- let f = function | `Rect -> "rect"
- | `Circle -> "circle"
- | `Poly -> "poly"
- | `Default -> "default"
- in user_attrib f "shape" d
-
- let a_coords coords =
- let f c = String.concat "," (List.map string_of_int c)
- in user_attrib f "coords" coords
-
- let a_usemap = string_attrib "usemap"
-
- let a_defer x =
- let f = function | `Defer -> "defer" in user_attrib f "defer" x
-
- let a_label = string_attrib "label"
-
- let area ~alt ?(a = []) () = Xml.leaf ~a: ((a_alt alt) :: a) "area"
-
- let map = star "map"
-
- let del = star "del"
-
- let ins = star "ins"
-
- let script = unary "script"
-
- let noscript = star "noscript"
-
- let article = star "article"
-
- let aside = star "aside"
-
- let video_audio name ?src ?srcs ?(a = []) elts =
- let a =
- match src with
- | None -> a
- | Some uri -> (a_src uri) :: a
- in
- match srcs with
- | None -> Xml.node name ~a elts
- | Some srcs -> Xml.node name ~a (W.append srcs elts)
-
- let audio = video_audio "audio"
-
- let video = video_audio "video"
-
- let canvas = star "canvas"
-
- let command ~label ?(a = []) () =
- Xml.leaf ~a: ((a_label label) :: a) "command"
-
- let menu ?child ?a () =
- let child = match child with
- | None -> W.nil ()
- | Some (`Lis l)
- | Some (`Flows l) -> l in
- Xml.node ?a "menu" child
-
- let embed = terminal "embed"
-
- let source = terminal "source"
-
- let meter = star "meter"
-
- let output_elt = star "output"
-
- let form = star "form"
-
- let svg ?(a = []) children =
- Svg.toelt (Svg.svg ~a children)
-
- let input = terminal "input"
-
- let keygen = terminal "keygen"
-
- let label = star "label"
-
- let option = unary "option"
-
- let select = star "select"
-
- let textarea = unary "textarea"
-
- let button = star "button"
-
- let datalist ?children ?a () =
- let children = match children with
- | None -> W.nil ()
- | Some (`Options x | `Phras x) -> x in
- Xml.node ?a "datalist" children
-
- let progress = star "progress"
-
- let legend = star "legend"
-
- let details summary ?a children =
- plus "details" ?a summary children
-
- let summary = star "summary"
-
- let fieldset ?legend ?a elts =
- Xml.node ?a "fieldset" (option_cons legend elts)
-
- let optgroup ~label ?(a = []) elts =
- Xml.node ~a: ((a_label label) :: a) "optgroup" elts
-
- let figcaption = star "figcaption"
- let figure ?figcaption ?a elts =
- let content = match figcaption with
- | None -> elts
- | Some (`Top c) -> W.cons c elts
- | Some (`Bottom c) -> W.append elts (W.singleton c)
- in
- Xml.node ?a "figure" content
-
- let caption = star "caption"
-
- let tablex ?caption ?columns ?thead ?tfoot ?a elts =
- let content = option_cons thead (option_cons tfoot elts) in
- let content = match columns with
- | None -> content
- | Some columns -> W.append columns content in
- let content = option_cons caption content in
- Xml.node ?a "table" content
-
- let table = tablex
-
- let td = star "td"
-
- let th = star "th"
-
- let tr = star "tr"
-
- let colgroup = star "colgroup"
-
- let col = terminal "col"
-
- let thead = star "thead"
-
- let tbody = star "tbody"
-
- let tfoot = star "tfoot"
-
- let iframe = star "iframe"
-
- let object_ ?params ?(a = []) elts =
- let elts = match params with
- | None -> elts
- | Some e -> W.append e elts in
- Xml.node ~a "object" elts
-
- let param = terminal "param"
-
- let img ~src ~alt ?(a = []) () =
- let a = (a_src src) :: (a_alt alt) :: a in
- Xml.leaf ~a "img"
-
- let meta = terminal "meta"
-
- let style ?(a = []) elts = Xml.node ~a "style" elts
-
- let link ~rel ~href ?(a = []) () =
- Xml.leaf ~a: ((a_rel rel) :: (a_href href) :: a) "link"
-
- let base = terminal "base"
-
- (******************************************************************)
- (* Conversion from and to Xml module *)
- let tot x = x
-
- let totl x = x
-
- let toelt x = x
-
- let toeltl x = x
-
- type doc = [ `Html ] elt
- let doc_toelt x = x
-
- module Unsafe = struct
-
- let data s = Xml.encodedpcdata s
-
- let leaf tag ?a () = Xml.leaf ?a tag
-
- let node tag ?a elts = Xml.node ?a tag elts
-
- let coerce_elt x = x
-
- let float_attrib = Xml.float_attrib
-
- let int_attrib = Xml.int_attrib
-
- let string_attrib = Xml.string_attrib
-
- let uri_attrib a s = Xml.uri_attrib a s
-
- let space_sep_attrib = Xml.space_sep_attrib
-
- let comma_sep_attrib = Xml.comma_sep_attrib
-
- end
-
-end
-
-module Make
- (Xml : Xml_sigs.T)
- (Svg : Svg_sigs.T with module Xml := Xml
- and type 'a list_wrap = 'a Xml.list_wrap) =
- MakeWrapped
- (Xml_wrap.NoWrap)
- (Xml)
- (Svg)
diff -Nru tyxml-3.5.0/lib/html5_f.mli tyxml-4.1.0/lib/html5_f.mli
--- tyxml-3.5.0/lib/html5_f.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/html5_f.mli 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2004 by Thorsten Ohl
- * Copyright (C) 2007 by Vincent Balat, Gabriel Kerneis
- * Copyright (C) 2010 by Cecile Herbelin
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(** Typesafe constructors for HTML5 documents (Functorial interface) *)
-
-module Make
- (Xml : Xml_sigs.T)
- (Svg : Svg_sigs.T with module Xml := Xml
- and type 'a list_wrap = 'a Xml.list_wrap)
- : Html5_sigs.Make(Xml)(Svg).T
- with type +'a elt = Xml.elt
- and type +'a attrib = Xml.attrib
-
-
-(** Like the {! Html5_f.Make } functor, but allows to wrap elements inside a monad described by {! Xml_wrap.T}.
- See the functorial interface documentation for more details. *)
-module MakeWrapped
- (W : Xml_wrap.T)
- (Xml : Xml_sigs.Wrapped with type 'a wrap = 'a W.t
- and type 'a list_wrap = 'a W.tlist)
- (Svg : Svg_sigs.T with module Xml := Xml
- and type 'a list_wrap = 'a Xml.list_wrap)
- : Html5_sigs.MakeWrapped(W)(Xml)(Svg).T
- with type +'a elt = Xml.elt
- and type +'a attrib = Xml.attrib
diff -Nru tyxml-3.5.0/lib/html5.ml tyxml-4.1.0/lib/html5.ml
--- tyxml-3.5.0/lib/html5.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/html5.ml 1970-01-01 00:00:00.000000000 +0000
@@ -1,24 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-module M = Html5_f.Make(Xml)(Svg.M)
-
-module P = Xml_print.Make_typed_simple(Xml)(M)
-
-module Make_printer = Xml_print.Make_typed(Xml)(M)
diff -Nru tyxml-3.5.0/lib/html5.mli tyxml-4.1.0/lib/html5.mli
--- tyxml-3.5.0/lib/html5.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/html5.mli 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(** Typesafe constructors and printers for HTML5 documents.
-
- @see W3C Recommendation *)
-
-(** Concrete implementation of HTML5 typesafe constructors *)
-module M : Html5_sigs.Make(Xml)(Svg.M).T
-
-(** Simple printer for HTML5 documents *)
-module P : Xml_sigs.Typed_simple_printer with type 'a elt := 'a M.elt
- and type doc := M.doc
-
-(** Parametrized stream printer for HTML5 documents *)
-module Make_printer(O : Xml_sigs.Output) :
- Xml_sigs.Typed_printer with type out := O.out
- and type 'a elt := 'a M.elt
- and type doc := M.doc
diff -Nru tyxml-3.5.0/lib/html5_sigs.mli tyxml-4.1.0/lib/html5_sigs.mli
--- tyxml-3.5.0/lib/html5_sigs.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/html5_sigs.mli 1970-01-01 00:00:00.000000000 +0000
@@ -1,1222 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-module type T = sig
-
- open Html5_types
-
- module Xml : Xml_sigs.Wrapped
- module Svg : Svg_sigs.T with module Xml := Xml
- module Info : Xml_sigs.Info
-
- type 'a wrap
- type 'a list_wrap
-
- type uri = Xml.uri
- val string_of_uri : uri -> string
- val uri_of_string : string -> uri
-
- (** {1 Common Attributes} *)
-
- type +'a attrib
-
- val to_xmlattribs : ('a attrib) list -> Xml.attrib list (* VB *)
- val to_attrib : Xml.attrib -> 'a attrib (* GH *)
- (** ['a] is known as a {i phantom type}. The implementation is
- actually monomorphic (the different element types are distinguished
- by a homogeneous variable, such as their textual representation)
- and the type variable [`a] is just used by the type checker.
-
- NB: It might be possible to use polymorphic variants directly, without
- phantom types, but the implementation is likely to be more involved. *)
-
- val a_autocomplete : [< | `On | `Off] wrap -> [> | `Autocomplete] attrib
-
- val a_async : [< | `Async] wrap -> [> | `Async] attrib
-
- val a_autofocus : [< | `Autofocus] wrap -> [> | `Autofocus] attrib
-
- val a_autoplay : [< | `Autoplay] wrap -> [> | `Autoplay] attrib
-
- val a_muted : [< | `Muted] wrap -> [> | `Muted] attrib
-
- val a_crossorigin :
- [< | `Anonymous | `Use_credentials ] wrap -> [> | `Crossorigin ] attrib
-
- val a_mediagroup : string wrap -> [> | `Mediagroup ] attrib
-
- val a_challenge : text wrap -> [> | `Challenge] attrib
-
- val a_contenteditable : bool wrap -> [> | `Contenteditable] attrib
-
- val a_contextmenu : idref wrap -> [> | `Contextmenu] attrib
-
- val a_controls : [< | `Controls] wrap -> [> | `Controls] attrib
-
- val a_dir : [< | `Rtl | `Ltr] wrap -> [> | `Dir] attrib
-
- val a_draggable : bool wrap -> [> | `Draggable] attrib
-
- val a_form : idref wrap -> [> | `Form] attrib
-
- val a_formaction : Xml.uri wrap -> [> | `Formaction] attrib
-
- val a_formenctype : contenttype wrap -> [> | `Formenctype] attrib
-
- val a_formmethod :
- [< | `Get | `Post | `Put | `Delete] wrap -> [> | `Formmethod] attrib
-
- val a_formnovalidate :
- [< | `Formnovalidate] wrap -> [> | `Formnovalidate] attrib
-
- val a_formtarget : text wrap -> [> | `Formtarget] attrib
-
- val a_hidden : [< | `Hidden] wrap -> [> | `Hidden] attrib
-
- val a_high : float_number wrap -> [> | `High] attrib
-
- val a_icon : Xml.uri wrap -> [> | `Icon] attrib
-
- val a_ismap : [< | `Ismap] wrap -> [> | `Ismap] attrib
-
- val a_keytype : text wrap -> [> | `Keytype] attrib
-
- val a_list : idref wrap -> [> | `List] attrib
-
- val a_loop : [< | `Loop] wrap -> [> | `Loop] attrib
-
- val a_low : float_number wrap -> [> | `High] attrib
-
- val a_max : float_number wrap -> [> | `Max] attrib
-
- val a_input_max : float_number wrap -> [> | `Input_Max] attrib
-
- val a_min : float_number wrap -> [> | `Min] attrib
-
- val a_input_min : float_number wrap -> [> | `Input_Min] attrib
-
- val a_novalidate : [< | `Novalidate] wrap -> [> | `Novalidate] attrib
-
- val a_open : [< | `Open] wrap -> [> | `Open] attrib
-
- val a_optimum : float_number wrap -> [> | `Optimum] attrib
-
- val a_pattern : text wrap -> [> | `Pattern] attrib
-
- val a_placeholder : text wrap -> [> | `Placeholder] attrib
-
- val a_poster : Xml.uri wrap -> [> | `Poster] attrib
-
- val a_preload : [< | `None | `Metadata | `Audio] wrap -> [> | `Preload] attrib
-
- val a_pubdate : [< | `Pubdate] wrap -> [> | `Pubdate] attrib
-
- val a_radiogroup : text wrap -> [> | `Radiogroup] attrib
-
- val a_required : [< | `Required] wrap -> [> | `Required] attrib
-
- val a_reversed : [< | `Reversed] wrap -> [> | `Reversed] attrib
-
- val a_sandbox :
- [<
- | `AllowSameOrigin
- | `AllowForms
- | `AllowScript
- | `AllowPointerLock
- | `AllowPopups
- | `AllowTopNavigation ] list wrap ->
- [> | `Sandbox] attrib
-
- val a_spellcheck : bool wrap -> [> | `Spellcheck] attrib
-
- val a_scoped : [< | `Scoped] wrap -> [> | `Scoped] attrib
-
- val a_seamless : [< | `Seamless] wrap -> [> | `Seamless] attrib
-
- val a_sizes : [< | `Sizes of (number * number) list | `Any] wrap -> [> | `Sizes] attrib
-
- val a_span : number wrap -> [> | `Span] attrib
-
- (** This attribute is deprecated, you should use {! a_xml_lang}. *)
- val a_srclang : nmtoken wrap -> [> | `XML_lang] attrib
-
- val a_start : number wrap -> [> | `Start] attrib
-
- val a_step : float_number option wrap -> [> | `Step] attrib
-
- val a_wrap : [< | `Soft | `Hard] wrap -> [> | `Wrap] attrib
-
- val a_class : nmtokens wrap -> [> | `Class] attrib
- (** This attribute assigns a class name or set of class names to an
- element. Any number of elements may be assigned the same class
- name or names. *)
-
- val a_user_data : nmtoken -> text wrap -> [> | `User_data] attrib
- (** May be used to specify custom attribs.
- The example given by the W3C is as follows :
- {v
- - Beyond The Sea
-
v}
- It should be used for preprocessing ends only. *)
- val a_id : text wrap -> [> | `Id] attrib
- (** This attribute assigns a name to an element. This name must be
- unique in a document. The text should be without any space. *)
-
- val a_title : text wrap -> [> | `Title] attrib
- (** This attribute offers advisory information about the element for
- which it is set. *)
-
- (** Values of the title attribute may be rendered by user agents in a
- variety of ways. For instance, visual browsers frequently display
- the title as a {i tool tip} (a short message that appears when the
- pointing device pauses over an object). Audio user agents may
- speak the title information in a similar context. *)
-
- (** The title attribute has an additional role when used with the [link]
- element to designate an external style sheet. Please consult the
- section on links and style sheets for details. *)
-
- (** {2 I18N} *)
-
- val a_xml_lang : languagecode wrap -> [> | `XML_lang] attrib
-
- val a_lang : languagecode wrap -> [> | `Lang] attrib
-
- (** {2 Events} *)
-
- (** Javascript events *)
- val a_onabort : Xml.event_handler -> [> | `OnAbort] attrib
- val a_onafterprint : Xml.event_handler -> [> | `OnAfterPrint] attrib
- val a_onbeforeprint : Xml.event_handler -> [> | `OnBeforePrint] attrib
- val a_onbeforeunload : Xml.event_handler -> [> | `OnBeforeUnload] attrib
- val a_onblur : Xml.event_handler -> [> | `OnBlur] attrib
- val a_oncanplay : Xml.event_handler -> [> | `OnCanPlay] attrib
- val a_oncanplaythrough : Xml.event_handler -> [> | `OnCanPlayThrough] attrib
- val a_onchange : Xml.event_handler -> [> | `OnChange] attrib
- val a_ondurationchange : Xml.event_handler -> [> | `OnDurationChange] attrib
- val a_onemptied : Xml.event_handler -> [> | `OnEmptied] attrib
- val a_onended : Xml.event_handler -> [> | `OnEnded] attrib
- val a_onerror : Xml.event_handler -> [> | `OnError] attrib
- val a_onfocus : Xml.event_handler -> [> | `OnFocus] attrib
- val a_onformchange : Xml.event_handler -> [> | `OnFormChange] attrib
- val a_onforminput : Xml.event_handler -> [> | `OnFormInput] attrib
- val a_onhashchange : Xml.event_handler -> [> | `OnHashChange] attrib
- val a_oninput : Xml.event_handler -> [> | `OnInput] attrib
- val a_oninvalid : Xml.event_handler -> [> | `OnInvalid] attrib
- val a_onmousewheel : Xml.event_handler -> [> | `OnMouseWheel] attrib
- val a_onoffline : Xml.event_handler -> [> | `OnOffLine] attrib
- val a_ononline : Xml.event_handler -> [> | `OnOnLine] attrib
- val a_onpause : Xml.event_handler -> [> | `OnPause] attrib
- val a_onplay : Xml.event_handler -> [> | `OnPlay] attrib
- val a_onplaying : Xml.event_handler -> [> | `OnPlaying] attrib
- val a_onpagehide : Xml.event_handler -> [> | `OnPageHide] attrib
- val a_onpageshow : Xml.event_handler -> [> | `OnPageShow] attrib
- val a_onpopstate : Xml.event_handler -> [> | `OnPopState] attrib
- val a_onprogress : Xml.event_handler -> [> | `OnProgress] attrib
- val a_onratechange : Xml.event_handler -> [> | `OnRateChange] attrib
- val a_onreadystatechange : Xml.event_handler -> [> | `OnReadyStateChange] attrib
- val a_onredo : Xml.event_handler -> [> | `OnRedo] attrib
- val a_onresize : Xml.event_handler -> [> | `OnResize] attrib
- val a_onscroll : Xml.event_handler -> [> | `OnScroll] attrib
- val a_onseeked : Xml.event_handler -> [> | `OnSeeked] attrib
- val a_onseeking : Xml.event_handler -> [> | `OnSeeking] attrib
- val a_onselect : Xml.event_handler -> [> | `OnSelect] attrib
- val a_onshow : Xml.event_handler -> [> | `OnShow] attrib
- val a_onstalled : Xml.event_handler -> [> | `OnStalled] attrib
- val a_onstorage : Xml.event_handler -> [> | `OnStorage] attrib
- val a_onsubmit : Xml.event_handler -> [> | `OnSubmit] attrib
- val a_onsuspend : Xml.event_handler -> [> | `OnSuspend] attrib
- val a_ontimeupdate : Xml.event_handler -> [> | `OnTimeUpdate] attrib
- val a_onundo : Xml.event_handler -> [> | `OnUndo] attrib
- val a_onunload : Xml.event_handler -> [> | `OnUnload] attrib
- val a_onvolumechange : Xml.event_handler -> [> | `OnVolumeChange] attrib
- val a_onwaiting : Xml.event_handler -> [> | `OnWaiting] attrib
- val a_onload : Xml.event_handler -> [> | `OnLoad] attrib
- val a_onloadeddata : Xml.event_handler -> [> | `OnLoadedData] attrib
- val a_onloadedmetadata : Xml.event_handler -> [> | `OnLoadedMetaData] attrib
- val a_onloadstart : Xml.event_handler -> [> | `OnLoadStart] attrib
- val a_onmessage : Xml.event_handler -> [> | `OnMessage] attrib
-
- (** Javascript mouse events *)
- val a_onclick : Xml.mouse_event_handler -> [> | `OnClick] attrib
- val a_oncontextmenu : Xml.mouse_event_handler -> [> | `OnContextMenu] attrib
- val a_ondblclick : Xml.mouse_event_handler -> [> | `OnDblClick] attrib
- val a_ondrag : Xml.mouse_event_handler -> [> | `OnDrag] attrib
- val a_ondragend : Xml.mouse_event_handler -> [> | `OnDragEnd] attrib
- val a_ondragenter : Xml.mouse_event_handler -> [> | `OnDragEnter] attrib
- val a_ondragleave : Xml.mouse_event_handler -> [> | `OnDragLeave] attrib
- val a_ondragover : Xml.mouse_event_handler -> [> | `OnDragOver] attrib
- val a_ondragstart : Xml.mouse_event_handler -> [> | `OnDragStart] attrib
- val a_ondrop : Xml.mouse_event_handler -> [> | `OnDrop] attrib
- val a_onmousedown : Xml.mouse_event_handler -> [> | `OnMouseDown] attrib
- val a_onmouseup : Xml.mouse_event_handler -> [> | `OnMouseUp] attrib
- val a_onmouseover : Xml.mouse_event_handler -> [> | `OnMouseOver] attrib
- val a_onmousemove : Xml.mouse_event_handler -> [> | `OnMouseMove] attrib
- val a_onmouseout : Xml.mouse_event_handler -> [> | `OnMouseOut] attrib
-
- (** Javascript keyboard events *)
- val a_onkeypress : Xml.keyboard_event_handler -> [> | `OnKeyPress] attrib
- val a_onkeydown : Xml.keyboard_event_handler -> [> | `OnKeyDown] attrib
- val a_onkeyup : Xml.keyboard_event_handler -> [> | `OnKeyUp] attrib
-
-
- val a_version : cdata wrap -> [> | `Version] attrib
-
- val a_xmlns : [< | `W3_org_1999_xhtml] wrap -> [> | `XMLns] attrib
-
- val a_manifest : Xml.uri wrap -> [> | `Manifest] attrib
-
- val a_cite : Xml.uri wrap -> [> | `Cite] attrib
-
- val a_xml_space : [< | `Default | `Preserve] wrap -> [> | `XML_space] attrib
-
- val a_accesskey : character wrap -> [> | `Accesskey] attrib
- (** This attribute assigns an access key to an element. An access key
- is a single character from the document character
- set. NB: authors should consider the input method of the
- expected reader when specifying an accesskey. *)
-
- val a_charset : charset wrap -> [> | `Charset] attrib
- (** This attribute specifies the character encoding of the resource
- designated by the link. Please consult the section on character
- encodings for more details. *)
-
- val a_accept_charset : charsets wrap -> [> | `Accept_charset] attrib
-
- val a_accept : contenttypes wrap -> [> | `Accept] attrib
-
- val a_href : Xml.uri wrap -> [> | `Href] attrib
- (** This attribute specifies the location of a Web resource, thus
- defining a link between the current element (the source anchor)
- and the destination anchor defined by this attribute. *)
-
- val a_hreflang : languagecode wrap -> [> | `Hreflang] attrib
- (** This attribute specifies the base language of the resource
- designated by href and may only be used when href is specified. *)
-
- val a_download : string option wrap -> [> | `Download] attrib
-
- val a_rel : linktypes wrap -> [> | `Rel] attrib
- (** This attribute describes the relationship from the current
- document to the anchor specified by the href attribute. The
- value of this attribute is a space-separated list of link
- types. *)
-
- (** This attribute is used to describe a reverse link from the
- anchor specified by the href attribute to the current
- document. The value of this attribute is a space-separated
- list of link types. *)
-
- val a_tabindex : number wrap -> [> | `Tabindex] attrib
- (** This attribute specifies the position of the current
- element in the tabbing order for the current document. This
- value must be a number between 0 and 32767. User agents
- should ignore leading zeros. *)
-
- val a_mime_type : contenttype wrap -> [> | `Mime_type] attrib
- (** This attribute gives an advisory hint as to the content type
- of the content available at the link target address. It
- allows user agents to opt to use a fallback mechanism rather
- than fetch the content if they are advised that they will
- get content in a content type they do not support.Authors
- who use this attribute take responsibility to manage the
- risk that it may become inconsistent with the content
- available at the link target address. *)
-
- val a_datetime : cdata wrap -> [> | `Datetime] attrib
-
- val a_action : Xml.uri wrap -> [> | `Action] attrib
- (** This attribute specifies a form processing agent. User agent
- behavior for a value other than an HTTP URI is undefined. *)
-
- val a_checked : [< | `Checked] wrap -> [> | `Checked] attrib
- (** When the [type] attribute has the value ["radio"] or
- ["checkbox"], this boolean attribute specifies that the
- button is on. User agents must ignore this attribute for
- other control types. *)
-
- val a_cols : number wrap -> [> | `Cols] attrib
- (** This attribute specifies the visible width in average
- character widths. Users should be able to enter longer lines
- than this, so user agents should provide some means to
- scroll through the contents of the control when the contents
- extend beyond the visible area. User agents may wrap visible
- text lines to keep long lines visible without the need for
- scrolling. *)
-
- val a_enctype : contenttype wrap -> [> | `Enctype] attrib
-
- val a_for : idref wrap -> [> | `For] attrib
-
- val a_for_list : idrefs wrap -> [> | `For_List] attrib
-
- val a_maxlength : number wrap -> [> | `Maxlength] attrib
-
- val a_method :
- [< | `Get | `Post | `Put | `Delete] wrap -> [> | `Method] attrib
-
- val a_multiple : [< | `Multiple] wrap -> [> | `Multiple] attrib
-
- val a_name : text wrap -> [> | `Name] attrib
- (** This attribute assigns the control name. *)
-
- val a_rows : number wrap -> [> | `Rows] attrib
- (** This attribute specifies the number of visible text
- lines. Users should be able to enter more lines than this,
- so user agents should provide some means to scroll through
- the contents of the control when the contents extend beyond
- the visible area. *)
-
- val a_selected : [< | `Selected] wrap -> [> | `Selected] attrib
- (** When set, this boolean attribute specifies that
- this option is pre-selected. *)
-
- val a_size : number wrap -> [> | `Size] attrib
-
- val a_src : Xml.uri wrap -> [> | `Src] attrib
-
- val a_input_type : [<
- | `Url
- | `Tel
- | `Text
- | `Time
- | `Search
- | `Password
- | `Checkbox
- | `Range
- | `Radio
- | `Submit
- | `Reset
- | `Number
- | `Hidden
- | `Month
- | `Week
- | `File
- | `Email
- | `Image
- | `Datetime_local
- | `Datetime
- | `Date
- | `Color
- | `Button] wrap -> [> | `Input_Type] attrib
-
- val a_text_value : text wrap -> [> | `Text_Value] attrib
- (** This attribute specifies the initial value of the
- control. If this attribute is not set, the initial value is
- set to the contents of the [option] element. *)
-
- val a_int_value : number wrap -> [> | `Int_Value] attrib
-
- (*VVV NO *)
- val a_value : cdata wrap -> [> | `Value] attrib
-
- val a_float_value : float_number wrap -> [> | `Float_Value] attrib
-
- val a_disabled : [< | `Disabled] wrap -> [> | `Disabled] attrib
-
- val a_readonly : [< | `ReadOnly] wrap -> [> | `ReadOnly] attrib
- val a_button_type :
- [< | `Button | `Submit | `Reset] wrap -> [> | `Button_Type] attrib
-
- val a_command_type :
- [< | `Command | `Checkbox | `Radio] wrap -> [> | `Command_Type] attrib
-
- val a_menu_type : [< | `Context | `Toolbar] wrap -> [> | `Menu_Type] attrib
-
- val a_label : text wrap -> [> | `Label] attrib
-
- val a_align :
- [< | `Left | `Right | `Justify | `Char] wrap -> [> | `Align] attrib
-
- val a_axis : cdata wrap -> [> | `Axis] attrib
-
- val a_colspan : number wrap -> [> | `Colspan] attrib
-
- val a_headers : idrefs wrap -> [> | `Headers] attrib
-
- val a_rowspan : number wrap -> [> | `Rowspan] attrib
-
- val a_scope :
- [< | `Row | `Col | `Rowgroup | `Colgroup] wrap -> [> | `Scope] attrib
-
- val a_summary : text wrap -> [> | `Summary] attrib
-
- val a_border : pixels wrap -> [> | `Border] attrib
-
- val a_cellpadding : length wrap -> [> | `Cellpadding] attrib
-
- val a_cellspacing : length wrap -> [> | `Cellspacing] attrib
-
- val a_datapagesize : cdata wrap -> [> | `Datapagesize] attrib
-
- val a_rules :
- [< | `None | `Groups | `Rows | `Cols | `All] wrap -> [> | `Rules] attrib
-
- val a_char : character wrap -> [> | `Char] attrib
-
- val a_charoff : length wrap -> [> | `Charoff] attrib
-
- val a_alt : text wrap -> [> | `Alt] attrib
-
- val a_height : number wrap -> [> | `Height] attrib
-
- val a_width : number wrap -> [> | `Width] attrib
-
- type shape = [ | `Rect | `Circle | `Poly | `Default ]
-
- val a_shape : shape wrap -> [> | `Shape] attrib
-
- val a_coords : numbers wrap -> [> | `Coords] attrib
-
- val a_usemap : idref wrap -> [> | `Usemap] attrib
-
- val a_data : Xml.uri wrap -> [> | `Data] attrib
-
- val a_codetype : contenttype wrap -> [> | `Codetype] attrib
-
- val a_fs_rows : multilengths wrap -> [> | `FS_Rows] attrib
-
- val a_fs_cols : multilengths wrap -> [> | `FS_Cols] attrib
-
- val a_frameborder : [< | `Zero | `One] wrap -> [> | `Frameborder] attrib
-
- val a_marginheight : pixels wrap -> [> | `Marginheight] attrib
-
- val a_marginwidth : pixels wrap -> [> | `Marginwidth] attrib
-
- val a_scrolling : [< | `Yes | `No | `Auto] wrap -> [> | `Scrolling] attrib
-
- val a_target : frametarget wrap -> [> | `Target] attrib
-
- val a_content : text wrap -> [> | `Content] attrib
-
- val a_http_equiv : text wrap -> [> | `Http_equiv] attrib
-
- val a_defer : [< | `Defer] wrap -> [> | `Defer] attrib
-
- val a_media : mediadesc wrap -> [> | `Media] attrib
-
- val a_style : string wrap -> [> | `Style_Attr] attrib
-
- val a_property : string wrap -> [> | `Property] attrib
-
- (** {1 Phantom types and XML elements} *)
-
- type +'a elt
-
- type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
-
- type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
-
- type ('a, 'b, 'c) star =
- ?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
- (** Star '*' denotes any number of children, uncluding zero. *)
-
- (** Root element *)
- type html = [ | `Html ] elt
-
- (** {1 Combined Element Sets:} *)
-
- (********************************)
- (* If the document is an *)
- (* iframe srcdoc document or if*)
- (*title information is available*)
- (*from a higher-level protocol: *)
- (* Zero or more elements of *)
- (* metadata content. *)
- (*Otherwise: *)
- (* One or more elements of *)
- (* metadata content, of which *)
- (*exactly one is a title element*)
- (********************************)
-
- val html :
- ?a: ((html_attrib attrib) list) ->
- [< | `Head] elt wrap -> [< | `Body] elt wrap -> [> | `Html] elt
-
- val head :
- ?a: ((head_attrib attrib) list) ->
- [< | `Title] elt wrap -> (head_content_fun elt) list_wrap -> [> | head] elt
-
- val base : ([< | base_attrib], [> | base]) nullary
-
- val title : (title_attrib, [< | title_content_fun], [> | title]) unary
-
- val body : ([< | body_attrib], [< | body_content_fun], [> | body]) star
-
-
- val svg : ?a : [< svg_attrib ] Svg.attrib list -> [< svg_content ] Svg.elt list_wrap -> [> svg ] elt
-
- (** {2 Section} *)
-
- val footer :
- ([< | common], [< | flow5_without_header_footer], [> | `Footer]) star
-
- val header :
- ([< | common], [< | flow5_without_header_footer], [> | `Header]) star
-
- val section :
- ([< | section_attrib], [< | section_content_fun], [> | section]) star
-
- val nav : ([< | nav_attrib], [< | nav_content_fun], [> | nav]) star
-
- val h1 : ([< | h1_attrib], [< | h1_content_fun], [> | h1]) star
-
- val h2 : ([< | h2_attrib], [< | h2_content_fun], [> | h2]) star
-
- val h3 : ([< | h3_attrib], [< | h3_content_fun], [> | h3]) star
-
- val h4 : ([< | h4_attrib], [< | h4_content_fun], [> | h4]) star
-
- val h5 : ([< | h5_attrib], [< | h5_content_fun], [> | h5]) star
-
- val h6 : ([< | h6_attrib], [< | h6_content_fun], [> | h6]) star
-
- (* theoretically a plus, simplified into star *)
- val hgroup :
- ([< | hgroup_attrib], [< | hgroup_content_fun], [> | hgroup]) star
-
- val address :
- ([< | address_attrib], [< | address_content_fun], [> | address]) star
-
- val article :
- ([< | article_attrib], [< | article_content_fun], [> | article]) star
-
- val aside :
- ([< | aside_attrib], [< | aside_content_fun], [> | aside]) star
-
- (** {2 Grouping content} *)
-
- val p : ([< | p_attrib], [< | p_content_fun], [> | p]) star
-
- val pre : ([< | pre_attrib], [< | pre_content_fun], [> | pre]) star
-
- val blockquote :
- ([< | blockquote_attrib], [< | blockquote_content_fun], [> | blockquote
- ]) star
-
- val div : ([< | div_attrib], [< | div_content_fun], [> | div]) star
-
- (********************************)
- (* In Dl *)
- (********************************)
- (* Zero or more groups each *)
- (* consisting of *)
- (* one or more dt element *)
- (* followed by *)
- (* one or more dd elements*)
- (********************************)
- (* theoretically
- val dl :
- ?a: (([< | common] attrib) list) ->
- ((([< | `Dt] elt) * (([< | `Dt] elt) list)) *
- (([< | `Dd] elt) * (([< | `Dd] elt) list))) list wrap -> [> | `Dl] elt
- but we simplify into star *)
- val dl : ([< | dl_attrib], [< | dl_content_fun], [> | dl]) star
-
- val ol : ([< | ol_attrib], [< | ol_content_fun], [> | ol]) star
-
- val ul : ([< | ul_attrib], [< | ul_content_fun], [> | ul]) star
-
- val dd : ([< | dd_attrib], [< | dd_content_fun], [> | dd]) star
-
- val dt : ([< | dt_attrib], [< | dt_content_fun], [> | dt]) star
-
- (********************************)
- (* In Li *)
- (********************************)
- (* Only if the element is a *)
- (* child of an ol element: *)
- (* value attribute *)
- (********************************)
-
- (** A list element.
- The 'a type is used to know whether the element has
- a int_value attribute or not. *)
- val li : ([< | li_attrib], [< | li_content_fun], [> | li]) star
-
- val figcaption :
- ([< | figcaption_attrib], [< | figcaption_content_fun], [> | figcaption]) star
-
- (********************************)
- (* In Figure *)
- (********************************)
- (*Either: One figcaption element*)
- (* followed by flow content.*)
- (*Or: Flow content followed by *)
- (* one figcaption element. *)
- (*Or: Flow content. *)
- (********************************)
- val figure :
- ?figcaption: ([`Top of [< `Figcaption ] elt wrap | `Bottom of [< `Figcaption ] elt wrap ]) ->
- ([< | figure_attrib], [< | figure_content_fun], [> | figure]) star
-
- val hr : ([< | hr_attrib], [> | hr]) nullary
-
- (** {2 Ruby} *)
-
- (**********************************)
- (* In Ruby *)
- (**********************************)
- (* One or more groups of: *)
- (*phrasing content followed either*)
- (* by a single rt element, *)
- (* or an rp element *)
- (* an rt element, and *)
- (* another rp element. *)
- (**********************************)
- (* simplified with simple stars *)
- val rt : ([< | rt_attrib], [< | rt_content_fun], [> | rt]) star
-
- val rp : ([< | rp_attrib], [< | rp_content_fun], [> | rp]) star
-
- val ruby : ([< | ruby_attrib], [< | ruby_content_fun], [> | ruby]) star
-
- (** {2 Semantic} *)
-
- val b : ([< | b_attrib], [< | b_content_fun], [> | b]) star
-
- val i : ([< | i_attrib], [< | i_content_fun], [> | i]) star
-
- val u : ([< | u_attrib], [< | u_content_fun], [> | u]) star
-
- val small :
- ([< | small_attrib], [< | small_content_fun], [> | small]) star
-
- val sub : ([< | sub_attrib], [< | sub_content_fun], [> | sub]) star
-
- val sup : ([< | sup_attrib], [< | sup_content_fun], [> | sup]) star
-
- val mark : ([< | mark_attrib], [< | mark_content_fun], [> | mark]) star
-
- val wbr : ([< | wbr_attrib], [> | wbr]) nullary
-
- val bdo :
- dir: [< | `Ltr | `Rtl] wrap ->
- ([< | common], [< | phrasing], [> | `Bdo]) star
-
- val abbr : ([< | abbr_attrib], [< | abbr_content_fun], [> | abbr]) star
-
- val br : ([< | br_attrib], [> | br]) nullary
-
- val cite : ([< | cite_attrib], [< | cite_content_fun], [> | cite]) star
-
- val code : ([< | code_attrib], [< | code_content_fun], [> | code]) star
-
- val dfn : ([< | dfn_attrib], [< | dfn_content_fun], [> | dfn]) star
-
- val em : ([< | em_attrib], [< | em_content_fun], [> | em]) star
-
- val kbd : ([< | kbd_attrib], [< | kbd_content_fun], [> | kbd]) star
-
- val q : ([< | q_attrib], [< | q_content_fun], [> | q]) star
-
- val samp : ([< | samp_attrib], [< | samp_content_fun], [> | samp]) star
-
- val span : ([< | span_attrib], [< | span_content_fun], [> | span]) star
-
- val strong :
- ([< | strong_attrib], [< | strong_content_fun], [> | strong]) star
-
- val time : ([< | time_attrib], [< | time_content_fun], [> | time]) star
-
- val var : ([< | var_attrib], [< | var_content_fun], [> | var]) star
-
- (** {2 Hypertext} *)
-
- (********************************)
- (* In A *)
- (********************************)
- (* The target, rel, media, *)
- (* hreflang, and type attributes*)
- (* must be omitted if the href *)
- (* attribute is not present. *)
- (********************************)
- (*Only phasing instead of flow ?*)
- (********************************)
- (* a's children are transparents*)
- (********************************)
- val a : ([< | a_attrib], 'a, [> | `A of 'a]) star
-
- (** {2 Edit} *)
-
- (**********************************)
- (* del's children are transparents*)
- (**********************************)
- val del : ([< | del_attrib], 'a, [> | `Del of 'a]) star
-
- (**********************************)
- (* ins's children are transparents*)
- (**********************************)
- val ins : ([< | ins_attrib], 'a, [> | `Ins of 'a]) star
-
- (** {2 Embedded} *)
-
- val img :
- src: Xml.uri wrap ->
- alt: text wrap ->
- ([< img_attrib], [> img]) nullary
-
- val iframe : (*| `Srcdoc*)
- ([< | common | `Src | `Name | `Sandbox | `Seamless | `Width | `Height],
- [< | `PCDATA], [> | `Iframe]) star
-
- val object_ :
- ?params: (([< | `Param] elt) list_wrap ) ->
- ([<
- | common
- | `Data
- | `Form
- | `Mime_type
- | `Height
- | `Width
- | `Name
- | `Usemap
- ], 'a, [> | `Object of 'a ]) star
-
- val param : ([< | param_attrib], [> | param]) nullary
-
- (**********************************)
- (* In Embed *)
- (**********************************)
- (* Any namespace-less attribute *)
- (* other than name, align, hspace,*)
- (* and vspace may be specified on*)
- (* the embed element, so long as *)
- (* its name is XML-compatible and *)
- (* contains no characters in the *)
- (* range U+0041 to U+005A *)
- (*(LATIN CAPITAL LETTER A to LATIN*)
- (*CAPITAL LETTER Z). *)
- (*These attributes are then passed*)
- (* as parameters to the plugin. *)
- (**********************************)
- val embed :
- ([< | common | `Src | `Height | `Mime_type | `Width], [> | `Embed])
- nullary
-
- (**************************************)
- (* In Audio and Video *)
- (**************************************)
- (* If the element has a src attribute:*)
- (* transparent, but with no media *)
- (* element descendants. *)
- (* If the element does not have a src *)
- (* attribute: *)
- (* one or more source elements, then*)
- (* transparent, but with no media *)
- (* element descendants. *)
- (**************************************)
- val audio :
- ?src:Xml.uri wrap ->
- ?srcs:(([< | source] elt) list_wrap) ->
- ([< | audio_attrib], 'a, [> 'a audio ]) star
-
- val video :
- ?src:Xml.uri wrap ->
- ?srcs: (([< | source] elt) list_wrap) ->
- ([< | video_attrib], 'a, [> 'a video]) star
-
- val canvas : ([< | canvas_attrib], 'a, [> | 'a canvas]) star
-
- val source : ([< | source_attrib], [> | source]) nullary
-
- (********************************)
- (* In Area *)
- (********************************)
- (* The alt, target, rel, media, *)
- (* hreflang, and type attributes*)
- (* must be omitted if the href *)
- (* attribute is not present. *)
- (********************************)
- val area :
- alt: text wrap ->
- ([<
- | common
- | `Alt
- | `Coords
- | `Shape
- | `Target
- | `Rel
- | `Media
- | `Hreflang
- | `Mime_type
- ], [> | `Area]) nullary
-
- (* XXX: SC : the current system doesn't allow
- to put tag inside a map (a priori) *)
- (* theoretically a plus, simplified into star *)
- val map : ([< | map_attrib], 'a, [> | `A of 'a]) star
-
- (** {2 Tables Data} *)
-
- val caption :
- ([< | caption_attrib], [< | caption_content_fun], [> | caption]) star
-
- (********************************)
- (* In Table and Tablex *)
- (********************************)
- (* In this order: *)
- (* optionally a caption element,*)
- (* followed by either *)
- (*zero or more colgroup elements*)
- (* followed optionally by a *)
- (*thead element, *)
- (* followed optionally by a *)
- (*tfoot element, *)
- (* followed by either *)
- (*zero or more tbody elements *)
- (*or one or more tr elements, *)
- (* followed optionally by *)
- (*a tfoot element *)
- (********************************)
- (* BUT ONLY ONE FOOT ELEMENT *)
- (* CHILD IN TOTAL *)
- (********************************)
- (* theoretically a plus, simplified into star *)
- val table :
- ?caption: [< | caption] elt wrap ->
- ?columns: [< | colgroup] elt list_wrap ->
- ?thead: [< | thead] elt wrap ->
- ?tfoot: [< | tfoot] elt wrap ->
- ([< | table_attrib], [< | table_content_fun], [> | table]) star
-
- val tablex :
- ?caption: [< | caption] elt wrap ->
- ?columns: [< | colgroup] elt list_wrap ->
- ?thead: [< | thead] elt wrap ->
- ?tfoot: [< | tfoot] elt wrap ->
- ([< | tablex_attrib], [< | tablex_content_fun], [> | tablex]) star
-
- (********************************)
- (* In Colgroup *)
- (********************************)
- (* If span attribute is: *)
- (* -present: Empty. *)
- (* -absent: Zero or more *)
- (* col elements. *)
- (********************************)
- val colgroup :
- ([< | colgroup_attrib], [< | colgroup_content_fun], [> | colgroup]) star
-
- val col : ([< | col_attrib], [> | col]) nullary
-
- val thead :
- ([< | thead_attrib], [< | thead_content_fun], [> | thead]) star
-
- val tbody :
- ([< | tbody_attrib], [< | tbody_content_fun], [> | tbody]) star
-
- val tfoot :
- ([< | tfoot_attrib], [< | tfoot_content_fun], [> | tfoot]) star
-
- val td : ([< | td_attrib], [< | td_content_fun], [> | td]) star
-
- val th : ([< | th_attrib], [< | th_content_fun], [> | th]) star
-
- (****************************************)
- (* In Tr *)
- (****************************************)
- (*If the parent node is a thead element:*)
- (* Zero or more th elements *)
- (* Otherwise: *)
- (* Zero or more td or th elements *)
- (****************************************)
- val tr : ([< | tr_attrib], [< | tr_content_fun], [> | tr]) star
-
- (** {2 Forms} *)
- (* theoretically a plus, simplified into star *)
- val form : ([< | form_attrib], [< | form_content_fun], [> | form]) star
-
- val fieldset :
- ?legend: [ | `Legend ] elt wrap ->
- ([< | common | `Disabled | `Form | `Name], [< | flow5],
- [> | `Fieldset]) star
-
- val legend :
- ([< | legend_attrib], [< | legend_content_fun], [> | legend]) star
-
- (** Label authorizes only one control inside them
- that should be labelled with a [for] attribute
- (although it is not necessary). Such constraints are not currently
- enforced by the type-system *)
- val label :
- ([< | label_attrib], [< | label_content_fun], [> | label]) star
-
- (** If the [type] attribute is not "hidden", must be considered
- as interactive. Distinction not made for now. *)
- val input : ([< | input_attrib], [> | input]) nullary
-
- (********************************)
- (* In Button *)
- (********************************)
- (* The formaction, formenctype, *)
- (* formmethod, formnovalidate, *)
- (* and formtarget must not be *)
- (* specified if the element's *)
- (* type attribute is not in the*)
- (* Submit Button state. *)
- (********************************)
- val button :
- ([< | button_attrib], [< | button_content_fun], [> | button]) star
-
- val select :
- ([< | select_attrib], [< | select_content_fun], [> | select]) star
-
- val datalist :
- ?children:(
- [<
- | `Options of ([< | `Option] elt) list_wrap
- | `Phras of ([< | phrasing] elt) list_wrap
- ]) -> ([< | common], [> | `Datalist]) nullary
-
- val optgroup :
- label: text wrap ->
- ([< | common | `Disabled | `Label], [< | `Option], [> | `Optgroup]) star
-
- val option :
- ([< | option_attrib], [< | option_content_fun], [> | selectoption]) unary
-
- val textarea :
- ([< | textarea_attrib], [< | textarea_content_fun], [> | textarea]) unary
-
- val keygen : ([< | keygen_attrib], [> | keygen]) nullary
-
- val progress :
- ([< | progress_attrib], [< | progress_content_fun], [> | progress]) star
-
- val meter :
- ([< | meter_attrib], [< | meter_content_fun], [> | meter]) star
-
- val output_elt :
- ([< | output_elt_attrib], [< | output_elt_content_fun], [> | output_elt]) star
-
- (** {2 Data} *)
-
- val pcdata : string wrap -> [> | `PCDATA] elt
-
- val entity : string -> [> | `PCDATA] elt
-
- val space : unit -> [> | `PCDATA] elt
-
- val cdata : string -> [> | `PCDATA] elt
-
- (* GK *)
- val cdata_script : string -> [> | `PCDATA] elt
-
- (* GK *)
- val cdata_style : string -> [> | `PCDATA] elt
-
-
- (** {2 Interactive} *)
-
- val details :
- [< | `Summary] elt wrap ->
- ([< | common | `Open], [< | flow5], [> | `Details]) star
-
- val summary :
- ([< | summary_attrib], [< | summary_content_fun], [> | summary]) star
-
- val command :
- label: text wrap ->
- ([<
- | common
- | `Icon
- | `Disabled
- | `Checked
- | `Radiogroup
- | `Command_Type
- ], [> | `Command]) nullary
-
- val menu :
- ?child:(
- [<
- | `Lis of ([< | `Li of [< | common]] elt) list_wrap
- | `Flows of ([< | flow5] elt) list_wrap
- ]) -> ([< | common | `Label | `Menu_Type], [> | `Menu]) nullary
-
- (** {2 Scripting} *)
-
- val script :
- ([< | script_attrib], [< | script_content_fun], [> | script]) unary
-
- (****************************************************)
- (* In Noscript *)
- (****************************************************)
- (*When scripting is DISABLED, IN a HEAD element: *)
- (* in any order, zero or more link elements, *)
- (* zero or more style elements, and zero or more *)
- (* meta elements. *)
- (*When scripting is DISABLED, NOT IN a HEAD element:*)
- (* transparent, but there must be no noscript *)
- (* element descendants. *)
- (*When scripting is ENABLED, IN a HEAD element: *)
- (* only text, except that invoking the HTML *)
- (* fragment parsing algorithm with the noscript *)
- (* element as the context element and the text *)
- (* contents as the input must result in a list of *)
- (* nodes that consists only of link, style, and *)
- (* meta elements that would be conforming if they *)
- (* were children of the noscript element, and no *)
- (* parse errors. *)
- (*When scripting is ENABLED, NOT IN a HEAD element: *)
- (* only text, except that the text must be such *)
- (* that running the following algorithm results in*)
- (* a conforming document with no noscript elements*)
- (* and no script elements, and such that no step *)
- (* in the algorithm causes an HTML parser to flag *)
- (* a parse error *)
- (****************************************************)
- (* PLUS ?? simplified into star *)
- val noscript :
- ([< | noscript_attrib], [< | noscript_content_fun], [> | noscript])
- star
-
- val meta : ([< | meta_attrib], [> | meta]) nullary
-
- (** {2 Style Sheets} *)
-
- (*********************************)
- (* In Style *)
- (*********************************)
- (* the content model depends on *)
- (*the value of the type attribute*)
- (*********************************)
- (* BUT WHAT ??? *)
- (* SC: contenttype defaults to *)
- (* text/css *)
- (*********************************)
- val style :
- ([< | style_attrib], [< | style_content_fun], [> | style]) star
-
- (** {2 Link} *)
-
- val link :
- rel: linktypes wrap ->
- href: Xml.uri wrap ->
- ([<
- | common
- | `Hreflang
- | `Media
- | `Rel
- | `Href
- | `Sizes
- | `Mime_type
- ], [> | `Link]) nullary
-
- (** {1 Tools} *)
-
- val tot : Xml.elt -> 'a elt
- val totl : Xml.elt list -> ('a elt) list
- val toelt : 'a elt -> Xml.elt
- val toeltl : ('a elt) list -> Xml.elt list
-
- (** *)
-
- type doc = [ `Html ] elt
- val doc_toelt : doc -> Xml.elt
-
-
- module Unsafe : sig
- (** Unsafe features. Warning using this module can break
- HTML5 validity and may introduce security problems like
- code injection.
- Use it with care.
- *)
-
- (** Insert raw text without any encoding *)
- val data : string wrap -> 'a elt
-
- (** Insert an XML node that is not implemented in this module.
- If it is a standard HTML5 node which is missing,
- please report to the Ocsigen team.
- *)
- val node : string -> ?a:'a attrib list -> 'b elt list_wrap -> 'c elt
-
- (** Insert an XML node without children
- that is not implemented in this module.
- If it is a standard HTML5 node which is missing,
- please report to the Ocsigen team.
- *)
- val leaf : string -> ?a:'a attrib list -> unit -> 'b elt
-
- (** Remove phantom type annotation on an element,
- to make it usable everywhere.
- *)
- val coerce_elt : 'a elt -> 'b elt
-
- (** Insert an attribute that is not implemented in this module.
- If it is a standard HTML5 attribute which is missing,
- please report to the Ocsigen team.
- *)
- val string_attrib : string -> string wrap -> 'a attrib
-
- (** Same, for float attribute *)
- val float_attrib : string -> float wrap -> 'a attrib
-
- (** Same, for int attribute *)
- val int_attrib : string -> int wrap -> 'a attrib
-
- (** Same, for URI attribute *)
- val uri_attrib : string -> uri wrap -> 'a attrib
-
- (** Same, for a space separated list of values *)
- val space_sep_attrib : string -> string list wrap -> 'a attrib
-
- (** Same, for a comma separated list of values *)
- val comma_sep_attrib : string -> string list wrap -> 'a attrib
-
- end
-
-end
-
-(** {2 Signature functors} *)
-(** See {% <> %}. *)
-
-(** Signature functor for {!Html5_f.MakeWrapped}. *)
-module MakeWrapped
- (W : Xml_wrap.T)
- (Xml : Xml_sigs.Wrapped)
- (Svg : Svg_sigs.T with module Xml := Xml) :
-sig
-
- (** See {!modtype:Html5_sigs.T}. *)
- module type T = T
- with type Xml.uri = Xml.uri
- and type Xml.event_handler = Xml.event_handler
- and type Xml.mouse_event_handler = Xml.mouse_event_handler
- and type Xml.keyboard_event_handler = Xml.keyboard_event_handler
- and type Xml.attrib = Xml.attrib
- and type Xml.elt = Xml.elt
- and module Svg := Svg
- and type 'a Xml.wrap = 'a W.t
- and type 'a wrap = 'a W.t
- and type 'a Xml.list_wrap = 'a W.tlist
- and type 'a list_wrap = 'a W.tlist
-end
-
-(** Signature functor for {!Html5_f.Make}. *)
-module Make
- (Xml : Xml_sigs.T)
- (Svg : Svg_sigs.T with module Xml := Xml) :
-sig
-
- (** See {!modtype:Html5_sigs.MakeWrapped} and {!modtype:Html5_sigs.T}. *)
- module type T = MakeWrapped(Xml_wrap.NoWrap)(Xml)(Svg).T
-end
diff -Nru tyxml-3.5.0/lib/html5_types.mli tyxml-4.1.0/lib/html5_types.mli
--- tyxml-3.5.0/lib/html5_types.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/html5_types.mli 1970-01-01 00:00:00.000000000 +0000
@@ -1,2227 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2010 by Simon Castellan
- * Copyright (C) 2010 by Cecile Herbelin
- * Copyright (C) 2010 by Vincent Balat
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(*
- TODO, Issues:
- -> Map cannot contain area children for now
- -> noscript (a [a []]) should not be typed.
- -> mathml !
-*)
-
-(* _fun prefix are the types that must be used
- in Html5.M. They are more restrictive as
- some param are already taken as seperate argument,
- to ensure better compatibility.
- SC *)
-
-(*
- TODO: from draft 8 may 2011:
- * add bdi element
- * add s element
- * add u element
- * area is only allowed inside a phrasing if included inside a map element
-
-*)
-
-(** HTML5 types with variants. (See also {!Html5.M})
-
- @see information concerning HTML5 at W3C.
-*)
-
-
-(** {1 Attribute types.} *)
-
-type cdata = string
-(** Character data *)
-
-type id = string
-(** A document-unique identifier *)
-
-type idref = string
-(** A reference to a document-unique identifier *)
-
-type idrefs = idref list
-(** A space-separated list of references to document-unique identifiers *)
-
-type name = string
-(** A name with the same character constraints as ID above *)
-
-type nmtoken = string
-(** A name composed of only name tokens as defined in XML 1.0
- @see XML 1.0 *)
-
-type nmtokens = nmtoken list
-(** One or more white space separated NMTOKEN values *)
-
-(** {2 Data Types} *)
-
-type character = char
-(** A single character from ISO 10646. *)
-
-type charset = string
-(** A character encoding, as per RFC2045 (MIME).
- @see RFC2045 *)
-
-type charsets = charset list
-(** A space-separated list of character encodings, as per RFC2045 (MIME).
- @see RFC2045 *)
-
-type contenttype = string
-(** A media type, as per RFC2045 (MIME).
- @see RFC2045 *)
-
-type contenttypes = contenttype list
-(** A comma-separated list of media types, as per RFC2045 (MIME).
- @see RFC2045 *)
-
-type coords = string list
-(** Comma- separated list of coordinates to use in defining areas. *)
-
-type datetime = string
-(** Date and time information. *)
-
-type fpi = string
-(** A character string representing an SGML Formal Public Identifier. *)
-
-type frametarget = string
-(** Frame name used as destination for results of certain actions. *)
-
-type languagecode = string
-(** A language code, as per RFC5646/BCP47.
- @see RFC5646 *)
-
-type length = [ | `Pixels of int | `Percent of int ]
-(** The value may be either in pixels or a percentage of the available
- horizontal or vertical space. Thus, the value [`Percent 50] means half of
- the available space. *)
-
-type linktypes =
- [
- | `Alternate
- | `Archives
- | `Author
- | `Bookmark
- | `External
- | `First
- | `Help
- | `Icon
- | `Index
- | `Last
- | `License
- | `Next
- | `Nofollow
- | `Noreferrer
- | `Pingback
- | `Prefetch
- | `Prev
- | `Search
- | `Stylesheet
- | `Sidebar
- | `Tag
- | `Up
- | `Other of string ] list
-(** Authors may use the following recognized link types, listed here with
- their conventional interpretations. A LinkTypes value refers to a
- space-separated list of link types. White space characters are not
- permitted within link types. These link types are case-insensitive, i.e.,
- ["Alternate"] has the same meaning as ["alternate"].
-
- User agents, search engines, etc. may interpret these link types in a
- variety of ways. For example, user agents may provide access to linked
- documents through a navigation bar.
-
- {ul
- {- [`Alternate]:
- Gives alternate representations of the current document.}
- {- [`Archives]:
- Provides a link to a collection of records, documents, or other materials of historical interest.}
- {- [`Author]:
- Gives a link to the current document's author.}
- {- [`Bookmark]:
- Gives the permalink for the nearest ancestor section.}
- {- [`External]:
- Indicates that the referenced document is not part of the same site as the current document.}
- {- [`First]:
- Indicates that the current document is a part of a series, and that the first document in the series is the referenced document.}
- {- [`Help]:
- Provides a link to context-sensitive help.}
- {- [`Icon]:
- Imports an icon to represent the current document.}
- {- [`Index]:
- Gives a link to the document that provides a table of contents or index listing the current document.}
- {- [`Last]:
- Indicates that the current document is a part of a series, and that the last document in the series is the referenced document.}
- {- [`Licence]:
- Indicates that the main content of the current document is covered by the copyright license described by the referenced document.}
- {- [`Next]:
- Indicates that the current document is a part of a series, and that the next document in the series is the referenced document.}
- {- [`Nofollow]:
- Indicates that the current document's original author or publisher does not endorse the referenced document.}
- {- [`Noreferrer]:
- Requires that the user agent not send an HTTP Referer (sic) header if the user follows the hyperlink.}
- {- [`Pingback]:
- Gives the address of the pingback server that handles pingbacks to the current document.}
- {- [`Prefetch]:
- Specifies that the target resource should be preemptively cached.}
- {- [`Prev]:
- Indicates that the current document is a part of a series, and that the previous document in the series is the referenced document.}
- {- [`Search]:
- Gives a link to a resource that can be used to search through the current document and its related pages.}
- {- [`Stylesheet]:
- Imports a stylesheet.}
- {- [`Sidebar]:
- Specifies that the referenced document, if retrieved, is intended to be shown in the browser's sidebar (if it has one).}
- {- [`Tag]:
- Gives a tag (identified by the given address) that applies to the current document.}
- {- [`Up]:
- Provides a link to a document giving the context for the current document.}
- } *)
-
-type mediadesc =
- [
- | `All
- | `Aural
- | `Braille
- | `Embossed
- | `Handheld
- | `Print
- | `Projection
- | `Screen
- | `Speech
- | `TTY
- | `TV
- | `Raw_mediadesc of string ] list
-(** The MediaDesc attribute is a comma-separated list of media descriptors.
- The following is a list of recognized media descriptors:
- {ul
- {- [`Screen]:
- For non-paged computer screens.}
- {- [`TTY]:
- For media using a fixed-pitch character grid (like teletypes, terminals, or devices with limited display capabilities).}
- {- [`TV]:
- For TV-type devices (low resolution, limited scrollability).}
- {- [`Projection]:
- For projectors.}
- {- [`Handheld]:
- For handheld devices (small screen, limited bandwidth).}
- {- [`Print]:
- For paged and for documents viewed on screen in print preview mode.}
- {- [`Braille]:
- For braille tactile feedback devices.}
- {- [`Aural]:
- For speech synthesizers.}
- {- [`All]:
- For speech synthesizers.}
- {- [`Raw_mediadesc]:
- For more complex (untyped) media descriptors.}}
-
-*)
-
-type multilength = [ | length | `Relative of int ]
-(** The value may be a Length or a relative length. A relative length
- has the form ["i*"], where ["i"] is an integer. When allotting space
- among elements competing for that space, user agents allot pixel
- and percentage lengths first, then divide up remaining available
- space among relative lengths. Each relative length receives a
- portion of the available space that is proportional to the integer
- preceding the ["*"]. The value ["*"] is equivalent to ["1*"]. Thus, if
- 60 pixels of space are available after the user agent allots pixel
- and percentage space, and the competing relative lengths are ["1*"],
- ["2*"], and ["3*"], the ["1*"] will be allotted 10 pixels, the ["2*"] will be
- allotted 20 pixels, and the ["3*"] will be allotted 30 pixels. *)
-
-(* comma-separated *)
-type multilengths = multilength list
-(** A comma separated list of items of type MultiLength. *)
-
-type number = int
-
-(* space-separated *)
-type numbers = number list
-
-type float_number = float
-
-type pixels = int
-(** The value is an integer that represents the number of pixels of
- the canvas (screen, paper). Thus, the value ["50"] means fifty
- pixels. For normative information about the definition of a pixel,
- please consult CSS2.
- @see CSS2 *)
-
-type script_ = string
-(** Script data can be the content of the ["script"] element and the
- value of intrinsic event attributes. User agents must not evaluate
- script data as HTML markup but instead must pass it on as data to a
- script engine.
-
- The case-sensitivity of script data depends on the scripting
- language.
-
- Please note that script data that is element content may not
- contain character references, but script data that is the value of
- an attribute may contain them. *)
-
-type text = string
-(** Arbitrary textual data, likely meant to be human-readable. *)
-
-(** {2 Core} *)
-
-type i18n = [ | `XML_lang | `Lang ]
-
-type core =
- [
- | `Accesskey
- | `Class
- | `Contenteditable
- | `Contextmenu
- | `Dir
- | `Draggable
- | `Hidden
- | `Id
- | i18n
- | `Spellcheck
- | `Style_Attr
- | `Tabindex
- | `Title
- | `User_data
- | `XMLns
- ]
-
-(** {2 Events} *)
-
-(** Javascript events *)
-type events =
- [
- | `OnAbort
- | `OnBlur
- | `OnCanPlay
- | `OnCanPlayThrough
- | `OnChange
- | `OnClick
- | `OnContextMenu
- | `OnDblClick
- | `OnDrag
- | `OnDragEnd
- | `OnDragEnter
- | `OnDragLeave
- | `OnDragOver
- | `OnDragStart
- | `OnDrop
- | `OnDurationChange
- | `OnEmptied
- | `OnEnded
- | `OnError
- | `OnFocus
- | `OnFormChange
- | `OnFormInput
- | `OnInput
- | `OnInvalid
- | `OnMouseDown
- | `OnMouseUp
- | `OnMouseOver
- | `OnMouseMove
- | `OnMouseOut
- | `OnMouseWheel
- | `OnPause
- | `OnPlay
- | `OnPlaying
- | `OnProgress
- | `OnRateChange
- | `OnReadyStateChange
- | `OnScroll
- | `OnSeeked
- | `OnSeeking
- | `OnSelect
- | `OnShow
- | `OnStalled
- | `OnSubmit
- | `OnSuspend
- | `OnTimeUpdate
- | `OnVolumeChange
- | `OnWaiting
- | `OnKeyPress
- | `OnKeyDown
- | `OnKeyUp
- | `OnLoad
- | `OnLoadedData
- | `OnLoadedMetaData
- | `OnLoadStart
- ]
-
-(** Common attributes *)
-type common = [ | core | i18n | events ]
-
-(** {1 Categegories of HTML5 elements} *)
-(** These category are mainly subdivised in
- - interactive,
- - phrasing,
- - flow5,
- these categories may overlap *)
-type heading = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 | `Hgroup ]
-
-type sectioning = [ | `Section | `Nav | `Aside | `Article ]
-
-type resetable = [ | `Textarea | `Select | `Output | `Keygen | `Input ]
-
-type submitable = [ | `Textarea | `Select | `Keygen | `Input | `Button ]
-
-type labelable = [ | resetable | `Progress | `Meter | `Button ]
-
-type labelable_without_interactive = [ `Progress | `Meter]
-
-type formatblock =
- [
- | heading
- | sectioning
- | `Pre
- | `P
- | `Header
- | `Footer
- | `Div
- | `Blockquote
- | `Address
- ]
-
-type sectionningroot =
- [ | `Td | `Figure | `Fieldset | `Details | `Body | `Blockquote
- ]
-
-type listed = [ | resetable | submitable | `Fieldset ]
-
-type formassociated = [ | listed | `Progress | `Meter | `Label ]
-
-
-(** Transparent elements.
- Such elements have a part of they children in their dataconsigor,
- and behaves like them. We could do something like [=a: 'a elt list -> 'a elt]
- but the information about the node name would be forgotten and would allow
- things like that : [=p [a [a []]]].
- This system allow to build non-conforming terms such as [a [a []]] but when passed
- to a standard element (such as [p]), it will yield an error.
- Exception to that : if you embdedd the element in another transparent (of an
- another kind) : [p [noscript (a [a []])]] will be correctly typed.
-*)
-type (+'interactive, +'noscript, +'regular, +'media) transparent =
- [
- | `A of 'interactive
- | `Noscript of 'noscript
- | `Canvas of 'regular
- | `Map of 'regular
- | `Ins of 'regular
- | `Del of 'regular
- | `Object of 'regular
- | `Object_interactive of 'regular
- | `Audio_interactive of 'media
- | `Video_interactive of 'media
- | `Audio of 'media
- | `Video of 'media
- ]
-(* _interactive variants are not used for now *)
-type (+'noscript, +'regular, +'media) transparent_without_interactive =
- [
- | `Noscript of 'noscript
- | `Ins of 'regular
- | `Del of 'regular
- | `Object of 'regular
- | `Canvas of 'regular
- | `Map of 'regular
- | `Audio of 'media
- | `Video of 'media
- ]
-
-type (+'interactive, +'regular, +'media) transparent_without_noscript =
- [
- | `A of 'interactive
- | `Ins of 'regular
- | `Del of 'regular
- | `Canvas of 'regular
- | `Map of 'regular
- | `Object of 'regular
- | `Object_interactive of 'regular
- | `Video of 'media
- | `Audio of 'media
- | `Video_interactive of 'media
- | `Audio_interactive of 'media
- ]
-
-type (+'interactive, +'noscript, +'regular) transparent_without_media =
- [
- | `A of 'interactive
- | `Noscript of 'noscript
- | `Ins of 'regular
- | `Del of 'regular
- | `Map of 'regular
- | `Canvas of 'regular
- | `Object of 'regular
- | `Object_interactive of 'regular
- ]
-
-(** Metadata without title *)
-type metadata_without_title =
- [
- | `Style
- | `Script
- | `Noscript of [ | `Meta | `Link | `Style ]
- | `Meta
- | `Link
- | `Command
- | `Base
- ]
-
-(** Metadata contents. Used specially in *)
-type metadata = [ | metadata_without_title | `Title ]
-
-(** Interactive contents : contents that require user-interaction
- (Forms, link, etc.) *)
-(** Core element types are element types without transparent. *)
-type core_interactive =
- [
- | `Textarea
- | `Select
- | `Menu
- | `Label
- | `Keygen
- | `Input
- | `Img_interactive
- | `Iframe
- | `Embed
- | `Details
- | `Button
- ]
-
-type interactive =
- [
- core_interactive | (interactive, interactive, interactive) transparent_without_interactive
- ]
-
-(** Phrasing contents is inline contents : bold text, span, and so on. *)
-type core_phrasing =
- [
- | labelable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Svg
- | `Time
- | `Sup
- | `Sub
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Label
- | `Kbd
- | `Iframe
- | `I
- | `Embed
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `Img | `Img_interactive
- | `PCDATA
- ]
-
-type core_phrasing_without_noscript =
- [
- | labelable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Time
- | `Sup
- | `Sub
- | `Svg
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Label
- | `Kbd
- | `Iframe
- | `I
- | `Embed
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `Img | `Img_interactive
- | `B
- | `Abbr
- | `PCDATA
- ]
-type core_phrasing_without_interactive =
- [
- | labelable_without_interactive
- | `Wbr
- | `Var
- | `U
- | `Img
- | `Time
- | `Sup
- | `Sub
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Svg
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Kbd
- | `Img
- | `I
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- ]
-
-type core_phrasing_without_media =
- [
- | labelable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Time
- | `Svg
- | `Sup
- | `Sub
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Label
- | `Kbd
- | `Img | `Img_interactive
- | `Iframe
- | `I
- | `Embed
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- ]
-
-type phrasing_without_noscript =
- (phrasing_without_interactive,
- phrasing,
- phrasing_without_media) transparent_without_noscript
-
-and phrasing_without_media =
- [
- | core_phrasing_without_media
- | (phrasing_without_interactive, phrasing_without_noscript, phrasing)
- transparent_without_media
- ]
-
-
-and phrasing_without_interactive =
- [
- | core_phrasing_without_interactive
- | (phrasing_without_noscript, phrasing, phrasing_without_media)
- transparent_without_interactive
- ]
-
-and phrasing =
- [
- | (phrasing_without_interactive, phrasing_without_noscript, phrasing,
- phrasing_without_media) transparent
- | core_phrasing
- ]
-
-type (+'a, +'b) between_phrasing_and_phrasing_without_interactive =
- ( [< core_phrasing
- | ([< phrasing_without_interactive] as 'b,
- phrasing_without_noscript,
- phrasing,
- phrasing_without_media) transparent
- > `Abbr `B `Bdo `Br `Canvas `Cite `Code `Command
- `Datalist `Del `Dfn `Em `I `Img `Ins `Kbd `Map `Mark `Meter
- `Noscript `Object `PCDATA `Progress `Q `Ruby `Samp `Script
- `Small `Span `Strong `Sub `Sup `Svg `Time `U `Var `Wbr ] as 'a)
-
-(** Phrasing without the interactive markups *)
-type phrasing_without_dfn =
- [
- | labelable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Time
- | `Sup
- | `Sub
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Label
- | `Img | `Img_interactive
- | `Kbd
- | `I
- | `Em
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- | (phrasing_without_interactive, phrasing_without_noscript,
- phrasing_without_dfn, phrasing_without_media) transparent
- ]
-
-type phrasing_without_label =
- [
- | labelable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Time
- | `Sup
- | `Sub
- | `Strong
- | `Span
- | `Img | `Img_interactive
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Kbd
- | `I
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- | (phrasing_without_interactive, phrasing_without_noscript,
- phrasing_without_label, phrasing_without_media) transparent
- ]
-
-type phrasing_without_progress =
- [
- | resetable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Time
- | `Sup
- | `Sub
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Img | `Img_interactive
- | `Ruby
- | `Q
- | `Meter
- | `Mark
- | `Label
- | `Kbd
- | `I
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Button
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- | (phrasing_without_interactive, phrasing_without_noscript,
- phrasing_without_progress, phrasing_without_media) transparent
- ]
-
-type phrasing_without_time =
- [
- | labelable
- | submitable
- | `Wbr
- | `Var
- | `U
- | `Sup
- | `Sub
- | `Strong
- | `Img | `Img_interactive
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Label
- | `Kbd
- | `I
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- | (phrasing_without_interactive, phrasing_without_noscript,
- phrasing_without_time, phrasing_without_media) transparent
- ]
-
-type phrasing_without_meter =
- [
- | submitable
- | resetable
- | `Progress
- | `Button
- | `Wbr
- | `Var
- | `U
- | `Time
- | `Sup
- | `Img | `Img_interactive
- | `Sub
- | `Strong
- | `Span
- | `Small
- | `Script
- | `Samp
- | `Ruby
- | `Q
- | `Mark
- | `Label
- | `Kbd
- | `I
- | `Em
- | `Dfn
- | `Datalist
- | `Command
- | `Code
- | `Cite
- | `Br
- | `Bdo
- | `B
- | `Abbr
- | `PCDATA
- | (phrasing_without_interactive, phrasing_without_noscript,
- phrasing_without_meter, phrasing_without_media) transparent
- ]
-
-type core_flow5 =
- [
- | core_phrasing
- | formassociated
- | formatblock
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | `Details
- ]
-
-type core_flow5_without_interactive =
- [
- | core_phrasing_without_interactive
- | formassociated
- | formatblock
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- ]
-
-type core_flow5_without_noscript =
- [
- | core_phrasing_without_noscript
- | formassociated
- | formatblock
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | `Details
- ]
-type core_flow5_without_media =
- [
- | core_phrasing_without_media
- | formassociated
- | formatblock
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | `Details
-
- ]
-
-type flow5_without_interactive =
- [
- core_flow5_without_interactive
- | (flow5_without_noscript, flow5, flow5_without_media)
- transparent_without_interactive
- ]
-
-and flow5_without_noscript =
- [ | core_flow5_without_noscript
- | (flow5_without_interactive,
- flow5,
- flow5_without_media) transparent_without_noscript
- ]
-
-and flow5_without_media =
- [ core_flow5_without_media
- | (flow5_without_interactive,
- flow5_without_noscript,
- flow5) transparent_without_media ]
-and flow5 =
- [
- | core_flow5
- | (flow5_without_interactive, flow5_without_noscript, flow5,
- flow5_without_media) transparent
- ]
-
-type flow5_without_table =
- [
- | core_phrasing
- | formassociated
- | formatblock
- | `Ul
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | `Details
- | (flow5_without_interactive, flow5_without_noscript, flow5,
- flow5_without_media) transparent
- ]
-
-type flow5_without_interactive_header_footer =
- [
- | heading
- | sectioning
- | `Pre
- | `P
- | `Div
- | `Blockquote
- | `Address
- | core_phrasing_without_interactive
- | formassociated
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | (flow5_without_noscript, flow5, flow5_without_media)
- transparent_without_interactive
- ]
-
-type flow5_without_header_footer =
- [
- | heading
- | sectioning
- | `Pre
- | `P
- | `Div
- | `Blockquote
- | `Address
- | core_phrasing
- | formassociated
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | `Details
- | (flow5_without_interactive_header_footer,
- flow5_without_noscript, flow5,
- flow5_without_media) transparent
- ]
-
-type +'a between_flow5_and_flow5_without_interactive_header_footer =
- [< flow5 > `Abbr `Address `Article `Aside `Audio `B `Bdo `Blockquote `Br
- `Button `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Div `Dl `Em
- `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img
- `Input `Ins `Kbd `Keygen `Label `Map`Mark `Menu `Meter `Nav `Noscript
- `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script
- `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table
- `Textarea `Time `U `Ul `Var `Video `Wbr] as 'a
-
-type (+'a, +'b) between_flow5_and_flow5_without_header_footer =
- [< core_flow5
- | ([< flow5_without_interactive ] as 'b,
- flow5_without_noscript, 'a,
- flow5_without_media)
- transparent
- > `A `Abbr `Address `Article `Aside `Audio `Audio_interactive `B
- `Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command
- `Datalist `Del `Details `Dfn `Div `Dl `Em `Embed `Fieldset
- `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Iframe
- `Img `Img_interactive `Input `Ins `Kbd `Keygen `Label `Map
- `Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive
- `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script
- `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg
- `Table `Textarea `Time `U `Ul `Var `Video `Video_interactive
- `Wbr ] as 'a
-
-type flow5_without_form =
- [
- | core_phrasing
- | formassociated
- | formatblock
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Figure
- | `Dl
- | `Details
- | (flow5_without_interactive, flow5_without_noscript, flow5,
- flow5_without_media) transparent
- ]
-
-type flow5_without_sectioning_heading_header_footer_address =
- [
- | core_phrasing
- | formassociated
- | `Pre
- | `P
- | `Div
- | `Blockquote
- | `Ul
- | `Table
- | `Style
- | `Ol
- | `Menu
- | `Hr
- | `Form
- | `Figure
- | `Dl
- | `Details
- | (flow5_without_interactive, flow5_without_noscript, flow5,
- flow5_without_media) transparent
- ]
-
-(*
- Type for HTML5 for elements
-*)
-type pcdata = [ | `PCDATA ]
-
-type notag
-
-type no_attribute_allowed
-
-type noattrib = [ `No_attribute_allowed of no_attribute_allowed ]
-
-type html = [ | `Html ]
-
-type html_content_fun = [ | `Head | `Body ]
-
-type html_content = html_content_fun
-
-type html_attrib = [ | common | `Manifest ]
-
-type head = [ | `Head ]
-
-type head_content = [ | metadata ]
-
-type head_content_fun = [ | metadata_without_title ]
-
-type head_attrib = [ | common ]
-
-type body = [ | `Body ]
-
-type body_attrib =
- [
- | common
- | `OnAfterPrint
- | `OnBeforePrint
- | `OneBeforeUnload
- | `OnHashChange
- | `OnMessage
- | `OnOffLine
- | `OnOnLine
- | `OnPageHide
- | `OnPageShow
- | `OnPopState
- | `OnRedo
- | `OnResize
- | `OnStorage
- | `OnUndo
- | `OnUnload
- ]
-
-type body_content = flow5
-
-type body_content_fun = flow5
-
-
-type svg = [ `Svg ]
-type svg_content = Svg_types.svg_content
-type svg_attrib = Svg_types.svg_attr
-(* NAME: base, KIND: nullary, TYPE: [= common | `Href | `Target], [= `Base ], ARG: notag, ATTRIB: OUT: [= `Base ] *)
-type base = [ | `Base ]
-
-type base_content = notag
-
-type base_content_fun = notag
-
-type base_attrib = [ | common | `Href | `Target ]
-
-type title = [ | `Title ]
-
-type title_content = [ | `PCDATA ]
-
-type title_content_fun = [ | `PCDATA ]
-
-type title_attrib = noattrib
-
-(* NAME: footer, KIND: star, TYPE: [= common ], [= flow5_without_header_footer ], [=`Footer], ARG: [= flow5_without_header_footer ], ATTRIB: OUT: [=`Footer] *)
-type footer = [ | `Footer ]
-
-type footer_content = [ | flow5_without_header_footer ]
-
-type footer_content_fun = [ | flow5_without_header_footer ]
-
-type footer_attrib = [ | common ]
-
-(* NAME: header, KIND: star, TYPE: [= common ], [= flow5_without_header_footer ], [=`Header], ARG: [= flow5_without_header_footer ], ATTRIB: OUT: [=`Header] *)
-type header = [ | `Header ]
-
-type header_content = [ | flow5_without_header_footer ]
-
-type header_content_fun = [ | flow5_without_header_footer ]
-
-type header_attrib = [ | common ]
-
-(* NAME: section, KIND: star, TYPE: [= common ], [= flow5 ], [=`Section], ARG: [= flow5 ], ATTRIB: OUT: [=`Section] *)
-type section = [ | `Section ]
-
-type section_content = [ | flow5 ]
-
-type section_content_fun = [ | flow5 ]
-
-type section_attrib = [ | common ]
-
-(* NAME: nav, KIND: star, TYPE: [= common ], [= flow5 ], [=`Nav], ARG: [= flow5 ], ATTRIB: OUT: [=`Nav] *)
-type nav = [ | `Nav ]
-
-type nav_content = [ | flow5 ]
-
-type nav_content_fun = [ | flow5 ]
-
-type nav_attrib = [ | common ]
-
-(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H1], ARG: [= phrasing ], ATTRIB: OUT: [=`H1] *)
-type h1 = [ | `H1 ]
-
-type h1_content = [ | phrasing ]
-
-type h1_content_fun = [ | phrasing ]
-
-type h1_attrib = [ | common ]
-
-(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H2], ARG: [= phrasing ], ATTRIB: OUT: [=`H2] *)
-type h2 = [ | `H2 ]
-
-type h2_content = [ | phrasing ]
-
-type h2_content_fun = [ | phrasing ]
-
-type h2_attrib = [ | common ]
-
-(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H3], ARG: [= phrasing ], ATTRIB: OUT: [=`H3] *)
-type h3 = [ | `H3 ]
-
-type h3_content = [ | phrasing ]
-
-type h3_content_fun = [ | phrasing ]
-
-type h3_attrib = [ | common ]
-
-(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H4], ARG: [= phrasing ], ATTRIB: OUT: [=`H4] *)
-type h4 = [ | `H4 ]
-
-type h4_content = [ | phrasing ]
-
-type h4_content_fun = [ | phrasing ]
-
-type h4_attrib = [ | common ]
-
-(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H5], ARG: [= phrasing ], ATTRIB: OUT: [=`H5] *)
-type h5 = [ | `H5 ]
-
-type h5_content = [ | phrasing ]
-
-type h5_content_fun = [ | phrasing ]
-
-type h5_attrib = [ | common ]
-
-(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H6], ARG: [= phrasing ], ATTRIB: OUT: [=`H6] *)
-type h6 = [ | `H6 ]
-
-type h6_content = [ | phrasing ]
-
-type h6_content_fun = [ | phrasing ]
-
-type h6_attrib = [ | common ]
-
-(* NAME: hgroup, KIND: plus, TYPE: [= common ], [= `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ], [=`Hgroup], ARG: [= `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ], ATTRIB: OUT: [=`Hgroup] *)
-type hgroup = [ | `Hgroup ]
-
-type hgroup_content = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ]
-
-type hgroup_content_fun = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ]
-
-type hgroup_attrib = [ | common ]
-
-(* NAME: address, KIND: star, TYPE: [= common ], [= flow5_without_sectioning_heading_header_footer_address ], [=`Address], ARG: [= flow5_without_sectioning_heading_header_footer_address ], ATTRIB: OUT: [=`Address] *)
-type address = [ | `Address ]
-
-type address_content =
- [ | flow5_without_sectioning_heading_header_footer_address
- ]
-
-type address_content_fun =
- [ | flow5_without_sectioning_heading_header_footer_address
- ]
-
-type address_attrib = [ | common ]
-
-(* NAME: article, KIND: star, TYPE: [= common ], [= flow5 ], [=`Article], ARG: [= flow5 ], ATTRIB: OUT: [=`Article] *)
-type article = [ | `Article ]
-
-type article_content = [ | flow5 ]
-
-type article_content_fun = [ | flow5 ]
-
-type article_attrib = [ | common ]
-
-(* NAME: aside, KIND: star, TYPE: [= common ], [= flow5 ], [=`Aside], ARG: [= flow5 ], ATTRIB: OUT: [=`Aside] *)
-type aside = [ | `Aside ]
-
-type aside_content = [ | flow5 ]
-
-type aside_content_fun = [ | flow5 ]
-
-type aside_attrib = [ | common ]
-
-(* NAME: p, KIND: star, TYPE: [= common ], [=phrasing ], [=`P], ARG: [=phrasing ], ATTRIB: OUT: [=`P] *)
-type p = [ | `P ]
-
-type p_content = [ | phrasing ]
-
-type p_content_fun = [ | phrasing ]
-
-type p_attrib = [ | common ]
-
-(* NAME: pre, KIND: star, TYPE: [= common ],[= phrasing ], [=`Pre], ARG: [= phrasing ], ATTRIB: OUT: [=`Pre] *)
-type pre = [ | `Pre ]
-
-type pre_content = [ | phrasing ]
-
-type pre_content_fun = [ | phrasing ]
-
-type pre_attrib = [ | common ]
-
-(* NAME: blockquote, KIND: star, TYPE: [= common | `Cite ],[= flow5 ], [=`Blockquote], ARG: [= flow5 ], ATTRIB: OUT: [=`Blockquote] *)
-type blockquote = [ | `Blockquote ]
-
-type blockquote_content = [ | flow5 ]
-
-type blockquote_content_fun = [ | flow5 ]
-
-type blockquote_attrib = [ | common | `Cite ]
-
-(* NAME: div, KIND: star, TYPE: [= common ], [= flow5 ], [=`Div], ARG: [= flow5 ], ATTRIB: OUT: [=`Div] *)
-type div = [ | `Div ]
-
-type div_content = [ | flow5 ]
-
-type div_content_fun = [ | flow5 ]
-
-type div_attrib = [ | common ]
-
-(* NAME: ol, KIND: star, TYPE: [= common | `Reserved |`Start ], [= `Li of [= common | `Int_Value ]], [=`Ol], ARG: [= `Li of [= common | `Int_Value ]], ATTRIB: OUT: [=`Ol] *)
-type ol = [ | `Ol ]
-
-type ol_content = [ | `Li of [ | common | `Int_Value ] ]
-
-type ol_content_fun = [ | `Li of [ | common | `Int_Value ] ]
-
-type ol_attrib = [ | common | `Reversed | `Start ]
-
-(* NAME: li, KIND: star, TYPE: [= common | `Int_Value] as 'a, [=flow5 ], [=`Li of 'a], ARG: [=flow5 ], ATTRIB: OUT: [=`Li of 'a] *)
-type li_content = [ | flow5 ]
-
-type li_content_fun = [ | flow5 ]
-
-type li_attrib = [ | common | `Int_Value ]
-
-type li = [ | `Li of li_attrib ]
-(* NAME: ul, KIND: star, TYPE: [= common ], [= `Li of [= common] ], [=`Ul], ARG: [= `Li of [= common] ], ATTRIB: OUT: [=`Ul] *)
-type ul = [ | `Ul ]
-
-type ul_content = [ | `Li of [ | li_attrib ] ]
-
-type ul_content_fun = [ | `Li of [ | li_attrib ] ]
-
-type ul_attrib = [ | common ]
-
-(* NAME: dd, KIND: star, TYPE: [= common ], [= flow5 ], [=`Dd], ARG: [= flow5 ], ATTRIB: OUT: [=`Dd] *)
-type dd = [ | `Dd ]
-
-type dd_content = [ | flow5 ]
-
-type dd_content_fun = [ | flow5 ]
-
-type dd_attrib = [ | common ]
-
-(* NAME: dt, KIND: star, TYPE: [= common ], [= phrasing], [=`Dt], ARG: [= phrasing], ATTRIB: OUT: [=`Dt] *)
-type dt = [ | `Dt ]
-
-type dt_content = [ | phrasing ]
-
-type dt_content_fun = [ | phrasing ]
-
-type dt_attrib = [ | common ]
-
-
-type dl = [ | `Dl ]
-
-type dl_content = [ | `Dt | `Dd ]
-
-type dl_content_fun = [ | `Dt | `Dd ]
-
-type dl_attrib = [ | common ]
-
-
-(* NAME: figcaption, KIND: star, TYPE: [= common ], [= flow5], [=`Figcaption], ARG: [= flow5], ATTRIB: OUT: [=`Figcaption] *)
-type figcaption = [ | `Figcaption ]
-
-type figcaption_content = [ | flow5 ]
-
-type figcaption_content_fun = [ | flow5 ]
-
-type figcaption_attrib = [ | common ]
-
-
-(* figure *)
-type figure = [ | `Figure ]
-
-type figure_content = [ | flow5 ]
-
-type figure_content_fun = [ | flow5 ]
-
-type figure_attrib = [ | common ]
-
-
-(* Rp, Rt and ruby *)
-type rp = [ | `Rp ]
-type rp_content = [ | phrasing ]
-type rp_content_fun = [ | phrasing ]
-type rp_attrib = [ | common ]
-
-type rt = [ | `Rt ]
-type rt_content = [ | phrasing ]
-type rt_content_fun = [ | phrasing ]
-type rt_attrib = [ | common ]
-
-type ruby = [ | `Ruby ]
-type ruby_content = [ | phrasing | rp | rt ]
-type ruby_content_fun = [ | phrasing | rp | rt ]
-type ruby_attrib = [ | common ]
-
-
-(* NAME: hr, KIND: nullary, TYPE: [= common ], [=`Hr], ARG: notag, ATTRIB: OUT: [=`Hr] *)
-type hr = [ | `Hr ]
-
-type hr_content = notag
-
-type hr_content_fun = notag
-
-type hr_attrib = [ | common ]
-
-(* NAME: b, KIND: star, TYPE: [= common ], [= phrasing ], [=`B], ARG: [= phrasing ], ATTRIB: OUT: [=`B] *)
-type b = [ | `B ]
-
-type b_content = [ | phrasing ]
-
-type b_content_fun = [ | phrasing ]
-
-type b_attrib = [ | common ]
-
-(* NAME: i, KIND: star, TYPE: [= common ], [= phrasing ], [=`I], ARG: [= phrasing ], ATTRIB: OUT: [=`I] *)
-type i = [ | `I ]
-
-type i_content = [ | phrasing ]
-
-type i_content_fun = [ | phrasing ]
-
-type i_attrib = [ | common ]
-
-(* NAME: u, KIND: star, TYPE: [= common ], [= phrasing ], [=`U], ARG: [= phrasing ], ATTRIB: OUT: [=`U] *)
-type u = [ | `U ]
-
-type u_content = [ | phrasing ]
-
-type u_content_fun = [ | phrasing ]
-
-type u_attrib = [ | common ]
-
-(* NAME: small, KIND: star, TYPE: [= common ], [= phrasing ], [=`Small], ARG: [= phrasing ], ATTRIB: OUT: [=`Small] *)
-type small = [ | `Small ]
-
-type small_content = [ | phrasing ]
-
-type small_content_fun = [ | phrasing ]
-
-type small_attrib = [ | common ]
-
-(* NAME: sub, KIND: star, TYPE: [= common ], [= phrasing ], [=`Sub], ARG: [= phrasing ], ATTRIB: OUT: [=`Sub] *)
-type sub = [ | `Sub ]
-
-type sub_content = [ | phrasing ]
-
-type sub_content_fun = [ | phrasing ]
-
-type sub_attrib = [ | common ]
-
-(* NAME: sup, KIND: star, TYPE: [= common ], [= phrasing ], [=`Sup], ARG: [= phrasing ], ATTRIB: OUT: [=`Sup] *)
-type sup = [ | `Sup ]
-
-type sup_content = [ | phrasing ]
-
-type sup_content_fun = [ | phrasing ]
-
-type sup_attrib = [ | common ]
-
-(* NAME: mark, KIND: star, TYPE: [= common ],[= phrasing ],[= `Mark ], ARG: [= phrasing ], ATTRIB: OUT: [= `Mark ] *)
-type mark = [ | `Mark ]
-
-type mark_content = [ | phrasing ]
-
-type mark_content_fun = [ | phrasing ]
-
-type mark_attrib = [ | common ]
-
-(* NAME: wbr, KIND: nullary, TYPE: [= common ],[= `Wbr ], ARG: notag, ATTRIB: OUT: [= `Wbr ] *)
-type wbr = [ | `Wbr ]
-
-type wbr_content = notag
-
-type wbr_content_fun = notag
-
-type wbr_attrib = [ | common ]
-
-(* NAME: bdo, KIND: star, TYPE: [= common ],[= phrasing ],[= `Bdo ], ARG: [= phrasing ], ATTRIB: OUT: [= `Bdo ] *)
-type bdo = [ | `Bdo ]
-
-type bdo_content = [ | phrasing ]
-
-type bdo_content_fun = [ | phrasing ]
-
-type bdo_attrib = [ | common ]
-
-(* NAME: abbr, KIND: star, TYPE: [= common ], [=phrasing ], [=`Abbr], ARG: [=phrasing ], ATTRIB: OUT: [=`Abbr] *)
-type abbr = [ | `Abbr ]
-
-type abbr_content = [ | phrasing ]
-
-type abbr_content_fun = [ | phrasing ]
-
-type abbr_attrib = [ | common ]
-
-(* NAME: br, KIND: nullary, TYPE: [= common ], [=`Br], ARG: notag, ATTRIB: OUT: [=`Br] *)
-type br = [ | `Br ]
-
-type br_content = notag
-
-type br_content_fun = notag
-
-type br_attrib = [ | common ]
-
-(* NAME: cite, KIND: star, TYPE: [= common ], [= phrasing ], [=`Cite], ARG: [= phrasing ], ATTRIB: OUT: [=`Cite] *)
-type cite = [ | `Cite ]
-
-type cite_content = [ | phrasing ]
-
-type cite_content_fun = [ | phrasing ]
-
-type cite_attrib = [ | common ]
-
-(* NAME: code, KIND: star, TYPE: [= common ], [= phrasing ], [=`Code], ARG: [= phrasing ], ATTRIB: OUT: [=`Code] *)
-type code = [ | `Code ]
-
-type code_content = [ | phrasing ]
-
-type code_content_fun = [ | phrasing ]
-
-type code_attrib = [ | common ]
-
-(* NAME: dfn, KIND: star, TYPE: [= common ], [= phrasing_without_dfn ], [=`Dfn], ARG: [= phrasing_without_dfn ], ATTRIB: OUT: [=`Dfn] *)
-type dfn = [ | `Dfn ]
-
-type dfn_content = [ | phrasing_without_dfn ]
-
-type dfn_content_fun = [ | phrasing_without_dfn ]
-
-type dfn_attrib = [ | common ]
-
-(* NAME: em, KIND: star, TYPE: [= common ], [= phrasing ], [=`Em], ARG: [= phrasing ], ATTRIB: OUT: [=`Em] *)
-type em = [ | `Em ]
-
-type em_content = [ | phrasing ]
-
-type em_content_fun = [ | phrasing ]
-
-type em_attrib = [ | common ]
-
-(* NAME: kbd, KIND: star, TYPE: [= common ], [= phrasing ], [=`Kbd], ARG: [= phrasing ], ATTRIB: OUT: [=`Kbd] *)
-type kbd = [ | `Kbd ]
-
-type kbd_content = [ | phrasing ]
-
-type kbd_content_fun = [ | phrasing ]
-
-type kbd_attrib = [ | common ]
-
-(* NAME: q, KIND: star, TYPE: [= common | `Cite ], [= phrasing ], [=`Q], ARG: [= phrasing ], ATTRIB: OUT: [=`Q] *)
-type q = [ | `Q ]
-
-type q_content = [ | phrasing ]
-
-type q_content_fun = [ | phrasing ]
-
-type q_attrib = [ | common | `Cite ]
-
-(* NAME: samp, KIND: star, TYPE: [= common ], [= phrasing ], [=`Samp], ARG: [= phrasing ], ATTRIB: OUT: [=`Samp] *)
-type samp = [ | `Samp ]
-
-type samp_content = [ | phrasing ]
-
-type samp_content_fun = [ | phrasing ]
-
-type samp_attrib = [ | common ]
-
-(* NAME: span, KIND: star, TYPE: [= common ], [= phrasing ], [=`Span], ARG: [= phrasing ], ATTRIB: OUT: [=`Span] *)
-type span = [ | `Span ]
-
-type span_content = [ | phrasing ]
-
-type span_content_fun = [ | phrasing ]
-
-type span_attrib = [ | common ]
-
-(* NAME: strong, KIND: star, TYPE: [= common ], [= phrasing ], [=`Strong], ARG: [= phrasing ], ATTRIB: OUT: [=`Strong] *)
-type strong = [ | `Strong ]
-
-type strong_content = [ | phrasing ]
-
-type strong_content_fun = [ | phrasing ]
-
-type strong_attrib = [ | common ]
-
-(* NAME: time, KIND: star, TYPE: [= common |`Datetime |`Pubdate], [= phrasing_without_time ], [=`Time], ARG: [= phrasing_without_time ], ATTRIB: OUT: [=`Time] *)
-type time = [ | `Time ]
-
-type time_content = [ | phrasing_without_time ]
-
-type time_content_fun = [ | phrasing_without_time ]
-
-type time_attrib = [ | common | `Datetime | `Pubdate ]
-
-(* NAME: var, KIND: star, TYPE: [= common ], [= phrasing ], [=`Var], ARG: [= phrasing ], ATTRIB: OUT: [=`Var] *)
-type var = [ | `Var ]
-
-type var_content = [ | phrasing ]
-
-type var_content_fun = [ | phrasing ]
-
-type var_attrib = [ | common ]
-
-(* NAME: a, KIND: star, TYPE: [= common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type ], 'a, [= `A of 'a ], ARG: 'a, ATTRIB: OUT: [= `A of 'a ] *)
-type a_content = flow5_without_interactive
-
-type a_content_fun = flow5_without_interactive
-
-type 'a a = [ | `A of 'a ]
-type a_ = [ `A of a_content ] (* should not be used as it may break *)
-type a_attrib =
- [ | common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type
- | `Download
- ]
-
-(* NAME: del, KIND: star, TYPE: [= common | `Cite | `Datetime ], 'a,[=`Del of 'a], ARG: 'a, ATTRIB: OUT: [=`Del of 'a] *)
-type 'a del = [ | `Del of 'a ]
-type del_content = flow5
-type del_ = del_content del
-type del_content_fun = flow5
-
-type del_attrib = [ | common | `Cite | `Datetime ]
-
-(* NAME: ins, KIND: star, TYPE: [= common | `Cite | `Datetime ],'a ,[=`Ins of 'a], ARG: 'a , ATTRIB: OUT: [=`Ins of 'a] *)
-type 'a ins = [ | `Ins of 'a ]
-
-type ins_content = flow5
-type ins_ = ins_content ins
-type ins_content_fun = flow5
-
-type ins_attrib = [ | common | `Cite | `Datetime ]
-
-(* NAME: iframe, KIND: ndbox, TYPE: *| `Srcdoc*, ARG: , ATTRIB: OUT: *)
-type iframe = [ | `Iframe ]
-
-type iframe_content = [ | `PCDATA ]
-
-type iframe_content_fun = [ | `PCDATA ]
-
-type iframe_attrib =
- [
- | common
- | `Src
- | (*| `Srcdoc*)
- `Name
- | `Sandbox
- | `Seamless
- | `Width
- | `Height
- ]
-
-type object__content = [ | flow5 | `Param ]
-
-type object__content_fun = flow5
-
-type 'a object_ = [ | `Object of 'a | `Object_interactive of 'a]
-type object__ = object__content object_
-type object__attrib =
- [
- | common
- | `Data
- | `Form
- | `Mime_type
- | `Height
- | `Width
- | `Name
- | `Usemap
- ]
-
-(* NAME: param, KIND: nullary, TYPE: [= common | `Name | `Text_Value ],[= `Param ], ARG: notag, ATTRIB: OUT: [= `Param ] *)
-type param = [ | `Param ]
-
-type param_content = notag
-
-type param_content_fun = notag
-
-type param_attrib = [ | common | `Name | `Text_Value ]
-
-(* NAME: embed, KIND: nullary, TYPE: [= common | `Src | `Height | `Mime_type | `Width], [=`Embed], ARG: notag, ATTRIB: OUT: [=`Embed] *)
-type embed = [ | `Embed ]
-
-type embed_content = notag
-
-type embed_content_fun = notag
-
-type embed_attrib = [ | common | `Src | `Height | `Mime_type | `Width ]
-
-
-type img = [ `Img ]
-type img_interactive = [ `Img | `Img_interactive ]
-type img_content = notag
-type img_content_fun = notag
-type img_attrib = [ | common | `Height | `Ismap | `Width]
-
-(* Attributes used by audio and video. *)
-type media_attrib =
- [ | `Crossorigin
- | `Preload
- | `Autoplay
- | `Mediagroup
- | `Loop
- | `Muted
- | `Controls
- ]
-
-type 'a audio = [ | `Audio of 'a ]
-type 'a audio_interactive = [ | `Audio of 'a | `Audio_interactive of 'a ]
-
-type audio_content = flow5_without_media
-type audio_ = audio_content audio
-type audio_content_fun = flow5_without_media
-
-type audio_attrib =
- [ | common
- | media_attrib
- ]
-
-
-type 'a video = [ | `Video of 'a ]
-type 'a video_interactive = [ | `Video of 'a | `Video_interactive of 'a ]
-
-type video_content = flow5_without_media
-type video_ = video_content video
-type video_content_fun = flow5_without_media
-
-type video_attrib =
- [ | common
- | media_attrib
- | `Poster
- | `Width
- | `Height
- ]
-
-(* NAME: canvas, KIND: star, TYPE: [= common |`Width |`Height],'a, [=`Canvas of 'a], ARG: 'a, ATTRIB: OUT: [=`Canvas of 'a] *)
-type 'a canvas = [ | `Canvas of 'a ]
-
-type canvas_content = flow5
-type canvas_ = canvas_content canvas
-type canvas_content_fun = flow5
-
-type canvas_attrib = [ | common | `Width | `Height ]
-
-(* NAME: source, KIND: nullary, TYPE: [= common |`Src |`Mime_type |`Media ], [=`Source], ARG: notag, ATTRIB: OUT: [=`Source] *)
-type source = [ | `Source ]
-
-type source_content = notag
-
-type source_content_fun = notag
-
-type source_attrib = [ | common | `Src | `Mime_type | `Media ]
-
-(* NAME: area, KIND: nullary, TYPE: [= common | `Alt | `Coords | `Shape| `Target | `Rel | `Media| `Hreflang | `Mime_type],[=`Area], ARG: notag, ATTRIB: OUT: [=`Area] *)
-type area = [ | `Area ]
-
-type area_content = notag
-
-type area_content_fun = notag
-
-type area_attrib =
- [
- | common
- | `Alt
- | `Coords
- | `Shape
- | `Target
- | `Rel
- | `Media
- | `Hreflang
- | `Mime_type
- | `Download
- ]
-
-(* NAME: map, KIND: plus, TYPE: [=common | `Name ],'a, [=`Map of 'a], ARG: 'a, ATTRIB: OUT: [=`Map of 'a] *)
-type 'a map = [ | `Map of 'a ]
-
-type map_content = flow5
-type map_ = map_content map
-
-type map_content_fun = flow5
-
-type map_attrib = [ | common | `Name ]
-
-(* NAME: caption, KIND: star, TYPE: [= common ], [= flow5_without_table], [=`Caption], ARG: [= flow5_without_table], ATTRIB: OUT: [=`Caption] *)
-type caption = [ | `Caption ]
-
-type caption_content = [ | flow5_without_table ]
-
-type caption_content_fun = [ | flow5_without_table ]
-
-type caption_attrib = [ | common ]
-
-(* NAME: table, KIND: plus, TYPE: [= common | `Summary ], [= `Tr ], [=`Table], ARG: [= `Tr ], ATTRIB: OUT: [=`Table] *)
-type table = [ | `Table ]
-
-type table_content = [ | `Tr ]
-
-type table_content_fun = [ | `Tr ]
-
-type table_attrib = [ | common | `Summary ]
-
-(* NAME: tablex, KIND: star, TYPE: [= common | `Summary ], [= `Tbody ], [=`Table], ARG: [= `Tbody ], ATTRIB: OUT: [=`Table] *)
-type tablex = [ | `Table ]
-
-type tablex_content = [ | `Tbody ]
-
-type tablex_content_fun = [ | `Tbody ]
-
-type tablex_attrib = [ | common | `Summary ]
-
-(* NAME: colgroup, KIND: star, TYPE: [= common | `Span ],[= `Col ], [=`Colgroup], ARG: [= `Col ], ATTRIB: OUT: [=`Colgroup] *)
-type colgroup = [ | `Colgroup ]
-
-type colgroup_content = [ | `Col ]
-
-type colgroup_content_fun = [ | `Col ]
-
-type colgroup_attrib = [ | common | `Span ]
-
-(* NAME: col, KIND: nullary, TYPE: [= common | `Span], [=`Col], ARG: notag, ATTRIB: OUT: [=`Col] *)
-type col = [ | `Col ]
-
-type col_content = notag
-
-type col_content_fun = notag
-
-type col_attrib = [ | common | `Span ]
-
-(* NAME: thead, KIND: star, TYPE: [= common],[= `Tr ], [=`Thead], ARG: [= `Tr ], ATTRIB: OUT: [=`Thead] *)
-type thead = [ | `Thead ]
-
-type thead_content = [ | `Tr ]
-
-type thead_content_fun = [ | `Tr ]
-
-type thead_attrib = [ | common ]
-
-(* NAME: tbody, KIND: star, TYPE: [= common],[= `Tr ], [=`Tbody], ARG: [= `Tr ], ATTRIB: OUT: [=`Tbody] *)
-type tbody = [ | `Tbody ]
-
-type tbody_content = [ | `Tr ]
-
-type tbody_content_fun = [ | `Tr ]
-
-type tbody_attrib = [ | common ]
-
-(* NAME: tfoot, KIND: star, TYPE: [= common],[= `Tr ], [=`Tfoot], ARG: [= `Tr ], ATTRIB: OUT: [=`Tfoot] *)
-type tfoot = [ | `Tfoot ]
-
-type tfoot_content = [ | `Tr ]
-
-type tfoot_content_fun = [ | `Tr ]
-
-type tfoot_attrib = [ | common ]
-
-(* NAME: td, KIND: star, TYPE: [= common | `Colspan | `Headers | `Rowspan ], [= flow5 ], [=`Td], ARG: [= flow5 ], ATTRIB: OUT: [=`Td] *)
-type td = [ | `Td ]
-
-type td_content = [ | flow5 ]
-
-type td_content_fun = [ | flow5 ]
-
-type td_attrib = [ | common | `Colspan | `Headers | `Rowspan ]
-
-(* NAME: th, KIND: star, TYPE: [= common | `Colspan | `Headers | `Rowspan | `Scope], [= phrasing], [=`Th], ARG: [= phrasing], ATTRIB: OUT: [=`Th] *)
-type th = [ | `Th ]
-
-type th_content = [ | phrasing ]
-
-type th_content_fun = [ | phrasing ]
-
-type th_attrib = [ | common | `Colspan | `Headers | `Rowspan | `Scope ]
-
-(* NAME: tr, KIND: star, TYPE: [= common ],[= `Td | `Th ], [=`Tr], ARG: [= `Td | `Th ], ATTRIB: OUT: [=`Tr] *)
-type tr = [ | `Tr ]
-
-type tr_content = [ | `Td | `Th ]
-
-type tr_content_fun = [ | `Td | `Th ]
-
-type tr_attrib = [ | common ]
-
-(* NAME: form, KIND: plus, TYPE: [= common |`Accept_charset | `Action | `Enctype | `Method | `Name | `Target | `Autocomplete | `Novalidate ], [= flow5_without_form ], [=`Form], ARG: [= flow5_without_form ], ATTRIB: OUT: [=`Form] *)
-type form = [ | `Form ]
-
-type form_content = [ | flow5_without_form ]
-
-type form_content_fun = [ | flow5_without_form ]
-
-type form_attrib =
- [
- | common
- | `Accept_charset
- | `Action
- | `Enctype
- | `Method
- | `Name
- | `Target
- | `Autocomplete
- | `Novalidate
- ]
-
-(* NAME: fieldset, KIND: star, TYPE: [= common | `Disabled | `Form | `Name], [= flow5 ], [=`Fieldset], ARG: [= flow5 ], ATTRIB: OUT: [=`Fieldset] *)
-type fieldset = [ | `Fieldset ]
-
-type fieldset_content = [ | flow5 ]
-
-type fieldset_content_fun = [ | flow5 ]
-
-type fieldset_attrib = [ | common | `Disabled | `Form | `Name ]
-
-(* NAME: legend, KIND: star, TYPE: [= common ],[= phrasing], [=`Legend], ARG: [= phrasing], ATTRIB: OUT: [=`Legend] *)
-type legend = [ | `Legend ]
-
-type legend_content = [ | phrasing ]
-
-type legend_content_fun = [ | phrasing ]
-
-type legend_attrib = [ | common ]
-
-(* NAME: label, KIND: star, TYPE: [= common | `For | `Form ],[= phrasing_without_label], [=`Label], ARG: [= phrasing_without_label], ATTRIB: OUT: [=`Label] *)
-type label = [ | `Label ]
-
-type label_content = [ | phrasing_without_label ]
-
-type label_content_fun = [ | phrasing_without_label ]
-
-type label_attrib = [ | common | `For | `Form ]
-
-(* NAME: input, KIND: nullary, TYPE: [= input_attr ], [=`Input], ARG: notag, ATTRIB: OUT: [=`Input] *)
-type input = [ | `Input ]
-
-type input_content = notag
-
-type input_content_fun = notag
-
-type input_attrib =
- [
- | common
- | `Accept
- | `Alt
- | `Autocomplete
- | `Autofocus
- | `Checked
- | `Disabled
- | `Form
- | `Formation
- | `Formenctype
- | `Formmethod
- | `Formnovalidate
- | `Formtarget
- | `Height
- | `List
- | `Input_Max
- | `Maxlength
- | `Input_Min
- | `Multiple
- | `Name
- | `Pattern
- | `Placeholder
- | `ReadOnly
- | `Required
- | `Size
- | `Src
- | `Step
- | `Input_Type
- | `Value
- | `Width
- ]
-
-type textarea = [ | `Textarea ]
-
-type textarea_attrib =
- [
- | common
- | `Autofocus
- | `Disabled
- | `Form
- | `Maxlength
- | `Name
- | `Placeholder
- | `ReadOnly
- | `Required
- | `Wrap
- | `Rows
- | `Cols
- ]
-
-type textarea_content = [ | `PCDATA ]
-
-type textarea_content_fun = textarea_content
-
-(* NAME: button, KIND: star, TYPE: [= button_attr ], [= phrasing_without_interactive ], [=`Button], ARG: [= phrasing_without_interactive ], ATTRIB: OUT: [=`Button] *)
-type button = [ | `Button ]
-
-type button_content = [ | phrasing_without_interactive ]
-
-type button_content_fun = [ | phrasing_without_interactive ]
-
-type button_attrib =
- [
- | common
- | `Autofocus
- | `Disabled
- | `Form
- | `Formaction
- | `Formenctype
- | `Formmethod
- | `Formnovalidate
- | `Formtarget
- | `Name
- | `Text_Value
- | `Button_Type
- ]
-
-(* NAME: select, KIND: star, TYPE: [= common |`Autofocus | `Multiple | `Name | `Size | `Form | `Disabled ], [ `Optgroup | `Option ],[=`Select], ARG: [ `Optgroup | `Option ], ATTRIB: OUT: [=`Select] *)
-type select = [ | `Select ]
-
-type select_content = [ | `Optgroup | `Option ]
-
-type select_content_fun = [ | `Optgroup | `Option ]
-
-type select_attrib =
- [ | common | `Autofocus | `Multiple | `Name | `Size | `Form | `Disabled | `Required
- ]
-
-(* NAME: datalist, KIND: nullary, TYPE: [= common ], [=`Datalist], ARG: notag, ATTRIB: OUT: [=`Datalist] *)
-type datalist = [ | `Datalist ]
-
-type datalist_content = notag
-
-type datalist_content_fun = notag
-
-type datalist_attrib = [ | common ]
-
-(* NAME: optgroup, KIND: star, TYPE: [= common | `Disabled | `Label ], [= `Option ], [=`Optgroup], ARG: [= `Option ], ATTRIB: OUT: [=`Optgroup] *)
-type optgroup = [ | `Optgroup ]
-
-type optgroup_content = [ | `Option ]
-
-type optgroup_content_fun = [ | `Option ]
-
-type optgroup_attrib = [ | common | `Disabled | `Label ]
-
-type option_attrib =
- [ | common | `Selected | `Text_Value | `Disabled | `Label | `Value ]
-
-type selectoption = [ | `Option ]
-
-type option_content_fun = [ | `PCDATA ]
-
-type option_content = [ | `PCDATA ]
-
-(* NAME: keygen, KIND: nullary, TYPE: [= common | `Autofcus | `Challenge | `Disabled | `Form | `Keytype | `Name ], [=`Keygen], ARG: notag, ATTRIB: OUT: [=`Keygen] *)
-type keygen = [ | `Keygen ]
-
-type keygen_content = notag
-
-type keygen_content_fun = notag
-
-type keygen_attrib =
- [ | common | `Autofcus | `Challenge | `Disabled | `Form | `Keytype | `Name
- ]
-
-(* NAME: progress, KIND: star, TYPE: [= common | `Float_Value |`Max| `Form ],[= phrasing_without_progress], [=`Progress], ARG: [= phrasing_without_progress], ATTRIB: OUT: [=`Progress] *)
-type progress = [ | `Progress ]
-
-type progress_content = [ | phrasing_without_progress ]
-
-type progress_content_fun = [ | phrasing_without_progress ]
-
-type progress_attrib = [ | common | `Float_Value | `Max | `Form ]
-
-(* NAME: meter, KIND: star, TYPE: [= common |`Float_Value |`Min |`Max |`Low |`High |`Optimum |`Form],[= phrasing_without_meter ],[=`Meter], ARG: [= phrasing_without_meter ], ATTRIB: OUT: [=`Meter] *)
-type meter = [ | `Meter ]
-
-type meter_content = [ | phrasing_without_meter ]
-
-type meter_content_fun = [ | phrasing_without_meter ]
-
-type meter_attrib =
- [ | common | `Float_Value | `Min | `Max | `Low | `High | `Optimum | `Form
- ]
-
-(* NAME: output_elt, KIND: star, TYPE: [= common |`Form |`For_List |`Name],[= phrasing ],[=`Output], ARG: [= phrasing ], ATTRIB: OUT: [=`Output] *)
-type output_elt = [ | `Output ]
-
-type output_elt_content = [ | phrasing ]
-
-type output_elt_content_fun = [ | phrasing ]
-
-type output_elt_attrib = [ | common | `Form | `For_List | `Name ]
-
-(* NAME: details, KIND: star, TYPE: [= common | `Open ], [= flow5] elt, [= `Details], ARG: [= flow5] elt, ATTRIB: OUT: [= `Details] *)
-type details = [ | `Details ]
-
-type details_content = [ | flow5 ]
-
-type details_content_fun = [ | flow5 ]
-
-type details_attrib = [ | common | `Open ]
-
-(* NAME: summary, KIND: star, TYPE: [= common ],[= phrasing ], [=`Summary], ARG: [= phrasing ], ATTRIB: OUT: [=`Summary] *)
-type summary = [ | `Summary ]
-
-type summary_content = [ | phrasing ]
-
-type summary_content_fun = [ | phrasing ]
-
-type summary_attrib = [ | common ]
-
-(* NAME: command, KIND: nullary, TYPE: [= common |`Icon |`Disabled |`Checked|`Radiogroup |`Command_Type], [=`Command], ARG: notag, ATTRIB: OUT: [=`Command] *)
-type command = [ | `Command ]
-
-type command_content = notag
-
-type command_content_fun = notag
-
-type command_attrib =
- [ | common | `Icon | `Disabled | `Checked | `Radiogroup | `Command_Type
- ]
-
-(* NAME: menu, KIND: nullary, TYPE: [= common |`Label |`Menu_Type ],[=`Menu], ARG: notag, ATTRIB: OUT: [=`Menu] *)
-type menu = [ | `Menu ]
-
-type menu_content = notag
-
-type menu_content_fun = notag
-
-type menu_attrib = [ | common | `Label | `Menu_Type ]
-
-(* NAME: noscript, KIND: plus, TYPE: [= common ], 'a, [=`Noscript of 'a], ARG: 'a, ATTRIB: OUT: [=`Noscript of 'a] *)
-type noscript = [ | `Noscript of flow5_without_noscript ]
-
-type noscript_content = flow5_without_noscript
-
-type noscript_content_fun = flow5_without_noscript
-
-type noscript_attrib = [ | common ]
-
-(* NAME: meta, KIND: nullary, TYPE: [= common | `Http_equiv | `Name | `Content | `Charset ], [=`Meta], ARG: notag, ATTRIB: OUT: [=`Meta] *)
-type meta = [ | `Meta ]
-
-type meta_content = notag
-
-type meta_content_fun = notag
-
-type meta_attrib = [ | common | `Http_equiv | `Name | `Content | `Charset | `Property ]
-
-(* NAME: style, KIND: star, TYPE: [= common | `Media | `Mime_type | `Scoped ], [= `PCDATA ], [=`Style], ARG: [= `PCDATA ], ATTRIB: OUT: [=`Style] *)
-type style = [ | `Style ]
-
-type style_content = [ | `PCDATA ]
-
-type style_content_fun = [ | `PCDATA ]
-
-type style_attrib = [ | common | `Media | `Mime_type | `Scoped ]
-
-type script = [ | `Script ]
-
-type script_attrib =
- [ | common | `Async | `Charset | `Src | `Defer | `Mime_type
- ]
-
-type script_content = [ | `PCDATA ]
-
-type script_content_fun = [ | `PCDATA ]
-
-(* NAME: link, KIND: nullary, TYPE: [= common | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type ], [=`Link], ARG: notag, ATTRIB: OUT: [=`Link] *)
-type link = [ | `Link ]
-
-type link_content = notag
-
-type link_content_fun = notag
-
-type link_attrib =
- [ | common | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type
- ]
diff -Nru tyxml-3.5.0/lib/html_f.ml tyxml-4.1.0/lib/html_f.ml
--- tyxml-3.5.0/lib/html_f.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/lib/html_f.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,1066 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2004 by Thorsten Ohl
+ * Copyright (C) 2007 by Vincent Balat, Gabriel Kerneis
+ * Copyright (C) 2010 by Cecile Herbelin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+module Make_with_wrapped_functions
+
+ (Xml : Xml_sigs.T)
+ (C : Html_sigs.Wrapped_functions with module Xml = Xml)
+ (Svg : Svg_sigs.T with module Xml := Xml) =
+
+struct
+
+ module Xml = Xml
+
+ module W = Xml.W
+
+ module Info = struct
+ let content_type = "text/html"
+ let alternative_content_types = ["application/xhtml+xml";"application/xml";"text/xml"]
+ let version = "HTML5-draft"
+ let standard = "http://www.w3.org/TR/html5/"
+ let namespace = "http://www.w3.org/1999/xhtml"
+ let doctype =
+ Xml_print.compose_doctype "html" []
+ let emptytags =
+ [ "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img";
+ "input"; "keygen"; "link"; "meta"; "param"; "source"; "wbr" ]
+ end
+
+ type 'a wrap = 'a W.t
+ type 'a list_wrap = 'a W.tlist
+
+ type uri = Xml.uri
+ let string_of_uri = Xml.string_of_uri
+ let uri_of_string = Xml.uri_of_string
+
+ type image_candidate =
+ [ `Url of uri
+ | `Url_width of uri * Html_types.number
+ | `Url_pixel of uri * Html_types.float_number ]
+
+
+ type 'a attrib = Xml.attrib
+
+ let to_xmlattribs x = x
+ let to_attrib x = x
+
+ (* VB *)
+ let float_attrib = Xml.float_attrib
+
+ let int_attrib = Xml.int_attrib
+
+ let string_attrib = Xml.string_attrib
+
+ let uri_attrib a s = Xml.uri_attrib a s
+
+ let space_sep_attrib = Xml.space_sep_attrib
+
+ let comma_sep_attrib = Xml.comma_sep_attrib
+
+ let user_attrib f name v = Xml.string_attrib name (W.fmap f v)
+
+ let bool_attrib = user_attrib C.string_of_bool
+
+ let constant_attrib a () =
+ string_attrib a (W.return a)
+
+ let linktypes_attrib name x =
+ user_attrib C.string_of_linktypes name x
+
+ let mediadesc_attrib name x =
+ user_attrib C.string_of_mediadesc name x
+
+ let srcset_attrib name x =
+ user_attrib C.string_of_srcset name x
+
+ (* Core: *)
+ let a_class = space_sep_attrib "class"
+
+ let a_id = string_attrib "id"
+
+ let a_user_data name = string_attrib ("data-" ^ name)
+
+ let a_title = string_attrib "title"
+
+ (* I18N: *)
+ let a_xml_lang = string_attrib "xml:lang"
+ let a_lang = string_attrib "lang"
+
+ (* Style: *)
+ let a_style = string_attrib "style"
+
+ let a_property = string_attrib "property"
+
+ (* Events: *)
+ let a_onabort = Xml.event_handler_attrib "onabort"
+ let a_onafterprint = Xml.event_handler_attrib "onafterprint"
+ let a_onbeforeprint = Xml.event_handler_attrib "onbeforeprint"
+ let a_onbeforeunload = Xml.event_handler_attrib "onbeforeunload"
+ let a_onblur = Xml.event_handler_attrib "onblur"
+ let a_oncanplay = Xml.event_handler_attrib "oncanplay"
+ let a_oncanplaythrough = Xml.event_handler_attrib "oncanplaythrough"
+ let a_onchange = Xml.event_handler_attrib "onchange"
+ let a_ondurationchange = Xml.event_handler_attrib "ondurationchange"
+ let a_onemptied = Xml.event_handler_attrib "onemptied"
+ let a_onended = Xml.event_handler_attrib "onended"
+ let a_onerror = Xml.event_handler_attrib "onerror"
+ let a_onfocus = Xml.event_handler_attrib "onfocus"
+ let a_onformchange = Xml.event_handler_attrib "onformchange"
+ let a_onforminput = Xml.event_handler_attrib "onforminput"
+ let a_onhashchange = Xml.event_handler_attrib "onhashchange"
+ let a_oninput = Xml.event_handler_attrib "oninput"
+ let a_oninvalid = Xml.event_handler_attrib "oninvalid"
+ let a_onoffline = Xml.event_handler_attrib "onoffline"
+ let a_ononline = Xml.event_handler_attrib "ononline"
+ let a_onpause = Xml.event_handler_attrib "onpause"
+ let a_onplay = Xml.event_handler_attrib "onplay"
+ let a_onplaying = Xml.event_handler_attrib "onplaying"
+ let a_onpagehide = Xml.event_handler_attrib "onpagehide"
+ let a_onpageshow = Xml.event_handler_attrib "onpageshow"
+ let a_onpopstate = Xml.event_handler_attrib "onpopstate"
+ let a_onprogress = Xml.event_handler_attrib "onprogress"
+ let a_onratechange = Xml.event_handler_attrib "onratechange"
+ let a_onreadystatechange = Xml.event_handler_attrib "onreadystatechange"
+ let a_onredo = Xml.event_handler_attrib "onredo"
+ let a_onresize = Xml.event_handler_attrib "onresize"
+ let a_onscroll = Xml.event_handler_attrib "onscroll"
+ let a_onseeked = Xml.event_handler_attrib "onseeked"
+ let a_onseeking = Xml.event_handler_attrib "onseeking"
+ let a_onselect = Xml.event_handler_attrib "onselect"
+ let a_onshow = Xml.event_handler_attrib "onshow"
+ let a_onstalled = Xml.event_handler_attrib "onstalled"
+ let a_onstorage = Xml.event_handler_attrib "onstorage"
+ let a_onsubmit = Xml.event_handler_attrib "onsubmit"
+ let a_onsuspend = Xml.event_handler_attrib "onsuspend"
+ let a_ontimeupdate = Xml.event_handler_attrib "ontimeupdate"
+ let a_onundo = Xml.event_handler_attrib "onundo"
+ let a_onunload = Xml.event_handler_attrib "onunload"
+ let a_onvolumechange = Xml.event_handler_attrib "onvolumechange"
+ let a_onwaiting = Xml.event_handler_attrib "onwaiting"
+ let a_onload = Xml.event_handler_attrib "onload"
+ let a_onloadeddata = Xml.event_handler_attrib "onloadeddata"
+ let a_onloadedmetadata = Xml.event_handler_attrib "onloadedmetadata"
+ let a_onloadstart = Xml.event_handler_attrib "onloadstart"
+ let a_onmessage = Xml.event_handler_attrib "onmessage"
+ let a_onmousewheel = Xml.event_handler_attrib "onmousewheel"
+
+ (** Javascript mouse events *)
+ let a_onclick = Xml.mouse_event_handler_attrib "onclick"
+ let a_oncontextmenu = Xml.mouse_event_handler_attrib "oncontextmenu"
+ let a_ondblclick = Xml.mouse_event_handler_attrib "ondblclick"
+ let a_ondrag = Xml.mouse_event_handler_attrib "ondrag"
+ let a_ondragend = Xml.mouse_event_handler_attrib "ondragend"
+ let a_ondragenter = Xml.mouse_event_handler_attrib "ondragenter"
+ let a_ondragleave = Xml.mouse_event_handler_attrib "ondragleave"
+ let a_ondragover = Xml.mouse_event_handler_attrib "ondragover"
+ let a_ondragstart = Xml.mouse_event_handler_attrib "ondragstart"
+ let a_ondrop = Xml.mouse_event_handler_attrib "ondrop"
+ let a_onmousedown = Xml.mouse_event_handler_attrib "onmousedown"
+ let a_onmouseup = Xml.mouse_event_handler_attrib "onmouseup"
+ let a_onmouseover = Xml.mouse_event_handler_attrib "onmouseover"
+ let a_onmousemove = Xml.mouse_event_handler_attrib "onmousemove"
+ let a_onmouseout = Xml.mouse_event_handler_attrib "onmouseout"
+
+ (** Javascript keyboard events *)
+ let a_onkeypress = Xml.keyboard_event_handler_attrib "onkeypress"
+ let a_onkeydown = Xml.keyboard_event_handler_attrib "onkeydown"
+ let a_onkeyup = Xml.keyboard_event_handler_attrib "onkeyup"
+
+ (* Other Attributes *)
+ let a_version = string_attrib "version"
+
+ let a_xmlns x =
+ user_attrib C.string_of_big_variant "xmlns" x
+
+ let a_manifest = uri_attrib "manifest"
+
+ let a_cite = uri_attrib "cite"
+
+ let a_xml_space x =
+ user_attrib C.string_of_big_variant "xml:space" x
+
+ let a_accesskey c =
+ user_attrib C.string_of_character "accesskey" c
+
+ let a_charset = string_attrib "charset"
+
+ let a_accept_charset = space_sep_attrib "accept-charset"
+
+ let a_accept = comma_sep_attrib "accept"
+
+ let a_href = uri_attrib "href"
+
+ let a_hreflang = string_attrib "hreflang"
+
+ let a_download file =
+ user_attrib (C.unoption_string) "download" file
+
+ let a_rel = linktypes_attrib "rel"
+
+ let a_tabindex = int_attrib "tabindex"
+
+ let a_mime_type = string_attrib "type"
+
+ let a_alt = string_attrib "alt"
+
+ let a_height p = int_attrib "height" p
+
+ let a_src = uri_attrib "src"
+
+ let a_width p = int_attrib "width" p
+
+ let a_label_for = string_attrib "for"
+ let a_for = a_label_for
+
+ let a_output_for = space_sep_attrib "for"
+ let a_for_list = a_output_for
+
+ let a_selected =
+ constant_attrib "selected"
+
+ let a_text_value = string_attrib "value"
+
+ let a_int_value = int_attrib "value"
+
+ let a_value = string_attrib "value"
+
+ let a_float_value = float_attrib "value"
+
+ let a_action = uri_attrib "action"
+
+ let a_method x =
+ user_attrib C.string_of_big_variant "method" x
+
+ let a_formmethod = a_method
+
+ let a_enctype = string_attrib "enctype"
+
+ let a_checked =
+ constant_attrib "checked"
+
+ let a_disabled =
+ constant_attrib "disabled"
+
+ let a_readonly =
+ constant_attrib "readonly"
+
+ let a_maxlength = int_attrib "maxlength"
+
+ let a_name = string_attrib "name"
+
+ let a_autocomplete x =
+ user_attrib C.onoff_of_bool "autocomplete" x
+
+ let a_async =
+ constant_attrib "async"
+
+ let a_autofocus =
+ constant_attrib "autofocus"
+
+ let a_autoplay =
+ constant_attrib "autoplay"
+
+ let a_muted =
+ constant_attrib "muted"
+
+ let a_crossorigin x =
+ user_attrib C.string_of_big_variant "crossorigin" x
+
+ let a_mediagroup = string_attrib "mediagroup"
+
+ let a_challenge = string_attrib "challenge"
+
+ let a_contenteditable ce =
+ bool_attrib "contenteditable" ce
+
+ let a_contextmenu = string_attrib "contextmenu"
+
+ let a_controls =
+ constant_attrib "controls"
+
+ let a_dir x =
+ user_attrib C.string_of_big_variant "dir" x
+
+ let a_draggable d =
+ bool_attrib "draggable" d
+
+ let a_form = string_attrib "form"
+
+ let a_formaction = uri_attrib "formaction"
+
+ let a_formenctype = string_attrib "formenctype"
+
+ let a_formnovalidate =
+ constant_attrib "formnovalidate"
+
+ let a_formtarget = string_attrib "formtarget"
+
+ let a_hidden =
+ constant_attrib "hidden"
+
+ let a_high = float_attrib "high"
+
+ let a_icon = uri_attrib "icon"
+
+ let a_ismap =
+ constant_attrib "ismap"
+
+ let a_keytype = string_attrib "keytype"
+
+ let a_list = string_attrib "list"
+
+ let a_loop =
+ constant_attrib "loop"
+
+ let a_low = float_attrib "low"
+
+ let a_max = float_attrib "max"
+
+ let a_input_max = user_attrib C.string_of_number_or_datetime "max"
+
+ let a_min = float_attrib "min"
+
+ let a_input_min = user_attrib C.string_of_number_or_datetime "min"
+
+ let a_inputmode x =
+ user_attrib C.string_of_big_variant "inputmode" x
+
+ let a_novalidate =
+ constant_attrib "novalidate"
+
+ let a_open =
+ constant_attrib "open"
+
+ let a_optimum = float_attrib "optimum"
+
+ let a_pattern = string_attrib "pattern"
+
+ let a_placeholder = string_attrib "placeholder"
+
+ let a_poster = uri_attrib "poster"
+
+ let a_preload x =
+ user_attrib C.string_of_big_variant "preload" x
+
+ let a_pubdate =
+ constant_attrib "pubdate"
+
+ let a_radiogroup = string_attrib "radiogroup"
+
+ let a_required =
+ constant_attrib "required"
+
+ let a_reversed =
+ constant_attrib "reserved"
+
+ let a_sandbox x =
+ user_attrib C.string_of_sandbox "sandbox" x
+
+ let a_spellcheck sc =
+ bool_attrib "spellcheck" sc
+
+ let a_scoped =
+ constant_attrib "scoped"
+
+ let a_seamless =
+ constant_attrib "seamless"
+
+ let a_sizes sizes =
+ user_attrib C.string_of_sizes "sizes" sizes
+
+ let a_span = int_attrib "span"
+
+ (*let a_srcdoc*)
+ let a_srclang = string_attrib "xml:lang"
+
+ let a_srcset = srcset_attrib "srcset"
+
+ let a_img_sizes = comma_sep_attrib "sizes"
+
+ let a_start = int_attrib "start"
+
+ let a_step step =
+ user_attrib C.string_of_step "step" step
+
+ let a_wrap x =
+ user_attrib C.string_of_big_variant "wrap" x
+
+ let a_size = int_attrib "size"
+
+ let a_input_type it =
+ user_attrib C.string_of_input_type "type" it
+
+ let a_menu_type x =
+ user_attrib C.string_of_big_variant "type" x
+
+ let a_command_type x =
+ user_attrib C.string_of_big_variant "type" x
+
+ let a_button_type bt =
+ user_attrib C.string_of_input_type "type" bt
+
+ let a_multiple =
+ constant_attrib "multiple"
+
+ let a_cols = int_attrib "cols"
+
+ let a_rows = int_attrib "rows"
+
+ let a_summary = string_attrib "summary"
+
+ let a_align x =
+ user_attrib C.string_of_big_variant "align" x
+
+ let a_axis = string_attrib "axis"
+
+ let a_colspan = int_attrib "colspan"
+
+ let a_headers = space_sep_attrib "headers"
+
+ let a_rowspan = int_attrib "rowspan"
+
+ let a_scope x =
+ user_attrib C.string_of_big_variant "scope" x
+
+ let a_border = int_attrib "border"
+
+ let a_rules x =
+ user_attrib C.string_of_big_variant "rules" x
+
+ let a_char c =
+ user_attrib C.string_of_character "char" c
+
+ let a_data = uri_attrib "data"
+
+ let a_codetype = string_attrib "codetype"
+
+ let a_frameborder x =
+ user_attrib C.string_of_big_variant "frameborder" x
+
+ let a_marginheight = int_attrib "marginheight"
+
+ let a_marginwidth = int_attrib "marginwidth"
+
+ let a_scrolling x =
+ user_attrib C.string_of_big_variant "scrolling" x
+
+ let a_target = string_attrib "target"
+
+ let a_content = string_attrib "content"
+
+ let a_http_equiv = string_attrib "http-equiv"
+
+ let a_media = mediadesc_attrib "media"
+
+ type 'a elt = Xml.elt
+
+ type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
+
+ type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
+
+ type ('a, 'b, 'c) star =
+ ?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
+
+ let terminal tag ?a () = Xml.leaf ?a tag
+
+ let unary tag ?a elt =
+ Xml.node ?a tag (W.singleton elt)
+
+ let star tag ?a elts = Xml.node ?a tag elts
+
+ let plus tag ?a elt elts =
+ Xml.node ?a tag (W.cons elt elts)
+
+ let option_cons opt elts =
+ match opt with
+ | None -> elts
+ | Some x -> W.cons x elts
+
+ let body = star "body"
+
+ let head = plus "head"
+
+ let title = unary "title"
+
+ let html ?a head body =
+ let content = W.cons head (W.singleton body) in
+ Xml.node ?a "html" content
+
+ let footer = star "footer"
+
+ let header = star "header"
+
+ let section = star "section"
+
+ let nav = star "nav"
+
+ let pcdata = Xml.pcdata
+
+ let entity = Xml.entity
+
+ let space () = entity "nbsp"
+
+ let cdata = Xml.cdata
+
+ let cdata_script = Xml.cdata_script
+
+ let cdata_style = Xml.cdata_style
+
+ let h1 = star "h1"
+
+ let h2 = star "h2"
+
+ let h3 = star "h3"
+
+ let h4 = star "h4"
+
+ let h5 = star "h5"
+
+ let h6 = star "h6"
+
+ let hgroup = star "hgroup"
+
+ let address = star "address"
+
+ let blockquote = star "blockquote"
+
+ let div = star "div"
+
+ let p = star "p"
+
+ let pre = star "pre"
+
+ let abbr = star "abbr"
+
+ let br = terminal "br"
+
+ let cite = star "cite"
+
+ let code = star "code"
+
+ let dfn = star "dfn"
+
+ let em = star "em"
+
+ let kbd = star "kbd"
+
+ let q = star "q"
+
+ let samp = star "samp"
+
+ let span = star "span"
+
+ let strong = star "strong"
+
+ let time = star "time"
+
+ let var = star "var"
+
+ let a = star "a"
+
+ let dl = star "dl"
+
+ let ol = star "ol"
+
+ let ul = star "ul"
+
+ let dd = star "dd"
+
+ let dt = star "dt"
+
+ let li = star "li"
+
+ let hr = terminal "hr"
+
+ let b = star "b"
+
+ let i = star "i"
+
+ let u = star "u"
+
+ let small = star "small"
+
+ let sub = star "sub"
+
+ let sup = star "sup"
+
+ let mark = star "mark"
+
+ let rp = star "rp"
+
+ let rt = star "rt"
+
+ let ruby = star "ruby"
+
+ let wbr = terminal "wbr"
+
+ (* VB *)
+ type shape = [ | `Rect | `Circle | `Poly | `Default ]
+
+ let bdo ~dir ?(a = []) elts = Xml.node ~a: ((a_dir dir) :: a) "bdo" elts
+
+ let a_datetime = string_attrib "datetime"
+
+ let a_shape x =
+ user_attrib C.string_of_big_variant "shape" x
+
+ let a_coords coords =
+ user_attrib C.string_of_numbers "coords" coords
+
+ let a_usemap = string_attrib "usemap"
+
+ let a_defer =
+ constant_attrib "defer"
+
+ let a_label = string_attrib "label"
+
+ let area ~alt ?(a = []) () = Xml.leaf ~a: ((a_alt alt) :: a) "area"
+
+ let map = star "map"
+
+ let del = star "del"
+
+ let ins = star "ins"
+
+ let script = unary "script"
+
+ let noscript = star "noscript"
+
+ let article = star "article"
+
+ let aside = star "aside"
+
+ let main = star "main"
+
+ let video_audio name ?src ?srcs ?(a = []) elts =
+ let a =
+ match src with
+ | None -> a
+ | Some uri -> (a_src uri) :: a
+ in
+ match srcs with
+ | None -> Xml.node name ~a elts
+ | Some srcs -> Xml.node name ~a (W.append srcs elts)
+
+ let audio = video_audio "audio"
+
+ let video = video_audio "video"
+
+ let canvas = star "canvas"
+
+ let command ~label ?(a = []) () =
+ Xml.leaf ~a: ((a_label label) :: a) "command"
+
+ let menu ?children ?a () =
+ let children = match children with
+ | None -> W.nil ()
+ | Some (`Lis l)
+ | Some (`Flows l) -> l in
+ Xml.node ?a "menu" children
+
+ let embed = terminal "embed"
+
+ let source = terminal "source"
+
+ let meter = star "meter"
+
+ let output_elt = star "output"
+
+ let form = star "form"
+
+ let svg ?(a = []) children =
+ Svg.toelt (Svg.svg ~a children)
+
+ let input = terminal "input"
+
+ let keygen = terminal "keygen"
+
+ let label = star "label"
+
+ let option = unary "option"
+
+ let select = star "select"
+
+ let textarea = unary "textarea"
+
+ let button = star "button"
+
+ let datalist ?children ?a () =
+ let children = match children with
+ | None -> W.nil ()
+ | Some (`Options x | `Phras x) -> x in
+ Xml.node ?a "datalist" children
+
+ let progress = star "progress"
+
+ let legend = star "legend"
+
+ let details summary ?a children =
+ plus "details" ?a summary children
+
+ let summary = star "summary"
+
+ let fieldset ?legend ?a elts =
+ Xml.node ?a "fieldset" (option_cons legend elts)
+
+ let optgroup ~label ?(a = []) elts =
+ Xml.node ~a: ((a_label label) :: a) "optgroup" elts
+
+ let figcaption = star "figcaption"
+ let figure ?figcaption ?a elts =
+ let content = match figcaption with
+ | None -> elts
+ | Some (`Top c) -> W.cons c elts
+ | Some (`Bottom c) -> W.append elts (W.singleton c)
+ in
+ Xml.node ?a "figure" content
+
+ let caption = star "caption"
+
+ let tablex ?caption ?columns ?thead ?tfoot ?a elts =
+ let content = option_cons thead (option_cons tfoot elts) in
+ let content = match columns with
+ | None -> content
+ | Some columns -> W.append columns content in
+ let content = option_cons caption content in
+ Xml.node ?a "table" content
+
+ let table = tablex
+
+ let td = star "td"
+
+ let th = star "th"
+
+ let tr = star "tr"
+
+ let colgroup = star "colgroup"
+
+ let col = terminal "col"
+
+ let thead = star "thead"
+
+ let tbody = star "tbody"
+
+ let tfoot = star "tfoot"
+
+ let iframe = star "iframe"
+
+ let object_ ?params ?(a = []) elts =
+ let elts = match params with
+ | None -> elts
+ | Some e -> W.append e elts in
+ Xml.node ~a "object" elts
+
+ let param = terminal "param"
+
+ let img ~src ~alt ?(a = []) () =
+ let a = (a_src src) :: (a_alt alt) :: a in
+ Xml.leaf ~a "img"
+
+ let meta = terminal "meta"
+
+ let style ?(a = []) elts = Xml.node ~a "style" elts
+
+ let link ~rel ~href ?(a = []) () =
+ Xml.leaf ~a: ((a_rel rel) :: (a_href href) :: a) "link"
+
+ let base = terminal "base"
+
+ (******************************************************************)
+ (* Conversion from and to Xml module *)
+ let tot x = x
+
+ let totl x = x
+
+ let toelt x = x
+
+ let toeltl x = x
+
+ type doc = [ `Html ] elt
+ let doc_toelt x = x
+
+ module Unsafe = struct
+
+ let data s = Xml.encodedpcdata s
+
+ let leaf tag ?a () = Xml.leaf ?a tag
+
+ let node tag ?a elts = Xml.node ?a tag elts
+
+ let coerce_elt x = x
+
+ let float_attrib = Xml.float_attrib
+
+ let int_attrib = Xml.int_attrib
+
+ let string_attrib = Xml.string_attrib
+
+ let uri_attrib a s = Xml.uri_attrib a s
+
+ let space_sep_attrib = Xml.space_sep_attrib
+
+ let comma_sep_attrib = Xml.comma_sep_attrib
+
+ end
+
+end
+
+module Wrapped_functions
+ (Xml : Xml_sigs.T with type ('a,'b) W.ft = 'a -> 'b) =
+struct
+
+ module Xml = Xml
+
+ let string_of_sandbox_token = function
+ | `Allow_forms -> "allow-forms"
+ | `Allow_pointer_lock -> "allow-pointer-lock"
+ | `Allow_popups -> "allow-popups"
+ | `Allow_top_navigation -> "allow-top-navigation"
+ | `Allow_same_origin -> "allow-same-origin"
+ | `Allow_script -> "allow-script"
+
+ let string_of_linktype = function
+ | `Alternate -> "alternate"
+ | `Archives -> "archives"
+ | `Author -> "author"
+ | `Bookmark -> "bookmark"
+ | `Canonical -> "canonical"
+ | `External -> "external"
+ | `First -> "first"
+ | `Help -> "help"
+ | `Icon -> "icon"
+ | `Index -> "index"
+ | `Last -> "last"
+ | `License -> "license"
+ | `Next -> "next"
+ | `Nofollow -> "nofollow"
+ | `Noreferrer -> "noreferrer"
+ | `Pingback -> "pingback"
+ | `Prefetch -> "prefetch"
+ | `Prev -> "prev"
+ | `Search -> "search"
+ | `Stylesheet -> "stylesheet"
+ | `Sidebar -> "sidebar"
+ | `Tag -> "tag"
+ | `Up -> "up"
+ | `Other s -> s
+
+ let string_of_mediadesc_token =
+ function
+ | `All -> "all"
+ | `Aural -> "aural"
+ | `Braille -> "braille"
+ | `Embossed -> "embossed"
+ | `Handheld -> "handheld"
+ | `Print -> "print"
+ | `Projection -> "projection"
+ | `Screen -> "screen"
+ | `Speech -> "speech"
+ | `Tty -> "tty"
+ | `Tv -> "tv"
+ | `Raw_mediadesc s -> s
+
+ let string_of_big_variant = function
+ | `Anonymous -> "anonymous"
+ | `Async -> "async"
+ | `Autofocus -> "autofocus"
+ | `Autoplay -> "autoplay"
+ | `Checked -> "checked"
+ | `Defer -> "defer"
+ | `Disabled -> "disabled"
+ | `Muted -> "muted"
+ | `ReadOnly -> "readonly"
+ | `Rect -> "rect"
+ | `Selected -> "selected"
+ | `Use_credentials -> "use-credentials"
+ | `W3_org_1999_xhtml -> "http://www.w3.org/1999/xhtml"
+ | `All -> "all"
+ | `Preserve -> "preserve"
+ | `Default -> "default"
+ | `Controls -> "controls"
+ | `Ltr -> "ltr"
+ | `Rtl -> "rtl"
+ | `Get -> "GET"
+ | `Post -> "POST"
+ | `Formnovalidate -> "formnovalidate"
+ | `Hidden -> "hidden"
+ | `Ismap -> "ismap"
+ | `Loop -> "loop"
+ | `Novalidate -> "novalidate"
+ | `Open -> "open"
+ | `None -> "none"
+ | `Metadata -> "metadata"
+ | `Audio -> "audio"
+ | `Pubdate -> "pubdate"
+ | `Required -> "required"
+ | `Reversed -> "reserved"
+ | `Scoped -> "scoped"
+ | `Seamless -> "seamless"
+ | `Any -> "any"
+ | `Soft -> "soft"
+ | `Hard -> "hard"
+ | `Context -> "context"
+ | `Toolbar -> "toolbar"
+ | `Command -> "command"
+ | `Checkbox -> "checkbox"
+ | `Radio -> "radio"
+ | `Multiple -> "multiple"
+ | `Left -> "left"
+ | `Right -> "right"
+ | `Justify -> "justify"
+ | `Char -> "char"
+ | `Row -> "row"
+ | `Col -> "col"
+ | `Rowgroup -> "rowgroup"
+ | `Colgroup -> "colgroup"
+ | `Groups -> "groups"
+ | `Rows -> "rows"
+ | `Cols -> "cols"
+ | `Zero -> "0"
+ | `One -> "1"
+ | `Yes -> "yes"
+ | `No -> "no"
+ | `Auto -> "auto"
+ | `Circle -> "circle"
+ | `Poly -> "poly"
+ | `Alternate -> "alternate"
+ | `Archives -> "archives"
+ | `Author -> "author"
+ | `Bookmark -> "bookmark"
+ | `External -> "external"
+ | `First -> "first"
+ | `Help -> "help"
+ | `Icon -> "icon"
+ | `Index -> "index"
+ | `Last -> "last"
+ | `License -> "license"
+ | `Next -> "next"
+ | `Nofollow -> "nofollow"
+ | `Noreferrer -> "noreferrer"
+ | `Pingback -> "pingback"
+ | `Prefetch -> "prefetch"
+ | `Prev -> "prev"
+ | `Search -> "search"
+ | `Stylesheet -> "stylesheet"
+ | `Sidebar -> "sidebar"
+ | `Tag -> "tag"
+ | `Up -> "up"
+ | `Verbatim -> "verbatim"
+ | `Latin -> "latin"
+ | `Latin_name -> "latin-name"
+ | `Latin_prose -> "latin-prose"
+ | `Full_width_latin -> "full-width-latin"
+ | `Kana -> "kana"
+ | `Katakana -> "katakana"
+ | `Numeric -> "numeric"
+ | `Tel -> "tel"
+ | `Email -> "email"
+ | `Url -> "url"
+ | `Other s -> s
+
+ let string_of_input_type = function
+ | `Button -> "button"
+ | `Checkbox -> "checkbox"
+ | `Color -> "color"
+ | `Date -> "date"
+ | `Datetime -> "datetime"
+ | `Datetime_local -> "datetime-local"
+ | `Email -> "email"
+ | `File -> "file"
+ | `Hidden -> "hidden"
+ | `Image -> "image"
+ | `Month -> "month"
+ | `Number -> "number"
+ | `Password -> "password"
+ | `Radio -> "radio"
+ | `Range -> "range"
+ | `Readonly -> "readonly"
+ | `Reset -> "reset"
+ | `Search -> "search"
+ | `Submit -> "submit"
+ | `Tel -> "tel"
+ | `Text -> "text"
+ | `Time -> "time"
+ | `Url -> "url"
+ | `Week -> "week"
+
+ let string_of_number_or_datetime = function
+ | `Number n -> string_of_int n
+ | `Datetime t -> t
+
+ let string_of_character = String.make 1
+
+ let string_of_number = string_of_int
+
+ let string_of_bool = string_of_bool
+
+ let onoff_of_bool = function
+ | false -> "off"
+ | true -> "on"
+
+ let unoption_string = function
+ | Some x -> x
+ | None -> ""
+
+ let string_of_step = function
+ | Some x -> Xml_print.string_of_number x
+ | None -> "any"
+
+ let string_of_sizes = function
+ | Some l ->
+ String.concat " "
+ (List.map (fun (x, y) -> Printf.sprintf "%dx%d" x y) l)
+ | None ->
+ "any"
+
+ let string_of_sandbox l =
+ String.concat " " (List.map string_of_sandbox_token l)
+
+ let string_of_numbers l =
+ String.concat "," (List.map string_of_number l)
+
+ let string_of_mediadesc l =
+ String.concat ", " (List.map string_of_mediadesc_token l)
+
+ let string_of_linktypes l =
+ String.concat " " (List.map string_of_linktype l)
+
+ type image_candidate =
+ [ `Url of Xml.uri
+ | `Url_width of Xml.uri * Html_types.number
+ | `Url_pixel of Xml.uri * Html_types.float_number ]
+
+ let string_of_srcset (l : [< image_candidate] list) =
+ let f = function
+ | `Url url -> Xml.string_of_uri url
+ | `Url_width (url, v) ->
+ Printf.sprintf "%s %sw" (Xml.string_of_uri url) (string_of_number v)
+ | `Url_pixel (url, v) ->
+ Printf.sprintf "%s %sx" (Xml.string_of_uri url) (Xml_print.string_of_number v)
+ in
+ String.concat ", " (List.map f l)
+
+end
+
+module Make
+ (Xml : Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
+ (Svg : Svg_sigs.T with module Xml := Xml) =
+ Make_with_wrapped_functions(Xml)(Wrapped_functions(Xml))(Svg)
diff -Nru tyxml-3.5.0/lib/html_f.mli tyxml-4.1.0/lib/html_f.mli
--- tyxml-3.5.0/lib/html_f.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/lib/html_f.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,53 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2004 by Thorsten Ohl
+ * Copyright (C) 2007 by Vincent Balat, Gabriel Kerneis
+ * Copyright (C) 2010 by Cecile Herbelin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Typesafe constructors for HTML documents (Functorial interface)
+
+ {% See <>. %}
+*)
+
+(** Create a new implementation of [HTML], using the given underlying [Xml]
+ and [Svg] implementation. Will output a module of type {!Html_sigs.T} with
+ the various type equalities.
+
+ If your [Xml] implementation uses a special function wrapping, use
+ {!Make_with_wrapped_functions}.
+*)
+module Make
+ (Xml : Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
+ (Svg : Svg_sigs.T with module Xml := Xml)
+ : Html_sigs.Make(Xml)(Svg).T
+ with type +'a elt = Xml.elt
+ and type +'a attrib = Xml.attrib
+
+(** The standard set of wrapped functions, when [W.ft] is the regular function. *)
+module Wrapped_functions
+ (Xml: Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
+ : Html_sigs.Wrapped_functions with module Xml = Xml
+
+(** Similar to {!Make} but with a custom set of wrapped functions. *)
+module Make_with_wrapped_functions
+ (Xml : Xml_sigs.T)
+ (C : Html_sigs.Wrapped_functions with module Xml = Xml)
+ (Svg : Svg_sigs.T with module Xml := Xml)
+ : Html_sigs.Make(Xml)(Svg).T
+ with type +'a elt = Xml.elt
+ and type +'a attrib = Xml.attrib
diff -Nru tyxml-3.5.0/lib/html_sigs.mli tyxml-4.1.0/lib/html_sigs.mli
--- tyxml-3.5.0/lib/html_sigs.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/lib/html_sigs.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,1188 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** HTML signatures for the functorial interface. *)
+
+(** Signature of typesafe constructors for HTML documents. *)
+module type T = sig
+
+ (** HTML elements.
+
+ Element constructors are in section {{!elements}elements}. Most elements constructors
+ are either {{!nullary}nullary}, {{!unary}unary} or {{!star}star},
+ depending on the number of children they accept.
+ Children are usually given as a list of elements.
+ {{!pcdata}pcdata} is used for text.
+
+ [div [a [pcdata "Foo"]]]
+ is equivalent to
+ []
+
+ The type variable ['a] is used to track the element's type. This
+ allows the OCaml typechecker to check HTML validity.
+
+ For example, [div []] is of type [[> `Div] elt].
+ The {{!span}span} function only accepts children of type
+ {!Html_types.span_content}.
+ Since [`Div] is not part of it. [span [div []]] will not typecheck.
+
+ Note that the concrete implementation of this type can vary.
+ See {!Xml} for details.
+ *)
+ type +'a elt
+
+ (** A complete HTML document. *)
+ type doc = [ `Html ] elt
+
+ (** HTML attributes
+
+ Attribute constructors are in section {{!attributes}attributes} and their name starts
+ with [a_]. Attributes are given to elements with the [~a] optional argument.
+
+ [a ~a:[a_href "ocsigen.org"] [pcdata "link!"]]
+ is equivalent to
+ [link!]
+
+ Similarly to {{!elt}elt}, attributes use the OCaml type system to enforce
+ HTML validity.
+
+ For example {!a_href} returns a value of type [[> `Href] attrib].
+ The {{!div}div} function only accepts attributes of type
+ {!Html_types.div_attrib}.
+ Since [`Href] is not part of it,
+ [div ~a:[a_href "ocsigen.org"] []] will not typecheck.
+
+ In some cases, attributes have to be disambiguated.
+ The [max] attribute has two version,
+ {!a_max} and {!a_input_max}, depending on the
+ element.
+ Such disambiguated attribute will contain the name of the associated element.
+ *)
+ type +'a attrib
+
+ (** Underlying XML data-structure
+
+ The type variables in {!elt} and {!attrib} are know as {i phantom types}.
+ The implementation, defined here, is actually monomorphic.
+
+ In particular, tyxml doesn't impose any overhead over the underlying
+ representation. The {!tot} and {!toelt} functions allows to convert
+ between the typed and the untyped representation without any cost.
+
+ Note that some implementation may not be iterable or printable, such as the
+ Dom representation exposed by js_of_ocaml.
+ *)
+ module Xml : Xml_sigs.T
+
+ (** [wrap] is a container for elements and values.
+
+ In most cases, ['a wrap = 'a]. For [R] modules (in eliom or js_of_ocaml),
+ It will be {!React.S.t}.
+ *)
+ type 'a wrap = 'a Xml.W.t
+
+ (** [list_wrap] is a container for list of elements.
+
+ In most cases, ['a list_wrap = 'a list]. For [R] modules (in eliom or js_of_ocaml),
+ It will be {!ReactiveData.RList.t}.
+ *)
+ type 'a list_wrap = 'a Xml.W.tlist
+
+ (** A nullary element is an element that doesn't have any children. *)
+ type ('a, 'b) nullary = ?a:('a attrib list) -> unit -> 'b elt
+
+ (** A unary element is an element that have exactly one children. *)
+ type ('a, 'b, 'c) unary = ?a:('a attrib list) -> 'b elt wrap -> 'c elt
+
+ (** A star element is an element that has any number of children, including zero. *)
+ type ('a, 'b, 'c) star =
+ ?a:('a attrib list) -> 'b elt list_wrap -> 'c elt
+
+ (** Associated SVG module, for the {!svg} combinator. *)
+ module Svg : Svg_sigs.T with module Xml := Xml
+
+ (** Various information about HTML, such as the doctype, ... *)
+ module Info : Xml_sigs.Info
+
+ open Html_types
+
+ (** {3 Uri} *)
+
+ type uri = Xml.uri
+ val string_of_uri : (uri, string) Xml.W.ft
+ val uri_of_string : (string, uri) Xml.W.ft
+
+ (** {2:attributes Attributes} *)
+
+ val a_class : nmtokens wrap -> [> | `Class] attrib
+ (** This attribute assigns a class name or set of class names to an
+ element. Any number of elements may be assigned the same class
+ name or names. *)
+
+ val a_user_data : nmtoken -> text wrap -> [> | `User_data] attrib
+ (** May be used to specify custom attributes.
+ The example given by the W3C is as follows :
+ {v
+
+ - Beyond The Sea
+
v}
+ It should be used for preprocessing ends only. *)
+
+ val a_id : text wrap -> [> | `Id] attrib
+ (** This attribute assigns a name to an element. This name must be
+ unique in a document. The text should be without any space. *)
+
+ val a_title : text wrap -> [> | `Title] attrib
+ (** This attribute offers advisory information about the element for
+ which it is set.
+
+ Values of the title attribute may be rendered by user agents in a
+ variety of ways. For instance, visual browsers frequently display
+ the title as a {i tool tip} (a short message that appears when the
+ pointing device pauses over an object). Audio user agents may
+ speak the title information in a similar context.
+
+ The title attribute has an additional role when used with the [link]
+ element to designate an external style sheet. Please consult the
+ section on links and style sheets for details. *)
+
+ (** {3 I18N} *)
+
+ val a_xml_lang : languagecode wrap -> [> | `XML_lang] attrib
+
+ val a_lang : languagecode wrap -> [> | `Lang] attrib
+
+ (** {3 Events}
+
+ {4 Javascript events} *)
+
+ val a_onabort : Xml.event_handler -> [> | `OnAbort] attrib
+ val a_onafterprint : Xml.event_handler -> [> | `OnAfterPrint] attrib
+ val a_onbeforeprint : Xml.event_handler -> [> | `OnBeforePrint] attrib
+ val a_onbeforeunload : Xml.event_handler -> [> | `OnBeforeUnload] attrib
+ val a_onblur : Xml.event_handler -> [> | `OnBlur] attrib
+ val a_oncanplay : Xml.event_handler -> [> | `OnCanPlay] attrib
+ val a_oncanplaythrough : Xml.event_handler -> [> | `OnCanPlayThrough] attrib
+ val a_onchange : Xml.event_handler -> [> | `OnChange] attrib
+ val a_ondurationchange : Xml.event_handler -> [> | `OnDurationChange] attrib
+ val a_onemptied : Xml.event_handler -> [> | `OnEmptied] attrib
+ val a_onended : Xml.event_handler -> [> | `OnEnded] attrib
+ val a_onerror : Xml.event_handler -> [> | `OnError] attrib
+ val a_onfocus : Xml.event_handler -> [> | `OnFocus] attrib
+ val a_onformchange : Xml.event_handler -> [> | `OnFormChange] attrib
+ val a_onforminput : Xml.event_handler -> [> | `OnFormInput] attrib
+ val a_onhashchange : Xml.event_handler -> [> | `OnHashChange] attrib
+ val a_oninput : Xml.event_handler -> [> | `OnInput] attrib
+ val a_oninvalid : Xml.event_handler -> [> | `OnInvalid] attrib
+ val a_onmousewheel : Xml.event_handler -> [> | `OnMouseWheel] attrib
+ val a_onoffline : Xml.event_handler -> [> | `OnOffLine] attrib
+ val a_ononline : Xml.event_handler -> [> | `OnOnLine] attrib
+ val a_onpause : Xml.event_handler -> [> | `OnPause] attrib
+ val a_onplay : Xml.event_handler -> [> | `OnPlay] attrib
+ val a_onplaying : Xml.event_handler -> [> | `OnPlaying] attrib
+ val a_onpagehide : Xml.event_handler -> [> | `OnPageHide] attrib
+ val a_onpageshow : Xml.event_handler -> [> | `OnPageShow] attrib
+ val a_onpopstate : Xml.event_handler -> [> | `OnPopState] attrib
+ val a_onprogress : Xml.event_handler -> [> | `OnProgress] attrib
+ val a_onratechange : Xml.event_handler -> [> | `OnRateChange] attrib
+ val a_onreadystatechange : Xml.event_handler -> [> | `OnReadyStateChange] attrib
+ val a_onredo : Xml.event_handler -> [> | `OnRedo] attrib
+ val a_onresize : Xml.event_handler -> [> | `OnResize] attrib
+ val a_onscroll : Xml.event_handler -> [> | `OnScroll] attrib
+ val a_onseeked : Xml.event_handler -> [> | `OnSeeked] attrib
+ val a_onseeking : Xml.event_handler -> [> | `OnSeeking] attrib
+ val a_onselect : Xml.event_handler -> [> | `OnSelect] attrib
+ val a_onshow : Xml.event_handler -> [> | `OnShow] attrib
+ val a_onstalled : Xml.event_handler -> [> | `OnStalled] attrib
+ val a_onstorage : Xml.event_handler -> [> | `OnStorage] attrib
+ val a_onsubmit : Xml.event_handler -> [> | `OnSubmit] attrib
+ val a_onsuspend : Xml.event_handler -> [> | `OnSuspend] attrib
+ val a_ontimeupdate : Xml.event_handler -> [> | `OnTimeUpdate] attrib
+ val a_onundo : Xml.event_handler -> [> | `OnUndo] attrib
+ val a_onunload : Xml.event_handler -> [> | `OnUnload] attrib
+ val a_onvolumechange : Xml.event_handler -> [> | `OnVolumeChange] attrib
+ val a_onwaiting : Xml.event_handler -> [> | `OnWaiting] attrib
+ val a_onload : Xml.event_handler -> [> | `OnLoad] attrib
+ val a_onloadeddata : Xml.event_handler -> [> | `OnLoadedData] attrib
+ val a_onloadedmetadata : Xml.event_handler -> [> | `OnLoadedMetaData] attrib
+ val a_onloadstart : Xml.event_handler -> [> | `OnLoadStart] attrib
+ val a_onmessage : Xml.event_handler -> [> | `OnMessage] attrib
+
+ (** {4 Mouse events} *)
+
+ val a_onclick : Xml.mouse_event_handler -> [> | `OnClick] attrib
+ val a_oncontextmenu : Xml.mouse_event_handler -> [> | `OnContextMenu] attrib
+ val a_ondblclick : Xml.mouse_event_handler -> [> | `OnDblClick] attrib
+ val a_ondrag : Xml.mouse_event_handler -> [> | `OnDrag] attrib
+ val a_ondragend : Xml.mouse_event_handler -> [> | `OnDragEnd] attrib
+ val a_ondragenter : Xml.mouse_event_handler -> [> | `OnDragEnter] attrib
+ val a_ondragleave : Xml.mouse_event_handler -> [> | `OnDragLeave] attrib
+ val a_ondragover : Xml.mouse_event_handler -> [> | `OnDragOver] attrib
+ val a_ondragstart : Xml.mouse_event_handler -> [> | `OnDragStart] attrib
+ val a_ondrop : Xml.mouse_event_handler -> [> | `OnDrop] attrib
+ val a_onmousedown : Xml.mouse_event_handler -> [> | `OnMouseDown] attrib
+ val a_onmouseup : Xml.mouse_event_handler -> [> | `OnMouseUp] attrib
+ val a_onmouseover : Xml.mouse_event_handler -> [> | `OnMouseOver] attrib
+ val a_onmousemove : Xml.mouse_event_handler -> [> | `OnMouseMove] attrib
+ val a_onmouseout : Xml.mouse_event_handler -> [> | `OnMouseOut] attrib
+
+ (** {4 Keyboard events} *)
+
+ val a_onkeypress : Xml.keyboard_event_handler -> [> | `OnKeyPress] attrib
+ val a_onkeydown : Xml.keyboard_event_handler -> [> | `OnKeyDown] attrib
+ val a_onkeyup : Xml.keyboard_event_handler -> [> | `OnKeyUp] attrib
+
+ (** {3 Other attributes} *)
+
+ val a_autocomplete : (bool[@onoff]) wrap -> [> | `Autocomplete] attrib
+
+ val a_async : unit -> [> | `Async] attrib
+
+ val a_autofocus : unit -> [> | `Autofocus] attrib
+
+ val a_autoplay : unit -> [> | `Autoplay] attrib
+
+ val a_muted : unit -> [> | `Muted] attrib
+
+ val a_crossorigin :
+ [< | `Anonymous | `Use_credentials ] wrap -> [> | `Crossorigin ] attrib
+
+ val a_mediagroup : string wrap -> [> | `Mediagroup ] attrib
+
+ val a_challenge : text wrap -> [> | `Challenge] attrib
+
+ val a_contenteditable : bool wrap -> [> | `Contenteditable] attrib
+
+ val a_contextmenu : idref wrap -> [> | `Contextmenu] attrib
+
+ val a_controls : unit -> [> | `Controls] attrib
+
+ val a_dir : [< | `Rtl | `Ltr] wrap -> [> | `Dir] attrib
+
+ val a_draggable : bool wrap -> [> | `Draggable] attrib
+
+ val a_form : idref wrap -> [> | `Form] attrib
+
+ val a_formaction : Xml.uri wrap -> [> | `Formaction] attrib
+
+ val a_formenctype : contenttype wrap -> [> | `Formenctype] attrib
+
+ val a_formnovalidate : unit -> [> | `Formnovalidate] attrib
+
+ val a_formtarget : text wrap -> [> | `Formtarget] attrib
+
+ val a_hidden : unit -> [> | `Hidden] attrib
+
+ val a_high : float_number wrap -> [> | `High] attrib
+
+ val a_icon : Xml.uri wrap -> [> | `Icon] attrib
+
+ val a_ismap : unit -> [> | `Ismap] attrib
+
+ val a_keytype : text wrap -> [> | `Keytype] attrib
+
+ val a_list : idref wrap -> [> | `List] attrib
+
+ val a_loop : unit -> [> | `Loop] attrib
+
+ val a_low : float_number wrap -> [> | `High] attrib
+
+ val a_max : float_number wrap -> [> | `Max] attrib
+
+ val a_input_max : number_or_datetime wrap -> [> | `Input_Max] attrib
+ [@@reflect.attribute "max" ["input"]]
+
+ val a_min : float_number wrap -> [> | `Min] attrib
+
+ val a_input_min : number_or_datetime wrap -> [> | `Input_Min] attrib
+ [@@reflect.attribute "min" ["input"]]
+
+ val a_inputmode :
+ [< `Verbatim | `Latin | `Latin_name | `Latin_prose | `Full_width_latin
+ | `Kana | `Katakana | `Numeric | `Tel | `Email | `Url ] wrap ->
+ [> `Inputmode] attrib
+ (** @see Input HTML documentation. *)
+
+ val a_novalidate : unit -> [> | `Novalidate] attrib
+
+ val a_open : unit -> [> | `Open] attrib
+
+ val a_optimum : float_number wrap -> [> | `Optimum] attrib
+
+ val a_pattern : text wrap -> [> | `Pattern] attrib
+
+ val a_placeholder : text wrap -> [> | `Placeholder] attrib
+
+ val a_poster : Xml.uri wrap -> [> | `Poster] attrib
+
+ val a_preload : [< | `None | `Metadata | `Audio] wrap -> [> | `Preload] attrib
+
+ val a_pubdate : unit -> [> | `Pubdate] attrib
+
+ val a_radiogroup : text wrap -> [> | `Radiogroup] attrib
+
+ val a_required : unit -> [> | `Required] attrib
+
+ val a_reversed : unit -> [> | `Reversed] attrib
+
+ val a_sandbox : [< | sandbox_token ] list wrap -> [> | `Sandbox] attrib
+
+ val a_spellcheck : bool wrap -> [> | `Spellcheck] attrib
+
+ val a_scoped : unit -> [> | `Scoped] attrib
+
+ val a_seamless : unit -> [> | `Seamless] attrib
+
+ val a_sizes : (number * number) list option wrap -> [> | `Sizes] attrib
+
+ val a_span : number wrap -> [> | `Span] attrib
+
+ (** @deprecated Use {!a_xml_lang} instead. *)
+ val a_srclang : nmtoken wrap -> [> | `XML_lang] attrib
+ [@@ocaml.deprecated "Use a_xml_lang instead."]
+
+ type image_candidate =
+ [ `Url of uri
+ | `Url_width of uri * number
+ | `Url_pixel of uri * float_number ]
+
+ val a_srcset : image_candidate list wrap -> [> | `Srcset] attrib
+
+ val a_img_sizes : text list wrap -> [> | `Img_sizes] attrib
+ [@@reflect.attribute "sizes" ["img"]]
+
+ val a_start : number wrap -> [> | `Start] attrib
+
+ val a_step : float_number option wrap -> [> | `Step] attrib
+
+ val a_wrap : [< | `Soft | `Hard] wrap -> [> | `Wrap] attrib
+
+ val a_version : cdata wrap -> [> | `Version] attrib
+
+ val a_xmlns : [< | `W3_org_1999_xhtml] wrap -> [> | `XMLns] attrib
+
+ val a_manifest : Xml.uri wrap -> [> | `Manifest] attrib
+
+ val a_cite : Xml.uri wrap -> [> | `Cite] attrib
+
+ val a_xml_space : [< | `Default | `Preserve] wrap -> [> | `XML_space] attrib
+
+ val a_accesskey : character wrap -> [> | `Accesskey] attrib
+ (** This attribute assigns an access key to an element. An access key
+ is a single character from the document character
+ set. NB: authors should consider the input method of the
+ expected reader when specifying an accesskey. *)
+
+ val a_charset : charset wrap -> [> | `Charset] attrib
+ (** This attribute specifies the character encoding of the resource
+ designated by the link. Please consult the section on character
+ encodings for more details. *)
+
+ val a_accept_charset : charsets wrap -> [> | `Accept_charset] attrib
+
+ val a_accept : contenttypes wrap -> [> | `Accept] attrib
+
+ val a_href : Xml.uri wrap -> [> | `Href] attrib
+ (** This attribute specifies the location of a Web resource, thus
+ defining a link between the current element (the source anchor)
+ and the destination anchor defined by this attribute. *)
+
+ val a_hreflang : languagecode wrap -> [> | `Hreflang] attrib
+ (** This attribute specifies the base language of the resource
+ designated by href and may only be used when href is specified. *)
+
+ val a_download : string option wrap -> [> | `Download] attrib
+
+ val a_rel : linktypes wrap -> [> | `Rel] attrib
+ (** This attribute describes the relationship from the current
+ document to the anchor specified by the href attribute. The
+ value of this attribute is a space-separated list of link
+ types. *)
+
+ (** This attribute is used to describe a reverse link from the
+ anchor specified by the href attribute to the current
+ document. The value of this attribute is a space-separated
+ list of link types. *)
+
+ val a_tabindex : number wrap -> [> | `Tabindex] attrib
+ (** This attribute specifies the position of the current
+ element in the tabbing order for the current document. This
+ value must be a number between 0 and 32767. User agents
+ should ignore leading zeros. *)
+
+ val a_mime_type : contenttype wrap -> [> | `Mime_type] attrib
+ [@@reflect.attribute "type" ["object"; "embed"; "area"; "link"]]
+ (** This attribute gives an advisory hint as to the content type
+ of the content available at the link target address. It
+ allows user agents to opt to use a fallback mechanism rather
+ than fetch the content if they are advised that they will
+ get content in a content type they do not support.Authors
+ who use this attribute take responsibility to manage the
+ risk that it may become inconsistent with the content
+ available at the link target address. *)
+
+ val a_datetime : cdata wrap -> [> | `Datetime] attrib
+
+ val a_action : Xml.uri wrap -> [> | `Action] attrib
+ (** This attribute specifies a form processing agent. User agent
+ behavior for a value other than an HTTP URI is undefined. *)
+
+ val a_checked : unit -> [> | `Checked] attrib
+ (** When the [type] attribute has the value ["radio"] or
+ ["checkbox"], this boolean attribute specifies that the
+ button is on. User agents must ignore this attribute for
+ other control types. *)
+
+ val a_cols : number wrap -> [> | `Cols] attrib
+ (** This attribute specifies the visible width in average
+ character widths. Users should be able to enter longer lines
+ than this, so user agents should provide some means to
+ scroll through the contents of the control when the contents
+ extend beyond the visible area. User agents may wrap visible
+ text lines to keep long lines visible without the need for
+ scrolling. *)
+
+ val a_enctype : contenttype wrap -> [> | `Enctype] attrib
+
+ val a_label_for : idref wrap -> [> | `Label_for] attrib
+ [@@reflect.attribute "for" ["label"]]
+
+ val a_for : idref wrap -> [> | `Label_for] attrib
+ [@@ocaml.deprecated "Use a_label_for"]
+ (** @deprecated Use a_label_for *)
+
+ val a_output_for : idrefs wrap -> [> | `Output_for] attrib
+ [@@reflect.attribute "for" ["output"]]
+
+ val a_for_list : idrefs wrap -> [> | `Output_for] attrib
+ [@@ocaml.deprecated "Use a_output_for"]
+ (** @deprecated Use a_output_for *)
+
+ val a_maxlength : number wrap -> [> | `Maxlength] attrib
+
+ val a_method :
+ [< | `Get | `Post] wrap -> [> | `Method] attrib
+
+ val a_formmethod :
+ [< | `Get | `Post] wrap -> [> | `Method] attrib
+ [@@ocaml.deprecated "Use a_method"]
+ (** @deprecated Use a_method *)
+
+ val a_multiple : unit -> [> | `Multiple] attrib
+
+ val a_name : text wrap -> [> | `Name] attrib
+ (** This attribute assigns the control name. *)
+
+ val a_rows : number wrap -> [> | `Rows] attrib
+ (** This attribute specifies the number of visible text
+ lines. Users should be able to enter more lines than this,
+ so user agents should provide some means to scroll through
+ the contents of the control when the contents extend beyond
+ the visible area. *)
+
+ val a_selected : unit -> [> | `Selected] attrib
+ (** When set, this boolean attribute specifies that
+ this option is pre-selected. *)
+
+ val a_size : number wrap -> [> | `Size] attrib
+
+ val a_src : Xml.uri wrap -> [> | `Src] attrib
+
+ val a_input_type : [<
+ | `Url
+ | `Tel
+ | `Text
+ | `Time
+ | `Search
+ | `Password
+ | `Checkbox
+ | `Range
+ | `Radio
+ | `Submit
+ | `Reset
+ | `Number
+ | `Hidden
+ | `Month
+ | `Week
+ | `File
+ | `Email
+ | `Image
+ | `Datetime_local
+ | `Datetime
+ | `Date
+ | `Color
+ | `Button] wrap -> [> | `Input_Type] attrib
+ [@@reflect.attribute "type" ["input"]]
+
+ val a_text_value : text wrap -> [> | `Text_Value] attrib
+ [@@reflect.attribute "value" ["param"; "button"; "option"]]
+ (** This attribute specifies the initial value of the
+ control. If this attribute is not set, the initial value is
+ set to the contents of the [option] element. *)
+
+ val a_int_value : number wrap -> [> | `Int_Value] attrib
+ [@@reflect.attribute "value" ["li"]]
+
+ val a_value : cdata wrap -> [> | `Value] attrib
+
+ val a_float_value : float_number wrap -> [> | `Float_Value] attrib
+ [@@reflect.attribute "value" ["progress"; "meter"]]
+
+ val a_disabled : unit -> [> | `Disabled] attrib
+
+ val a_readonly : unit -> [> | `ReadOnly] attrib
+ val a_button_type :
+ [< | `Button | `Submit | `Reset] wrap -> [> | `Button_Type] attrib
+ [@@reflect.attribute "type" ["button"]]
+
+ val a_command_type :
+ [< | `Command | `Checkbox | `Radio] wrap -> [> | `Command_Type] attrib
+ [@@reflect.attribute "type" ["command"]]
+
+ val a_menu_type : [< | `Context | `Toolbar] wrap -> [> | `Menu_Type] attrib
+ [@@reflect.attribute "type" ["menu"]]
+
+ val a_label : text wrap -> [> | `Label] attrib
+
+ val a_align :
+ [< | `Left | `Right | `Justify | `Char] wrap -> [> | `Align] attrib
+ [@@ocaml.deprecated "Use CSS text-align"]
+ (** @deprecated Use CSS text-align *)
+
+ val a_axis : cdata wrap -> [> | `Axis] attrib
+ [@@ocaml.deprecated "Not supported in HTML5"]
+ (** @deprecated Not supported in HTML5 *)
+
+ val a_colspan : number wrap -> [> | `Colspan] attrib
+
+ val a_headers : idrefs wrap -> [> | `Headers] attrib
+
+ val a_rowspan : number wrap -> [> | `Rowspan] attrib
+
+ val a_scope :
+ [< | `Row | `Col | `Rowgroup | `Colgroup] wrap -> [> | `Scope] attrib
+ [@@ocaml.deprecated "Not supported in HTML5"]
+ (** @deprecated Not supported in HTML5 *)
+
+ val a_summary : text wrap -> [> | `Summary] attrib
+ [@@ocaml.deprecated "Move content elsewhere or to a child"]
+ (** @deprecated Move content elsewhere or to a child *)
+
+ val a_border : pixels wrap -> [> | `Border] attrib
+ [@@ocaml.deprecated "Use CSS border and/or border-width"]
+ (** @deprecated Use CSS border and/or border-width *)
+
+ val a_rules :
+ [< | `None | `Groups | `Rows | `Cols | `All] wrap -> [> | `Rules] attrib
+ [@@ocaml.deprecated "Use CSS border"]
+ (** @deprecated Use CSS border *)
+
+ val a_char : character wrap -> [> | `Char] attrib
+ [@@ocaml.deprecated "The char attribute is not supported in HTML5"]
+ (** @deprecated The char attribute is not supported in HTML5 *)
+
+ val a_alt : text wrap -> [> | `Alt] attrib
+
+ val a_height : number wrap -> [> | `Height] attrib
+
+ val a_width : number wrap -> [> | `Width] attrib
+
+ type shape = [ | `Rect | `Circle | `Poly | `Default ]
+
+ val a_shape : shape wrap -> [> | `Shape] attrib
+
+ val a_coords : numbers wrap -> [> | `Coords] attrib
+
+ val a_usemap : idref wrap -> [> | `Usemap] attrib
+
+ val a_data : Xml.uri wrap -> [> | `Data] attrib
+
+ val a_codetype : contenttype wrap -> [> | `Codetype] attrib
+ [@@ocaml.deprecated "Not supported in HTML5"]
+ (** @deprecated Not supported in HTML5 *)
+
+ val a_frameborder : [< | `Zero | `One] wrap -> [> | `Frameborder] attrib
+ [@@ocaml.deprecated "Use CSS border"]
+ (** @deprecated Use CSS border *)
+
+ val a_marginheight : pixels wrap -> [> | `Marginheight] attrib
+ [@@ocaml.deprecated "Use CSS margin"]
+ (** @deprecated Use CSS *)
+
+ val a_marginwidth : pixels wrap -> [> | `Marginwidth] attrib
+ [@@ocaml.deprecated "Use CSS margin"]
+ (** @deprecated Use CSS *)
+
+ val a_scrolling : [< | `Yes | `No | `Auto] wrap -> [> | `Scrolling] attrib
+
+ val a_target : frametarget wrap -> [> | `Target] attrib
+
+ val a_content : text wrap -> [> | `Content] attrib
+
+ val a_http_equiv : text wrap -> [> | `Http_equiv] attrib
+
+ val a_defer : unit -> [> | `Defer] attrib
+
+ val a_media : mediadesc wrap -> [> | `Media] attrib
+
+ val a_style : string wrap -> [> | `Style_Attr] attrib
+
+ val a_property : string wrap -> [> | `Property] attrib
+
+ (** {2:elements Elements} *)
+
+ val pcdata : string wrap -> [> | `PCDATA] elt
+
+ val html :
+ ?a: ((html_attrib attrib) list) ->
+ [< | `Head] elt wrap -> [< | `Body] elt wrap -> [> | `Html] elt
+ [@@reflect.element "html"]
+
+ val head :
+ ?a: ((head_attrib attrib) list) ->
+ [< | `Title] elt wrap -> (head_content_fun elt) list_wrap -> [> | head] elt
+ [@@reflect.element "head"]
+
+ val base : ([< | base_attrib], [> | base]) nullary
+
+ val title : (title_attrib, [< | title_content_fun], [> | title]) unary
+
+ val body : ([< | body_attrib], [< | body_content_fun], [> | body]) star
+
+
+ val svg : ?a : [< svg_attrib ] Svg.attrib list -> [< svg_content ] Svg.elt list_wrap -> [> svg ] elt
+
+ (** {3 Section} *)
+
+ val footer :
+ ([< | common], [< | flow5_without_header_footer], [> | `Footer]) star
+
+ val header :
+ ([< | common], [< | flow5_without_header_footer], [> | `Header]) star
+
+ val section :
+ ([< | section_attrib], [< | section_content_fun], [> | section]) star
+
+ val nav : ([< | nav_attrib], [< | nav_content_fun], [> | nav]) star
+
+ val h1 : ([< | h1_attrib], [< | h1_content_fun], [> | h1]) star
+
+ val h2 : ([< | h2_attrib], [< | h2_content_fun], [> | h2]) star
+
+ val h3 : ([< | h3_attrib], [< | h3_content_fun], [> | h3]) star
+
+ val h4 : ([< | h4_attrib], [< | h4_content_fun], [> | h4]) star
+
+ val h5 : ([< | h5_attrib], [< | h5_content_fun], [> | h5]) star
+
+ val h6 : ([< | h6_attrib], [< | h6_content_fun], [> | h6]) star
+
+ val hgroup :
+ ([< | hgroup_attrib], [< | hgroup_content_fun], [> | hgroup]) star
+
+ val address :
+ ([< | address_attrib], [< | address_content_fun], [> | address]) star
+
+ val article :
+ ([< | article_attrib], [< | article_content_fun], [> | article]) star
+
+ val aside :
+ ([< | aside_attrib], [< | aside_content_fun], [> | aside]) star
+
+ val main :
+ ([< | main_attrib], [< | main_content_fun], [> | main]) star
+
+ (** {3 Grouping content} *)
+
+ val p : ([< | p_attrib], [< | p_content_fun], [> | p]) star
+
+ val pre : ([< | pre_attrib], [< | pre_content_fun], [> | pre]) star
+
+ val blockquote :
+ ([< | blockquote_attrib], [< | blockquote_content_fun], [> | blockquote])
+ star
+
+ val div : ([< | div_attrib], [< | div_content_fun], [> | div]) star
+
+ val dl : ([< | dl_attrib], [< | dl_content_fun], [> | dl]) star
+
+ val ol : ([< | ol_attrib], [< | ol_content_fun], [> | ol]) star
+ [@@reflect.element "ol"]
+
+ val ul : ([< | ul_attrib], [< | ul_content_fun], [> | ul]) star
+ [@@reflect.element "ul"]
+
+ val dd : ([< | dd_attrib], [< | dd_content_fun], [> | dd]) star
+
+ val dt : ([< | dt_attrib], [< | dt_content_fun], [> | dt]) star
+
+ val li : ([< | li_attrib], [< | li_content_fun], [> | li]) star
+
+ val figcaption :
+ ([< | figcaption_attrib], [< | figcaption_content_fun], [> | figcaption]) star
+
+ val figure :
+ ?figcaption: ([`Top of [< `Figcaption ] elt wrap | `Bottom of [< `Figcaption ] elt wrap ]) ->
+ ([< | figure_attrib], [< | figure_content_fun], [> | figure]) star
+ [@@reflect.element "figure"]
+
+ val hr : ([< | hr_attrib], [> | hr]) nullary
+
+ (** {3 Semantic} *)
+
+ val b : ([< | b_attrib], [< | b_content_fun], [> | b]) star
+
+ val i : ([< | i_attrib], [< | i_content_fun], [> | i]) star
+
+ val u : ([< | u_attrib], [< | u_content_fun], [> | u]) star
+
+ val small :
+ ([< | small_attrib], [< | small_content_fun], [> | small]) star
+
+ val sub : ([< | sub_attrib], [< | sub_content_fun], [> | sub]) star
+
+ val sup : ([< | sup_attrib], [< | sup_content_fun], [> | sup]) star
+
+ val mark : ([< | mark_attrib], [< | mark_content_fun], [> | mark]) star
+
+ val wbr : ([< | wbr_attrib], [> | wbr]) nullary
+
+ val bdo :
+ dir: [< | `Ltr | `Rtl] wrap ->
+ ([< | common], [< | phrasing], [> | `Bdo]) star
+
+ val abbr : ([< | abbr_attrib], [< | abbr_content_fun], [> | abbr]) star
+
+ val br : ([< | br_attrib], [> | br]) nullary
+
+ val cite : ([< | cite_attrib], [< | cite_content_fun], [> | cite]) star
+
+ val code : ([< | code_attrib], [< | code_content_fun], [> | code]) star
+
+ val dfn : ([< | dfn_attrib], [< | dfn_content_fun], [> | dfn]) star
+
+ val em : ([< | em_attrib], [< | em_content_fun], [> | em]) star
+
+ val kbd : ([< | kbd_attrib], [< | kbd_content_fun], [> | kbd]) star
+
+ val q : ([< | q_attrib], [< | q_content_fun], [> | q]) star
+
+ val samp : ([< | samp_attrib], [< | samp_content_fun], [> | samp]) star
+
+ val span : ([< | span_attrib], [< | span_content_fun], [> | span]) star
+
+ val strong :
+ ([< | strong_attrib], [< | strong_content_fun], [> | strong]) star
+
+ val time : ([< | time_attrib], [< | time_content_fun], [> | time]) star
+
+ val var : ([< | var_attrib], [< | var_content_fun], [> | var]) star
+
+ (** {3 Hypertext} *)
+
+ val a : ([< | a_attrib], 'a, [> | `A of 'a]) star
+
+ (** {3 Edit} *)
+
+ val del : ([< | del_attrib], 'a, [> | `Del of 'a]) star
+ val ins : ([< | ins_attrib], 'a, [> | `Ins of 'a]) star
+
+ (** {3 Embedded} *)
+
+ val img :
+ src: Xml.uri wrap ->
+ alt: text wrap ->
+ ([< img_attrib], [> img]) nullary
+
+ val iframe :
+ ([< | common | `Src | `Name | `Sandbox | `Seamless | `Width | `Height],
+ [< | `PCDATA], [> | `Iframe]) star
+
+ val object_ :
+ ?params: (([< | `Param] elt) list_wrap ) ->
+ ([<
+ | common
+ | `Data
+ | `Form
+ | `Mime_type
+ | `Height
+ | `Width
+ | `Name
+ | `Usemap
+ ], 'a, [> | `Object of 'a ]) star
+ [@@reflect.element "object_" "object"]
+
+ val param : ([< | param_attrib], [> | param]) nullary
+
+ val embed :
+ ([< | common | `Src | `Height | `Mime_type | `Width], [> | `Embed]) nullary
+
+ val audio :
+ ?src:Xml.uri wrap ->
+ ?srcs:(([< | source] elt) list_wrap) ->
+ ([< | audio_attrib], 'a, [> 'a audio ]) star
+ [@@reflect.element "audio_video"]
+
+ val video :
+ ?src:Xml.uri wrap ->
+ ?srcs: (([< | source] elt) list_wrap) ->
+ ([< | video_attrib], 'a, [> 'a video]) star
+ [@@reflect.element "audio_video"]
+
+ val canvas : ([< | canvas_attrib], 'a, [> | 'a canvas]) star
+
+ val source : ([< | source_attrib], [> | source]) nullary
+
+ val area :
+ alt: text wrap ->
+ ([<
+ | common
+ | `Alt
+ | `Coords
+ | `Shape
+ | `Target
+ | `Rel
+ | `Media
+ | `Hreflang
+ | `Mime_type
+ ], [> | `Area]) nullary
+
+ val map : ([< | map_attrib], 'a, [> | `A of 'a]) star
+
+ (** {3 Tables Data} *)
+
+ val caption :
+ ([< | caption_attrib], [< | caption_content_fun], [> | caption]) star
+
+ val table :
+ ?caption: [< | caption] elt wrap ->
+ ?columns: [< | colgroup] elt list_wrap ->
+ ?thead: [< | thead] elt wrap ->
+ ?tfoot: [< | tfoot] elt wrap ->
+ ([< | table_attrib], [< | table_content_fun], [> | table]) star
+ [@@reflect.element "table"]
+
+ val tablex :
+ ?caption: [< | caption] elt wrap ->
+ ?columns: [< | colgroup] elt list_wrap ->
+ ?thead: [< | thead] elt wrap ->
+ ?tfoot: [< | tfoot] elt wrap ->
+ ([< | tablex_attrib], [< | tablex_content_fun], [> | tablex]) star
+ [@@reflect.element "table" "table"]
+
+ val colgroup :
+ ([< | colgroup_attrib], [< | colgroup_content_fun], [> | colgroup]) star
+
+ val col : ([< | col_attrib], [> | col]) nullary
+
+ val thead :
+ ([< | thead_attrib], [< | thead_content_fun], [> | thead]) star
+
+ val tbody :
+ ([< | tbody_attrib], [< | tbody_content_fun], [> | tbody]) star
+
+ val tfoot :
+ ([< | tfoot_attrib], [< | tfoot_content_fun], [> | tfoot]) star
+
+ val td : ([< | td_attrib], [< | td_content_fun], [> | td]) star
+
+ val th : ([< | th_attrib], [< | th_content_fun], [> | th]) star
+
+ val tr : ([< | tr_attrib], [< | tr_content_fun], [> | tr]) star
+
+ (** {3 Forms} *)
+
+ val form : ([< | form_attrib], [< | form_content_fun], [> | form]) star
+
+ val fieldset :
+ ?legend: [ | `Legend ] elt wrap ->
+ ([< | common | `Disabled | `Form | `Name], [< | flow5],
+ [> | `Fieldset]) star
+ [@@reflect.element "fieldset"]
+
+ val legend :
+ ([< | legend_attrib], [< | legend_content_fun], [> | legend]) star
+
+ (** Label authorizes only one control inside them
+ that should be labelled with a [for] attribute
+ (although it is not necessary). Such constraints are not currently
+ enforced by the type-system *)
+ val label :
+ ([< | label_attrib], [< | label_content_fun], [> | label]) star
+
+ val input : ([< | input_attrib], [> | input]) nullary
+
+ val button :
+ ([< | button_attrib], [< | button_content_fun], [> | button]) star
+
+ val select :
+ ([< | select_attrib], [< | select_content_fun], [> | select]) star
+ [@@reflect.element "select"]
+
+ val datalist :
+ ?children:(
+ [<
+ | `Options of ([< | `Option] elt) list_wrap
+ | `Phras of ([< | phrasing] elt) list_wrap
+ ]) -> ([< | common], [> | `Datalist]) nullary
+ [@@reflect.element "datalist"]
+
+ val optgroup :
+ label: text wrap ->
+ ([< | common | `Disabled | `Label], [< | `Option], [> | `Optgroup]) star
+
+ val option :
+ ([< | option_attrib], [< | option_content_fun], [> | selectoption]) unary
+
+ val textarea :
+ ([< | textarea_attrib], [< | textarea_content_fun], [> | textarea]) unary
+
+ val keygen : ([< | keygen_attrib], [> | keygen]) nullary
+
+ val progress :
+ ([< | progress_attrib], [< | progress_content_fun], [> | progress]) star
+
+ val meter :
+ ([< | meter_attrib], [< | meter_content_fun], [> | meter]) star
+
+ val output_elt :
+ ([< | output_elt_attrib], [< | output_elt_content_fun], [> | output_elt]) star
+ [@@reflect.element "star" "output"]
+
+ (** {3 Data} *)
+
+ (** [entity "foo"] is the HTML entity [&foo;]. Both numerical and named form are allowed.
+
+ @see A tutorial on HTML entities.
+ @see The list of HTML entities.
+ *)
+ val entity : string -> [> | `PCDATA] elt
+
+ val space : unit -> [> | `PCDATA] elt
+
+ val cdata : string -> [> | `PCDATA] elt
+ val cdata_script : string -> [> | `PCDATA] elt
+ val cdata_style : string -> [> | `PCDATA] elt
+
+
+ (** {3 Interactive} *)
+
+ val details :
+ [< | `Summary] elt wrap ->
+ ([< | common | `Open], [< | flow5], [> | `Details]) star
+ [@@reflect.element "details"]
+
+ val summary :
+ ([< | summary_attrib], [< | summary_content_fun], [> | summary]) star
+
+ val command :
+ label: text wrap ->
+ ([<
+ | common
+ | `Icon
+ | `Disabled
+ | `Checked
+ | `Radiogroup
+ | `Command_Type
+ ], [> | `Command]) nullary
+
+ val menu :
+ ?children:(
+ [<
+ | `Lis of ([< | `Li of [< | common]] elt) list_wrap
+ | `Flows of ([< | flow5] elt) list_wrap
+ ]) -> ([< | common | `Label | `Menu_Type], [> | `Menu]) nullary
+ [@@reflect.element "menu"]
+
+ (** {3 Scripting} *)
+
+ val script :
+ ([< | script_attrib], [< | script_content_fun], [> | script]) unary
+
+ val noscript :
+ ([< | noscript_attrib], [< | noscript_content_fun], [> | noscript]) star
+
+ val meta : ([< | meta_attrib], [> | meta]) nullary
+
+ (** {3 Style Sheets} *)
+
+ val style :
+ ([< | style_attrib], [< | style_content_fun], [> | style]) star
+
+ val link :
+ rel: linktypes wrap ->
+ href: Xml.uri wrap ->
+ ([<
+ | common
+ | `Hreflang
+ | `Media
+ | `Rel
+ | `Href
+ | `Sizes
+ | `Mime_type
+ ], [> | `Link]) nullary
+
+ (** {3 Ruby} *)
+
+ val rt : ([< | rt_attrib], [< | rt_content_fun], [> | rt]) star
+
+ val rp : ([< | rp_attrib], [< | rp_content_fun], [> | rp]) star
+
+ val ruby : ([< | ruby_attrib], [< | ruby_content_fun], [> | ruby]) star
+
+ (** {2 Conversion with untyped representation} *)
+
+ val tot : Xml.elt -> 'a elt
+ val totl : Xml.elt list_wrap -> 'a elt list_wrap
+ val toelt : 'a elt -> Xml.elt
+ val toeltl : 'a elt list_wrap -> Xml.elt list_wrap
+
+ val doc_toelt : doc -> Xml.elt
+ val to_xmlattribs : 'a attrib list -> Xml.attrib list
+ val to_attrib : Xml.attrib -> 'a attrib
+
+ (** Unsafe features.
+
+ Using this module can break
+ HTML validity and may introduce security problems like
+ code injection.
+ Use it with care.
+ *)
+ module Unsafe : sig
+
+ (** Insert raw text without any encoding *)
+ val data : string wrap -> 'a elt
+
+ (** Insert an XML node that is not implemented in this module.
+ If it is a standard HTML node which is missing,
+ please report to the Ocsigen team.
+ *)
+ val node : string -> ?a:'a attrib list -> 'b elt list_wrap -> 'c elt
+
+ (** Insert an XML node without children
+ that is not implemented in this module.
+ If it is a standard HTML node which is missing,
+ please report to the Ocsigen team.
+ *)
+ val leaf : string -> ?a:'a attrib list -> unit -> 'b elt
+
+ (** Remove phantom type annotation on an element,
+ to make it usable everywhere.
+ *)
+ val coerce_elt : 'a elt -> 'b elt
+
+ (** Insert an attribute that is not implemented in this module.
+ If it is a standard HTML attribute which is missing,
+ please report to the Ocsigen team.
+ *)
+ val string_attrib : string -> string wrap -> 'a attrib
+
+ (** Same, for float attribute *)
+ val float_attrib : string -> float wrap -> 'a attrib
+
+ (** Same, for int attribute *)
+ val int_attrib : string -> int wrap -> 'a attrib
+
+ (** Same, for URI attribute *)
+ val uri_attrib : string -> uri wrap -> 'a attrib
+
+ (** Same, for a space separated list of values *)
+ val space_sep_attrib : string -> string list wrap -> 'a attrib
+
+ (** Same, for a comma separated list of values *)
+ val comma_sep_attrib : string -> string list wrap -> 'a attrib
+
+ end
+
+end
+
+(** Equivalent to {!T}, but without wrapping. *)
+module type NoWrap = T with module Xml.W = Xml_wrap.NoWrap
+
+
+(** {2 Signature functors}
+ {% See <>. %} *)
+
+(** Signature functor for {!Html_f.Make}. *)
+module Make
+ (Xml : Xml_sigs.T)
+ (Svg : Svg_sigs.T with module Xml := Xml) :
+sig
+
+ (** See {!modtype:Html_sigs.T}. *)
+ module type T = T
+ with type 'a Xml.W.t = 'a Xml.W.t
+ and type 'a Xml.W.tlist = 'a Xml.W.tlist
+ and type ('a,'b) Xml.W.ft = ('a,'b) Xml.W.ft
+ and type Xml.uri = Xml.uri
+ and type Xml.event_handler = Xml.event_handler
+ and type Xml.mouse_event_handler = Xml.mouse_event_handler
+ and type Xml.keyboard_event_handler = Xml.keyboard_event_handler
+ and type Xml.attrib = Xml.attrib
+ and type Xml.elt = Xml.elt
+ and module Svg := Svg
+end
+
+(** Wrapped functions, to be used with {!Html_f.Make_with_wrapped_functions}. *)
+module type Wrapped_functions = sig
+
+ module Xml : Xml_sigs.T
+
+ val string_of_big_variant :
+ ([< Html_types.big_variant], string) Xml.W.ft
+
+ val string_of_bool : (bool, string) Xml.W.ft
+
+ val onoff_of_bool : (bool, string) Xml.W.ft
+
+ val string_of_character : (Html_types.character, string) Xml.W.ft
+
+ val string_of_input_type :
+ ([< Html_types.input_type], string) Xml.W.ft
+
+ val string_of_number_or_datetime :
+ ([< Html_types.number_or_datetime], string) Xml.W.ft
+
+ val string_of_linktypes :
+ ([< Html_types.linktype] list, string) Xml.W.ft
+
+ val string_of_mediadesc :
+ ([< Html_types.mediadesc_token] list, string) Xml.W.ft
+
+ val string_of_numbers : (Html_types.numbers, string) Xml.W.ft
+
+ val string_of_sandbox :
+ ([< Html_types.sandbox_token] list, string) Xml.W.ft
+
+ val string_of_sizes :
+ ((Html_types.number * Html_types.number) list option, string) Xml.W.ft
+
+ type image_candidate =
+ [ `Url of Xml.uri
+ | `Url_width of Xml.uri * Html_types.number
+ | `Url_pixel of Xml.uri * Html_types.float_number ]
+
+ val string_of_srcset :
+ ([< image_candidate] list, string) Xml.W.ft
+
+ val string_of_step : (float option, string) Xml.W.ft
+
+ val unoption_string : (string option, string) Xml.W.ft
+
+end
diff -Nru tyxml-3.5.0/lib/html_types.mli tyxml-4.1.0/lib/html_types.mli
--- tyxml-3.5.0/lib/html_types.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/lib/html_types.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,2331 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2010 by Simon Castellan
+ * Copyright (C) 2010 by Cecile Herbelin
+ * Copyright (C) 2010 by Vincent Balat
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(* _fun prefix are the types that must be used
+ in Html_sigs. They are more restrictive as
+ some param are already taken as seperate argument,
+ to ensure better compatibility.
+ SC *)
+
+
+(** HTML types with variants, goes with {!Html_sigs.T}.
+
+ @see information concerning HTML at W3C.
+*)
+
+
+(** {1 Attribute types.} *)
+
+type cdata = string
+(** Character data *)
+
+type id = string
+(** A document-unique identifier *)
+
+type idref = string
+(** A reference to a document-unique identifier *)
+
+type idrefs = idref list
+(** A space-separated list of references to document-unique identifiers *)
+
+type name = string
+(** A name with the same character constraints as ID above *)
+
+type nmtoken = string
+(** A name composed of only name tokens as defined in XML 1.0
+ @see XML 1.0 *)
+
+type nmtokens = nmtoken list
+(** One or more white space separated NMTOKEN values *)
+
+(** {2 Data Types} *)
+
+type character = char
+(** A single character from ISO 10646. *)
+
+type charset = string
+(** A character encoding, as per RFC2045 (MIME).
+ @see RFC2045 *)
+
+type charsets = charset list
+(** A space-separated list of character encodings, as per RFC2045 (MIME).
+ @see RFC2045 *)
+
+type contenttype = string
+(** A media type, as per RFC2045 (MIME).
+ @see RFC2045 *)
+
+type contenttypes = contenttype list
+(** A comma-separated list of media types, as per RFC2045 (MIME).
+ @see RFC2045 *)
+
+type number = int
+
+(* space-separated *)
+type numbers = number list
+
+type coords = string list
+(** Comma- separated list of coordinates to use in defining areas. *)
+
+type datetime = string
+(** Date and time information. *)
+
+type number_or_datetime = [ | `Number of number | `Datetime of datetime ]
+(** Either a number or date and time information. *)
+
+type fpi = string
+(** A character string representing an SGML Formal Public Identifier. *)
+
+type frametarget = string
+(** Frame name used as destination for results of certain actions. *)
+
+type languagecode = string
+(** A language code, as per RFC5646/BCP47.
+ @see RFC5646 *)
+
+type linktype =
+ [
+ | `Alternate
+ | `Archives
+ | `Author
+ | `Bookmark
+ | `Canonical
+ | `External
+ | `First
+ | `Help
+ | `Icon
+ | `Index
+ | `Last
+ | `License
+ | `Next
+ | `Nofollow
+ | `Noreferrer
+ | `Pingback
+ | `Prefetch
+ | `Prev
+ | `Search
+ | `Stylesheet
+ | `Sidebar
+ | `Tag
+ | `Up
+ | `Other of string ] [@@reflect.total_variant]
+
+type linktypes = linktype list
+(** Authors may use the following recognized link types, listed here with
+ their conventional interpretations. A LinkTypes value refers to a
+ space-separated list of link types. White space characters are not
+ permitted within link types. These link types are case-insensitive, i.e.,
+ ["Alternate"] has the same meaning as ["alternate"].
+
+ User agents, search engines, etc. may interpret these link types in a
+ variety of ways. For example, user agents may provide access to linked
+ documents through a navigation bar.
+
+ {ul
+ {- [`Alternate]:
+ Gives alternate representations of the current document.}
+ {- [`Archives]:
+ Provides a link to a collection of records, documents, or other materials of historical interest.}
+ {- [`Author]:
+ Gives a link to the current document's author.}
+ {- [`Bookmark]:
+ Gives the permalink for the nearest ancestor section.}
+ {- [`Canonical]:
+ Gives the preferred location for accessing the current document.}
+ {- [`External]:
+ Indicates that the referenced document is not part of the same site as the current document.}
+ {- [`First]:
+ Indicates that the current document is a part of a series, and that the first document in the series is the referenced document.}
+ {- [`Help]:
+ Provides a link to context-sensitive help.}
+ {- [`Icon]:
+ Imports an icon to represent the current document.}
+ {- [`Index]:
+ Gives a link to the document that provides a table of contents or index listing the current document.}
+ {- [`Last]:
+ Indicates that the current document is a part of a series, and that the last document in the series is the referenced document.}
+ {- [`Licence]:
+ Indicates that the main content of the current document is covered by the copyright license described by the referenced document.}
+ {- [`Next]:
+ Indicates that the current document is a part of a series, and that the next document in the series is the referenced document.}
+ {- [`Nofollow]:
+ Indicates that the current document's original author or publisher does not endorse the referenced document.}
+ {- [`Noreferrer]:
+ Requires that the user agent not send an HTTP Referer (sic) header if the user follows the hyperlink.}
+ {- [`Pingback]:
+ Gives the address of the pingback server that handles pingbacks to the current document.}
+ {- [`Prefetch]:
+ Specifies that the target resource should be preemptively cached.}
+ {- [`Prev]:
+ Indicates that the current document is a part of a series, and that the previous document in the series is the referenced document.}
+ {- [`Search]:
+ Gives a link to a resource that can be used to search through the current document and its related pages.}
+ {- [`Stylesheet]:
+ Imports a stylesheet.}
+ {- [`Sidebar]:
+ Specifies that the referenced document, if retrieved, is intended to be shown in the browser's sidebar (if it has one).}
+ {- [`Tag]:
+ Gives a tag (identified by the given address) that applies to the current document.}
+ {- [`Up]:
+ Provides a link to a document giving the context for the current document.}
+ } *)
+
+type mediadesc_token =
+ [ `All
+ | `Aural
+ | `Braille
+ | `Embossed
+ | `Handheld
+ | `Print
+ | `Projection
+ | `Screen
+ | `Speech
+ | `Tty
+ | `Tv
+ | `Raw_mediadesc of string ] [@@reflect.total_variant]
+
+type mediadesc = mediadesc_token list
+
+(** The MediaDesc attribute is a comma-separated list of media descriptors.
+ The following is a list of recognized media descriptors:
+ {ul
+ {- [`Screen]:
+ For non-paged computer screens.}
+ {- [`TTY]:
+ For media using a fixed-pitch character grid (like teletypes, terminals, or devices with limited display capabilities).}
+ {- [`TV]:
+ For TV-type devices (low resolution, limited scrollability).}
+ {- [`Projection]:
+ For projectors.}
+ {- [`Handheld]:
+ For handheld devices (small screen, limited bandwidth).}
+ {- [`Print]:
+ For paged and for documents viewed on screen in print preview mode.}
+ {- [`Braille]:
+ For braille tactile feedback devices.}
+ {- [`Aural]:
+ For speech synthesizers.}
+ {- [`All]:
+ For speech synthesizers.}
+ {- [`Raw_mediadesc]:
+ For more complex (untyped) media descriptors.}}
+
+*)
+
+type float_number = float
+
+type pixels = int
+(** The value is an integer that represents the number of pixels of
+ the canvas (screen, paper). Thus, the value ["50"] means fifty
+ pixels. For normative information about the definition of a pixel,
+ please consult CSS2.
+ @see CSS2 *)
+
+type script_ = string
+(** Script data can be the content of the ["script"] element and the
+ value of intrinsic event attributes. User agents must not evaluate
+ script data as HTML markup but instead must pass it on as data to a
+ script engine.
+
+ The case-sensitivity of script data depends on the scripting
+ language.
+
+ Please note that script data that is element content may not
+ contain character references, but script data that is the value of
+ an attribute may contain them. *)
+
+type text = string
+(** Arbitrary textual data, likely meant to be human-readable. *)
+
+(** {2 Core} *)
+
+type i18n = [ | `XML_lang | `Lang ]
+
+type core =
+ [
+ | `Accesskey
+ | `Class
+ | `Contenteditable
+ | `Contextmenu
+ | `Dir
+ | `Draggable
+ | `Hidden
+ | `Id
+ | i18n
+ | `Spellcheck
+ | `Style_Attr
+ | `Tabindex
+ | `Title
+ | `User_data
+ | `XMLns
+ ]
+
+(** {2 Events} *)
+
+(** Javascript events *)
+type events =
+ [
+ | `OnAbort
+ | `OnBlur
+ | `OnCanPlay
+ | `OnCanPlayThrough
+ | `OnChange
+ | `OnClick
+ | `OnContextMenu
+ | `OnDblClick
+ | `OnDrag
+ | `OnDragEnd
+ | `OnDragEnter
+ | `OnDragLeave
+ | `OnDragOver
+ | `OnDragStart
+ | `OnDrop
+ | `OnDurationChange
+ | `OnEmptied
+ | `OnEnded
+ | `OnError
+ | `OnFocus
+ | `OnFormChange
+ | `OnFormInput
+ | `OnInput
+ | `OnInvalid
+ | `OnMouseDown
+ | `OnMouseUp
+ | `OnMouseOver
+ | `OnMouseMove
+ | `OnMouseOut
+ | `OnMouseWheel
+ | `OnPause
+ | `OnPlay
+ | `OnPlaying
+ | `OnProgress
+ | `OnRateChange
+ | `OnReadyStateChange
+ | `OnScroll
+ | `OnSeeked
+ | `OnSeeking
+ | `OnSelect
+ | `OnShow
+ | `OnStalled
+ | `OnSubmit
+ | `OnSuspend
+ | `OnTimeUpdate
+ | `OnVolumeChange
+ | `OnWaiting
+ | `OnKeyPress
+ | `OnKeyDown
+ | `OnKeyUp
+ | `OnLoad
+ | `OnLoadedData
+ | `OnLoadedMetaData
+ | `OnLoadStart
+ ]
+
+(** Common attributes *)
+type common = [ | core | i18n | events ]
+
+(** {1 Categories of HTML elements}
+
+ These category are mainly subdivised in
+ - interactive,
+ - phrasing,
+ - flow5,
+ these categories may overlap *)
+
+type heading = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 | `Hgroup ]
+
+type sectioning = [ | `Section | `Nav | `Aside | `Article ]
+
+type resetable = [ | `Textarea | `Select | `Output | `Keygen | `Input ]
+
+type submitable = [ | `Textarea | `Select | `Keygen | `Input | `Button ]
+
+type labelable = [ | resetable | `Progress | `Meter | `Button ]
+
+type labelable_without_interactive = [ `Progress | `Meter]
+
+type formatblock =
+ [
+ | heading
+ | sectioning
+ | `Pre
+ | `P
+ | `Header
+ | `Footer
+ | `Div
+ | `Blockquote
+ | `Address
+ ]
+
+type sectionningroot =
+ [ | `Td | `Figure | `Fieldset | `Details | `Body | `Blockquote
+ ]
+
+type listed = [ | resetable | submitable | `Fieldset ]
+
+type formassociated = [ | listed | `Progress | `Meter | `Label ]
+
+
+(** Transparent elements.
+ Such elements have a part of they children in their data
+ and behaves like them. We could do something like [a: 'a elt list -> 'a elt]
+ but the information about the node name would be forgotten and would allow
+ things like that : [p [a [a []]]].
+ This system allow to build non-conforming terms such as [a [a []]] but when passed
+ to a standard element (such as [p]), it will yield an error.
+ Exception to that : if you embdedd the element in another transparent (of an
+ another kind) : [p [noscript (a [a []])]] will be correctly typed.
+*)
+type (+'interactive, +'noscript, +'regular, +'media) transparent =
+ [
+ | `A of 'interactive
+ | `Noscript of 'noscript
+ | `Canvas of 'regular
+ | `Map of 'regular
+ | `Ins of 'regular
+ | `Del of 'regular
+ | `Object of 'regular
+ | `Object_interactive of 'regular
+ | `Audio_interactive of 'media
+ | `Video_interactive of 'media
+ | `Audio of 'media
+ | `Video of 'media
+ ]
+(* _interactive variants are not used for now *)
+type (+'noscript, +'regular, +'media) transparent_without_interactive =
+ [
+ | `Noscript of 'noscript
+ | `Ins of 'regular
+ | `Del of 'regular
+ | `Object of 'regular
+ | `Canvas of 'regular
+ | `Map of 'regular
+ | `Audio of 'media
+ | `Video of 'media
+ ]
+
+type (+'interactive, +'regular, +'media) transparent_without_noscript =
+ [
+ | `A of 'interactive
+ | `Ins of 'regular
+ | `Del of 'regular
+ | `Canvas of 'regular
+ | `Map of 'regular
+ | `Object of 'regular
+ | `Object_interactive of 'regular
+ | `Video of 'media
+ | `Audio of 'media
+ | `Video_interactive of 'media
+ | `Audio_interactive of 'media
+ ]
+
+type (+'interactive, +'noscript, +'regular) transparent_without_media =
+ [
+ | `A of 'interactive
+ | `Noscript of 'noscript
+ | `Ins of 'regular
+ | `Del of 'regular
+ | `Map of 'regular
+ | `Canvas of 'regular
+ | `Object of 'regular
+ | `Object_interactive of 'regular
+ ]
+
+(** Metadata without title *)
+type metadata_without_title =
+ [
+ | `Style
+ | `Script
+ | `Noscript of [ | `Meta | `Link | `Style ]
+ | `Meta
+ | `Link
+ | `Command
+ | `Base
+ ]
+
+(** Metadata contents. Used specially in *)
+type metadata = [ | metadata_without_title | `Title ]
+
+(** Interactive contents : contents that require user-interaction
+ (Forms, link, etc.) *)
+
+(** Core element types are element types without transparent. *)
+type core_interactive =
+ [
+ | `Textarea
+ | `Select
+ | `Menu
+ | `Label
+ | `Keygen
+ | `Input
+ | `Img_interactive
+ | `Iframe
+ | `Embed
+ | `Details
+ | `Button
+ ]
+
+type interactive =
+ [
+ core_interactive | (interactive, interactive, interactive) transparent_without_interactive
+ ]
+
+(** Phrasing contents is inline contents : bold text, span, and so on. *)
+type core_phrasing =
+ [
+ | labelable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Svg
+ | `Time
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Label
+ | `Kbd
+ | `Iframe
+ | `I
+ | `Embed
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `Img | `Img_interactive
+ | `PCDATA
+ ]
+
+type core_phrasing_without_noscript =
+ [
+ | labelable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Time
+ | `Sup
+ | `Sub
+ | `Svg
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Label
+ | `Kbd
+ | `Iframe
+ | `I
+ | `Embed
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `Img | `Img_interactive
+ | `B
+ | `Abbr
+ | `PCDATA
+ ]
+type core_phrasing_without_interactive =
+ [
+ | labelable_without_interactive
+ | `Wbr
+ | `Var
+ | `U
+ | `Img
+ | `Time
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Svg
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Kbd
+ | `Img
+ | `I
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ ]
+
+type core_phrasing_without_media =
+ [
+ | labelable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Time
+ | `Svg
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Label
+ | `Kbd
+ | `Img | `Img_interactive
+ | `Iframe
+ | `I
+ | `Embed
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ ]
+
+type phrasing_without_noscript =
+ (phrasing_without_interactive,
+ phrasing,
+ phrasing_without_media) transparent_without_noscript
+
+and phrasing_without_media =
+ [
+ | core_phrasing_without_media
+ | (phrasing_without_interactive, phrasing_without_noscript, phrasing)
+ transparent_without_media
+ ]
+
+
+and phrasing_without_interactive =
+ [
+ | core_phrasing_without_interactive
+ | (phrasing_without_noscript, phrasing, phrasing_without_media)
+ transparent_without_interactive
+ ]
+
+and phrasing =
+ [
+ | (phrasing_without_interactive, phrasing_without_noscript, phrasing,
+ phrasing_without_media) transparent
+ | core_phrasing
+ ]
+
+type (+'a, +'b) between_phrasing_and_phrasing_without_interactive =
+ ( [< core_phrasing
+ | ([< phrasing_without_interactive] as 'b,
+ phrasing_without_noscript,
+ phrasing,
+ phrasing_without_media) transparent
+ > `Abbr `B `Bdo `Br `Canvas `Cite `Code `Command
+ `Datalist `Del `Dfn `Em `I `Img `Ins `Kbd `Map `Mark `Meter
+ `Noscript `Object `PCDATA `Progress `Q `Ruby `Samp `Script
+ `Small `Span `Strong `Sub `Sup `Svg `Time `U `Var `Wbr ] as 'a)
+
+(** Phrasing without the interactive markups *)
+type phrasing_without_dfn =
+ [
+ | labelable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Time
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Label
+ | `Img | `Img_interactive
+ | `Kbd
+ | `I
+ | `Em
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ | (phrasing_without_interactive, phrasing_without_noscript,
+ phrasing_without_dfn, phrasing_without_media) transparent
+ ]
+
+type phrasing_without_label =
+ [
+ | labelable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Time
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Span
+ | `Img | `Img_interactive
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Kbd
+ | `I
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ | (phrasing_without_interactive, phrasing_without_noscript,
+ phrasing_without_label, phrasing_without_media) transparent
+ ]
+
+type phrasing_without_progress =
+ [
+ | resetable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Time
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Img | `Img_interactive
+ | `Ruby
+ | `Q
+ | `Meter
+ | `Mark
+ | `Label
+ | `Kbd
+ | `I
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Button
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ | (phrasing_without_interactive, phrasing_without_noscript,
+ phrasing_without_progress, phrasing_without_media) transparent
+ ]
+
+type phrasing_without_time =
+ [
+ | labelable
+ | submitable
+ | `Wbr
+ | `Var
+ | `U
+ | `Sup
+ | `Sub
+ | `Strong
+ | `Img | `Img_interactive
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Label
+ | `Kbd
+ | `I
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ | (phrasing_without_interactive, phrasing_without_noscript,
+ phrasing_without_time, phrasing_without_media) transparent
+ ]
+
+type phrasing_without_meter =
+ [
+ | submitable
+ | resetable
+ | `Progress
+ | `Button
+ | `Wbr
+ | `Var
+ | `U
+ | `Time
+ | `Sup
+ | `Img | `Img_interactive
+ | `Sub
+ | `Strong
+ | `Span
+ | `Small
+ | `Script
+ | `Samp
+ | `Ruby
+ | `Q
+ | `Mark
+ | `Label
+ | `Kbd
+ | `I
+ | `Em
+ | `Dfn
+ | `Datalist
+ | `Command
+ | `Code
+ | `Cite
+ | `Br
+ | `Bdo
+ | `B
+ | `Abbr
+ | `PCDATA
+ | (phrasing_without_interactive, phrasing_without_noscript,
+ phrasing_without_meter, phrasing_without_media) transparent
+ ]
+
+type core_flow5 =
+ [
+ | core_phrasing
+ | formassociated
+ | formatblock
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ ]
+
+type core_flow5_without_interactive =
+ [
+ | core_phrasing_without_interactive
+ | formassociated
+ | formatblock
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Main
+ ]
+
+type core_flow5_without_noscript =
+ [
+ | core_phrasing_without_noscript
+ | formassociated
+ | formatblock
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ ]
+type core_flow5_without_media =
+ [
+ | core_phrasing_without_media
+ | formassociated
+ | formatblock
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ ]
+
+type flow5_without_interactive =
+ [
+ core_flow5_without_interactive
+ | (flow5_without_noscript, flow5, flow5_without_media)
+ transparent_without_interactive
+ ]
+
+and flow5_without_noscript =
+ [ | core_flow5_without_noscript
+ | (flow5_without_interactive,
+ flow5,
+ flow5_without_media) transparent_without_noscript
+ ]
+
+and flow5_without_media =
+ [ core_flow5_without_media
+ | (flow5_without_interactive,
+ flow5_without_noscript,
+ flow5) transparent_without_media ]
+and flow5 =
+ [
+ | core_flow5
+ | (flow5_without_interactive, flow5_without_noscript, flow5,
+ flow5_without_media) transparent
+ ]
+
+type flow5_without_table =
+ [
+ | core_phrasing
+ | formassociated
+ | formatblock
+ | `Ul
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ | (flow5_without_interactive, flow5_without_noscript, flow5,
+ flow5_without_media) transparent
+ ]
+
+type flow5_without_interactive_header_footer =
+ [
+ | heading
+ | sectioning
+ | `Pre
+ | `P
+ | `Div
+ | `Blockquote
+ | `Address
+ | core_phrasing_without_interactive
+ | formassociated
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Main
+ | (flow5_without_noscript, flow5, flow5_without_media)
+ transparent_without_interactive
+ ]
+
+type flow5_without_header_footer =
+ [
+ | heading
+ | sectioning
+ | `Pre
+ | `P
+ | `Div
+ | `Blockquote
+ | `Address
+ | core_phrasing
+ | formassociated
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ | (flow5_without_interactive_header_footer,
+ flow5_without_noscript, flow5,
+ flow5_without_media) transparent
+ ]
+
+type +'a between_flow5_and_flow5_without_interactive_header_footer =
+ [< flow5 > `Abbr `Address `Article `Aside `Audio `B `Bdo `Blockquote `Br
+ `Button `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Div `Dl `Em
+ `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img
+ `Input `Ins `Kbd `Keygen `Label `Map`Mark `Menu `Meter `Nav `Noscript
+ `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script
+ `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table
+ `Textarea `Time `U `Ul `Var `Video `Wbr] as 'a
+
+type (+'a, +'b) between_flow5_and_flow5_without_header_footer =
+ [< core_flow5
+ | ([< flow5_without_interactive ] as 'b,
+ flow5_without_noscript, 'a,
+ flow5_without_media)
+ transparent
+ > `A `Abbr `Address `Article `Aside `Audio `Audio_interactive `B
+ `Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command
+ `Datalist `Del `Details `Dfn `Div `Dl `Em `Embed `Fieldset
+ `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Iframe
+ `Img `Img_interactive `Input `Ins `Kbd `Keygen `Label `Map
+ `Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive
+ `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script
+ `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg
+ `Table `Textarea `Time `U `Ul `Var `Video `Video_interactive
+ `Wbr ] as 'a
+
+type flow5_without_form =
+ [
+ | core_phrasing
+ | formassociated
+ | formatblock
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ | (flow5_without_interactive, flow5_without_noscript, flow5,
+ flow5_without_media) transparent
+ ]
+
+type flow5_without_sectioning_heading_header_footer_address =
+ [
+ | core_phrasing
+ | formassociated
+ | `Pre
+ | `P
+ | `Div
+ | `Blockquote
+ | `Ul
+ | `Table
+ | `Style
+ | `Ol
+ | `Menu
+ | `Hr
+ | `Form
+ | `Figure
+ | `Dl
+ | `Details
+ | `Main
+ | (flow5_without_interactive, flow5_without_noscript, flow5,
+ flow5_without_media) transparent
+ ]
+
+(*
+ Type for HTML for elements
+*)
+type pcdata = [ | `PCDATA ]
+
+type notag
+
+type no_attribute_allowed
+
+type noattrib = [ `No_attribute_allowed of no_attribute_allowed ]
+
+type html = [ | `Html ]
+
+type html_content_fun = [ | `Head | `Body ]
+
+type html_content = html_content_fun
+
+type html_attrib = [ | common | `Manifest ]
+
+type head = [ | `Head ]
+
+type head_content = [ | metadata ]
+
+type head_content_fun = [ | metadata_without_title ]
+
+type head_attrib = [ | common ]
+
+type body = [ | `Body ]
+
+type body_attrib =
+ [
+ | common
+ | `OnAfterPrint
+ | `OnBeforePrint
+ | `OneBeforeUnload
+ | `OnHashChange
+ | `OnMessage
+ | `OnOffLine
+ | `OnOnLine
+ | `OnPageHide
+ | `OnPageShow
+ | `OnPopState
+ | `OnRedo
+ | `OnResize
+ | `OnStorage
+ | `OnUndo
+ | `OnUnload
+ ]
+
+type body_content = flow5
+
+type body_content_fun = flow5
+
+
+type svg = [ `Svg ]
+type svg_content = Svg_types.svg_content
+type svg_attrib = Svg_types.svg_attr
+(* NAME: base, KIND: nullary, TYPE: [= common | `Href | `Target], [= `Base ], ARG: notag, ATTRIB: OUT: [= `Base ] *)
+type base = [ | `Base ]
+
+type base_content = notag
+
+type base_content_fun = notag
+
+type base_attrib = [ | common | `Href | `Target ]
+
+type title = [ | `Title ]
+
+type title_content = [ | `PCDATA ]
+
+type title_content_fun = [ | `PCDATA ]
+
+type title_attrib = noattrib
+
+(* NAME: footer, KIND: star, TYPE: [= common ], [= flow5_without_header_footer ], [=`Footer], ARG: [= flow5_without_header_footer ], ATTRIB: OUT: [=`Footer] *)
+type footer = [ | `Footer ]
+
+type footer_content = [ | flow5_without_header_footer ]
+
+type footer_content_fun = [ | flow5_without_header_footer ]
+
+type footer_attrib = [ | common ]
+
+(* NAME: header, KIND: star, TYPE: [= common ], [= flow5_without_header_footer ], [=`Header], ARG: [= flow5_without_header_footer ], ATTRIB: OUT: [=`Header] *)
+type header = [ | `Header ]
+
+type header_content = [ | flow5_without_header_footer ]
+
+type header_content_fun = [ | flow5_without_header_footer ]
+
+type header_attrib = [ | common ]
+
+(* NAME: section, KIND: star, TYPE: [= common ], [= flow5 ], [=`Section], ARG: [= flow5 ], ATTRIB: OUT: [=`Section] *)
+type section = [ | `Section ]
+
+type section_content = [ | flow5 ]
+
+type section_content_fun = [ | flow5 ]
+
+type section_attrib = [ | common ]
+
+(* NAME: nav, KIND: star, TYPE: [= common ], [= flow5 ], [=`Nav], ARG: [= flow5 ], ATTRIB: OUT: [=`Nav] *)
+type nav = [ | `Nav ]
+
+type nav_content = [ | flow5 ]
+
+type nav_content_fun = [ | flow5 ]
+
+type nav_attrib = [ | common ]
+
+(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H1], ARG: [= phrasing ], ATTRIB: OUT: [=`H1] *)
+type h1 = [ | `H1 ]
+
+type h1_content = [ | phrasing ]
+
+type h1_content_fun = [ | phrasing ]
+
+type h1_attrib = [ | common ]
+
+(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H2], ARG: [= phrasing ], ATTRIB: OUT: [=`H2] *)
+type h2 = [ | `H2 ]
+
+type h2_content = [ | phrasing ]
+
+type h2_content_fun = [ | phrasing ]
+
+type h2_attrib = [ | common ]
+
+(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H3], ARG: [= phrasing ], ATTRIB: OUT: [=`H3] *)
+type h3 = [ | `H3 ]
+
+type h3_content = [ | phrasing ]
+
+type h3_content_fun = [ | phrasing ]
+
+type h3_attrib = [ | common ]
+
+(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H4], ARG: [= phrasing ], ATTRIB: OUT: [=`H4] *)
+type h4 = [ | `H4 ]
+
+type h4_content = [ | phrasing ]
+
+type h4_content_fun = [ | phrasing ]
+
+type h4_attrib = [ | common ]
+
+(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H5], ARG: [= phrasing ], ATTRIB: OUT: [=`H5] *)
+type h5 = [ | `H5 ]
+
+type h5_content = [ | phrasing ]
+
+type h5_content_fun = [ | phrasing ]
+
+type h5_attrib = [ | common ]
+
+(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H6], ARG: [= phrasing ], ATTRIB: OUT: [=`H6] *)
+type h6 = [ | `H6 ]
+
+type h6_content = [ | phrasing ]
+
+type h6_content_fun = [ | phrasing ]
+
+type h6_attrib = [ | common ]
+
+(* NAME: hgroup, KIND: plus, TYPE: [= common ], [= `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ], [=`Hgroup], ARG: [= `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ], ATTRIB: OUT: [=`Hgroup] *)
+type hgroup = [ | `Hgroup ]
+
+type hgroup_content = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ]
+
+type hgroup_content_fun = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ]
+
+type hgroup_attrib = [ | common ]
+
+(* NAME: address, KIND: star, TYPE: [= common ], [= flow5_without_sectioning_heading_header_footer_address ], [=`Address], ARG: [= flow5_without_sectioning_heading_header_footer_address ], ATTRIB: OUT: [=`Address] *)
+type address = [ | `Address ]
+
+type address_content =
+ [ | flow5_without_sectioning_heading_header_footer_address
+ ]
+
+type address_content_fun =
+ [ | flow5_without_sectioning_heading_header_footer_address
+ ]
+
+type address_attrib = [ | common ]
+
+(* NAME: article, KIND: star, TYPE: [= common ], [= flow5 ], [=`Article], ARG: [= flow5 ], ATTRIB: OUT: [=`Article] *)
+type article = [ | `Article ]
+
+type article_content = [ | flow5 ]
+
+type article_content_fun = [ | flow5 ]
+
+type article_attrib = [ | common ]
+
+(* NAME: aside, KIND: star, TYPE: [= common ], [= flow5 ], [=`Aside], ARG: [= flow5 ], ATTRIB: OUT: [=`Aside] *)
+type aside = [ | `Aside ]
+
+type aside_content = [ | flow5 ]
+
+type aside_content_fun = [ | flow5 ]
+
+type aside_attrib = [ | common ]
+
+(* NAME: main, KIND: star, TYPE: [= common ], [= flow5 ], [=`Main], ARG: [= flow5 ], ATTRIB: OUT: [=`Main] *)
+type main = [ | `Main ]
+
+type main_content = [ | flow5 ]
+
+type main_content_fun = [ | flow5 ]
+
+type main_attrib = [ | common ]
+
+(* NAME: p, KIND: star, TYPE: [= common ], [=phrasing ], [=`P], ARG: [=phrasing ], ATTRIB: OUT: [=`P] *)
+type p = [ | `P ]
+
+type p_content = [ | phrasing ]
+
+type p_content_fun = [ | phrasing ]
+
+type p_attrib = [ | common ]
+
+(* NAME: pre, KIND: star, TYPE: [= common ],[= phrasing ], [=`Pre], ARG: [= phrasing ], ATTRIB: OUT: [=`Pre] *)
+type pre = [ | `Pre ]
+
+type pre_content = [ | phrasing ]
+
+type pre_content_fun = [ | phrasing ]
+
+type pre_attrib = [ | common ]
+
+(* NAME: blockquote, KIND: star, TYPE: [= common | `Cite ],[= flow5 ], [=`Blockquote], ARG: [= flow5 ], ATTRIB: OUT: [=`Blockquote] *)
+type blockquote = [ | `Blockquote ]
+
+type blockquote_content = [ | flow5 ]
+
+type blockquote_content_fun = [ | flow5 ]
+
+type blockquote_attrib = [ | common | `Cite ]
+
+(* NAME: div, KIND: star, TYPE: [= common ], [= flow5 ], [=`Div], ARG: [= flow5 ], ATTRIB: OUT: [=`Div] *)
+type div = [ | `Div ]
+
+type div_content = [ | flow5 ]
+
+type div_content_fun = [ | flow5 ]
+
+type div_attrib = [ | common ]
+
+(* NAME: ol, KIND: star, TYPE: [= common | `Reserved |`Start ], [= `Li of [= common | `Int_Value ]], [=`Ol], ARG: [= `Li of [= common | `Int_Value ]], ATTRIB: OUT: [=`Ol] *)
+type ol = [ | `Ol ]
+
+type ol_content = [ | `Li of [ | common | `Int_Value ] ]
+
+type ol_content_fun = [ | `Li of [ | common | `Int_Value ] ]
+
+type ol_attrib = [ | common | `Reversed | `Start ]
+
+(* NAME: li, KIND: star, TYPE: [= common | `Int_Value] as 'a, [=flow5 ], [=`Li of 'a], ARG: [=flow5 ], ATTRIB: OUT: [=`Li of 'a] *)
+type li_content = [ | flow5 ]
+
+type li_content_fun = [ | flow5 ]
+
+type li_attrib = [ | common | `Int_Value ]
+
+type li = [ | `Li of li_attrib ]
+(* NAME: ul, KIND: star, TYPE: [= common ], [= `Li of [= common] ], [=`Ul], ARG: [= `Li of [= common] ], ATTRIB: OUT: [=`Ul] *)
+type ul = [ | `Ul ]
+
+type ul_content = [ | `Li of [ | li_attrib ] ]
+
+type ul_content_fun = [ | `Li of [ | li_attrib ] ]
+
+type ul_attrib = [ | common ]
+
+(* NAME: dd, KIND: star, TYPE: [= common ], [= flow5 ], [=`Dd], ARG: [= flow5 ], ATTRIB: OUT: [=`Dd] *)
+type dd = [ | `Dd ]
+
+type dd_content = [ | flow5 ]
+
+type dd_content_fun = [ | flow5 ]
+
+type dd_attrib = [ | common ]
+
+(* NAME: dt, KIND: star, TYPE: [= common ], [= phrasing], [=`Dt], ARG: [= phrasing], ATTRIB: OUT: [=`Dt] *)
+type dt = [ | `Dt ]
+
+type dt_content = [ | phrasing ]
+
+type dt_content_fun = [ | phrasing ]
+
+type dt_attrib = [ | common ]
+
+
+type dl = [ | `Dl ]
+
+type dl_content = [ | `Dt | `Dd ]
+
+type dl_content_fun = [ | `Dt | `Dd ]
+
+type dl_attrib = [ | common ]
+
+
+(* NAME: figcaption, KIND: star, TYPE: [= common ], [= flow5], [=`Figcaption], ARG: [= flow5], ATTRIB: OUT: [=`Figcaption] *)
+type figcaption = [ | `Figcaption ]
+
+type figcaption_content = [ | flow5 ]
+
+type figcaption_content_fun = [ | flow5 ]
+
+type figcaption_attrib = [ | common ]
+
+
+(* figure *)
+type figure = [ | `Figure ]
+
+type figure_content = [ | flow5 ]
+
+type figure_content_fun = [ | flow5 ]
+
+type figure_attrib = [ | common ]
+
+
+(* Rp, Rt and ruby *)
+type rp = [ | `Rp ]
+type rp_content = [ | phrasing ]
+type rp_content_fun = [ | phrasing ]
+type rp_attrib = [ | common ]
+
+type rt = [ | `Rt ]
+type rt_content = [ | phrasing ]
+type rt_content_fun = [ | phrasing ]
+type rt_attrib = [ | common ]
+
+type ruby = [ | `Ruby ]
+type ruby_content = [ | phrasing | rp | rt ]
+type ruby_content_fun = [ | phrasing | rp | rt ]
+type ruby_attrib = [ | common ]
+
+
+(* NAME: hr, KIND: nullary, TYPE: [= common ], [=`Hr], ARG: notag, ATTRIB: OUT: [=`Hr] *)
+type hr = [ | `Hr ]
+
+type hr_content = notag
+
+type hr_content_fun = notag
+
+type hr_attrib = [ | common ]
+
+(* NAME: b, KIND: star, TYPE: [= common ], [= phrasing ], [=`B], ARG: [= phrasing ], ATTRIB: OUT: [=`B] *)
+type b = [ | `B ]
+
+type b_content = [ | phrasing ]
+
+type b_content_fun = [ | phrasing ]
+
+type b_attrib = [ | common ]
+
+(* NAME: i, KIND: star, TYPE: [= common ], [= phrasing ], [=`I], ARG: [= phrasing ], ATTRIB: OUT: [=`I] *)
+type i = [ | `I ]
+
+type i_content = [ | phrasing ]
+
+type i_content_fun = [ | phrasing ]
+
+type i_attrib = [ | common ]
+
+(* NAME: u, KIND: star, TYPE: [= common ], [= phrasing ], [=`U], ARG: [= phrasing ], ATTRIB: OUT: [=`U] *)
+type u = [ | `U ]
+
+type u_content = [ | phrasing ]
+
+type u_content_fun = [ | phrasing ]
+
+type u_attrib = [ | common ]
+
+(* NAME: small, KIND: star, TYPE: [= common ], [= phrasing ], [=`Small], ARG: [= phrasing ], ATTRIB: OUT: [=`Small] *)
+type small = [ | `Small ]
+
+type small_content = [ | phrasing ]
+
+type small_content_fun = [ | phrasing ]
+
+type small_attrib = [ | common ]
+
+(* NAME: sub, KIND: star, TYPE: [= common ], [= phrasing ], [=`Sub], ARG: [= phrasing ], ATTRIB: OUT: [=`Sub] *)
+type sub = [ | `Sub ]
+
+type sub_content = [ | phrasing ]
+
+type sub_content_fun = [ | phrasing ]
+
+type sub_attrib = [ | common ]
+
+(* NAME: sup, KIND: star, TYPE: [= common ], [= phrasing ], [=`Sup], ARG: [= phrasing ], ATTRIB: OUT: [=`Sup] *)
+type sup = [ | `Sup ]
+
+type sup_content = [ | phrasing ]
+
+type sup_content_fun = [ | phrasing ]
+
+type sup_attrib = [ | common ]
+
+(* NAME: mark, KIND: star, TYPE: [= common ],[= phrasing ],[= `Mark ], ARG: [= phrasing ], ATTRIB: OUT: [= `Mark ] *)
+type mark = [ | `Mark ]
+
+type mark_content = [ | phrasing ]
+
+type mark_content_fun = [ | phrasing ]
+
+type mark_attrib = [ | common ]
+
+(* NAME: wbr, KIND: nullary, TYPE: [= common ],[= `Wbr ], ARG: notag, ATTRIB: OUT: [= `Wbr ] *)
+type wbr = [ | `Wbr ]
+
+type wbr_content = notag
+
+type wbr_content_fun = notag
+
+type wbr_attrib = [ | common ]
+
+(* NAME: bdo, KIND: star, TYPE: [= common ],[= phrasing ],[= `Bdo ], ARG: [= phrasing ], ATTRIB: OUT: [= `Bdo ] *)
+type bdo = [ | `Bdo ]
+
+type bdo_content = [ | phrasing ]
+
+type bdo_content_fun = [ | phrasing ]
+
+type bdo_attrib = [ | common ]
+
+(* NAME: abbr, KIND: star, TYPE: [= common ], [=phrasing ], [=`Abbr], ARG: [=phrasing ], ATTRIB: OUT: [=`Abbr] *)
+type abbr = [ | `Abbr ]
+
+type abbr_content = [ | phrasing ]
+
+type abbr_content_fun = [ | phrasing ]
+
+type abbr_attrib = [ | common ]
+
+(* NAME: br, KIND: nullary, TYPE: [= common ], [=`Br], ARG: notag, ATTRIB: OUT: [=`Br] *)
+type br = [ | `Br ]
+
+type br_content = notag
+
+type br_content_fun = notag
+
+type br_attrib = [ | common ]
+
+(* NAME: cite, KIND: star, TYPE: [= common ], [= phrasing ], [=`Cite], ARG: [= phrasing ], ATTRIB: OUT: [=`Cite] *)
+type cite = [ | `Cite ]
+
+type cite_content = [ | phrasing ]
+
+type cite_content_fun = [ | phrasing ]
+
+type cite_attrib = [ | common ]
+
+(* NAME: code, KIND: star, TYPE: [= common ], [= phrasing ], [=`Code], ARG: [= phrasing ], ATTRIB: OUT: [=`Code] *)
+type code = [ | `Code ]
+
+type code_content = [ | phrasing ]
+
+type code_content_fun = [ | phrasing ]
+
+type code_attrib = [ | common ]
+
+(* NAME: dfn, KIND: star, TYPE: [= common ], [= phrasing_without_dfn ], [=`Dfn], ARG: [= phrasing_without_dfn ], ATTRIB: OUT: [=`Dfn] *)
+type dfn = [ | `Dfn ]
+
+type dfn_content = [ | phrasing_without_dfn ]
+
+type dfn_content_fun = [ | phrasing_without_dfn ]
+
+type dfn_attrib = [ | common ]
+
+(* NAME: em, KIND: star, TYPE: [= common ], [= phrasing ], [=`Em], ARG: [= phrasing ], ATTRIB: OUT: [=`Em] *)
+type em = [ | `Em ]
+
+type em_content = [ | phrasing ]
+
+type em_content_fun = [ | phrasing ]
+
+type em_attrib = [ | common ]
+
+(* NAME: kbd, KIND: star, TYPE: [= common ], [= phrasing ], [=`Kbd], ARG: [= phrasing ], ATTRIB: OUT: [=`Kbd] *)
+type kbd = [ | `Kbd ]
+
+type kbd_content = [ | phrasing ]
+
+type kbd_content_fun = [ | phrasing ]
+
+type kbd_attrib = [ | common ]
+
+(* NAME: q, KIND: star, TYPE: [= common | `Cite ], [= phrasing ], [=`Q], ARG: [= phrasing ], ATTRIB: OUT: [=`Q] *)
+type q = [ | `Q ]
+
+type q_content = [ | phrasing ]
+
+type q_content_fun = [ | phrasing ]
+
+type q_attrib = [ | common | `Cite ]
+
+(* NAME: samp, KIND: star, TYPE: [= common ], [= phrasing ], [=`Samp], ARG: [= phrasing ], ATTRIB: OUT: [=`Samp] *)
+type samp = [ | `Samp ]
+
+type samp_content = [ | phrasing ]
+
+type samp_content_fun = [ | phrasing ]
+
+type samp_attrib = [ | common ]
+
+(* NAME: span, KIND: star, TYPE: [= common ], [= phrasing ], [=`Span], ARG: [= phrasing ], ATTRIB: OUT: [=`Span] *)
+type span = [ | `Span ]
+
+type span_content = [ | phrasing ]
+
+type span_content_fun = [ | phrasing ]
+
+type span_attrib = [ | common ]
+
+(* NAME: strong, KIND: star, TYPE: [= common ], [= phrasing ], [=`Strong], ARG: [= phrasing ], ATTRIB: OUT: [=`Strong] *)
+type strong = [ | `Strong ]
+
+type strong_content = [ | phrasing ]
+
+type strong_content_fun = [ | phrasing ]
+
+type strong_attrib = [ | common ]
+
+(* NAME: time, KIND: star, TYPE: [= common |`Datetime |`Pubdate], [= phrasing_without_time ], [=`Time], ARG: [= phrasing_without_time ], ATTRIB: OUT: [=`Time] *)
+type time = [ | `Time ]
+
+type time_content = [ | phrasing_without_time ]
+
+type time_content_fun = [ | phrasing_without_time ]
+
+type time_attrib = [ | common | `Datetime | `Pubdate ]
+
+(* NAME: var, KIND: star, TYPE: [= common ], [= phrasing ], [=`Var], ARG: [= phrasing ], ATTRIB: OUT: [=`Var] *)
+type var = [ | `Var ]
+
+type var_content = [ | phrasing ]
+
+type var_content_fun = [ | phrasing ]
+
+type var_attrib = [ | common ]
+
+(* NAME: a, KIND: star, TYPE: [= common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type ], 'a, [= `A of 'a ], ARG: 'a, ATTRIB: OUT: [= `A of 'a ] *)
+type a_content = flow5_without_interactive
+
+type a_content_fun = flow5_without_interactive
+
+type 'a a = [ | `A of 'a ]
+type a_ = [ `A of a_content ] (* should not be used as it may break *)
+type a_attrib =
+ [ | common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type
+ | `Download
+ ]
+
+(* NAME: del, KIND: star, TYPE: [= common | `Cite | `Datetime ], 'a,[=`Del of 'a], ARG: 'a, ATTRIB: OUT: [=`Del of 'a] *)
+type 'a del = [ | `Del of 'a ]
+type del_content = flow5
+type del_ = del_content del
+type del_content_fun = flow5
+
+type del_attrib = [ | common | `Cite | `Datetime ]
+
+(* NAME: ins, KIND: star, TYPE: [= common | `Cite | `Datetime ],'a ,[=`Ins of 'a], ARG: 'a , ATTRIB: OUT: [=`Ins of 'a] *)
+type 'a ins = [ | `Ins of 'a ]
+
+type ins_content = flow5
+type ins_ = ins_content ins
+type ins_content_fun = flow5
+
+type ins_attrib = [ | common | `Cite | `Datetime ]
+
+(* NAME: iframe, KIND: ndbox, TYPE: *| `Srcdoc*, ARG: , ATTRIB: OUT: *)
+type iframe = [ | `Iframe ]
+
+type iframe_content = [ | `PCDATA ]
+
+type iframe_content_fun = [ | `PCDATA ]
+
+type iframe_attrib =
+ [
+ | common
+ | `Src
+ | (*| `Srcdoc*)
+ `Name
+ | `Sandbox
+ | `Seamless
+ | `Width
+ | `Height
+ ]
+
+type object__content = [ | flow5 | `Param ]
+
+type object__content_fun = flow5
+
+type 'a object_ = [ | `Object of 'a | `Object_interactive of 'a]
+type object__ = object__content object_
+type object__attrib =
+ [
+ | common
+ | `Data
+ | `Form
+ | `Mime_type
+ | `Height
+ | `Width
+ | `Name
+ | `Usemap
+ ]
+
+(* NAME: param, KIND: nullary, TYPE: [= common | `Name | `Text_Value ],[= `Param ], ARG: notag, ATTRIB: OUT: [= `Param ] *)
+type param = [ | `Param ]
+
+type param_content = notag
+
+type param_content_fun = notag
+
+type param_attrib = [ | common | `Name | `Text_Value ]
+
+(* NAME: embed, KIND: nullary, TYPE: [= common | `Src | `Height | `Mime_type | `Width], [=`Embed], ARG: notag, ATTRIB: OUT: [=`Embed] *)
+type embed = [ | `Embed ]
+
+type embed_content = notag
+
+type embed_content_fun = notag
+
+type embed_attrib = [ | common | `Src | `Height | `Mime_type | `Width ]
+
+type img = [ `Img ]
+type img_interactive = [ `Img | `Img_interactive ]
+type img_content = notag
+type img_content_fun = notag
+type img_attrib = [ | common | `Height | `Ismap | `Width | `Srcset | `Img_sizes]
+
+(* Attributes used by audio and video. *)
+type media_attrib =
+ [ | `Crossorigin
+ | `Preload
+ | `Autoplay
+ | `Mediagroup
+ | `Loop
+ | `Muted
+ | `Controls
+ ]
+
+type 'a audio = [ | `Audio of 'a ]
+type 'a audio_interactive = [ | `Audio of 'a | `Audio_interactive of 'a ]
+
+type audio_content = flow5_without_media
+type audio_ = audio_content audio
+type audio_content_fun = flow5_without_media
+
+type audio_attrib =
+ [ | common
+ | media_attrib
+ ]
+
+
+type 'a video = [ | `Video of 'a ]
+type 'a video_interactive = [ | `Video of 'a | `Video_interactive of 'a ]
+
+type video_content = flow5_without_media
+type video_ = video_content video
+type video_content_fun = flow5_without_media
+
+type video_attrib =
+ [ | common
+ | media_attrib
+ | `Poster
+ | `Width
+ | `Height
+ ]
+
+(* NAME: canvas, KIND: star, TYPE: [= common |`Width |`Height],'a, [=`Canvas of 'a], ARG: 'a, ATTRIB: OUT: [=`Canvas of 'a] *)
+type 'a canvas = [ | `Canvas of 'a ]
+
+type canvas_content = flow5
+type canvas_ = canvas_content canvas
+type canvas_content_fun = flow5
+
+type canvas_attrib = [ | common | `Width | `Height ]
+
+(* NAME: source, KIND: nullary, TYPE: [= common |`Src |`Mime_type |`Media ], [=`Source], ARG: notag, ATTRIB: OUT: [=`Source] *)
+type source = [ | `Source ]
+
+type source_content = notag
+
+type source_content_fun = notag
+
+type source_attrib = [ | common | `Src | `Mime_type | `Media ]
+
+(* NAME: area, KIND: nullary, TYPE: [= common | `Alt | `Coords | `Shape| `Target | `Rel | `Media| `Hreflang | `Mime_type],[=`Area], ARG: notag, ATTRIB: OUT: [=`Area] *)
+type area = [ | `Area ]
+
+type area_content = notag
+
+type area_content_fun = notag
+
+type area_attrib =
+ [
+ | common
+ | `Alt
+ | `Coords
+ | `Shape
+ | `Target
+ | `Rel
+ | `Media
+ | `Hreflang
+ | `Mime_type
+ | `Download
+ ]
+
+(* NAME: map, KIND: plus, TYPE: [=common | `Name ],'a, [=`Map of 'a], ARG: 'a, ATTRIB: OUT: [=`Map of 'a] *)
+type 'a map = [ | `Map of 'a ]
+
+type map_content = flow5
+type map_ = map_content map
+
+type map_content_fun = flow5
+
+type map_attrib = [ | common | `Name ]
+
+(* NAME: caption, KIND: star, TYPE: [= common ], [= flow5_without_table], [=`Caption], ARG: [= flow5_without_table], ATTRIB: OUT: [=`Caption] *)
+type caption = [ | `Caption ]
+
+type caption_content = [ | flow5_without_table ]
+
+type caption_content_fun = [ | flow5_without_table ]
+
+type caption_attrib = [ | common ]
+
+(* NAME: table, KIND: plus, TYPE: [= common | `Summary ], [= `Tr ], [=`Table], ARG: [= `Tr ], ATTRIB: OUT: [=`Table] *)
+type table = [ | `Table ]
+
+type table_content = [ | `Tr ]
+
+type table_content_fun = [ | `Tr ]
+
+type table_attrib = [ | common | `Summary ]
+
+(* NAME: tablex, KIND: star, TYPE: [= common | `Summary ], [= `Tbody ], [=`Table], ARG: [= `Tbody ], ATTRIB: OUT: [=`Table] *)
+type tablex = [ | `Table ]
+
+type tablex_content = [ | `Tbody ]
+
+type tablex_content_fun = [ | `Tbody ]
+
+type tablex_attrib = [ | common | `Summary ]
+
+(* NAME: colgroup, KIND: star, TYPE: [= common | `Span ],[= `Col ], [=`Colgroup], ARG: [= `Col ], ATTRIB: OUT: [=`Colgroup] *)
+type colgroup = [ | `Colgroup ]
+
+type colgroup_content = [ | `Col ]
+
+type colgroup_content_fun = [ | `Col ]
+
+type colgroup_attrib = [ | common | `Span ]
+
+(* NAME: col, KIND: nullary, TYPE: [= common | `Span], [=`Col], ARG: notag, ATTRIB: OUT: [=`Col] *)
+type col = [ | `Col ]
+
+type col_content = notag
+
+type col_content_fun = notag
+
+type col_attrib = [ | common | `Span ]
+
+(* NAME: thead, KIND: star, TYPE: [= common],[= `Tr ], [=`Thead], ARG: [= `Tr ], ATTRIB: OUT: [=`Thead] *)
+type thead = [ | `Thead ]
+
+type thead_content = [ | `Tr ]
+
+type thead_content_fun = [ | `Tr ]
+
+type thead_attrib = [ | common ]
+
+(* NAME: tbody, KIND: star, TYPE: [= common],[= `Tr ], [=`Tbody], ARG: [= `Tr ], ATTRIB: OUT: [=`Tbody] *)
+type tbody = [ | `Tbody ]
+
+type tbody_content = [ | `Tr ]
+
+type tbody_content_fun = [ | `Tr ]
+
+type tbody_attrib = [ | common ]
+
+(* NAME: tfoot, KIND: star, TYPE: [= common],[= `Tr ], [=`Tfoot], ARG: [= `Tr ], ATTRIB: OUT: [=`Tfoot] *)
+type tfoot = [ | `Tfoot ]
+
+type tfoot_content = [ | `Tr ]
+
+type tfoot_content_fun = [ | `Tr ]
+
+type tfoot_attrib = [ | common ]
+
+(* NAME: td, KIND: star, TYPE: [= common | `Colspan | `Headers | `Rowspan ], [= flow5 ], [=`Td], ARG: [= flow5 ], ATTRIB: OUT: [=`Td] *)
+type td = [ | `Td ]
+
+type td_content = [ | flow5 ]
+
+type td_content_fun = [ | flow5 ]
+
+type td_attrib = [ | common | `Colspan | `Headers | `Rowspan ]
+
+(* NAME: th, KIND: star, TYPE: [= common | `Colspan | `Headers | `Rowspan | `Scope], [= phrasing], [=`Th], ARG: [= phrasing], ATTRIB: OUT: [=`Th] *)
+type th = [ | `Th ]
+
+type th_content = [ | phrasing ]
+
+type th_content_fun = [ | phrasing ]
+
+type th_attrib = [ | common | `Colspan | `Headers | `Rowspan | `Scope ]
+
+(* NAME: tr, KIND: star, TYPE: [= common ],[= `Td | `Th ], [=`Tr], ARG: [= `Td | `Th ], ATTRIB: OUT: [=`Tr] *)
+type tr = [ | `Tr ]
+
+type tr_content = [ | `Td | `Th ]
+
+type tr_content_fun = [ | `Td | `Th ]
+
+type tr_attrib = [ | common ]
+
+(* NAME: form, KIND: plus, TYPE: [= common |`Accept_charset | `Action | `Enctype | `Method | `Name | `Target | `Autocomplete | `Novalidate ], [= flow5_without_form ], [=`Form], ARG: [= flow5_without_form ], ATTRIB: OUT: [=`Form] *)
+type form = [ | `Form ]
+
+type form_content = [ | flow5_without_form ]
+
+type form_content_fun = [ | flow5_without_form ]
+
+type form_attrib =
+ [
+ | common
+ | `Accept_charset
+ | `Action
+ | `Enctype
+ | `Method
+ | `Name
+ | `Target
+ | `Autocomplete
+ | `Novalidate
+ ]
+
+(* NAME: fieldset, KIND: star, TYPE: [= common | `Disabled | `Form | `Name], [= flow5 ], [=`Fieldset], ARG: [= flow5 ], ATTRIB: OUT: [=`Fieldset] *)
+type fieldset = [ | `Fieldset ]
+
+type fieldset_content = [ | flow5 ]
+
+type fieldset_content_fun = [ | flow5 ]
+
+type fieldset_attrib = [ | common | `Disabled | `Form | `Name ]
+
+(* NAME: legend, KIND: star, TYPE: [= common ],[= phrasing], [=`Legend], ARG: [= phrasing], ATTRIB: OUT: [=`Legend] *)
+type legend = [ | `Legend ]
+
+type legend_content = [ | phrasing ]
+
+type legend_content_fun = [ | phrasing ]
+
+type legend_attrib = [ | common ]
+
+(* NAME: label, KIND: star, TYPE: [= common | `Label_for | `Form ],[= phrasing_without_label], [=`Label], ARG: [= phrasing_without_label], ATTRIB: OUT: [=`Label] *)
+type label = [ | `Label ]
+
+type label_content = [ | phrasing_without_label ]
+
+type label_content_fun = [ | phrasing_without_label ]
+
+type label_attrib = [ | common | `Label_for | `Form ]
+
+(* NAME: input, KIND: nullary, TYPE: [= input_attr ], [=`Input], ARG: notag, ATTRIB: OUT: [=`Input] *)
+type input = [ | `Input ]
+
+type input_content = notag
+
+type input_content_fun = notag
+
+type input_attrib =
+ [
+ | common
+ | `Accept
+ | `Alt
+ | `Autocomplete
+ | `Autofocus
+ | `Checked
+ | `Disabled
+ | `Form
+ | `Formation
+ | `Formenctype
+ | `Method
+ | `Formnovalidate
+ | `Formtarget
+ | `Height
+ | `List
+ | `Input_Max
+ | `Maxlength
+ | `Input_Min
+ | `Multiple
+ | `Name
+ | `Pattern
+ | `Placeholder
+ | `ReadOnly
+ | `Required
+ | `Size
+ | `Src
+ | `Step
+ | `Input_Type
+ | `Value
+ | `Width
+ | `Inputmode
+ ]
+
+type textarea = [ | `Textarea ]
+
+type textarea_attrib =
+ [
+ | common
+ | `Autofocus
+ | `Disabled
+ | `Form
+ | `Maxlength
+ | `Name
+ | `Placeholder
+ | `ReadOnly
+ | `Required
+ | `Wrap
+ | `Rows
+ | `Cols
+ ]
+
+type textarea_content = [ | `PCDATA ]
+
+type textarea_content_fun = textarea_content
+
+(* NAME: button, KIND: star, TYPE: [= button_attr ], [= phrasing_without_interactive ], [=`Button], ARG: [= phrasing_without_interactive ], ATTRIB: OUT: [=`Button] *)
+type button = [ | `Button ]
+
+type button_content = [ | phrasing_without_interactive ]
+
+type button_content_fun = [ | phrasing_without_interactive ]
+
+type button_attrib =
+ [
+ | common
+ | `Autofocus
+ | `Disabled
+ | `Form
+ | `Formaction
+ | `Formenctype
+ | `Method
+ | `Formnovalidate
+ | `Formtarget
+ | `Name
+ | `Text_Value
+ | `Button_Type
+ ]
+
+(* NAME: select, KIND: star, TYPE: [= common |`Autofocus | `Multiple | `Name | `Size | `Form | `Disabled ], [ `Optgroup | `Option ],[=`Select], ARG: [ `Optgroup | `Option ], ATTRIB: OUT: [=`Select] *)
+type select = [ | `Select ]
+
+type select_content = [ | `Optgroup | `Option ]
+
+type select_content_fun = [ | `Optgroup | `Option ]
+
+type select_attrib =
+ [ | common | `Autofocus | `Multiple | `Name | `Size | `Form | `Disabled | `Required
+ ]
+
+(* NAME: datalist, KIND: nullary, TYPE: [= common ], [=`Datalist], ARG: notag, ATTRIB: OUT: [=`Datalist] *)
+type datalist = [ | `Datalist ]
+
+type datalist_content = notag
+
+type datalist_content_fun = notag
+
+type datalist_attrib = [ | common ]
+
+(* NAME: optgroup, KIND: star, TYPE: [= common | `Disabled | `Label ], [= `Option ], [=`Optgroup], ARG: [= `Option ], ATTRIB: OUT: [=`Optgroup] *)
+type optgroup = [ | `Optgroup ]
+
+type optgroup_content = [ | `Option ]
+
+type optgroup_content_fun = [ | `Option ]
+
+type optgroup_attrib = [ | common | `Disabled | `Label ]
+
+type option_attrib =
+ [ | common | `Selected | `Text_Value | `Disabled | `Label | `Value ]
+
+type selectoption = [ | `Option ]
+
+type option_content_fun = [ | `PCDATA ]
+
+type option_content = [ | `PCDATA ]
+
+(* NAME: keygen, KIND: nullary, TYPE: [= common | `Autofcus | `Challenge | `Disabled | `Form | `Keytype | `Name ], [=`Keygen], ARG: notag, ATTRIB: OUT: [=`Keygen] *)
+type keygen = [ | `Keygen ]
+
+type keygen_content = notag
+
+type keygen_content_fun = notag
+
+type keygen_attrib =
+ [ | common | `Autofcus | `Challenge | `Disabled | `Form | `Keytype | `Name
+ ]
+
+(* NAME: progress, KIND: star, TYPE: [= common | `Float_Value |`Max| `Form ],[= phrasing_without_progress], [=`Progress], ARG: [= phrasing_without_progress], ATTRIB: OUT: [=`Progress] *)
+type progress = [ | `Progress ]
+
+type progress_content = [ | phrasing_without_progress ]
+
+type progress_content_fun = [ | phrasing_without_progress ]
+
+type progress_attrib = [ | common | `Float_Value | `Max | `Form ]
+
+(* NAME: meter, KIND: star, TYPE: [= common |`Float_Value |`Min |`Max |`Low |`High |`Optimum |`Form],[= phrasing_without_meter ],[=`Meter], ARG: [= phrasing_without_meter ], ATTRIB: OUT: [=`Meter] *)
+type meter = [ | `Meter ]
+
+type meter_content = [ | phrasing_without_meter ]
+
+type meter_content_fun = [ | phrasing_without_meter ]
+
+type meter_attrib =
+ [ | common | `Float_Value | `Min | `Max | `Low | `High | `Optimum | `Form
+ ]
+
+(* NAME: output_elt, KIND: star, TYPE: [= common |`Form |`Output_for |`Name],[= phrasing ],[=`Output], ARG: [= phrasing ], ATTRIB: OUT: [=`Output] *)
+type output_elt = [ | `Output ]
+
+type output_elt_content = [ | phrasing ]
+
+type output_elt_content_fun = [ | phrasing ]
+
+type output_elt_attrib = [ | common | `Form | `Output_for | `Name ]
+
+(* NAME: details, KIND: star, TYPE: [= common | `Open ], [= flow5] elt, [= `Details], ARG: [= flow5] elt, ATTRIB: OUT: [= `Details] *)
+type details = [ | `Details ]
+
+type details_content = [ | flow5 ]
+
+type details_content_fun = [ | flow5 ]
+
+type details_attrib = [ | common | `Open ]
+
+(* NAME: summary, KIND: star, TYPE: [= common ],[= phrasing ], [=`Summary], ARG: [= phrasing ], ATTRIB: OUT: [=`Summary] *)
+type summary = [ | `Summary ]
+
+type summary_content = [ | phrasing ]
+
+type summary_content_fun = [ | phrasing ]
+
+type summary_attrib = [ | common ]
+
+(* NAME: command, KIND: nullary, TYPE: [= common |`Icon |`Disabled |`Checked|`Radiogroup |`Command_Type], [=`Command], ARG: notag, ATTRIB: OUT: [=`Command] *)
+type command = [ | `Command ]
+
+type command_content = notag
+
+type command_content_fun = notag
+
+type command_attrib =
+ [ | common | `Icon | `Disabled | `Checked | `Radiogroup | `Command_Type
+ ]
+
+(* NAME: menu, KIND: nullary, TYPE: [= common |`Label |`Menu_Type ],[=`Menu], ARG: notag, ATTRIB: OUT: [=`Menu] *)
+type menu = [ | `Menu ]
+
+type menu_content = notag
+
+type menu_content_fun = notag
+
+type menu_attrib = [ | common | `Label | `Menu_Type ]
+
+(* NAME: noscript, KIND: plus, TYPE: [= common ], 'a, [=`Noscript of 'a], ARG: 'a, ATTRIB: OUT: [=`Noscript of 'a] *)
+type noscript = [ | `Noscript of flow5_without_noscript ]
+
+type noscript_content = flow5_without_noscript
+
+type noscript_content_fun = flow5_without_noscript
+
+type noscript_attrib = [ | common ]
+
+(* NAME: meta, KIND: nullary, TYPE: [= common | `Http_equiv | `Name | `Content | `Charset ], [=`Meta], ARG: notag, ATTRIB: OUT: [=`Meta] *)
+type meta = [ | `Meta ]
+
+type meta_content = notag
+
+type meta_content_fun = notag
+
+type meta_attrib = [ | common | `Http_equiv | `Name | `Content | `Charset | `Property ]
+
+(* NAME: style, KIND: star, TYPE: [= common | `Media | `Mime_type | `Scoped ], [= `PCDATA ], [=`Style], ARG: [= `PCDATA ], ATTRIB: OUT: [=`Style] *)
+type style = [ | `Style ]
+
+type style_content = [ | `PCDATA ]
+
+type style_content_fun = [ | `PCDATA ]
+
+type style_attrib = [ | common | `Media | `Mime_type | `Scoped ]
+
+type script = [ | `Script ]
+
+type script_attrib =
+ [ | common | `Async | `Charset | `Src | `Defer | `Mime_type
+ ]
+
+type script_content = [ | `PCDATA ]
+
+type script_content_fun = [ | `PCDATA ]
+
+(* NAME: link, KIND: nullary, TYPE: [= common | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type ], [=`Link], ARG: notag, ATTRIB: OUT: [=`Link] *)
+type link = [ | `Link ]
+
+type link_content = notag
+
+type link_content_fun = notag
+
+type link_attrib =
+ [ | common | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type
+ ]
+
+type big_variant =
+ [ `W3_org_1999_xhtml
+ | `Default
+ | `Preserve
+ | `Selected
+ | `Get
+ | `Post
+ | `Checked
+ | `Disabled
+ | `ReadOnly
+ | `Async
+ | `Autofocus
+ | `Autoplay
+ | `Muted
+ | `Anonymous
+ | `Use_credentials
+ | `Controls
+ | `Ltr
+ | `Rtl
+ | `Formnovalidate
+ | `Hidden
+ | `Ismap
+ | `Loop
+ | `Novalidate
+ | `Open
+ | `Audio
+ | `Metadata
+ | `None
+ | `Pubdate
+ | `Required
+ | `Reversed
+ | `Scoped
+ | `Seamless
+ | `Hard
+ | `Soft
+ | `Multiple
+ | `Checkbox
+ | `Command
+ | `Radio
+ | `Context
+ | `Toolbar
+ | `Char
+ | `Justify
+ | `Left
+ | `Right
+ | `Col
+ | `Colgroup
+ | `Row
+ | `Rowgroup
+ | `All
+ | `Cols
+ | `Groups
+ | `None
+ | `Rows
+ | `Rect
+ | `Circle
+ | `Poly
+ | `Default
+ | `One
+ | `Zero
+ | `Auto
+ | `No
+ | `Yes
+ | `Defer
+ | `Verbatim
+ | `Latin
+ | `Latin_name
+ | `Latin_prose
+ | `Full_width_latin
+ | `Kana
+ | `Katakana
+ | `Numeric
+ | `Tel
+ | `Email
+ | `Url
+ ]
+
+type sandbox_token =
+ [ `Allow_forms
+ | `Allow_pointer_lock
+ | `Allow_popups
+ | `Allow_top_navigation
+ | `Allow_same_origin
+ | `Allow_script ]
+
+
+type input_type =
+ [ `Button
+ | `Checkbox
+ | `Color
+ | `Date
+ | `Datetime
+ | `Datetime_local
+ | `Email
+ | `File
+ | `Hidden
+ | `Image
+ | `Month
+ | `Number
+ | `Password
+ | `Radio
+ | `Range
+ | `Reset
+ | `Search
+ | `Submit
+ | `Tel
+ | `Text
+ | `Time
+ | `Url
+ | `Week ]
diff -Nru tyxml-3.5.0/lib/META tyxml-4.1.0/lib/META
--- tyxml-3.5.0/lib/META 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/META 1970-01-01 00:00:00.000000000 +0000
@@ -1,57 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: 021d471bb39b23f70df98da6742b16a3)
-version = "3.5.0"
-description = "HTML5 pages typed with polymorphic variants"
-requires = "str uutf"
-archive(byte) = "tyxml.cma"
-archive(byte, plugin) = "tyxml.cma"
-archive(native) = "tyxml.cmxa"
-archive(native, plugin) = "tyxml.cmxs"
-exists_if = "tyxml.cma"
-package "tools" (
- version = "3.5.0"
- description = "HTML5 pages typed with polymorphic variants"
- requires = "bytes"
- archive(byte) = "tyxml_tools.cma"
- archive(byte, plugin) = "tyxml_tools.cma"
- archive(native) = "tyxml_tools.cmxa"
- archive(native, plugin) = "tyxml_tools.cmxs"
- exists_if = "tyxml_tools.cma"
-)
-
-package "syntax" (
- version = "3.5.0"
- description = "HTML5 and SVG syntax extension"
- requires = "bytes camlp4"
- archive(syntax, preprocessor) = "pa_tyxml.cma"
- archive(syntax, toploop) = "pa_tyxml.cma"
- archive(syntax, preprocessor, native) = "pa_tyxml.cmxa"
- archive(syntax, preprocessor, native, plugin) = "pa_tyxml.cmxs"
- requires(toploop) = "tyxml"
- exists_if = "pa_tyxml.cma"
-)
-
-package "parser" (
- version = "3.5.0"
- description = "Simple XML parser"
- requires = "bytes camlp4.lib"
- archive(byte) = "tymlx_p.cma"
- archive(byte, plugin) = "tymlx_p.cma"
- archive(native) = "tymlx_p.cmxa"
- archive(native, plugin) = "tymlx_p.cmxs"
- exists_if = "tymlx_p.cma"
-)
-
-package "functor" (
- version = "3.5.0"
- description =
- "HTML5 pages typed with polymorphic variants (Functor version)"
- requires = "uutf"
- archive(byte) = "tyxml_f.cma"
- archive(byte, plugin) = "tyxml_f.cma"
- archive(native) = "tyxml_f.cmxa"
- archive(native, plugin) = "tyxml_f.cmxs"
- exists_if = "tyxml_f.cma"
-)
-# OASIS_STOP
-
diff -Nru tyxml-3.5.0/lib/svg_f.ml tyxml-4.1.0/lib/svg_f.ml
--- tyxml-3.5.0/lib/svg_f.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/svg_f.ml 2017-03-03 16:33:22.000000000 +0000
@@ -37,23 +37,23 @@
module Unit = struct
- let rel x = (x, None)
- let deg x = (x, Some `Deg)
- let grad x = (x, Some `Grad)
- let rad x = (x, Some `Rad)
- let ms x = (x, Some `Ms)
- let s x = (x, Some `S)
- let em x = (x, Some `Em)
- let ex x = (x, Some `Ex)
- let px x = (x, Some `Px)
- let in_ x = (x, Some `In)
- let cm x = (x, Some `Cm)
- let mm x = (x, Some `Mm)
- let pt x = (x, Some `Pt)
- let pc x = (x, Some `Pc)
- let percent x = (x, Some `Percent)
- let hz x = (x, Some `Hz)
- let khz x = (x, Some `KHz)
+ (* let rel x = (x, None) *)
+ (* let deg x = (x, Some `Deg) *)
+ (* let grad x = (x, Some `Grad) *)
+ (* let rad x = (x, Some `Rad) *)
+ (* let ms x = (x, Some `Ms) *)
+ (* let s x = (x, Some `S) *)
+ (* let em x = (x, Some `Em) *)
+ (* let ex x = (x, Some `Ex) *)
+ (* let px x = (x, Some `Px) *)
+ (* let in_ x = (x, Some `In) *)
+ (* let cm x = (x, Some `Cm) *)
+ (* let mm x = (x, Some `Mm) *)
+ (* let pt x = (x, Some `Pt) *)
+ (* let pc x = (x, Some `Pc) *)
+ (* let percent x = (x, Some `Percent) *)
+ (* let hz x = (x, Some `Hz) *)
+ (* let khz x = (x, Some `KHz) *)
let to_string f (n, unit) = Printf.sprintf "%g%s" n begin
match unit with
@@ -64,16 +64,16 @@
let angle_names = function `Deg -> "deg" | `Grad -> "grad" | `Rad -> "rad"
let string_of_angle a = to_string angle_names a
- let time_names = function `Ms -> "ms" | `S -> "s"
- let string_of_time a = to_string time_names a
+ (* let time_names = function `Ms -> "ms" | `S -> "s" *)
+ (* let string_of_time a = to_string time_names a *)
let length_names = function
| `Em -> "em" | `Ex -> "ex" | `Px -> "px" | `In -> "in" | `Cm -> "cm"
| `Mm -> "mm" | `Pt -> "pt" | `Pc -> "pc" | `Percent -> "%"
let string_of_length (a: length) = to_string length_names a
- let freq_names = function `Hz -> "Hz" | `KHz -> "kHz"
- let string_of_freq a = to_string freq_names a
+ (* let freq_names = function `Hz -> "Hz" | `KHz -> "kHz" *)
+ (* let string_of_freq a = to_string freq_names a *)
end
@@ -84,40 +84,6 @@
| None -> s
let list ?(sep=" ") f l = String.concat sep (List.map f l)
-let comma_list = list ~sep:", "
-
-let string_of_coord = string_of_length
-let string_of_number = string_of_float
-let string_of_number_optional_number =
- function
- | (x, Some y) -> Printf.sprintf "%g, %g" x y
- | (x, None) -> Printf.sprintf "%g" x
-let string_of_percentage = Printf.sprintf "%d%%"
-
-
-let string_of_transform =
- function
- | Matrix ((a, b, c, d, e, f)) ->
- Printf.sprintf "matrix(%g %g %g %g %g %g)" a b c d e f
- | Translate x ->
- Printf.sprintf "translate(%s)" (string_of_number_optional_number x)
- | Scale x ->
- Printf.sprintf "scale(%s)" (string_of_number_optional_number x)
- | Rotate ((angle, x)) ->
- Printf.sprintf "rotate(%s %s)" (string_of_angle angle)
- (match x with
- | Some ((x, y)) -> Printf.sprintf "%g %g" x y
- | None -> "")
- | SkewX angle -> Printf.sprintf "skewX(%s)" (string_of_angle angle)
- | SkewY angle -> Printf.sprintf "skewY(%s)" (string_of_angle angle)
-let string_of_transforms x = String.concat " " (List.map string_of_transform x)
-let string_of_fourfloats (a, b, c, d) = Printf.sprintf "%g %g %g %g" a b c d
-
-let string_of_lengths = list string_of_length
-let string_of_numbers = list string_of_float
-let string_of_numbers_semicolon = list ~sep:"; " string_of_float
-
-let string_of_coords = list (fun (a, b) -> Printf.sprintf "%g, %g" a b)
let string_of_color s = s
(* For now just string, we may want something better in the future. *)
@@ -135,13 +101,15 @@
(string_of_iri iri) ^" "^ (string_of_paint_whitout_icc b)
| #paint_whitout_icc as c -> string_of_paint_whitout_icc c
-module MakeWrapped
- (W : Xml_wrap.T)
- (Xml : Xml_sigs.Wrapped with type 'a wrap = 'a W.t
- and type 'a list_wrap = 'a W.tlist) =
+module Make_with_wrapped_functions
+
+ (Xml : Xml_sigs.T)
+ (C : Svg_sigs.Wrapped_functions with module Xml = Xml) =
+
struct
module Xml = Xml
+ module W = Xml.W
module Info = struct
let content_type = "image/svg+xml"
@@ -170,8 +138,6 @@
type 'a wrap = 'a W.t
type 'a list_wrap = 'a W.tlist
- type +'a elts = Xml.elt list
-
type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
@@ -187,9 +153,6 @@
let toeltl x = x
- let string_of_string x = x
-
- let to_xmlattribs x = x
let to_attrib x = x
let nullary tag ?a () =
@@ -209,12 +172,15 @@
let float_attrib = Xml.float_attrib
- let int_attrib = Xml.int_attrib
-
let string_attrib = Xml.string_attrib
- let uri_attrib = Xml.uri_attrib
+ (* wrap C module functions *)
+
+ let string_of_coord = C.string_of_length
+ let string_of_length = C.string_of_length
+
+ let string_of_lengths = C.string_of_lengths
(* Custom XML attributes *)
@@ -223,19 +189,22 @@
let number_attrib = float_attrib
+ (* for now string_attrib, we may want something better in the
+ future. *)
+ let color_attrib = Xml.string_attrib
(* SVG attributes *)
let metadata ?a children = Xml.node ?a "metadata" children
- let foreignobject ?a children = Xml.node ?a "foreignObject" children
+ let foreignObject ?a children = Xml.node ?a "foreignObject" children
let pcdata s = Xml.pcdata s
(* generated *)
let a_version = string_attrib "version"
- let a_baseprofile = string_attrib "baseProfile"
+ let a_baseProfile = string_attrib "baseProfile"
let a_x = user_attrib string_of_coord "x"
@@ -245,31 +214,32 @@
let a_height = user_attrib string_of_length "height"
- let a_preserveaspectratio =
+ let a_preserveAspectRatio =
string_attrib "preserveAspectRatio"
- let a_contentscripttype =
+ let a_contentScriptType =
string_attrib "contentScriptType"
- let a_contentstyletype = string_attrib "contentStyleType"
+ let a_contentStyleType = string_attrib "contentStyleType"
let a_zoomAndPan x =
- let f = function `Disable -> "disable" | `Magnify -> "magnify" in
- user_attrib f "zoomAndSpan" x
+ user_attrib C.string_of_big_variant "zoomAndSpan" x
+
+ let a_href = string_attrib "href"
let a_xlink_href = string_attrib "xlink:href"
- let a_requiredfeatures =
+ let a_requiredFeatures =
Xml.space_sep_attrib "requiredFeatures"
- let a_requiredextensions =
+ let a_requiredExtensions =
Xml.space_sep_attrib "requiredExtension"
- let a_systemlanguage =
+ let a_systemLanguage =
Xml.comma_sep_attrib "systemLanguage"
- let a_externalressourcesrequired =
- user_attrib string_of_bool "externalRessourcesRequired"
+ let a_externalRessourcesRequired =
+ user_attrib C.string_of_bool "externalRessourcesRequired"
let a_id = string_attrib "id"
@@ -278,26 +248,25 @@
let a_xml_lang = string_attrib "xml:lang"
let a_xml_space x =
- let f = function `Default -> "default" | `Preserve -> "preserve" in
- user_attrib f "xml:space" x
+ user_attrib C.string_of_big_variant "xml:space" x
let a_type = string_attrib "type"
let a_media = Xml.comma_sep_attrib "media"
- let a_title = string_attrib "title"
+ let a_xlink_title = string_attrib "xlink:title"
let a_class = Xml.space_sep_attrib "class"
let a_style = string_attrib "style"
- let a_transform = user_attrib string_of_transform "transform"
+ let a_transform = user_attrib C.string_of_transforms "transform"
- let a_viewbox = user_attrib string_of_fourfloats "viewBox"
+ let a_viewBox = user_attrib C.string_of_fourfloats "viewBox"
let a_d = string_attrib "d"
- let a_pathlength = number_attrib "pathLength"
+ let a_pathLength = number_attrib "pathLength"
let a_rx = user_attrib string_of_length "rx"
@@ -317,352 +286,231 @@
let a_y2 = user_attrib string_of_coord "y2"
- let a_points = user_attrib string_of_coords "points"
+ let a_points = user_attrib C.string_of_coords "points"
let a_x_list = user_attrib string_of_lengths "x"
let a_y_list = user_attrib string_of_lengths "y"
- let a_dx = user_attrib string_of_number "dx"
+ let a_dx = user_attrib C.string_of_number "dx"
- let a_dy = user_attrib string_of_number "dy"
+ let a_dy = user_attrib C.string_of_number "dy"
let a_dx_list = user_attrib string_of_lengths "dx"
let a_dy_list = user_attrib string_of_lengths "dy"
- let a_lengthadjust x =
- let f = function
- | `Spacing -> "spacing"
- | `SpacingAndGlyphs -> "spacingAndGlyphs" in
- user_attrib f "lengthAdjust" x
+ let a_lengthAdjust x =
+ user_attrib C.string_of_big_variant "lengthAdjust" x
- let a_textlength = user_attrib string_of_length "textLength"
+ let a_textLength = user_attrib string_of_length "textLength"
let a_text_anchor x =
- let f = function
- | `Start -> "start" | `Middle -> "middle"
- | `End -> "end" | `Inherit -> "inherit" in
- user_attrib f "text-anchor" x
+ user_attrib C.string_of_big_variant "text-anchor" x
let a_text_decoration x =
- let f = function
- | `None -> "none" | `Underline -> "underline"
- | `Overline -> "overline" | `Line_through -> "line-through"
- | `Blink -> "blink" | `Inherit -> "inherit" in
- user_attrib f "text-decoration" x
+ user_attrib C.string_of_big_variant "text-decoration" x
let a_text_rendering x =
- let f = function
- | `Auto -> "auto"
- | `OptimizeSpeed -> "optimizeSpeed"
- | `OptimizeLegibility -> "optimizeLegibility"
- | `GeometricPrecision -> "geometricPrecision"
- | `Inherit -> "inherit" in
- user_attrib f "text-rendering" x
+ user_attrib C.string_of_big_variant "text-rendering" x
- let a_rotate = user_attrib string_of_numbers "rotate"
+ let a_rotate = user_attrib C.string_of_numbers "rotate"
- let a_startoffset = user_attrib string_of_length "startOffset"
+ let a_startOffset = user_attrib string_of_length "startOffset"
let a_method x =
- let f = function | `Align -> "align" | `Stretch -> "stretch" in
- user_attrib f "method" x
+ user_attrib C.string_of_big_variant "method" x
let a_spacing x =
- let f = function | `Auto -> "auto" | `Exact -> "exact" in
- user_attrib f "spacing" x
+ user_attrib C.string_of_big_variant "spacing" x
- let a_glyphref = string_attrib "glyphRef"
+ let a_glyphRef = string_attrib "glyphRef"
let a_format = string_attrib "format"
- let a_markerunits x =
- let f = function `StrokeWidth -> "strokeWidth"| `UserSpaceOnUse -> "userSpaceOnUse" in
- user_attrib f "markerUnits" x
+ let a_markerUnits x =
+ user_attrib C.string_of_big_variant "markerUnits" x
- let a_refx = user_attrib string_of_coord "refX"
+ let a_refX = user_attrib string_of_coord "refX"
- let a_refy = user_attrib string_of_coord "refY"
+ let a_refY = user_attrib string_of_coord "refY"
- let a_markerwidth = user_attrib string_of_length "markerWidth"
+ let a_markerWidth = user_attrib string_of_length "markerWidth"
- let a_markerheight = user_attrib string_of_length "markerHeight"
+ let a_markerHeight = user_attrib string_of_length "markerHeight"
let a_orient x =
- let f = function | `Auto -> "auto" | `Angle __svg -> string_of_angle __svg in
- user_attrib f "orient" x
+ user_attrib C.string_of_orient "orient" x
let a_local = string_attrib "local"
- let a_renderingindent x =
- let f = function
- | `Auto -> "auto" | `Perceptual -> "perceptual"
- | `Relative_colorimetric -> "relative_colorimetric" | `Saturation -> "saturation"
- | `Absolute_colorimetric -> "absolute_colorimetric" in
- user_attrib f "rendering:indent" x
-
- let a_gradientunits x =
- let f = function
- | `UserSpaceOnUse -> "userSpaceOnUse"
- | `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "gradientUnits" x
-
- let a_gradienttransform =
- user_attrib string_of_transforms "gradient:transform"
-
- let a_spreadmethod x =
- let f = function
- | `Pad -> "pad"| `Reflect -> "reflect"| `Repeat -> "repeat" in
- user_attrib f "spreadMethod" x
+ let a_rendering_intent x =
+ user_attrib C.string_of_big_variant "rendering-intent" x
+
+ let a_gradientUnits x =
+ user_attrib C.string_of_big_variant "gradientUnits" x
+
+ let a_gradientTransform =
+ user_attrib C.string_of_transforms "gradientTransform"
+
+ let a_spreadMethod x =
+ user_attrib C.string_of_big_variant "spreadMethod" x
let a_fx = user_attrib string_of_coord "fx"
let a_fy = user_attrib string_of_coord "fy"
let a_offset x =
- let f = function
- | `Number x -> string_of_number x
- | `Percentage x -> string_of_percentage x in
- user_attrib f "offset" x
-
- let a_patternunits x =
- let f = function
- | `UserSpaceOnUse -> "userSpaceOnUse"| `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "patternUnits" x
-
- let a_patterncontentunits x =
- let f = function | `UserSpaceOnUse -> "userSpaceOnUse"| `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "patternContentUnits" x
-
- let a_patterntransform x =
- user_attrib string_of_transforms "patternTransform" x
-
- let a_clippathunits x =
- let f = function
- | `UserSpaceOnUse -> "userSpaceOnUse"
- | `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "clipPathUnits" x
-
- let a_maskunits x =
- let f = function
- | `UserSpaceOnUse -> "userSpaceOnUse"
- | `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "maskUnits" x
-
- let a_maskcontentunits x =
- let f = function
- | `UserSpaceOnUse -> "userSpaceOnUse"
- | `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "maskContentUnits" x
-
- let a_primitiveunits x =
- let f = function
- | `UserSpaceOnUse -> "userSpaceOnUse"
- | `ObjectBoundingBox -> "objectBoundingBox" in
- user_attrib f "primitiveUnits" x
+ user_attrib C.string_of_offset "offset" x
+
+ let a_patternUnits x =
+ user_attrib C.string_of_big_variant "patternUnits" x
+
+ let a_patternContentUnits x =
+ user_attrib C.string_of_big_variant "patternContentUnits" x
+
+ let a_patternTransform x =
+ user_attrib C.string_of_transforms "patternTransform" x
+
+ let a_clipPathUnits x =
+ user_attrib C.string_of_big_variant "clipPathUnits" x
- let a_filterres x =
- user_attrib string_of_number_optional_number "filterResUnits" x
+ let a_maskUnits x =
+ user_attrib C.string_of_big_variant "maskUnits" x
+
+ let a_maskContentUnits x =
+ user_attrib C.string_of_big_variant "maskContentUnits" x
+
+ let a_primitiveUnits x =
+ user_attrib C.string_of_big_variant "primitiveUnits" x
+
+ let a_filterRes =
+ user_attrib C.string_of_number_optional_number "filterResUnits"
let a_result = string_attrib "result"
let a_in x =
- let f = function
- | `SourceGraphic -> "sourceGraphic"
- | `SourceAlpha -> "sourceAlpha"
- | `BackgroundImage -> "backgroundImage"
- | `BackgroundAlpha -> "backgroundAlpha"
- | `FillPaint -> "fillPaint"
- | `StrokePaint -> "strokePaint"
- | `Ref _svg -> _svg in
- user_attrib f "in" x
+ user_attrib C.string_of_in_value "in" x
let a_in2 x =
- let f = function
- | `SourceGraphic -> "sourceGraphic"
- | `SourceAlpha -> "sourceAlpha"
- | `BackgroundImage -> "backgroundImage"
- | `BackgroundAlpha -> "backgroundAlpha"
- | `FillPaint -> "fillPaint"
- | `StrokePaint -> "strokePaint"
- | `Ref _svg -> _svg in
- user_attrib f "in2" x
+ user_attrib C.string_of_in_value "in2" x
- let a_aizmuth = number_attrib "azimuth"
+ let a_azimuth = number_attrib "azimuth"
let a_elevation = number_attrib "elevation"
- let a_pointatx = number_attrib "pointsAtX"
+ let a_pointsAtX = number_attrib "pointsAtX"
- let a_pointaty = number_attrib "pointsAtY"
+ let a_pointsAtY = number_attrib "pointsAtY"
- let a_pointatz = number_attrib "pointsAtZ"
+ let a_pointsAtZ = number_attrib "pointsAtZ"
- let a_specularexponent = number_attrib "specularExponent"
+ let a_specularExponent = number_attrib "specularExponent"
- let a_specularconstant = number_attrib "specularConstant"
+ let a_specularConstant = number_attrib "specularConstant"
- let a_limitingconeangle = number_attrib "limitingConeAngle"
+ let a_limitingConeAngle = number_attrib "limitingConeAngle"
let a_mode x =
- let f = function
- | `Normal -> "normal"
- | `Multiply -> "multiply"
- | `Screen -> "screen"
- | `Darken -> "darken"
- | `Lighten -> "lighten" in
- user_attrib f "mode" x
+ user_attrib C.string_of_big_variant "mode" x
- let a_typefecolor x =
- let f = function
- | `Matrix -> "matrix"
- | `Saturate -> "saturate"
- | `HueRotate -> "hueRotate"
- | `LuminanceToAlpha -> "luminanceToAlpha" in
- user_attrib f "type" x
+ let a_feColorMatrix_type x =
+ user_attrib C.string_of_big_variant "type" x
- let a_values = user_attrib string_of_numbers "values"
+ let a_values = user_attrib C.string_of_numbers "values"
- let a_transferttype x =
- let f = function
- | `Identity -> "identity"
- | `Table -> "table"
- | `Discrete -> "discrete"
- | `Linear -> "linear"
- | `Gamma -> "gamma" in
- user_attrib f "type" x
+ let a_transfer_type x =
+ user_attrib C.string_of_big_variant "type" x
- let a_tablevalues = user_attrib string_of_numbers "tableValues"
+ let a_tableValues = user_attrib C.string_of_numbers "tableValues"
- let a_intercept = user_attrib string_of_number "intercept"
+ let a_intercept = user_attrib C.string_of_number "intercept"
- let a_amplitude = user_attrib string_of_number "amplitude"
+ let a_amplitude = user_attrib C.string_of_number "amplitude"
- let a_exponent = user_attrib string_of_number "exponent"
+ let a_exponent = user_attrib C.string_of_number "exponent"
- let a_offsettransfer = user_attrib string_of_number "offset"
+ let a_transfer_offset = user_attrib C.string_of_number "offset"
- let a_operator x =
- let f = function
- | `Over -> "over"
- | `In -> "in"
- | `Out -> "out"
- | `Atop -> "atop"
- | `Xor -> "xor"
- | `Arithmetic -> "arithmetic" in
- user_attrib f "operator" x
+ let a_feComposite_operator x =
+ user_attrib C.string_of_big_variant "operator" x
- let a_k1 = user_attrib string_of_number "k1"
+ let a_k1 = user_attrib C.string_of_number "k1"
- let a_k2 = user_attrib string_of_number "k2"
+ let a_k2 = user_attrib C.string_of_number "k2"
- let a_k3 = user_attrib string_of_number "k3"
+ let a_k3 = user_attrib C.string_of_number "k3"
- let a_k4 = user_attrib string_of_number "k4"
+ let a_k4 = user_attrib C.string_of_number "k4"
- let a_order = user_attrib string_of_number_optional_number "order"
+ let a_order = user_attrib C.string_of_number_optional_number "order"
- let a_kernelmatrix = user_attrib string_of_numbers "kernelMatrix"
+ let a_kernelMatrix = user_attrib C.string_of_numbers "kernelMatrix"
- let a_divisor = user_attrib string_of_number "divisor"
+ let a_divisor = user_attrib C.string_of_number "divisor"
- let a_bias = user_attrib string_of_number "bias"
+ let a_bias = user_attrib C.string_of_number "bias"
- let a_kernelunitlength =
- user_attrib string_of_number_optional_number "kernelUnitLength"
+ let a_kernelUnitLength =
+ user_attrib C.string_of_number_optional_number "kernelUnitLength"
- let a_targetX = user_attrib string_of_int "targetX"
+ let a_targetX = user_attrib C.string_of_int "targetX"
- let a_targetY = user_attrib string_of_int "targetY"
+ let a_targetY = user_attrib C.string_of_int "targetY"
- let a_edgemode x =
- let f = function
- | `Duplicate -> "duplicate"
- | `Wrap -> "wrap"
- | `None -> "none" in
- user_attrib f "targetY" x
+ let a_edgeMode x =
+ user_attrib C.string_of_big_variant "targetY" x
- let a_preservealpha = user_attrib string_of_bool "targetY"
+ let a_preserveAlpha = user_attrib C.string_of_bool "preserveAlpha"
- let a_surfacescale = user_attrib string_of_number "surfaceScale"
+ let a_surfaceScale = user_attrib C.string_of_number "surfaceScale"
- let a_diffuseconstant = user_attrib string_of_number "diffuseConstant"
+ let a_diffuseConstant =
+ user_attrib C.string_of_number "diffuseConstant"
- let a_scale = user_attrib string_of_number "scale"
+ let a_scale = user_attrib C.string_of_number "scale"
- let a_xchannelselector x =
- let f = function
- | `R -> "r"
- | `G -> "g"
- | `B -> "b"
- | `A -> "a" in
- user_attrib f "xChannelSelector" x
+ let a_xChannelSelector x =
+ user_attrib C.string_of_big_variant "xChannelSelector" x
- let a_ychannelselector x =
- let f = function
- | `R -> "r"
- | `G -> "g"
- | `B -> "b"
- | `A -> "a" in
- user_attrib f "yChannelSelector" x
+ let a_yChannelSelector x =
+ user_attrib C.string_of_big_variant "yChannelSelector" x
- let a_stddeviation =
- user_attrib string_of_number_optional_number "stdDeviation"
+ let a_stdDeviation =
+ user_attrib C.string_of_number_optional_number "stdDeviation"
- let a_operatormorphology x =
- let f = function
- | `Erode -> "erode"
- | `Dilate -> "dilate" in
- user_attrib f "operatorMorphology" x
+ let a_feMorphology_operator x =
+ user_attrib C.string_of_big_variant "operator" x
- let a_radius = user_attrib string_of_number_optional_number "radius"
+ let a_radius = user_attrib C.string_of_number_optional_number "radius"
- let a_basefrenquency =
- user_attrib string_of_number_optional_number "baseFrequency"
+ let a_baseFrenquency =
+ user_attrib C.string_of_number_optional_number "baseFrequency"
- let a_numoctaves = user_attrib string_of_int "numOctaves"
+ let a_numOctaves = user_attrib C.string_of_int "numOctaves"
- let a_seed = user_attrib string_of_number "seed"
+ let a_seed = user_attrib C.string_of_number "seed"
- let a_stitchtiles x =
- let f = function
- | `Stitch -> "stitch"
- | `NoStitch -> "noStitch" in
- user_attrib f "stitchTiles" x
+ let a_stitchTiles x =
+ user_attrib C.string_of_big_variant "stitchTiles" x
- let a_stitchtype x =
- let f = function
- | `FractalNoise -> "fractalNoise"
- | `Turbulence -> "turbulence" in
- user_attrib f "typeStitch" x
+ let a_feTurbulence_type x =
+ user_attrib C.string_of_big_variant "type" x
- let a_xlinkshow x =
- let f = function
- | `New -> "new"
- | `Replace -> "replace" in
- user_attrib f "xlink:show" x
+ let a_xlink_show x =
+ user_attrib C.string_of_big_variant "xlink:show" x
- let a_xlinkactuate x =
- let f = function
- | `OnRequest -> "onRequest"
- | `OnLoad -> "onLoad"
- | `Other -> "other"
- | `None -> "none"
- in user_attrib f "xlink:actuate" x
+ let a_xlink_actuate x =
+ user_attrib C.string_of_big_variant "xlink:actuate" x
let a_target = string_attrib "xlink:target"
- let a_viewtarget = string_attrib "viewTarget"
+ let a_viewTarget = string_attrib "viewTarget"
- let a_attributename = string_attrib "attributeName"
+ let a_attributeName = string_attrib "attributeName"
- let a_attributetype x =
- let f = function
- | `CSS -> "CSS"
- | `XML -> "XML"
- | `Auto -> "auto" in
- user_attrib f "attributeType" x
+ let a_attributeType x =
+ user_attrib C.string_of_big_variant "attributeType" x
let a_begin = string_attrib "begin"
@@ -673,37 +521,25 @@
let a_max = string_attrib "max"
let a_restart x =
- let f = function
- | `Always -> "always"
- | `WhenNotActive -> "whenNotActive"
- | `Never -> "never" in
- user_attrib f "restart" x
+ user_attrib C.string_of_big_variant "restart" x
- let a_repeatcount = string_attrib "repeatCount"
+ let a_repeatCount = string_attrib "repeatCount"
- let a_repeatdur = string_attrib "repeatDur"
+ let a_repeatDur = string_attrib "repeatDur"
- let a_fill = user_attrib string_of_paint "fill"
+ let a_fill = user_attrib C.string_of_paint "fill"
- let a_fill_animation x =
- let f = function
- | `Freeze -> "freeze"
- | `Remove -> "remove" in
- user_attrib f "fill" x
+ let a_animation_fill x =
+ user_attrib C.string_of_big_variant "fill" x
- let a_calcmode x =
- let f = function
- | `Discrete -> "discrete"
- | `Linear -> "linear"
- | `Paced -> "paced"
- | `Spline -> "spline" in
- user_attrib f "calcMode" x
+ let a_calcMode x =
+ user_attrib C.string_of_big_variant "calcMode" x
- let a_values_anim = Xml.comma_sep_attrib "values"
+ let a_animation_values = Xml.comma_sep_attrib "values"
- let a_keytimes = Xml.comma_sep_attrib "keyTimes"
+ let a_keyTimes = Xml.comma_sep_attrib "keyTimes"
- let a_keysplines = Xml.comma_sep_attrib "keySplines"
+ let a_keySplines = Xml.comma_sep_attrib "keySplines"
let a_from = string_attrib "from"
@@ -712,59 +548,39 @@
let a_by = string_attrib "by"
let a_additive x =
- let f = function
- | `Replace -> "replace"
- | `Sum -> "sum" in
- user_attrib f "additive" x
+ user_attrib C.string_of_big_variant "additive" x
let a_accumulate x =
- let f = function
- | `None -> "none"
- | `Sum -> "sum" in
- user_attrib f "accumulate" x
+ user_attrib C.string_of_big_variant "accumulate" x
- let a_keypoints = user_attrib string_of_numbers_semicolon "keyPoints"
+ let a_keyPoints = user_attrib C.string_of_numbers_semicolon "keyPoints"
let a_path = string_attrib "path"
- let a_typeanimatecolor x =
- let f = function
- | `Translate -> "translate"
- | `Scale -> "scale"
- | `Rotate -> "rotate"
- | `SkewX -> "skewX"
- | `SkewY -> "skewY" in
- user_attrib f "type" x
+ let a_animateTransform_type =
+ user_attrib C.string_of_big_variant "type"
- let a_horiz_origin_x = user_attrib string_of_number "horiz-origin-x"
+ let a_horiz_origin_x = user_attrib C.string_of_number "horiz-origin-x"
- let a_horiz_origin_y = user_attrib string_of_number "horiz-origin-y"
+ let a_horiz_origin_y = user_attrib C.string_of_number "horiz-origin-y"
- let a_horiz_adv_x = user_attrib string_of_number "horiz-adv-x"
+ let a_horiz_adv_x = user_attrib C.string_of_number "horiz-adv-x"
- let a_vert_origin_x = user_attrib string_of_number "vert-origin-x"
+ let a_vert_origin_x = user_attrib C.string_of_number "vert-origin-x"
- let a_vert_origin_y = user_attrib string_of_number "vert-origin-y"
+ let a_vert_origin_y = user_attrib C.string_of_number "vert-origin-y"
- let a_vert_adv_y = user_attrib string_of_number "vert-adv-y"
+ let a_vert_adv_y = user_attrib C.string_of_number "vert-adv-y"
let a_unicode = string_attrib "unicode"
- let a_glyphname = string_attrib "glyphname"
+ let a_glyph_name = string_attrib "glyphname"
let a_orientation x =
- let f = function
- | `H -> "h"
- | `V -> "v" in
- user_attrib f "orientation" x
-
- let a_arabicform x =
- let f = function
- | `Initial -> "initial"
- | `Medial -> "medial"
- | `Terminal -> "terminal"
- | `Isolated -> "isolated" in
- user_attrib f "arabic-form" x
+ user_attrib C.string_of_big_variant "orientation" x
+
+ let a_arabic_form x =
+ user_attrib C.string_of_big_variant "arabic-form" x
let a_lang = string_attrib "lang"
@@ -778,112 +594,82 @@
let a_k = string_attrib "k"
- let a_fontfamily = string_attrib "font-family"
+ let a_font_family = string_attrib "font-family"
- let a_fontstyle = string_attrib "font-style"
+ let a_font_style = string_attrib "font-style"
- let a_fontvariant = string_attrib "font-variant"
+ let a_font_variant = string_attrib "font-variant"
- let a_fontweight = string_attrib "font-weight"
+ let a_font_weight = string_attrib "font-weight"
- let a_fontstretch = string_attrib "font-stretch"
+ let a_font_stretch = string_attrib "font-stretch"
- let a_fontsize = string_attrib "font-size"
+ let a_font_size = string_attrib "font-size"
- let a_unicoderange = string_attrib "unicode-range"
+ let a_unicode_range = string_attrib "unicode-range"
- let a_unitsperem = string_attrib "units-per-em"
+ let a_units_per_em = string_attrib "units-per-em"
- let a_stemv = user_attrib string_of_number "stemv"
+ let a_stemv = user_attrib C.string_of_number "stemv"
- let a_stemh = user_attrib string_of_number "stemh"
+ let a_stemh = user_attrib C.string_of_number "stemh"
- let a_slope = user_attrib string_of_number "slope"
+ let a_slope = user_attrib C.string_of_number "slope"
- let a_capheight = user_attrib string_of_number "cap-height"
+ let a_cap_height = user_attrib C.string_of_number "cap-height"
- let a_xheight = user_attrib string_of_number "x-height"
+ let a_x_height = user_attrib C.string_of_number "x-height"
- let a_accentheight = user_attrib string_of_number "accent-height"
+ let a_accent_height = user_attrib C.string_of_number "accent-height"
- let a_ascent = user_attrib string_of_number "ascent"
+ let a_ascent = user_attrib C.string_of_number "ascent"
let a_widths = string_attrib "widths"
let a_bbox = string_attrib "bbox"
- let a_ideographic = user_attrib string_of_number "ideographic"
+ let a_ideographic = user_attrib C.string_of_number "ideographic"
- let a_alphabetic = user_attrib string_of_number "alphabetic"
+ let a_alphabetic = user_attrib C.string_of_number "alphabetic"
- let a_mathematical = user_attrib string_of_number "mathematical"
+ let a_mathematical = user_attrib C.string_of_number "mathematical"
- let a_hanging = user_attrib string_of_number "hanging"
+ let a_hanging = user_attrib C.string_of_number "hanging"
- let a_videographic = user_attrib string_of_number "v-ideographic"
+ let a_videographic = user_attrib C.string_of_number "v-ideographic"
- let a_valphabetic = user_attrib string_of_number "v-alphabetic"
+ let a_v_alphabetic = user_attrib C.string_of_number "v-alphabetic"
- let a_vmathematical = user_attrib string_of_number "v-mathematical"
+ let a_v_mathematical = user_attrib C.string_of_number "v-mathematical"
- let a_vhanging = user_attrib string_of_number "v-hanging"
+ let a_v_hanging = user_attrib C.string_of_number "v-hanging"
- let a_underlineposition =
- user_attrib string_of_number "underline-position"
+ let a_underline_position =
+ user_attrib C.string_of_number "underline-position"
- let a_underlinethickness =
- user_attrib string_of_number "underline-thickness"
+ let a_underline_thickness =
+ user_attrib C.string_of_number "underline-thickness"
- let a_strikethroughposition =
- user_attrib string_of_number "strikethrough-position"
+ let a_strikethrough_position =
+ user_attrib C.string_of_number "strikethrough-position"
- let a_strikethroughthickness =
- user_attrib string_of_number "strikethrough-thickness"
+ let a_strikethrough_thickness =
+ user_attrib C.string_of_number "strikethrough-thickness"
- let a_overlineposition = user_attrib string_of_number "overline-position"
+ let a_overline_position = user_attrib C.string_of_number "overline-position"
- let a_overlinethickness =
- user_attrib string_of_number "overline-thickness"
+ let a_overline_thickness =
+ user_attrib C.string_of_number "overline-thickness"
let a_string = string_attrib "string"
let a_name = string_attrib "name"
- let string_of_alignment_baseline = function
- | `Auto -> "auto"
- | `Baseline -> "baseline"
- | `Before_edge -> "before-edge"
- | `Text_before_edge -> "text-before-edge"
- | `Middle -> "middle"
- | `Central -> "central"
- | `After_edge -> "after-edge"
- | `Text_after_edge -> "text-after-edge"
- | `Ideographic -> "ideographic"
- | `Alphabetic -> "alphabetic"
- | `Hanging-> "hanging"
- | `Mathematical -> "mathematical"
- | `Inherit -> "inherit"
-
let a_alignment_baseline x =
- user_attrib string_of_alignment_baseline "alignment-baseline" x
-
- let string_of_dominant_baseline = function
- | `Auto -> "auto"
- | `Use_script -> "use-script"
- | `No_change -> "no-change"
- | `Reset_size -> "reset-size"
- | `Ideographic -> "ideographic"
- | `Alphabetic -> "alphabetic"
- | `Hanging -> "hanging"
- | `Mathematical -> "mathematical"
- | `Central -> "central"
- | `Middle -> "middle"
- | `Text_after_edge -> "text-after-edge"
- | `Text_before_edge -> "text-before-edge"
- | `Inherit -> "inherit"
+ user_attrib C.string_of_alignment_baseline "alignment-baseline" x
let a_dominant_baseline x =
- user_attrib string_of_dominant_baseline "dominant-baseline" x
+ user_attrib C.string_of_dominant_baseline "dominant-baseline" x
(** Javascript events *)
@@ -910,43 +696,31 @@
let a_onmouseout = Xml.mouse_event_handler_attrib "onmouseout"
let a_onmousemove = Xml.mouse_event_handler_attrib "onmousemove"
+ let a_stop_color = color_attrib "stop-color"
- let a_stopcolor = user_attrib string_of_color "stop-color"
+ let a_stop_opacity = user_attrib C.string_of_number "stop-opacity"
- let a_stopopacity = user_attrib string_of_number "stop-opacity"
+ let a_stroke = user_attrib C.string_of_paint "stroke"
- let a_stroke = user_attrib string_of_paint "stroke"
+ let a_stroke_width = user_attrib C.string_of_length "stroke-width"
- let a_strokewidth = user_attrib string_of_length "stroke-width"
+ let a_stroke_linecap x =
+ user_attrib C.string_of_big_variant "stroke-linecap" x
- let a_strokelinecap x =
- let f = function
- | `Butt -> "butt"
- | `Round -> "round"
- | `Square -> "square" in
- user_attrib f "stroke-linecap" x
-
- let a_strokelinejoin x =
- let f = function
- | `Miter -> "miter"
- | `Round -> "round"
- | `Bever -> "bevel" in
- user_attrib f "stroke-linejoin" x
-
- let a_strokemiterlimit =
- user_attrib string_of_number "stroke-miterlimit"
-
- let a_strokedasharray x =
- let f = function
- | [] -> "none"
- | l -> list string_of_length l in
- user_attrib f "stroke-dasharray" x
+ let a_stroke_linejoin x =
+ user_attrib C.string_of_big_variant "stroke-linejoin" x
- let a_strokedashoffset =
- user_attrib string_of_length "stroke-dashoffset"
+ let a_stroke_miterlimit =
+ user_attrib C.string_of_number "stroke-miterlimit"
- let a_strokeopacity =
- user_attrib string_of_number "stroke-opacity"
+ let a_stroke_dasharray x =
+ user_attrib C.string_of_strokedasharray "stroke-dasharray" x
+
+ let a_stroke_dashoffset =
+ user_attrib C.string_of_length "stroke-dashoffset"
+
+ let a_stroke_opacity =
+ user_attrib C.string_of_number "stroke-opacity"
(* xlink namespace given a nickname since some attributes mandated by
the svg standard such as xlink:href live in that namespace, and we
@@ -958,7 +732,7 @@
:: string_attrib "xmlns:xlink" (W.return "http://www.w3.org/1999/xlink")
:: to_xmlattribs a
in
- star ~a:(attribs) "svg" (W.map toeltl children)
+ star ~a:(attribs) "svg" children
(* also generated *)
let g = star "g"
@@ -999,77 +773,77 @@
let tref = star "tref"
- let textpath = star "textPath"
+ let textPath = star "textPath"
- let altglyph = unary "altGlyph"
+ let altGlyph = unary "altGlyph"
- let altglyphdef = unary "altGlyphDef"
+ let altGlyphDef = unary "altGlyphDef"
- let altglyphitem = star "altGlyphItem"
+ let altGlyphItem = star "altGlyphItem"
- let glyphref = nullary "glyphRef"
+ let glyphRef = nullary "glyphRef"
let marker = star "marker"
- let colorprofile = star "colorProfile"
+ let color_profile = star "color-profile"
- let lineargradient = star "linearGradient"
+ let linearGradient = star "linearGradient"
- let radialgradient = star "radialGradient"
+ let radialGradient = star "radialGradient"
let stop = star "stop"
let pattern = star "pattern"
- let clippath = star "clipPath"
+ let clipPath = star "clipPath"
let filter = star "filter"
- let fedistantlight = star "feDistantLight"
+ let feDistantLight = star "feDistantLight"
- let fepointlight = star "fePointLight"
+ let fePointLight = star "fePointLight"
- let fespotlight = star "feSpotLight"
+ let feSpotLight = star "feSpotLight"
- let feblend = star "feBlend"
+ let feBlend = star "feBlend"
- let fecolormatrix = star "feColorMatrix"
+ let feColorMatrix = star "feColorMatrix"
- let fecomponenttransfer = star "feComponentTransfer"
+ let feComponentTransfer = star "feComponentTransfer"
- let fefunca = star "feFuncA"
+ let feFuncA = star "feFuncA"
- let fefuncg = star "feFuncG"
+ let feFuncG = star "feFuncG"
- let fefuncb = star "feFuncB"
+ let feFuncB = star "feFuncB"
- let fefuncr = star "feFuncR"
+ let feFuncR = star "feFuncR"
- let fecomposite = star "feComposite"
+ let feComposite = star "feComposite"
- let feconvolvematrix = star "feConvolveMatrix"
+ let feConvolveMatrix = star "feConvolveMatrix"
- let fediffuselighting = star "feDiffuseLighting"
+ let feDiffuseLighting = star "feDiffuseLighting"
- let fedisplacementmap = star "feDisplacementMap"
+ let feDisplacementMap = star "feDisplacementMap"
- let feflood = star "feFlood"
+ let feFlood = star "feFlood"
- let fegaussianblur = star "feGaussianBlur"
+ let feGaussianBlur = star "feGaussianBlur"
- let feimage = star "feImage"
+ let feImage = star "feImage"
- let femerge = star "feMerge"
+ let feMerge = star "feMerge"
- let femorphology = star "feMorphology"
+ let feMorphology = star "feMorphology"
- let feoffset = star "feOffset"
+ let feOffset = star "feOffset"
- let fespecularlighting = star "feSpecularLighting"
+ let feSpecularLighting = star "feSpecularLighting"
- let fetile = star "feTile"
+ let feTile = star "feTile"
- let feturbulence = star "feTurbulence"
+ let feTurbulence = star "feTurbulence"
let cursor = star "cursor"
@@ -1083,33 +857,33 @@
let set = star "set"
- let animatemotion = star "animateMotion"
+ let animateMotion = star "animateMotion"
let mpath = star "mpath"
- let animatecolor = star "animateColor"
+ let animateColor = star "animateColor"
- let animatetransform = star "animateTransform"
+ let animateTransform = star "animateTransform"
let font = star "font"
let glyph = star "glyph"
- let missingglyph = star "missingGlyph"
+ let missing_glyph = star "missing-glyph"
let hkern = nullary "hkern"
let vkern = nullary "vkern"
- let fontface = nullary "fontFace"
+ let font_face = nullary "font-face"
- let fontfacesrc = star "font-face-src"
+ let font_face_src = star "font-face-src"
- let fontfaceuri = star "font-face-uri"
+ let font_face_uri = star "font-face-uri"
- let fontfaceformat = nullary "font-face-uri"
+ let font_face_format = nullary "font-face-uri"
- let fontfacename = nullary "font-face-name"
+ let font_face_name = nullary "font-face-name"
type doc = [ `Svg ] elt
let doc_toelt x = x
@@ -1140,7 +914,213 @@
end
-module Make(Xml : Xml_sigs.T) =
- MakeWrapped
- (Xml_wrap.NoWrap)
- (Xml)
+module Wrapped_functions
+ (Xml : Xml_sigs.T with type ('a,'b) W.ft = 'a -> 'b) =
+struct
+
+ module Xml = Xml
+
+ let string_of_alignment_baseline = function
+ | `Auto -> "auto"
+ | `Baseline -> "baseline"
+ | `Before_edge -> "before-edge"
+ | `Text_before_edge -> "text-before-edge"
+ | `Middle -> "middle"
+ | `Central -> "central"
+ | `After_edge -> "after-edge"
+ | `Text_after_edge -> "text-after-edge"
+ | `Ideographic -> "ideographic"
+ | `Alphabetic -> "alphabetic"
+ | `Hanging-> "hanging"
+ | `Mathematical -> "mathematical"
+ | `Inherit -> "inherit"
+
+ let string_of_big_variant = function
+ | `A -> "a"
+ | `Absolute_colorimetric -> "absolute_colorimetric"
+ | `Align -> ""
+ | `Always -> "always"
+ | `Atop -> "atop"
+ | `Arithmetic -> "arithmetic"
+ | `Auto -> "auto"
+ | `B -> "b"
+ | `Bever -> "bevel"
+ | `Blink -> "blink"
+ | `Butt -> "butt"
+ | `CSS -> "CSS"
+ | `Darken -> "darken"
+ | `Default -> "default"
+ | `Dilate -> "dilate"
+ | `Disable -> "disable"
+ | `Discrete -> "discrete"
+ | `Duplicate -> "duplicate"
+ | `End -> "end"
+ | `Erode -> "erode"
+ | `Exact -> "exact"
+ | `FractalNoise -> "fractalNoise"
+ | `Freeze -> "freeze"
+ | `HueRotate -> "hueRotate"
+ | `G -> "g"
+ | `Gamma -> "gamma"
+ | `GeometricPrecision -> "geometricPrecision"
+ | `H -> "h"
+ | `Identity -> "identity"
+ | `In -> "in"
+ | `Inherit -> "inherit"
+ | `Initial -> "initial"
+ | `Isolated -> "isolated"
+ | `Lighten -> "lighten"
+ | `Line_through -> "line-through"
+ | `Linear -> "linear"
+ | `LuminanceToAlpha -> "luminanceToAlpha"
+ | `Magnify -> "magnify"
+ | `Matrix -> "matrix"
+ | `Medial -> "medial"
+ | `Middle -> "middle"
+ | `Miter -> "miter"
+ | `Multiply -> "multiply"
+ | `Never -> "never"
+ | `New -> "new"
+ | `None -> "none"
+ | `Normal -> "normal"
+ | `NoStitch -> "noStitch"
+ | `ObjectBoundingBox -> "objectBoundingBox"
+ | `OnLoad -> "onLoad"
+ | `OnRequest -> "onRequest"
+ | `OptimizeLegibility -> "optimizeLegibility"
+ | `OptimizeSpeed -> "optimizeSpeed"
+ | `Other -> "other"
+ | `Out -> "out"
+ | `Over -> "over"
+ | `Overline -> "overline"
+ | `Paced -> "paced"
+ | `Pad -> "pad"
+ | `Perceptual -> "perceptual"
+ | `Preserve -> "preserve"
+ | `R -> "r"
+ | `Reflect -> "reflect"
+ | `Remove -> "remove"
+ | `Repeat -> "repeat"
+ | `Replace -> "replace"
+ | `Relative_colorimetric -> "relative_colorimetric"
+ | `Rotate -> "rotate"
+ | `Round -> "round"
+ | `Saturate -> "saturate"
+ | `Saturation -> "saturation"
+ | `Scale -> "scale"
+ | `Screen -> "screen"
+ | `SkewX -> "skewX"
+ | `SkewY -> "skewY"
+ | `Spacing -> "spacing"
+ | `SpacingAndGlyphs -> "spacingAndGlyphs"
+ | `Spline -> "spline"
+ | `Square -> "square"
+ | `Start -> "start"
+ | `Stitch -> "stitch"
+ | `Stretch -> "stretch"
+ | `StrokeWidth -> "stroke-width"
+ | `Sum -> "sum"
+ | `Table -> "table"
+ | `Terminal -> "terminal"
+ | `Translate -> "translate"
+ | `Turbulence -> "turbulence"
+ | `Underline -> "underline"
+ | `UserSpaceOnUse -> "userSpaceOnUse"
+ | `V -> "v"
+ | `WhenNotActive -> "whenNotActive"
+ | `Wrap -> "wrap"
+ | `XML -> "XML"
+ | `Xor -> "xor"
+
+ let string_of_bool = string_of_bool
+
+ let string_of_coords =
+ list (fun (a, b) -> Printf.sprintf "%g, %g" a b)
+
+ let string_of_dominant_baseline = function
+ | `Auto -> "auto"
+ | `Use_script -> "usescript"
+ | `No_change -> "nochange"
+ | `Reset_size -> "resetsize"
+ | `Ideographic -> "ideographic"
+ | `Alphabetic -> "alphabetic"
+ | `Hanging -> "hanging"
+ | `Mathematical -> "mathematical"
+ | `Central -> "central"
+ | `Middle -> "middle"
+ | `Text_after_edge -> "textafteredge"
+ | `Text_before_edge -> "textbeforeedge"
+ | `Inherit -> "inherit"
+
+
+ let string_of_in_value = function
+ | `SourceGraphic -> "sourceGraphic"
+ | `SourceAlpha -> "sourceAlpha"
+ | `BackgroundImage -> "backgroundImage"
+ | `BackgroundAlpha -> "backgroundAlpha"
+ | `FillPaint -> "fillPaint"
+ | `StrokePaint -> "strokePaint"
+ | `Ref _svg -> _svg
+
+ let string_of_int = string_of_int
+
+ let string_of_length = Unit.string_of_length
+
+ let string_of_lengths = list string_of_length
+
+ let string_of_number = Xml_print.string_of_number
+
+ let string_of_percentage x = (string_of_number x) ^ "%"
+
+ let string_of_fourfloats (a, b, c, d) =
+ Printf.sprintf "%s %s %s %s"
+ (string_of_number a) (string_of_number b) (string_of_number c) (string_of_number d)
+
+ let string_of_number_optional_number = function
+ | x, Some y -> Printf.sprintf "%g, %g" x y
+ | x, None -> Printf.sprintf "%g" x
+
+ let string_of_numbers = list string_of_number
+
+ let string_of_numbers_semicolon = list ~sep:"; " string_of_number
+
+ let string_of_offset = function
+ | `Number x -> string_of_number x
+ | `Percentage x -> string_of_percentage x
+
+ let string_of_orient = function
+ | None -> "auto"
+ | Some __svg -> string_of_angle __svg
+
+ let string_of_paint = string_of_paint
+
+ let string_of_strokedasharray = function
+ | [] -> "none"
+ | l -> list string_of_length l
+
+ let string_of_transform = function
+ | `Matrix (a, b, c, d, e, f) ->
+ Printf.sprintf "matrix(%g %g %g %g %g %g)" a b c d e f
+ | `Translate x ->
+ Printf.sprintf "translate(%s)"
+ (string_of_number_optional_number x)
+ | `Scale x ->
+ Printf.sprintf "scale(%s)" (string_of_number_optional_number x)
+ | `Rotate ((angle, x)) ->
+ Printf.sprintf "rotate(%s %s)" (string_of_angle angle)
+ (match x with
+ | Some ((x, y)) -> Printf.sprintf "%g %g" x y
+ | None -> "")
+ | `SkewX angle ->
+ Printf.sprintf "skewX(%s)" (string_of_angle angle)
+ | `SkewY angle ->
+ Printf.sprintf "skewY(%s)" (string_of_angle angle)
+
+ let string_of_transforms l =
+ String.concat " " (List.map string_of_transform l)
+
+end
+
+module Make
+ (Xml : Xml_sigs.T with type ('a, 'b) W.ft = ('a -> 'b)) =
+ Make_with_wrapped_functions(Xml)(Wrapped_functions(Xml))
diff -Nru tyxml-3.5.0/lib/svg_f.mli tyxml-4.1.0/lib/svg_f.mli
--- tyxml-3.5.0/lib/svg_f.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/svg_f.mli 2017-03-03 16:33:22.000000000 +0000
@@ -17,15 +17,14 @@
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
-(** Typesafe constructors for SVG documents (Functorial interface) *)
-
-(** This module defines basic data types for data, attributes
- and element occuring in SVG documents.
- It is based on the specification available at http://www.w3.org/TR/SVG/.
+(** Typesafe constructors for SVG documents (Functorial interface)
This module is experimental, it may lack of some attributes,
and the interface is very low level and do not take deeply into account
- the needs of SVG elements. *)
+ the needs of SVG elements.
+
+ {% See <>. %}
+*)
(*
open Svg_types
@@ -80,17 +79,27 @@
val string_of_transforms : transforms -> string
*)
-module Make(Xml : Xml_sigs.T)
+(** Create a new implementation of [Svg], using the given underlying [Xml]
+ implementation. Will output a module of type {!Svg_sigs.T} with
+ the various type equalities.
+
+ If your [Xml] implementation uses a special function wrapping, use
+ {!Make_with_wrapped_functions}.
+*)
+module Make(Xml : Xml_sigs.T with type ('a, 'b) W.ft = ('a -> 'b))
: Svg_sigs.Make(Xml).T
with type +'a elt = Xml.elt
and type +'a attrib = Xml.attrib
-(** Like the {! Svg_f.Make } functor, but allows to wrap elements inside a monad described by {! Xml_wrap.T}.
- See the functorial interface documentation for more details. *)
-module MakeWrapped
- (W: Xml_wrap.T)
- (Xml : Xml_sigs.Wrapped with type 'a wrap = 'a W.t
- and type 'a list_wrap = 'a W.tlist)
- : Svg_sigs.MakeWrapped(W)(Xml).T
+(** The standard set of wrapped functions, when [W.ft] is the regular function. *)
+module Wrapped_functions
+ (Xml: Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
+ : Svg_sigs.Wrapped_functions with module Xml = Xml
+
+(** Similar to {!Make} but with a custom set of wrapped functions. *)
+module Make_with_wrapped_functions
+ (Xml : Xml_sigs.T)
+ (C : Svg_sigs.Wrapped_functions with module Xml = Xml)
+ : Svg_sigs.Make(Xml).T
with type +'a elt = Xml.elt
and type +'a attrib = Xml.attrib
diff -Nru tyxml-3.5.0/lib/svg.ml tyxml-4.1.0/lib/svg.ml
--- tyxml-3.5.0/lib/svg.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/svg.ml 1970-01-01 00:00:00.000000000 +0000
@@ -1,24 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-module M = Svg_f.Make(Xml)
-
-module P = Xml_print.Make_typed_simple(Xml)(M)
-
-module Make_printer = Xml_print.Make_typed(Xml)(M)
diff -Nru tyxml-3.5.0/lib/svg.mli tyxml-4.1.0/lib/svg.mli
--- tyxml-3.5.0/lib/svg.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/svg.mli 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2011 Pierre Chambart, Grégoire Henry
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(** Typesafe constructors and printers for SVG documents.
-
- @see W3C Recommendation *)
-
-(** Concrete implementation of SVG typesafe constructors *)
-module M : Svg_sigs.Make(Xml).T
-
-(** Simple printer for SVG documents *)
-module P : Xml_sigs.Typed_simple_printer with type 'a elt := 'a M.elt
- and type doc := M.doc
-
-(** Parametrized stream printer for SVG documents *)
-module Make_printer(O : Xml_sigs.Output) :
- Xml_sigs.Typed_printer with type out := O.out
- and type 'a elt := 'a M.elt
- and type doc := M.doc
diff -Nru tyxml-3.5.0/lib/svg_sigs.mli tyxml-4.1.0/lib/svg_sigs.mli
--- tyxml-3.5.0/lib/svg_sigs.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/svg_sigs.mli 2017-03-03 16:33:22.000000000 +0000
@@ -17,46 +17,104 @@
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
+(** SVG signatures for the functorial interface. *)
+
+(** Signature of typesafe constructors for SVG documents. *)
module type T = sig
- open Svg_types
- open Unit
+ (** SVG elements.
- module Xml : Xml_sigs.Wrapped
- module Info : Xml_sigs.Info
+ Element constructors are in section {!elements}. Most elements constructors
+ are either {{!nullary}nullary}, {{!unary}unary} or {{!star}star},
+ depending on the number of children they accept.
+ Children are usually given as a list of elements.
+ {{!pcdata}pcdata} is used for text.
+
+ The type variable ['a] is used to track the element's type. This
+ allows the OCaml typechecker to check SVG validity.
+
+ Note that the concrete implementation of this type can vary.
+ See {!Xml} for details.
+ *)
+ type +'a elt
- type uri = Xml.uri
- val string_of_uri : uri -> string
- val uri_of_string : string -> uri
+ (** A complete SVG document. *)
+ type doc = [ `Svg ] elt
+
+ (** SVG attributes
- (** {1 Abstraction over XML's types} *)
+ Attribute constructors are in section {!attributes} and their name starts
+ with [a_]. Attributes are given to elements with the [~a] optional argument.
+ Similarly to {{!elt}elt}, attributes use the OCaml type system to enforce
+ Html validity.
+
+ In some cases, attributes have to be disambiguated.
+ The [max] attribute has two version,
+ {!a_fill} and {!a_animation_fill},
+ depending on the element.
+ Such disambiguated attribute will contain the name of the associated element.
+ *)
type +'a attrib
- type 'a wrap
- type 'a list_wrap
+ (** Underlying XML data-structure
- type +'a elt
+ The type variables in {!elt} and {!attrib} are know as {i phantom types}.
+ The implementation, defined here, is actually monomorphic.
+
+ In particular, tyxml doesn't impose any overhead over the underlying
+ representation. The {!tot} and {!toelt} functions allows to convert
+ between the typed and the untyped representation without any cost.
+
+ Note that some implementation may not be iterable or printable, such as the
+ Dom representation exposed by js_of_ocaml.
+ *)
+ module Xml : Xml_sigs.T
+
+ (** [wrap] is a container for elements and values.
+
+ In most cases, ['a wrap = 'a]. For [R] modules (in eliom or js_of_ocaml),
+ It will be {!React.S.t}.
+ *)
+ type 'a wrap = 'a Xml.W.t
+ (** [list_wrap] is a containre for list of elements.
+
+ In most cases, ['a list_wrap = 'a list]. For [R] modules (in eliom or js_of_ocaml),
+ It will be {!ReactiveData.RList.t}.
+ *)
+ type 'a list_wrap = 'a Xml.W.tlist
+
+ (** A nullary element is an element that doesn't have any children. *)
type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
+ (** A unary element is an element that have exactly one children. *)
type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
+ (** A star element is an element that has any number of children, including zero. *)
type ('a, 'b, 'c) star =
?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
- (* to be processed by a script *)
- type altglyphdef_content =
- [ | `Ref of (glyphref elt) list | `Item of (altglyphitem elt) list
- ]
+ (** Various information about SVG, such as the doctype, ... *)
+ module Info : Xml_sigs.Info
- val pcdata : string wrap -> [> | `PCDATA] elt
+ (** {3 Uri} *)
- (** {1 attributes } *)
+ type uri = Xml.uri
+ val string_of_uri : (uri, string) Xml.W.ft
+ val uri_of_string : (string, uri) Xml.W.ft
+
+ open Svg_types
+
+ (** {2:attributes Attributes } *)
val a_version : string wrap -> [> | `Version ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val a_baseprofile : string wrap -> [> | `BaseProfile ] attrib
+ val a_baseProfile : string wrap -> [> | `BaseProfile ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val a_x : coord wrap -> [> | `X ] attrib
@@ -66,51 +124,67 @@
val a_height : Unit.length wrap -> [> | `Height ] attrib
- val a_preserveaspectratio : string wrap -> [> | `PreserveAspectRatio ] attrib
-
- val a_contentscripttype : string wrap -> [> | `ContentScriptType ] attrib
+ val a_preserveAspectRatio : string wrap -> [> | `PreserveAspectRatio ] attrib
- val a_contentstyletype : string wrap -> [> | `ContentStyleType ] attrib
+ val a_contentScriptType : string wrap -> [> | `ContentScriptType ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
+
+ val a_contentStyleType : string wrap -> [> | `ContentStyleType ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val a_zoomAndPan : [< | `Disable | `Magnify ] wrap -> [> | `ZoomAndSpan ] attrib
+ val a_href : iri wrap -> [> | `Xlink_href ] attrib
+
val a_xlink_href : iri wrap -> [> | `Xlink_href ] attrib
+ [@@ocaml.deprecated "Use a_href"]
+ (** @deprecated Use a_href *)
- val a_requiredfeatures : spacestrings wrap -> [> | `RequiredFeatures ] attrib
+ val a_requiredFeatures : spacestrings wrap -> [> | `RequiredFeatures ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val a_requiredextensions :
+ val a_requiredExtensions :
spacestrings wrap -> [> | `RequiredExtension ] attrib
- val a_systemlanguage : commastrings wrap -> [> | `SystemLanguage ] attrib
+ val a_systemLanguage : commastrings wrap -> [> | `SystemLanguage ] attrib
- val a_externalressourcesrequired :
+ val a_externalRessourcesRequired :
bool wrap -> [> | `ExternalRessourcesRequired ] attrib
val a_id : string wrap -> [> | `Id ] attrib
val a_xml_base : iri wrap -> [> | `Xml_Base ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val a_xml_lang : iri wrap -> [> | `Xml_Lang ] attrib
val a_xml_space : [< `Default | `Preserve ] wrap -> [> | `Xml_Space ] attrib
+ [@@ocaml.deprecated "Use CSS white-space"]
+ (** @deprecated Use CSS white-space *)
val a_type : string wrap -> [> | `Type ] attrib
val a_media : commastrings wrap -> [> | `Media ] attrib
- val a_title : string wrap -> [> | `Title ] attrib
+ val a_xlink_title : string wrap -> [> | `Title ] attrib
+ [@@ocaml.deprecated "Use a child title element"]
+ (** @deprecated Use a child title element *)
val a_class : spacestrings wrap -> [> | `Class ] attrib
val a_style : string wrap -> [> | `Style ] attrib
- val a_transform : transform wrap -> [> | `Transform ] attrib
+ val a_transform : transforms wrap -> [> | `Transform ] attrib
- val a_viewbox : fourfloats wrap -> [> | `ViewBox ] attrib
+ val a_viewBox : fourfloats wrap -> [> | `ViewBox ] attrib
val a_d : string wrap -> [> | `D ] attrib
- val a_pathlength : float wrap -> [> | `PathLength ] attrib
+ val a_pathLength : float wrap -> [> | `PathLength ] attrib
(* XXX: better language support *)
val a_rx : Unit.length wrap -> [> | `Rx ] attrib
@@ -134,21 +208,25 @@
val a_points : coords wrap -> [> | `Points ] attrib
val a_x_list : lengths wrap -> [> | `X_list ] attrib
+ [@@reflect.attribute "x" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_y_list : lengths wrap -> [> | `Y_list ] attrib
+ [@@reflect.attribute "y" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_dx : number wrap -> [> | `Dx ] attrib
val a_dy : number wrap -> [> | `Dy ] attrib
val a_dx_list : lengths wrap -> [> | `Dx_list ] attrib
+ [@@reflect.attribute "dx" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_dy_list : lengths wrap -> [> | `Dy_list ] attrib
+ [@@reflect.attribute "dy" ["text"; "tspan"; "tref"; "altGlyph"]]
- val a_lengthadjust :
+ val a_lengthAdjust :
[< `Spacing | `SpacingAndGlyphs ] wrap -> [> | `LengthAdjust ] attrib
- val a_textlength : Unit.length wrap -> [> | `TextLength ] attrib
+ val a_textLength : Unit.length wrap -> [> | `TextLength ] attrib
val a_text_anchor : [< `Start | `Middle | `End | `Inherit ] wrap -> [> | `Text_Anchor ] attrib
@@ -158,32 +236,32 @@
val a_rotate : numbers wrap -> [> | `Rotate ] attrib
- val a_startoffset : Unit.length wrap -> [> | `StartOffset ] attrib
+ val a_startOffset : Unit.length wrap -> [> | `StartOffset ] attrib
val a_method : [< `Align | `Stretch ] wrap -> [> | `Method ] attrib
val a_spacing : [< `Auto | `Exact ] wrap -> [> | `Spacing ] attrib
- val a_glyphref : string wrap -> [> | `GlyphRef ] attrib
+ val a_glyphRef : string wrap -> [> | `GlyphRef ] attrib
val a_format : string wrap -> [> | `Format ] attrib
- val a_markerunits :
+ val a_markerUnits :
[< `StrokeWidth | `UserSpaceOnUse ] wrap -> [> | `MarkerUnits ] attrib
- val a_refx : coord wrap -> [> | `RefX ] attrib
+ val a_refX : coord wrap -> [> | `RefX ] attrib
- val a_refy : coord wrap -> [> | `RefY ] attrib
+ val a_refY : coord wrap -> [> | `RefY ] attrib
- val a_markerwidth : Unit.length wrap -> [> | `MarkerWidth ] attrib
+ val a_markerWidth : Unit.length wrap -> [> | `MarkerWidth ] attrib
- val a_markerheight : Unit.length wrap -> [> | `MarkerHeight ] attrib
+ val a_markerHeight : Unit.length wrap -> [> | `MarkerHeight ] attrib
- val a_orient : [< `Auto | `Angle of angle ] wrap -> [> | `Orient ] attrib
+ val a_orient : Unit.angle option wrap -> [> | `Orient ] attrib
val a_local : string wrap -> [> | `Local ] attrib
- val a_renderingindent :
+ val a_rendering_intent :
[<
| `Auto
| `Perceptual
@@ -191,13 +269,13 @@
| `Saturation
| `Absolute_colorimetric ] wrap -> [> | `Rendering_Indent ] attrib
- val a_gradientunits :
+ val a_gradientUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[ | `GradientUnits ] attrib
- val a_gradienttransform : transforms wrap -> [> | `Gradient_Transform ] attrib
+ val a_gradientTransform : transforms wrap -> [> | `Gradient_Transform ] attrib
- val a_spreadmethod :
+ val a_spreadMethod :
[< `Pad | `Reflect | `Repeat ] wrap -> [> | `SpreadMethod ] attrib
val a_fx : coord wrap -> [> | `Fx ] attrib
@@ -208,32 +286,32 @@
[< `Number of number | `Percentage of percentage ] wrap ->
[> | `Offset ] attrib
- val a_patternunits :
+ val a_patternUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `PatternUnits ] attrib
- val a_patterncontentunits :
+ val a_patternContentUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `PatternContentUnits ] attrib
- val a_patterntransform : transforms wrap -> [> | `PatternTransform ] attrib
+ val a_patternTransform : transforms wrap -> [> | `PatternTransform ] attrib
- val a_clippathunits :
+ val a_clipPathUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `ClipPathUnits ] attrib
- val a_maskunits :
+ val a_maskUnits :
[< | `UserSpaceOnUse | `ObjectBoundingBox ] wrap -> [> | `MaskUnits ] attrib
- val a_maskcontentunits :
+ val a_maskContentUnits :
[< | `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `MaskContentUnits ] attrib
- val a_primitiveunits :
+ val a_primitiveUnits :
[< | `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `PrimitiveUnits ] attrib
- val a_filterres : number_optional_number wrap -> [> | `FilterResUnits ] attrib
+ val a_filterRes : number_optional_number wrap -> [> | `FilterResUnits ] attrib
val a_result : string wrap -> [> | `Result ] attrib
@@ -257,37 +335,39 @@
| `StrokePaint
| `Ref of string ] wrap -> [> | `In2 ] attrib
- val a_aizmuth : float wrap -> [> | `Azimuth ] attrib
+ val a_azimuth : float wrap -> [> | `Azimuth ] attrib
val a_elevation : float wrap -> [> | `Elevation ] attrib
- val a_pointatx : float wrap -> [> | `PointsAtX ] attrib
+ val a_pointsAtX : float wrap -> [> | `PointsAtX ] attrib
- val a_pointaty : float wrap -> [> | `PointsAtY ] attrib
+ val a_pointsAtY : float wrap -> [> | `PointsAtY ] attrib
- val a_pointatz : float wrap -> [> | `PointsAtZ ] attrib
+ val a_pointsAtZ : float wrap -> [> | `PointsAtZ ] attrib
- val a_specularexponent : float wrap -> [> | `SpecularExponent ] attrib
+ val a_specularExponent : float wrap -> [> | `SpecularExponent ] attrib
- val a_specularconstant : float wrap -> [> | `SpecularConstant ] attrib
+ val a_specularConstant : float wrap -> [> | `SpecularConstant ] attrib
- val a_limitingconeangle : float wrap -> [> | `LimitingConeAngle ] attrib
+ val a_limitingConeAngle : float wrap -> [> | `LimitingConeAngle ] attrib
val a_mode :
[< | `Normal | `Multiply | `Screen | `Darken | `Lighten ] wrap ->
[> | `Mode ] attrib
- val a_typefecolor :
+ val a_feColorMatrix_type :
[< | `Matrix | `Saturate | `HueRotate | `LuminanceToAlpha ] wrap ->
[> | `Typefecolor ] attrib
+ [@@reflect.attribute "type" ["feColorMatrix"]]
val a_values : numbers wrap -> [> | `Values ] attrib
- val a_transferttype :
+ val a_transfer_type :
[< | `Identity | `Table | `Discrete | `Linear | `Gamma ] wrap ->
- [> | `Typetransfert ] attrib
+ [> | `Type_transfert ] attrib
+ [@@reflect.attribute "type" ["feFuncR"; "feFuncG"; "feFuncB"; "feFuncA"]]
- val a_tablevalues : numbers wrap -> [> | `TableValues ] attrib
+ val a_tableValues : numbers wrap -> [> | `TableValues ] attrib
val a_intercept : number wrap -> [> | `Intercept ] attrib
@@ -295,11 +375,13 @@
val a_exponent : number wrap -> [> | `Exponent ] attrib
- val a_offsettransfer : number wrap -> [> | `Offsettransfer ] attrib
+ val a_transfer_offset : number wrap -> [> | `Offset_transfer ] attrib
+ [@@reflect.attribute "offset" ["feFuncR"; "feFuncG"; "feFuncB"; "feFuncA"]]
- val a_operator :
+ val a_feComposite_operator :
[< | `Over | `In | `Out | `Atop | `Xor | `Arithmetic ] wrap ->
- [> | `Operator ] attrib
+ [> | `OperatorComposite ] attrib
+ [@@reflect.attribute "operator" ["feComposite"]]
val a_k1 : number wrap -> [> | `K1 ] attrib
@@ -311,103 +393,108 @@
val a_order : number_optional_number wrap -> [> | `Order ] attrib
- val a_kernelmatrix : numbers wrap -> [> | `KernelMatrix ] attrib
+ val a_kernelMatrix : numbers wrap -> [> | `KernelMatrix ] attrib
val a_divisor : number wrap -> [> | `Divisor ] attrib
val a_bias : number wrap -> [> | `Bias ] attrib
- val a_kernelunitlength :
+ val a_kernelUnitLength :
number_optional_number wrap -> [> | `KernelUnitLength ] attrib
val a_targetX : int wrap -> [> | `TargetX ] attrib
val a_targetY : int wrap -> [> | `TargetY ] attrib
- val a_edgemode :
+ val a_edgeMode :
[< | `Duplicate | `Wrap | `None ] wrap -> [> | `TargetY ] attrib
- val a_preservealpha : bool wrap -> [> | `TargetY ] attrib
+ val a_preserveAlpha : bool wrap -> [> | `TargetY ] attrib
- val a_surfacescale : number wrap -> [> | `SurfaceScale ] attrib
+ val a_surfaceScale : number wrap -> [> | `SurfaceScale ] attrib
- val a_diffuseconstant : number wrap -> [> | `DiffuseConstant ] attrib
+ val a_diffuseConstant : number wrap -> [> | `DiffuseConstant ] attrib
val a_scale : number wrap -> [> | `Scale ] attrib
- val a_xchannelselector :
+ val a_xChannelSelector :
[< | `R | `G | `B | `A ] wrap -> [> | `XChannelSelector ] attrib
- val a_ychannelselector :
+ val a_yChannelSelector :
[< | `R | `G | `B | `A ] wrap -> [> | `YChannelSelector ] attrib
- val a_stddeviation : number_optional_number wrap -> [> | `StdDeviation ] attrib
+ val a_stdDeviation : number_optional_number wrap -> [> | `StdDeviation ] attrib
- val a_operatormorphology :
+ val a_feMorphology_operator :
[< | `Erode | `Dilate ] wrap -> [> | `OperatorMorphology ] attrib
+ [@@reflect.attribute "operator" ["feMorphology"]]
val a_radius : number_optional_number wrap -> [> | `Radius ] attrib
- val a_basefrenquency :
+ val a_baseFrenquency :
number_optional_number wrap -> [> | `BaseFrequency ] attrib
- val a_numoctaves : int wrap -> [> | `NumOctaves ] attrib
+ val a_numOctaves : int wrap -> [> | `NumOctaves ] attrib
val a_seed : number wrap -> [> | `Seed ] attrib
- val a_stitchtiles :
+ val a_stitchTiles :
[< | `Stitch | `NoStitch ] wrap -> [> | `StitchTiles ] attrib
- val a_stitchtype :
+ val a_feTurbulence_type :
[< | `FractalNoise | `Turbulence ] wrap -> [> | `TypeStitch ] attrib
+ [@@reflect.attribute "type" ["feTurbulence"]]
- val a_xlinkshow : [< | `New | `Replace ] wrap -> [> | `Xlink_show ] attrib
+ val a_xlink_show : [< | `New | `Replace ] wrap -> [> | `Xlink_show ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val a_xlinkactuate :
+ val a_xlink_actuate :
[< | `OnRequest | `OnLoad | `Other | `None ] wrap
-> [> | `Xlink_actuate ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val a_target : string wrap -> [> | `Xlink_target ] attrib
- val a_viewtarget : string wrap -> [> | `ViewTarget ] attrib
+ val a_viewTarget : string wrap -> [> | `ViewTarget ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val a_attributename : string wrap -> [> | `AttributeName ] attrib
+ val a_attributeName : string wrap -> [> | `AttributeName ] attrib
- val a_attributetype :
+ val a_attributeType :
[< | `CSS | `XML | `Auto ] wrap -> [> | `AttributeType ] attrib
val a_begin : string wrap -> [> | `Begin ] attrib
val a_dur : string wrap -> [> | `Dur ] attrib
- (* XXX*)
val a_min : string wrap -> [> | `Min ] attrib
- (* XXX *)
val a_max : string wrap -> [> | `Max ] attrib
- (* XXX *)
val a_restart :
[< | `Always | `WhenNotActive | `Never ] wrap -> [> | `Restart ] attrib
- val a_repeatcount : string wrap -> [> | `RepeatCount ] attrib
+ val a_repeatCount : string wrap -> [> | `RepeatCount ] attrib
- (* XXX *)
- val a_repeatdur : string wrap -> [> | `RepeatDur ] attrib
+ val a_repeatDur : string wrap -> [> | `RepeatDur ] attrib
- (* XXX *)
val a_fill : paint wrap -> [> | `Fill ] attrib
- val a_fill_animation : [< | `Freeze | `Remove ] wrap -> [> | `Fill_Animation ] attrib
+ val a_animation_fill : [< | `Freeze | `Remove ] wrap -> [> | `Fill_Animation ] attrib
+ [@@reflect.attribute "fill" ["animation"]]
- val a_calcmode :
+ val a_calcMode :
[< | `Discrete | `Linear | `Paced | `Spline ] wrap -> [> | `CalcMode ] attrib
- val a_values_anim : strings wrap -> [> | `Valuesanim ] attrib
+ val a_animation_values : strings wrap -> [> | `Valuesanim ] attrib
+ [@@reflect.attribute "values" ["animation"]]
- val a_keytimes : strings wrap -> [> | `KeyTimes ] attrib
+ val a_keyTimes : strings wrap -> [> | `KeyTimes ] attrib
- val a_keysplines : strings wrap -> [> | `KeySplines ] attrib
+ val a_keySplines : strings wrap -> [> | `KeySplines ] attrib
val a_from : string wrap -> [> | `From ] attrib
@@ -419,33 +506,34 @@
val a_accumulate : [< | `None | `Sum ] wrap -> [> | `Accumulate ] attrib
- val a_keypoints : numbers_semicolon wrap -> [> | `KeyPoints ] attrib
+ val a_keyPoints : numbers_semicolon wrap -> [> | `KeyPoints ] attrib
val a_path : string wrap -> [> | `Path ] attrib
- val a_typeanimatecolor :
+ val a_animateTransform_type :
[ | `Translate | `Scale | `Rotate | `SkewX | `SkewY ] wrap ->
- [ | `Typeanimatecolor ] attrib
+ [ | `Typeanimatetransform ] attrib
+ [@@reflect.attribute "type" ["animateTransform"]]
- val a_horiz_origin_x : number wrap -> [> | `Horizoriginx ] attrib
+ val a_horiz_origin_x : number wrap -> [> | `HorizOriginX ] attrib
- val a_horiz_origin_y : number wrap -> [> | `Horizoriginy ] attrib
+ val a_horiz_origin_y : number wrap -> [> | `HorizOriginY ] attrib
- val a_horiz_adv_x : number wrap -> [> | `Horizadvx ] attrib
+ val a_horiz_adv_x : number wrap -> [> | `HorizAdvX ] attrib
- val a_vert_origin_x : number wrap -> [> | `Vertoriginx ] attrib
+ val a_vert_origin_x : number wrap -> [> | `VertOriginX ] attrib
- val a_vert_origin_y : number wrap -> [> | `Vertoriginy ] attrib
+ val a_vert_origin_y : number wrap -> [> | `VertOriginY ] attrib
- val a_vert_adv_y : number wrap -> [> | `Vertadvy ] attrib
+ val a_vert_adv_y : number wrap -> [> | `VertAdvY ] attrib
val a_unicode : string wrap -> [> | `Unicode ] attrib
- val a_glyphname : string wrap -> [> | `glyphname ] attrib
+ val a_glyph_name : string wrap -> [> | `glyphname ] attrib
val a_orientation : [< | `H | `V ] wrap -> [> | `Orientation ] attrib
- val a_arabicform :
+ val a_arabic_form :
[< | `Initial | `Medial | `Terminal | `Isolated ] wrap ->
[> | `Arabicform ] attrib
@@ -461,21 +549,21 @@
val a_k : string wrap -> [> | `K ] attrib
- val a_fontfamily : string wrap -> [> | `Font_Family ] attrib
+ val a_font_family : string wrap -> [> | `Font_Family ] attrib
- val a_fontstyle : string wrap -> [> | `Font_Style ] attrib
+ val a_font_style : string wrap -> [> | `Font_Style ] attrib
- val a_fontvariant : string wrap -> [> | `Font_Variant ] attrib
+ val a_font_variant : string wrap -> [> | `Font_Variant ] attrib
- val a_fontweight : string wrap -> [> | `Font_Weight ] attrib
+ val a_font_weight : string wrap -> [> | `Font_Weight ] attrib
- val a_fontstretch : string wrap -> [> | `Font_Stretch ] attrib
+ val a_font_stretch : string wrap -> [> | `Font_Stretch ] attrib
- val a_fontsize : string wrap -> [> | `Font_Size ] attrib
+ val a_font_size : string wrap -> [> | `Font_Size ] attrib
- val a_unicoderange : string wrap -> [> | `UnicodeRange ] attrib
+ val a_unicode_range : string wrap -> [> | `UnicodeRange ] attrib
- val a_unitsperem : string wrap -> [> | `UnitsPerEm ] attrib
+ val a_units_per_em : string wrap -> [> | `UnitsPerEm ] attrib
val a_stemv : number wrap -> [> | `Stemv ] attrib
@@ -483,11 +571,11 @@
val a_slope : number wrap -> [> | `Slope ] attrib
- val a_capheight : number wrap -> [> | `CapHeight ] attrib
+ val a_cap_height : number wrap -> [> | `CapHeight ] attrib
- val a_xheight : number wrap -> [> | `XHeight ] attrib
+ val a_x_height : number wrap -> [> | `XHeight ] attrib
- val a_accentheight : number wrap -> [> | `AccentHeight ] attrib
+ val a_accent_height : number wrap -> [> | `AccentHeight ] attrib
val a_ascent : number wrap -> [> | `Ascent ] attrib
@@ -505,25 +593,25 @@
val a_videographic : number wrap -> [> | `VIdeographic ] attrib
- val a_valphabetic : number wrap -> [> | `VAlphabetic ] attrib
+ val a_v_alphabetic : number wrap -> [> | `VAlphabetic ] attrib
- val a_vmathematical : number wrap -> [> | `VMathematical ] attrib
+ val a_v_mathematical : number wrap -> [> | `VMathematical ] attrib
- val a_vhanging : number wrap -> [> | `VHanging ] attrib
+ val a_v_hanging : number wrap -> [> | `VHanging ] attrib
- val a_underlineposition : number wrap -> [> | `UnderlinePosition ] attrib
+ val a_underline_position : number wrap -> [> | `UnderlinePosition ] attrib
- val a_underlinethickness : number wrap -> [> | `UnderlineThickness ] attrib
+ val a_underline_thickness : number wrap -> [> | `UnderlineThickness ] attrib
- val a_strikethroughposition :
+ val a_strikethrough_position :
number wrap -> [> | `StrikethroughPosition ] attrib
- val a_strikethroughthickness :
+ val a_strikethrough_thickness :
number wrap -> [> | `StrikethroughThickness ] attrib
- val a_overlineposition : number wrap -> [> | `OverlinePosition ] attrib
+ val a_overline_position : number wrap -> [> | `OverlinePosition ] attrib
- val a_overlinethickness : number wrap -> [> | `OverlineThickness ] attrib
+ val a_overline_thickness : number wrap -> [> | `OverlineThickness ] attrib
val a_string : string wrap -> [> | `String ] attrib
@@ -541,7 +629,32 @@
| `Text_after_edge | `Text_before_edge | `Inherit ] wrap ->
[> | `Dominant_Baseline ] attrib
- (** Javascript events *)
+ val a_stop_color : color wrap -> [> | `Stop_Color ] attrib
+
+ val a_stop_opacity : number wrap -> [> | `Stop_Opacity ] attrib
+
+ val a_stroke : paint wrap -> [> | `Stroke ] attrib
+
+ val a_stroke_width : Unit.length wrap -> [> | `Stroke_Width ] attrib
+
+ val a_stroke_linecap :
+ [< `Butt | `Round | `Square ] wrap -> [> | `Stroke_Linecap ] attrib
+
+ val a_stroke_linejoin :
+ [< `Miter | `Round | `Bever ] wrap -> [> `Stroke_Linejoin ] attrib
+
+ val a_stroke_miterlimit : float wrap -> [> `Stroke_Miterlimit ] attrib
+
+ val a_stroke_dasharray :
+ Unit.length list wrap -> [> `Stroke_Dasharray ] attrib
+
+ val a_stroke_dashoffset : Unit.length wrap -> [> `Stroke_Dashoffset ] attrib
+
+ val a_stroke_opacity : float wrap -> [> `Stroke_Opacity ] attrib
+
+ (** {2 Events}
+
+ {3 Javascript events} *)
val a_onabort : Xml.event_handler -> [> | `OnAbort ] attrib
val a_onactivate : Xml.event_handler -> [> | `OnActivate ] attrib
@@ -551,13 +664,16 @@
val a_onfocusin : Xml.event_handler -> [> | `OnFocusIn ] attrib
val a_onfocusout : Xml.event_handler -> [> | `OnFocusOut ] attrib
val a_onload : Xml.event_handler -> [> | `OnLoad ] attrib
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
+
val a_onrepeat : Xml.event_handler -> [> | `OnRepeat ] attrib
val a_onresize : Xml.event_handler -> [> | `OnResize ] attrib
val a_onscroll : Xml.event_handler -> [> | `OnScroll ] attrib
val a_onunload : Xml.event_handler -> [> | `OnUnload ] attrib
val a_onzoom : Xml.event_handler -> [> | `OnZoom ] attrib
- (** Javascript mouse events *)
+ (** {3 Javascript mouse events} *)
val a_onclick : Xml.mouse_event_handler -> [> | `OnClick ] attrib
val a_onmousedown : Xml.mouse_event_handler -> [> | `OnMouseDown ] attrib
@@ -566,39 +682,10 @@
val a_onmouseout : Xml.mouse_event_handler -> [> | `OnMouseOut ] attrib
val a_onmousemove : Xml.mouse_event_handler -> [> | `OnMouseMove ] attrib
+ (** {2:elements Elements} *)
- val metadata :
- ?a: ((metadata_attr attrib) list) -> Xml.elt list_wrap -> [> | metadata] elt
-
- val foreignobject :
- ?a: ((foreignobject_attr attrib) list) ->
- Xml.elt list_wrap -> [> | foreignobject] elt
-
- val a_stopcolor : color wrap -> [> | `Stop_Color ] attrib
-
- val a_stopopacity : number wrap -> [> | `Stop_Opacity ] attrib
-
- val a_stroke : paint wrap -> [> | `Stroke ] attrib
-
- val a_strokewidth : length wrap -> [> | `Stroke_Width ] attrib
-
- val a_strokelinecap :
- [< `Butt | `Round | `Square ] wrap -> [> | `Stroke_Linecap ] attrib
-
- val a_strokelinejoin :
- [< `Miter | `Round | `Bever ] wrap -> [> `Stroke_Linejoin ] attrib
-
- val a_strokemiterlimit : float wrap -> [> `Stroke_Miterlimit ] attrib
-
- val a_strokedasharray : Unit.length list wrap -> [> `Stroke_Dasharray ] attrib
-
- val a_strokedashoffset : Unit.length wrap -> [> `Stroke_Dashoffset ] attrib
-
- val a_strokeopacity : float wrap -> [> `Stroke_Opacity ] attrib
-
- (** {1 Elements} *)
+ val pcdata : string wrap -> [> | `PCDATA] elt
- (* generated *)
val svg : ([< | svg_attr], [< | svg_content], [> | svg]) star
val g : ([< | g_attr], [< | g_content], [> | g]) star
@@ -641,35 +728,50 @@
val tspan : ([< | tspan_attr], [< | tspan_content], [> | tspan]) star
val tref : ([< | tref_attr], [< | tref_content], [> | tref]) star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val textpath :
+ val textPath :
([< | textpath_attr], [< | textpath_content], [> | textpath]) star
- val altglyph :
+ val altGlyph :
([< | altglyph_attr], [< | altglyph_content], [> | altglyph]) unary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
+
+ type altglyphdef_content =
+ [ | `Ref of (glyphref elt) list | `Item of (altglyphitem elt) list
+ ]
- val altglyphdef :
+ val altGlyphDef :
([< | altglyphdef_attr], [< | altglyphdef_content], [> | altglyphdef])
unary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- (* theoretically a plus, simplified into star *)
- val altglyphitem :
+ val altGlyphItem :
([< | altglyphitem_attr], [< | altglyphitem_content], [> | altglyphitem
]) star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val glyphref : ([< | glyphref_attr], [> | glyphref]) nullary
+ val glyphRef : ([< | glyphref_attr], [> | glyphref]) nullary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val marker : ([< | marker_attr], [< | marker_content], [> | marker]) star
- val colorprofile :
+ val color_profile :
([< | colorprofile_attr], [< | colorprofile_content], [> | colorprofile
]) star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val lineargradient :
+ val linearGradient :
([< | lineargradient_attr], [< | lineargradient_content],
[> | lineargradient]) star
- val radialgradient :
+ val radialGradient :
([< | radialgradient_attr], [< | radialgradient_content],
[> | radialgradient]) star
@@ -679,89 +781,89 @@
val pattern :
([< | pattern_attr], [< | pattern_content], [> | pattern]) star
- val clippath :
+ val clipPath :
([< | clippath_attr], [< | clippath_content], [> | clippath]) star
val filter : ([< | filter_attr], [< | filter_content], [> | filter]) star
- val fedistantlight :
+ val feDistantLight :
([< | fedistantlight_attr], [< | fedistantlight_content],
[> | fedistantlight]) star
- val fepointlight :
+ val fePointLight :
([< | fepointlight_attr], [< | fepointlight_content], [> | fepointlight
]) star
- val fespotlight :
+ val feSpotLight :
([< | fespotlight_attr], [< | fespotlight_content], [> | fespotlight])
star
- val feblend :
+ val feBlend :
([< | feblend_attr], [< | feblend_content], [> | feblend]) star
- val fecolormatrix :
+ val feColorMatrix :
([< | fecolormatrix_attr], [< | fecolormatrix_content],
[> | fecolormatrix]) star
- val fecomponenttransfer :
+ val feComponentTransfer :
([< | fecomponenttransfer_attr], [< | fecomponenttransfer_content],
[> | fecomponenttransfer]) star
- val fefunca :
+ val feFuncA :
([< | fefunca_attr], [< | fefunca_content], [> | fefunca]) star
- val fefuncg :
+ val feFuncG :
([< | fefuncg_attr], [< | fefuncg_content], [> | fefuncg]) star
- val fefuncb :
+ val feFuncB :
([< | fefuncb_attr], [< | fefuncb_content], [> | fefuncb]) star
- val fefuncr :
+ val feFuncR :
([< | fefuncr_attr], [< | fefuncr_content], [> | fefuncr]) star
- val fecomposite :
+ val feComposite :
([< | fecomposite_attr], [< | fecomposite_content], [> | fecomposite])
star
- val feconvolvematrix :
+ val feConvolveMatrix :
([< | feconvolvematrix_attr], [< | feconvolvematrix_content],
[> | feconvolvematrix]) star
- val fediffuselighting :
+ val feDiffuseLighting :
([< | fediffuselighting_attr], [< | fediffuselighting_content],
[> | fediffuselighting]) star
- val fedisplacementmap :
+ val feDisplacementMap :
([< | fedisplacementmap_attr], [< | fedisplacementmap_content],
[> | fedisplacementmap]) star
- val feflood :
+ val feFlood :
([< | feflood_attr], [< | feflood_content], [> | feflood]) star
- val fegaussianblur :
+ val feGaussianBlur :
([< | fegaussianblur_attr], [< | fegaussianblur_content],
[> | fegaussianblur]) star
- val feimage :
+ val feImage :
([< | feimage_attr], [< | feimage_content], [> | feimage]) star
- val femerge :
+ val feMerge :
([< | femerge_attr], [< | femerge_content], [> | femerge]) star
- val femorphology :
+ val feMorphology :
([< | femorphology_attr], [< | femorphology_content], [> | femorphology
]) star
- val feoffset :
+ val feOffset :
([< | feoffset_attr], [< | feoffset_content], [> | feoffset]) star
- val fespecularlighting :
+ val feSpecularLighting :
([< | fespecularlighting_attr], [< | fespecularlighting_content],
[> | fespecularlighting]) star
- val fetile : ([< | fetile_attr], [< | fetile_content], [> | fetile]) star
+ val feTile : ([< | fetile_attr], [< | fetile_content], [> | fetile]) star
- val feturbulence :
+ val feTurbulence :
([< | feturbulence_attr], [< | feturbulence_content], [> | feturbulence
]) star
@@ -779,64 +881,93 @@
val set : ([< | set_attr], [< | set_content], [> | set]) star
- val animatemotion :
+ val animateMotion :
([< | animatemotion_attr], [< | animatemotion_content],
[> | animatemotion]) star
val mpath : ([< | mpath_attr], [< | mpath_content], [> | mpath]) star
- val animatecolor :
+ val animateColor :
([< | animatecolor_attr], [< | animatecolor_content], [> | animatecolor
]) star
- val animatetransform :
+ val animateTransform :
([< | animatetransform_attr], [< | animatetransform_content],
[> | animatetransform]) star
val font : ([< | font_attr], [< | font_content], [> | font]) star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val glyph : ([< | glyph_attr], [< | glyph_content], [> | glyph]) star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val missingglyph :
+ val missing_glyph :
([< | missingglyph_attr], [< | missingglyph_content], [> | missingglyph
]) star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val hkern : ([< | hkern_attr], [> | hkern]) nullary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
val vkern : ([< | vkern_attr], [> | vkern]) nullary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val fontface : ([< | fontface_attr], [> | fontface]) nullary
+ val font_face : ([< | font_face_attr], [> | font_face]) nullary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val fontfacesrc :
- ([< | fontfacesrc_attr], [< | fontfacesrc_content], [> | fontfacesrc])
+ val font_face_src :
+ ([< | font_face_src_attr], [< | font_face_src_content], [> | font_face_src])
star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val fontfaceuri :
- ([< | fontfaceuri_attr], [< | fontfaceuri_content], [> | fontfaceuri])
+ val font_face_uri :
+ ([< | font_face_uri_attr], [< | font_face_uri_content], [> | font_face_uri])
star
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val fontfaceformat :
- ([< | fontfaceformat_attr], [> | fontfaceformat]) nullary
+ val font_face_format :
+ ([< | font_face_format_attr], [> | font_face_format]) nullary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
+
+ val font_face_name : ([< | font_face_name_attr], [> | font_face_name]) nullary
+ [@@ocaml.deprecated "Removed in SVG2"]
+ (** @deprecated Removed in SVG2 *)
- val fontfacename : ([< | fontfacename_attr], [> | fontfacename]) nullary
+ val metadata :
+ ?a: ((metadata_attr attrib) list) -> Xml.elt list_wrap -> [> | metadata] elt
- val tot : Xml.elt -> 'a elt
+ val foreignObject :
+ ?a: ((foreignobject_attr attrib) list) ->
+ Xml.elt list_wrap -> [> | foreignobject] elt
- val totl : Xml.elt list -> ('a elt) list
+ (** {2 Conversion with untyped representation} *)
+ val tot : Xml.elt -> 'a elt
+ val totl : Xml.elt list_wrap -> ('a elt) list_wrap
val toelt : 'a elt -> Xml.elt
+ val toeltl : ('a elt) list_wrap -> Xml.elt list_wrap
- val toeltl : ('a elt) list -> Xml.elt list
-
+ val doc_toelt : doc -> Xml.elt
val to_xmlattribs : ('a attrib) list -> Xml.attrib list
val to_attrib : Xml.attrib -> 'a attrib
+ (** Unsafe features.
+
+ Using this module can break
+ SVG validity and may introduce security problems like
+ code injection.
+ Use it with care.
+ *)
module Unsafe : sig
- (** Unsafe features. Warning using this module can break
- validity and may introduce security problems like
- code injection.
- Use it with care.
- *)
(** Insert raw text without any encoding *)
val data : string wrap -> 'a elt
@@ -882,41 +1013,78 @@
end
- (** {2 ... } *)
-
- type doc = [ `Svg ] elt
- val doc_toelt : doc -> Xml.elt
+end
+(** Equivalent to {!T}, but without wrapping. *)
+module type NoWrap = T with module Xml.W = Xml_wrap.NoWrap
-end
-(** {2 Signature functors} *)
-(** See {% <> %}. *)
+(** {2 Signature functors}
+ See {% <> %}. *)
-(** Signature functor for {!Svg_f.MakeWrapped}. *)
-module MakeWrapped
- (W : Xml_wrap.T)
- (Xml : Xml_sigs.Wrapped) :
-sig
+(** Signature functor for {!Svg_f.Make}. *)
+module Make (Xml : Xml_sigs.T) : sig
(** See {!modtype:Svg_sigs.T}. *)
module type T = T
- with type Xml.uri = Xml.uri
+ with type 'a Xml.W.t = 'a Xml.W.t
+ and type 'a Xml.W.tlist = 'a Xml.W.tlist
+ and type ('a,'b) Xml.W.ft = ('a,'b) Xml.W.ft
+ and type Xml.uri = Xml.uri
and type Xml.event_handler = Xml.event_handler
and type Xml.mouse_event_handler = Xml.mouse_event_handler
and type Xml.keyboard_event_handler = Xml.keyboard_event_handler
and type Xml.attrib = Xml.attrib
and type Xml.elt = Xml.elt
- and type 'a Xml.wrap = 'a W.t
- and type 'a wrap = 'a W.t
- and type 'a Xml.list_wrap = 'a W.tlist
- and type 'a list_wrap = 'a W.tlist
+
end
-(** Signature functor for {!Svg_f.Make}. *)
-module Make(Xml : Xml_sigs.T) :
-sig
+(** Wrapped functions, to be used with {!Svg_f.Make_with_wrapped_functions}. *)
+module type Wrapped_functions = sig
+
+ module Xml : Xml_sigs.T
+
+ val string_of_alignment_baseline :
+ ([< Svg_types.alignment_baseline], string) Xml.W.ft
+
+ val string_of_bool : (bool, string) Xml.W.ft
+
+ val string_of_big_variant : ([< Svg_types.big_variant], string) Xml.W.ft
+
+ val string_of_coords : (Svg_types.coords, string) Xml.W.ft
+
+ val string_of_dominant_baseline :
+ ([< Svg_types.dominant_baseline], string) Xml.W.ft
+
+ val string_of_fourfloats : (float * float * float * float, string) Xml.W.ft
+
+ val string_of_in_value : ([< Svg_types.in_value], string) Xml.W.ft
+
+ val string_of_int : (int, string) Xml.W.ft
+
+ val string_of_length : (Svg_types.Unit.length, string) Xml.W.ft
+
+ val string_of_lengths : (Svg_types.lengths, string) Xml.W.ft
+
+ val string_of_number : (float, string) Xml.W.ft
+
+ val string_of_number_optional_number :
+ (float * float option, string) Xml.W.ft
+
+ val string_of_numbers : (float list, string) Xml.W.ft
+
+ val string_of_numbers_semicolon : (float list, string) Xml.W.ft
+
+ val string_of_offset : ([< Svg_types.offset], string) Xml.W.ft
+
+ val string_of_orient : (Svg_types.Unit.angle option, string) Xml.W.ft
+
+ val string_of_paint : ([< Svg_types.paint], string) Xml.W.ft
+
+ val string_of_strokedasharray : (Svg_types.lengths, string) Xml.W.ft
+
+ val string_of_transform : (Svg_types.transform, string) Xml.W.ft
+
+ val string_of_transforms : (Svg_types.transforms, string) Xml.W.ft
- (** See {!modtype:Svg_sigs.MakeWrapped} and {!modtype:Svg_sigs.T}. *)
- module type T = MakeWrapped(Xml_wrap.NoWrap)(Xml).T
end
diff -Nru tyxml-3.5.0/lib/svg_types.mli tyxml-4.1.0/lib/svg_types.mli
--- tyxml-3.5.0/lib/svg_types.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/svg_types.mli 2017-03-03 16:33:22.000000000 +0000
@@ -19,7 +19,7 @@
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
-(** SVG types with variants. (See also {!Svg.M}) *)
+(** SVG types with variants, goes with {!Svg_sigs.T}. *)
(** This module defines basic data types for data, attributes
and element occuring in SVG documents.
@@ -155,7 +155,7 @@
]
type animation_value_attr =
- [ | `CalcMode | `Values | `KeyTimes | `KeySplines | `From | `To | `By
+ [ | `CalcMode | `Valuesanim | `KeyTimes | `KeySplines | `From | `To | `By
]
type animation_addition_attr = [ | `Additive | `Accumulate ]
@@ -273,7 +273,7 @@
type coord = length
type number = float
type number_optional_number = (number * (number option))
-type percentage = int
+type percentage = float
type strings = string list
type color = string
@@ -290,12 +290,12 @@
(* Transformation *)
type transform =
- | Matrix of (float * float * float * float * float * float)
- | Translate of (float * (float option))
- | Scale of (float * (float option))
- | Rotate of (angle * ((float * float) option))
- | SkewX of angle
- | SkewY of angle
+ [ `Matrix of (float * float * float * float * float * float)
+ | `Translate of (float * (float option))
+ | `Scale of (float * (float option))
+ | `Rotate of (angle * ((float * float) option))
+ | `SkewX of angle
+ | `SkewY of angle ]
type spacestrings = string list
type commastrings = string list
@@ -893,8 +893,8 @@
| `Style
| `X
| `Y
- | `Dx_single
- | `Dy_single
+ | `Dx
+ | `Dy
| `GlyphRef
| `Format
| `Xlink_href
@@ -1287,7 +1287,7 @@
| `Style
| `In
| `In2
- | `Operator
+ | `OperatorComposite
| `K1
| `K2
| `K3
@@ -1420,7 +1420,7 @@
| core_attr
| presentation_attr
| filter_primitive_attr
- | `Operator_morphology
+ | `OperatorMorphology
| `Class
| `Style
| `In
@@ -1497,7 +1497,7 @@
| `NumOctaves
| `Seed
| `StitchTiles
- | `Type_stitch
+ | `TypeStitch
]
type cursor = [ | `Cursor ]
@@ -1693,7 +1693,7 @@
| animation_value_attr
| animation_addition_attr
| `ExternalResourcesRequired
- | `Typeanimatecolor
+ | `Typeanimatetransform
]
type font = [ | `Font ]
@@ -1825,12 +1825,12 @@
(* nullary *)
type vkern_attr = [ | core_attr | `U1 | `G1 | `U2 | `G2 | `K ]
-type fontface = [ | `Font_Face ]
+type font_face = [ | `Font_Face ]
(* nullary *)
-type fontface_content = [ | descriptive_element | `Font_Face_Src ]
+type font_face_content = [ | descriptive_element | `Font_Face_Src ]
-type fontface_attr =
+type font_face_attr =
[
| core_attr
| `Font_Family
@@ -1868,29 +1868,29 @@
| `OverlineThickness
]
-type fontfacesrc = [ | `Font_Face_Src ]
-
(* star *)
-type fontfacesrc_content = [ | `Font_Face_Name | `Font_Face_Uri ]
+type font_face_src = [ | `Font_Face_Src ]
-type fontfacesrc_attr = core_attr
+type font_face_src_content = [ | `Font_Face_Name | `Font_Face_Uri ]
-type fontfaceuri = [ | `Font_Face_Uri ]
+type font_face_src_attr = core_attr
(* star *)
-type fontfaceuri_content = [ | `Font_Face_Format ]
+type font_face_uri = [ | `Font_Face_Uri ]
-type fontfaceuri_attr = [ | core_attr | xlink_attr | `Xlink_href ]
+type font_face_uri_content = [ | `Font_Face_Format ]
-type fontfaceformat = [ | `Font_Face_Format ]
+type font_face_uri_attr = [ | core_attr | xlink_attr | `Xlink_href ]
(* nullary *)
-type fontfaceformat_attr = [ | core_attr | `String ]
+type font_face_format = [ | `Font_Face_Format ]
-type fontfacename = [ | `Font_Face_Name ]
+type font_face_format_attr = [ | core_attr | `String ]
(* nullary *)
-type fontfacename_attr = [ | core_attr | `Name ]
+type font_face_name = [ | `Font_Face_Name ]
+
+type font_face_name_attr = [ | core_attr | `Name ]
type metadata = [ | `Metadata ]
@@ -1913,3 +1913,145 @@
| `Width
| `Height
]
+
+type alignment_baseline =
+ [ `After_edge
+ | `Alphabetic
+ | `Auto
+ | `Baseline
+ | `Before_edge
+ | `Central
+ | `Hanging
+ | `Ideographic
+ | `Inherit
+ | `Mathematical
+ | `Middle
+ | `Text_after_edge
+ | `Text_before_edge ]
+
+type dominant_baseline =
+ [ `Auto
+ | `Use_script
+ | `No_change
+ | `Reset_size
+ | `Ideographic
+ | `Alphabetic
+ | `Hanging
+ | `Mathematical
+ | `Central
+ | `Middle
+ | `Text_after_edge
+ | `Text_before_edge
+ | `Inherit
+ ]
+
+type in_value =
+ [ `SourceGraphic
+ | `SourceAlpha
+ | `BackgroundImage
+ | `BackgroundAlpha
+ | `FillPaint
+ | `StrokePaint
+ | `Ref of string ] [@@reflect.total_variant]
+
+type offset =
+ [ `Number of number
+ | `Percentage of percentage ]
+
+type big_variant =
+ [ `A
+ | `Absolute_colorimetric
+ | `Align
+ | `Always
+ | `Atop
+ | `Arithmetic
+ | `Auto
+ | `B
+ | `Bever
+ | `Blink
+ | `Butt
+ | `CSS
+ | `Darken
+ | `Default
+ | `Dilate
+ | `Disable
+ | `Discrete
+ | `Duplicate
+ | `End
+ | `Erode
+ | `Exact
+ | `FractalNoise
+ | `Freeze
+ | `HueRotate
+ | `G
+ | `Gamma
+ | `GeometricPrecision
+ | `H
+ | `Identity
+ | `In
+ | `Inherit
+ | `Initial
+ | `Isolated
+ | `Lighten
+ | `Line_through
+ | `Linear
+ | `LuminanceToAlpha
+ | `Magnify
+ | `Matrix
+ | `Medial
+ | `Middle
+ | `Miter
+ | `Multiply
+ | `Never
+ | `New
+ | `None
+ | `Normal
+ | `NoStitch
+ | `ObjectBoundingBox
+ | `OnLoad
+ | `OnRequest
+ | `OptimizeLegibility
+ | `OptimizeSpeed
+ | `Other
+ | `Out
+ | `Over
+ | `Overline
+ | `Paced
+ | `Pad
+ | `Perceptual
+ | `Preserve
+ | `R
+ | `Reflect
+ | `Remove
+ | `Repeat
+ | `Replace
+ | `Relative_colorimetric
+ | `Rotate
+ | `Round
+ | `Saturate
+ | `Saturation
+ | `Scale
+ | `Screen
+ | `SkewX
+ | `SkewY
+ | `Spacing
+ | `SpacingAndGlyphs
+ | `Spline
+ | `Square
+ | `Start
+ | `Stitch
+ | `Stretch
+ | `StrokeWidth
+ | `Sum
+ | `Table
+ | `Terminal
+ | `Translate
+ | `Turbulence
+ | `Underline
+ | `UserSpaceOnUse
+ | `V
+ | `WhenNotActive
+ | `Wrap
+ | `XML
+ | `Xor
+ ]
diff -Nru tyxml-3.5.0/lib/tyxml_f.mldylib tyxml-4.1.0/lib/tyxml_f.mldylib
--- tyxml-3.5.0/lib/tyxml_f.mldylib 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/tyxml_f.mldylib 2017-03-03 16:33:22.000000000 +0000
@@ -1,8 +1,8 @@
# OASIS_START
-# DO NOT EDIT (digest: 0fa001b15457fb6ba2d2dd88ed88135a)
+# DO NOT EDIT (digest: c50b31e7fcf48d4e470776748ce82005)
Xml_iter
Xml_wrap
Xml_print
Svg_f
-Html5_f
+Html_f
# OASIS_STOP
diff -Nru tyxml-3.5.0/lib/tyxml_f.mllib tyxml-4.1.0/lib/tyxml_f.mllib
--- tyxml-3.5.0/lib/tyxml_f.mllib 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/tyxml_f.mllib 2017-03-03 16:33:22.000000000 +0000
@@ -1,8 +1,8 @@
# OASIS_START
-# DO NOT EDIT (digest: 0fa001b15457fb6ba2d2dd88ed88135a)
+# DO NOT EDIT (digest: c50b31e7fcf48d4e470776748ce82005)
Xml_iter
Xml_wrap
Xml_print
Svg_f
-Html5_f
+Html_f
# OASIS_STOP
diff -Nru tyxml-3.5.0/lib/tyxml.mldylib tyxml-4.1.0/lib/tyxml.mldylib
--- tyxml-3.5.0/lib/tyxml.mldylib 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/tyxml.mldylib 1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: bce6e3a042f2111300775728d0a3325b)
-Xml
-Svg
-Html5
-Xml_iter
-Xml_wrap
-Xml_print
-Svg_f
-Html5_f
-# OASIS_STOP
diff -Nru tyxml-3.5.0/lib/tyxml.mllib tyxml-4.1.0/lib/tyxml.mllib
--- tyxml-3.5.0/lib/tyxml.mllib 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/tyxml.mllib 1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: bce6e3a042f2111300775728d0a3325b)
-Xml
-Svg
-Html5
-Xml_iter
-Xml_wrap
-Xml_print
-Svg_f
-Html5_f
-# OASIS_STOP
diff -Nru tyxml-3.5.0/lib/xml.ml tyxml-4.1.0/lib/xml.ml
--- tyxml-3.5.0/lib/xml.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml.ml 1970-01-01 00:00:00.000000000 +0000
@@ -1,133 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2004 Thorsten Ohl
- * Copyright (C) 2007 Gabriel Kerneis
- * Copyright (C) 2010 Cecile Herbelin
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(** Attributes *)
-
-module M = struct
-
- type 'a wrap = 'a
- type 'a list_wrap = 'a list
-
- type uri = string
- let uri_of_string s = s
- let string_of_uri s = s
-
- type separator = Space | Comma
-
- type aname = string
- type acontent =
- | AFloat of float
- | AInt of int
- | AStr of string
- | AStrL of separator * string list
- type attrib = aname * acontent
- type event_handler = string
- type mouse_event_handler = string
- type keyboard_event_handler = string
-
- let acontent (_, a) = a
- let aname (name, _) = name
-
- let float_attrib name value = name, AFloat value
- let int_attrib name value = name, AInt value
- let string_attrib name value = name, AStr value
- let space_sep_attrib name values = name, AStrL (Space, values)
- let comma_sep_attrib name values = name, AStrL (Comma, values)
- let event_handler_attrib name value = name, AStr value
- let mouse_event_handler_attrib name value = name, AStr value
- let keyboard_event_handler_attrib name value = name, AStr value
- let uri_attrib name value = name, AStr value
- let uris_attrib name values = name, AStrL (Space, values)
-
-
- (** Element *)
-
- type ename = string
- type econtent =
- | Empty
- | Comment of string
- | EncodedPCDATA of string
- | PCDATA of string
- | Entity of string
- | Leaf of ename * attrib list
- | Node of ename * attrib list * elt list
- and elt = {
- elt : econtent ;
- }
-
- let content elt = elt.elt
-
- let empty () = { elt = Empty }
-
- let comment c = { elt = Comment c }
-
- let pcdata d = { elt = PCDATA d }
- let encodedpcdata d = { elt = EncodedPCDATA d }
- let entity e = { elt = Entity e }
-
- let cdata s = (* GK *)
- (* For security reasons, we do not allow "]]>" inside CDATA
- (as this string is to be considered as the end of the cdata)
- *)
- let s' = "\n")) "" s)
- ^"\n]]>\n" in
- encodedpcdata s'
-
- let cdata_script s = (* GK *)
- (* For security reasons, we do not allow "]]>" inside CDATA
- (as this string is to be considered as the end of the cdata)
- *)
- let s' = "\n//")) "" s)
- ^"\n//]]>\n" in
- encodedpcdata s'
-
- let cdata_style s = (* GK *)
- (* For security reasons, we do not allow "]]>" inside CDATA
- (as this string is to be considered as the end of the cdata)
- *)
- let s' = "\n/* ")) "" s)
- ^"\n/* ]]> */\n" in
- encodedpcdata s'
-
- let leaf ?a name =
- { elt =
- (match a with
- | Some a -> Leaf (name, a)
- | None -> Leaf (name, [])) }
-
- let node ?a name children =
- { elt =
- (match a with
- | Some a -> Node (name, a, children)
- | None -> Node (name, [], children)) }
-
-
-end
-
-include M
-include Xml_print.Make_simple(M)(struct let emptytags = [] end)
-include Xml_iter.Make(M)
-
-let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]
-let print fmt x = Format.fprintf fmt "<< %a >>" print x
diff -Nru tyxml-3.5.0/lib/xml.mli tyxml-4.1.0/lib/xml.mli
--- tyxml-3.5.0/lib/xml.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml.mli 1970-01-01 00:00:00.000000000 +0000
@@ -1,135 +0,0 @@
-(* TyXML
- * http://www.ocsigen.org/tyxml
- * Copyright (C) 2004 Thorsten Ohl
- * Copyright (C) 2007 Gabriel Kerneis
- * Copyright (C) 2010 Cecile Herbelin
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
-*)
-
-(** Basic functions for construction and manipulation of XML tree. *)
-
-type 'a wrap = 'a
-type 'a list_wrap = 'a list
-type uri = string
-val string_of_uri : uri -> string
-val uri_of_string : string -> uri
-
-type aname = string
-type separator = Space | Comma
-type event_handler = string
-type mouse_event_handler = string
-type keyboard_event_handler = string
-
-type attrib
-val aname : attrib -> aname
-
-type acontent = private
- | AFloat of float
- | AInt of int
- | AStr of string
- | AStrL of separator * string list
-val acontent : attrib -> acontent
-
-val float_attrib : aname -> float -> attrib
-val int_attrib : aname -> int -> attrib
-val string_attrib : aname -> string -> attrib
-val space_sep_attrib : aname -> string list -> attrib
-val comma_sep_attrib : aname -> string list -> attrib
-val event_handler_attrib : aname -> event_handler -> attrib
-val mouse_event_handler_attrib : aname -> event_handler -> attrib
-val keyboard_event_handler_attrib : aname -> event_handler -> attrib
-val uri_attrib : aname -> uri -> attrib
-val uris_attrib : aname -> uri list -> attrib
-
-type ename = string
-
-type elt
-type econtent = private
- | Empty
- | Comment of string
- | EncodedPCDATA of string
- | PCDATA of string
- | Entity of string
- | Leaf of ename * attrib list
- | Node of ename * attrib list * elt list
-val content : elt -> econtent
-
-val empty : unit -> elt
-
-val comment : string -> elt
-val pcdata : string -> elt
-val encodedpcdata : string -> elt
-val entity : string -> elt
-(** Neither [comment], [pcdata] nor [entity] check their argument for invalid
- characters. Unsafe characters will be escaped later by the output routines. *)
-
-val leaf : ?a:(attrib list) -> ename -> elt
-val node : ?a:(attrib list) -> ename -> elt list -> elt
-
-val cdata : string -> elt
-val cdata_script : string -> elt
-val cdata_style : string -> elt
-
-(** {2 Iterators} *)
-
-val amap : (ename -> attrib list -> attrib list) -> elt -> elt
-(** Recursively edit attributes for the element and all its children. *)
-
-val amap1 : (ename -> attrib list -> attrib list) -> elt -> elt
-(** Edit attributes only for one element. *)
-
-(** The following can safely be exported by higher level libraries,
- because removing an attribute from a element is always legal. *)
-
-val rm_attrib : (aname -> bool) -> attrib list -> attrib list
-val rm_attrib_from_list : (aname -> bool) -> (string -> bool) -> attrib list -> attrib list
-
-val map_int_attrib :
- (aname -> bool) -> (int -> int) -> attrib list -> attrib list
-val map_string_attrib :
- (aname -> bool) -> (string -> string) -> attrib list -> attrib list
-val map_string_attrib_in_list :
- (aname -> bool) -> (string -> string) -> attrib list -> attrib list
-
-(** Exporting the following by higher level libraries would drive
- a hole through a type system, because they allow to add {e any}
- attribute to {e any} element. *)
-
-val add_int_attrib : aname -> int -> attrib list -> attrib list
-val add_string_attrib : aname -> string -> attrib list -> attrib list
-val add_comma_sep_attrib : aname -> string -> attrib list -> attrib list
-val add_space_sep_attrib : aname -> string -> attrib list -> attrib list
-
-val fold : (unit -> 'a) -> (string -> 'a) -> (string -> 'a) -> (string -> 'a) ->
- (string -> 'a) -> (ename -> attrib list -> 'a) ->
- (ename -> attrib list -> 'a list -> 'a) ->
- elt -> 'a
-
-val all_entities : elt -> string list
-
-val translate :
- (ename -> attrib list -> elt) ->
- (ename -> attrib list -> elt list -> elt) ->
- ('state -> ename -> attrib list -> elt list) ->
- ('state -> ename -> attrib list -> elt list -> elt list) ->
- (ename -> attrib list -> 'state -> 'state) -> 'state -> elt -> elt
-
-(** {2 Printer} *)
-
-val print_list:
- output:(string -> unit) -> ?encode:(string -> string) -> elt list -> unit
-
-val print : Format.formatter -> elt -> unit
diff -Nru tyxml-3.5.0/lib/xml_print.ml tyxml-4.1.0/lib/xml_print.ml
--- tyxml-3.5.0/lib/xml_print.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml_print.ml 2017-03-03 16:33:22.000000000 +0000
@@ -48,25 +48,48 @@
Buffer.contents b
let compose_decl ?(version = "1.0") ?(encoding = "UTF-8") () =
- "\n"
+ Format.sprintf
+ {|\n|}
+ version encoding
let compose_doctype dt args =
- " "\"" ^ a ^ "\"") args)) ^ ">"
-
+ let pp_args fmt = function
+ | [] -> ()
+ | l ->
+ Format.fprintf fmt " PUBLIC %a"
+ (Format.pp_print_list ~pp_sep:Format.pp_print_space
+ (fun fmt -> Format.fprintf fmt "\"%s\""))
+ l
+ in
+ Format.asprintf
+ ""
+ dt
+ pp_args args
+
+let re_end_comment = Re.(compile @@ alt [
+ seq [ bos ; str ">" ] ;
+ seq [ bos ; str "->" ] ;
+ str "-->" ;
+ str "--!>" ;
+])
+let escape_comment s =
+ let f g = match Re.Group.get g 0 with
+ | ">" -> ">"
+ | "->" -> "->"
+ | "-->" -> "-->"
+ | "--!>" -> "--!>"
+ | s -> s
+ in
+ Re.replace ~all:true re_end_comment ~f s
(* copied form js_of_ocaml: compiler/javascript.ml *)
-let string_of_number v =
+let pp_number fmt v =
if v = infinity
- then "Infinity"
+ then Format.pp_print_string fmt "Infinity"
else if v = neg_infinity
- then "-Infinity"
+ then Format.pp_print_string fmt "-Infinity"
else if v <> v
- then "NaN"
+ then Format.pp_print_string fmt "NaN"
else
let vint = int_of_float v in
(* compiler 1000 into 1e3 *)
@@ -77,19 +100,21 @@
then div (n/10) (succ i)
else
if i > 2
- then Printf.sprintf "%de%d" n i
- else string_of_int vint in
+ then Format.fprintf fmt "%de%d" n i
+ else Format.pp_print_int fmt vint in
div vint 0
else
let s1 = Printf.sprintf "%.12g" v in
if v = float_of_string s1
- then s1
+ then Format.pp_print_string fmt s1
else
let s2 = Printf.sprintf "%.15g" v in
if v = float_of_string s2
- then s2
- else Printf.sprintf "%.18g" v
+ then Format.pp_print_string fmt s2
+ else Format.fprintf fmt "%.18g" v
+let string_of_number v =
+ Format.asprintf "%a" pp_number v
module Utf8 = struct
type utf8 = string
@@ -98,7 +123,7 @@
let warn = ref false in
let buffer = Buffer.create (String.length src) in
Uutf.String.fold_utf_8
- (fun _ i d ->
+ (fun _ _ d ->
match d with
| `Uchar code -> Uutf.Buffer.add_utf_8 buffer code
| `Malformed _ ->
@@ -127,38 +152,41 @@
let warn = ref false in
let buffer = Buffer.create (String.length src) in
Uutf.String.fold_utf_8
- (fun _ i d ->
+ (fun _ _ d ->
match d with
- | `Uchar 34 ->
- Buffer.add_string buffer """
- | `Uchar 38 ->
- Buffer.add_string buffer "&"
- | `Uchar 60 ->
- Buffer.add_string buffer "<"
- | `Uchar 62 ->
- Buffer.add_string buffer ">"
- | `Uchar code ->
- let u =
- (* Illegal characters in html
- http://en.wikipedia.org/wiki/Character_encodings_in_HTML
- http://www.w3.org/TR/html5/syntax.html *)
- if (* A. control C0 *)
- (code <= 31 && code <> 9 && code <> 10 && code <> 13)
- (* B. DEL + control C1
- - invalid in html
- - discouraged in xml;
- except 0x85 see http://www.w3.org/TR/newline
- but let's discard it anyway *)
- || (code >= 127 && code <= 159)
- (* C. UTF-16 surrogate halves : already discarded by uutf *)
- (* || (code >= 0xD800 && code <= 0xDFFF) *)
- (* D. BOOM related *)
- || code land 0xFFFF = 0xFFFE
- || code land 0xFFFF = 0xFFFF
- then (warn:=true; Uutf.u_rep)
- else code
- in
- Uutf.Buffer.add_utf_8 buffer u
+ | `Uchar u ->
+ begin match Uchar.to_int u with
+ | 34 ->
+ Buffer.add_string buffer """
+ | 38 ->
+ Buffer.add_string buffer "&"
+ | 60 ->
+ Buffer.add_string buffer "<"
+ | 62 ->
+ Buffer.add_string buffer ">"
+ | code ->
+ let u =
+ (* Illegal characters in html
+ http://en.wikipedia.org/wiki/Character_encodings_in_HTML
+ http://www.w3.org/TR/html5/syntax.html *)
+ if (* A. control C0 *)
+ (code <= 31 && code <> 9 && code <> 10 && code <> 13)
+ (* B. DEL + control C1
+ - invalid in html
+ - discouraged in xml;
+ except 0x85 see http://www.w3.org/TR/newline
+ but let's discard it anyway *)
+ || (code >= 127 && code <= 159)
+ (* C. UTF-16 surrogate halves : already discarded
+ by uutf || (code >= 0xD800 && code <= 0xDFFF) *)
+ (* D. BOM related *)
+ || code land 0xFFFF = 0xFFFE
+ || code land 0xFFFF = 0xFFFF
+ then (warn:=true; Uutf.u_rep)
+ else u
+ in
+ Uutf.Buffer.add_utf_8 buffer u
+ end
| `Malformed _ ->
Uutf.Buffer.add_utf_8 buffer Uutf.u_rep;
warn:=true)
@@ -169,10 +197,130 @@
end
+module type TagList = sig val emptytags : string list end
+
+(** Format based printers *)
+
+let pp_noop _fmt _ = ()
+
+module Make_fmt
+ (Xml : Xml_sigs.Iterable)
+ (I : TagList) =
+struct
+ open Xml
+
+ module S = Set.Make(String)
+ let is_emptytag = match I.emptytags with
+ | [] -> fun _ -> false
+ | l ->
+ let set = List.fold_left (fun s x -> S.add x s) S.empty l in
+ fun x -> S.mem x set
+
+ let pp_encode encode fmt s =
+ Format.pp_print_string fmt (encode s)
+
+ let pp_sep = function
+ | Space -> fun fmt () -> Format.pp_print_char fmt ' '
+ | Comma -> fun fmt () -> Format.pp_print_string fmt ", "
+
+ let pp_attrib_value encode fmt a = match acontent a with
+ | AFloat f -> Format.fprintf fmt "\"%a\"" pp_number f
+ | AInt i -> Format.fprintf fmt "\"%d\"" i
+ | AStr s -> Format.fprintf fmt "\"%s\"" (encode s)
+ | AStrL (sep, slist) ->
+ Format.fprintf fmt "\"%a\""
+ (Format.pp_print_list ~pp_sep:(pp_sep sep) (pp_encode encode)) slist
+
+ let pp_attrib encode fmt a =
+ Format.fprintf fmt
+ " %s=%a" (aname a) (pp_attrib_value encode) a
+
+ let pp_attribs encode =
+ Format.pp_print_list ~pp_sep:pp_noop (pp_attrib encode)
+
+ let pp_closedtag encode fmt tag attrs =
+ if is_emptytag tag then
+ Format.fprintf fmt "<%s%a/>" tag (pp_attribs encode) attrs
+ else
+ Format.fprintf fmt "<%s%a>%s>" tag (pp_attribs encode) attrs tag
+
+ let rec pp_tag encode fmt tag attrs taglist =
+ match taglist with
+ | [] -> pp_closedtag encode fmt tag attrs
+ | _ ->
+ Format.fprintf fmt "<%s%a>%a%s>"
+ tag
+ (pp_attribs encode) attrs
+ (pp_elts encode) taglist
+ tag
+
+ and pp_elt encode fmt elt = match content elt with
+ | Comment texte ->
+ Format.fprintf fmt "" (escape_comment texte)
+
+ | Entity e ->
+ Format.fprintf fmt "&%s;" e
+
+ | PCDATA texte ->
+ pp_encode encode fmt texte
+
+ | EncodedPCDATA texte ->
+ Format.pp_print_string fmt texte
+
+ | Node (name, xh_attrs, xh_taglist) ->
+ pp_tag encode fmt name xh_attrs xh_taglist
+
+ | Leaf (name, xh_attrs) ->
+ pp_closedtag encode fmt name xh_attrs
+
+ | Empty -> ()
+
+ and pp_elts encode =
+ Format.pp_print_list ~pp_sep:pp_noop (pp_elt encode)
+
+ let pp ?(encode=encode_unsafe_char) () =
+ pp_elt encode
+
+end
+
+module Make_typed_fmt
+ (Xml : Xml_sigs.Iterable)
+ (Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml) =
+struct
+
+ module P = Make_fmt(Xml)(Typed_xml.Info)
+
+ (* Add an xmlns tag on the html element if it's not already present *)
+ let prepare_document doc =
+ let doc = Typed_xml.doc_toelt doc in
+ match Xml.content doc with
+ | Xml.Node (n, a, c) ->
+ let a =
+ if List.exists (fun a -> Xml.aname a = "xmlns") a
+ then a
+ else Xml.string_attrib "xmlns" Typed_xml.Info.namespace :: a
+ in
+ Xml.node ~a n c
+ | _ -> doc
+
+ let pp_elt ?(encode=encode_unsafe_char) () fmt foret =
+ P.pp_elt encode fmt (Typed_xml.toelt foret)
+
+ let pp ?(encode = encode_unsafe_char) ?advert () fmt doc =
+ Format.pp_print_string fmt Typed_xml.Info.doctype ;
+
+ begin match advert with
+ | Some s -> Format.fprintf fmt "\n" s
+ | None -> Format.pp_print_newline fmt ()
+ end ;
+
+ P.pp_elt encode fmt (prepare_document doc)
+
+end
module Make
(Xml : Xml_sigs.Iterable)
- (F : sig val emptytags : string list end)
+ (I : TagList)
(O : Xml_sigs.Output) =
struct
@@ -201,10 +349,8 @@
O.put (" "^ attrib_to_string encode attr)
++ xh_print_attrs encode queue
- and xh_print_text texte = O.put texte
-
and xh_print_closedtag encode tag attrs =
- if F.emptytags = [] || List.mem tag F.emptytags
+ if I.emptytags = [] || List.mem tag I.emptytags
then
(O.put ("<"^tag)
++ xh_print_attrs encode attrs
@@ -267,7 +413,7 @@
module Make_typed
(Xml : Xml_sigs.Iterable)
- (Typed_xml : Xml_sigs.Iterable_typed_xml with module Xml := Xml)
+ (Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
(O : Xml_sigs.Output) =
struct
@@ -306,11 +452,9 @@
module Make_simple
(Xml : Xml_sigs.Iterable)
- (I : sig val emptytags : string list end) =
+ (I : TagList) =
struct
- type elt = Xml.elt
- type out = unit
let print_list ~output =
let module M = Make(Xml)(I)(Simple_output(struct let put = output end)) in
M.print_list
@@ -322,10 +466,6 @@
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml) =
struct
- type out = unit
- type 'a elt = 'a Typed_xml.elt
- type doc = Typed_xml.doc
-
let print_list ~output =
let module M =
Make_typed(Xml)(Typed_xml)(Simple_output(struct let put = output end)) in
diff -Nru tyxml-3.5.0/lib/xml_print.mli tyxml-4.1.0/lib/xml_print.mli
--- tyxml-3.5.0/lib/xml_print.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml_print.mli 2017-03-03 16:33:22.000000000 +0000
@@ -18,17 +18,28 @@
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
-(** Printer for XML. *)
+(** Printing utilities.
+
+ This module contains various encoding functions that can be used
+ with {!Tyxml.Html.pp} and {!Tyxml.Svg.pp}.
+
+ It also contains functors to create printers for your own XML data structure.
+
+*)
+
+(** {2 Encoding functions} *)
val encode_unsafe_char : string -> string
(** The encoder maps strings to HTML and {e must} encode the unsafe characters
['<'], ['>'], ['"'], ['&'] and the control characters 0-8, 11-12, 14-31, 127
- to HTML entities. [encode_unsafe] is the default for [?encode] in [output]
+ to HTML entities. [encode_unsafe_char] is the default for [?encode] in [output]
and [pretty_print] below. Other implementations are provided by the module
[Netencoding] in the
{{:http://www.ocaml-programming.de/programming/ocamlnet.html}OcamlNet}
library, e.g.:
- [let encode = Netencoding.Html.encode ~in_enc:`Enc_iso88591 ~out_enc:`Enc_usascii ()],
+ {[
+let encode = Netencoding.Html.encode ~in_enc:`Enc_iso88591 ~out_enc:`Enc_usascii ()
+ ]}
Where national characters are replaced by HTML entities.
The user is of course free to write her own implementation.
@see OcamlNet *)
@@ -37,24 +48,17 @@
(** In addition, encode ["@"] as ["@"] in the hope that this will fool
simple minded email address harvesters. *)
-val compose_decl : ?version:string -> ?encoding:string -> unit -> string
-(** [encoding] is the name of the character encoding, e.g. ["US-ASCII"] or ["UTF-8"] *)
-
-val compose_doctype : string -> string list -> string
-
-val string_of_number : float -> string
-(** Convert a float to a string using a compact representation compatible with Javascript norme. *)
-
(** Utf8 normalizer and encoder for HTML.
-Given a module [Htmlprinter] produced by one of the functors in {!Xml_print}, this modules is used as following:
+Given a module [pp] functions produced by one of the functors in {!Xml_print}, this modules is used as following:
{[
- let encode x = fst (Utf8.normalize_html x) in
- Htmlprinter.print ~encode document
+ let encode x = fst (Xml_print.Utf8.normalize_html x) in
+ Format.printf "%a" (Html.pp ~encode ()) document
]} *)
module Utf8 : sig
type utf8 = string
+
(** [normalize str] take a possibly invalid utf-8 string
and return a valid utf-8 string
where invalid bytes have been replaced by
@@ -70,11 +74,49 @@
end
+(** {2 Utilities} *)
+
+val compose_decl : ?version:string -> ?encoding:string -> unit -> string
+(** [encoding] is the name of the character encoding, e.g. ["US-ASCII"] or ["UTF-8"] *)
+
+val compose_doctype : string -> string list -> string
+
+val string_of_number : float -> string
+(** Convert a float to a string using a compact representation compatible with Javascript norme. *)
+
+val pp_number : Format.formatter -> float -> unit
+(** See {!string_of_number}. *)
+
+(** {2 Formatter functors} *)
+
+(** Printers for typed XML module, such as the one produced by {!Svg_f} and {!Html_f}. *)
+module Make_typed_fmt
+ (Xml : Xml_sigs.Iterable)
+ (Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
+ : Xml_sigs.Typed_pp
+ with type 'a elt := 'a Typed_xml.elt
+ and type doc := Typed_xml.doc
+
+(** List of tags that can be printed as empty tags: [ ]. *)
+module type TagList = sig val emptytags : string list end
+
+(** Printers for raw XML modules. *)
+module Make_fmt
+ (Xml : Xml_sigs.Iterable)
+ (I : TagList)
+ : Xml_sigs.Pp with type elt := Xml.elt
+
+(** {2 Deprecated functors}
+
+ Use {!Make_fmt} and {!Make_typed_fmt} instead.
+*)
+
module Make
(Xml : Xml_sigs.Iterable)
- (I : sig val emptytags : string list end)
+ (I : TagList)
(O : Xml_sigs.Output)
: Xml_sigs.Printer with type out := O.out and type xml_elt := Xml.elt
+ [@@ocaml.deprecated "Use Xml_print.Make_fmt instead."]
module Make_typed
(Xml : Xml_sigs.Iterable)
@@ -83,14 +125,17 @@
: Xml_sigs.Typed_printer with type out := O.out
and type 'a elt := 'a Typed_xml.elt
and type doc := Typed_xml.doc
+ [@@ocaml.deprecated "Use Xml_print.Make_typed_fmt instead."]
module Make_simple
(Xml : Xml_sigs.Iterable)
- (F : sig val emptytags : string list end)
+ (I : TagList)
: Xml_sigs.Simple_printer with type xml_elt := Xml.elt
+ [@@ocaml.deprecated "Use Xml_print.Make_fmt instead."]
module Make_typed_simple
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
: Xml_sigs.Typed_simple_printer with type 'a elt := 'a Typed_xml.elt
and type doc := Typed_xml.doc
+ [@@ocaml.deprecated "Use Xml_print.Make_typed_fmt instead."]
diff -Nru tyxml-3.5.0/lib/xml_sigs.mli tyxml-4.1.0/lib/xml_sigs.mli
--- tyxml-3.5.0/lib/xml_sigs.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml_sigs.mli 2017-03-03 16:33:22.000000000 +0000
@@ -18,14 +18,18 @@
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
-module type Wrapped = sig
+(** XML Signatures. *)
- type 'a wrap
- type 'a list_wrap
+module type T = sig
+
+ module W : Xml_wrap.T
+
+ type 'a wrap = 'a W.t
+ type 'a list_wrap = 'a W.tlist
type uri
- val string_of_uri : uri -> string
- val uri_of_string : string -> uri
+ val string_of_uri : (uri, string) W.ft
+ val uri_of_string : (string, uri) W.ft
type aname = string
type event_handler
@@ -64,11 +68,10 @@
end
-module type T = Wrapped with type 'a wrap = 'a
- and type 'a list_wrap = 'a list
+module type NoWrap = T with module W = Xml_wrap.NoWrap
module type Iterable = sig
- include T
+ include NoWrap
type separator = Space | Comma
@@ -114,19 +117,7 @@
module type Typed_xml = sig
- module Xml : T
- module Info : Info
-
- type 'a elt
- type doc
- val toelt : 'a elt -> Xml.elt
- val doc_toelt : doc -> Xml.elt
-
-end
-
-module type Iterable_typed_xml = sig
-
- module Xml : Iterable
+ module Xml : NoWrap
module Info : Info
type 'a elt
@@ -184,3 +175,45 @@
doc -> unit
end
+
+module type Pp = sig
+
+ type elt
+
+(** [pp ()] is a {!Format} printer for untyped XML.
+
+ It can be used in combination with ["%a"]. For example, to get a string:
+ {[let s = Format.asprintf "%a" (pp ()) my_xml]}
+
+ A custom encoding function can be provided with the [~encode] argument.
+ Various implementations of [encode] are available in {!Xml_print}.
+*)
+ val pp:
+ ?encode:(string -> string) -> unit -> Format.formatter -> elt -> unit
+end
+
+module type Typed_pp = sig
+
+ type 'a elt
+ type doc
+
+(** [pp_elt ()] is a {!Format} printer for individual elements.
+
+ A custom encoding function can be provided with the [~encode] argument.
+ Various implementations of [encode] are available in {!Xml_print}.
+*)
+ val pp_elt :
+ ?encode:(string -> string) -> unit -> Format.formatter -> 'a elt -> unit
+
+(** [pp ()] is a {!Format} printer for complete documents.
+
+ It can be used in combination with ["%a"]. For example, to get a string:
+ {[let s = Format.asprintf "%a" (pp ()) my_document]}
+
+ A custom encoding function can be provided with the [~encode] argument.
+ Various implementations of [encode] are available in {!Xml_print}.
+*)
+ val pp:
+ ?encode:(string -> string) -> ?advert:string -> unit -> Format.formatter -> doc -> unit
+
+end
diff -Nru tyxml-3.5.0/lib/xml_wrap.ml tyxml-4.1.0/lib/xml_wrap.ml
--- tyxml-3.5.0/lib/xml_wrap.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml_wrap.ml 2017-03-03 16:33:22.000000000 +0000
@@ -17,23 +17,30 @@
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
-
module type T = sig
type 'a t
- type 'a tlist
val return : 'a -> 'a t
- val fmap : ('a -> 'b) -> 'a t -> 'b t
+ type (-'a, 'b) ft
+ val fmap : ('a, 'b) ft -> 'a t -> 'b t
+
+ type 'a tlist
val nil : unit -> 'a tlist
val singleton : 'a t -> 'a tlist
val cons : 'a t -> 'a tlist -> 'a tlist
val append : 'a tlist -> 'a tlist -> 'a tlist
- val map : ('a -> 'b) -> 'a tlist -> 'b tlist
+ val map : ('a, 'b) ft -> 'a tlist -> 'b tlist
end
+module type NoWrap =
+ T with type 'a t = 'a
+ and type 'a tlist = 'a list
+ and type (-'a, 'b) ft = 'a -> 'b
+
module NoWrap = struct
type 'a t = 'a
type 'a tlist = 'a list
+ type (-'a, 'b) ft = 'a -> 'b
external return : 'a -> 'a = "%identity"
let fmap f : 'a t -> 'b t = f
diff -Nru tyxml-3.5.0/lib/xml_wrap.mli tyxml-4.1.0/lib/xml_wrap.mli
--- tyxml-3.5.0/lib/xml_wrap.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/lib/xml_wrap.mli 2017-03-03 16:33:22.000000000 +0000
@@ -19,16 +19,22 @@
module type T = sig
type 'a t
- type 'a tlist
val return : 'a -> 'a t
- val fmap : ('a -> 'b) -> 'a t -> 'b t
+ type (-'a, 'b) ft
+ val fmap : ('a, 'b) ft -> 'a t -> 'b t
+
+ type 'a tlist
val nil : unit -> 'a tlist
val singleton : 'a t -> 'a tlist
val cons : 'a t -> 'a tlist -> 'a tlist
val append : 'a tlist -> 'a tlist -> 'a tlist
- val map : ('a -> 'b ) -> 'a tlist -> 'b tlist
+ val map : ('a, 'b) ft -> 'a tlist -> 'b tlist
end
-module NoWrap : T with type 'a t = 'a
- and type 'a tlist = 'a list
+module type NoWrap =
+ T with type 'a t = 'a
+ and type 'a tlist = 'a list
+ and type (-'a, 'b) ft = 'a -> 'b
+
+module NoWrap : NoWrap
diff -Nru tyxml-3.5.0/Makefile tyxml-4.1.0/Makefile
--- tyxml-3.5.0/Makefile 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/Makefile 2017-03-03 16:33:22.000000000 +0000
@@ -1,3 +1,6 @@
+OCAMLFIND_IGNORE_DUPS_IN = $(shell ocamlfind query compiler-libs)
+export OCAMLFIND_IGNORE_DUPS_IN
+
# OASIS_START
# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
diff -Nru tyxml-3.5.0/.merlin tyxml-4.1.0/.merlin
--- tyxml-3.5.0/.merlin 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -1,7 +1,13 @@
S lib
S syntax
S tools
+S ppx
B _build/*
-PKG uutf
\ No newline at end of file
+FLG -w +A-4-9-40-42-44-48
+FLG -w -32-34-37
+FLG -strict_sequence -safe_string
+
+PKG uchar uutf re
+PKG compiler-libs.common ppx_tools.metaquot markup
diff -Nru tyxml-3.5.0/myocamlbuild.ml tyxml-4.1.0/myocamlbuild.ml
--- tyxml-3.5.0/myocamlbuild.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/myocamlbuild.ml 2017-03-03 16:33:22.000000000 +0000
@@ -19,23 +19,16 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
* 02111-1307, USA.
*)
-
+[@@@ocaml.warning "-3"]
(* OASIS_START *)
-(* DO NOT EDIT (digest: 9c9509f12b10b2d15113fa1ad7a5b4a7) *)
+(* DO NOT EDIT (digest: 9011746f9578807777d03b786d851aa4) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
- let ns_ str =
- str
-
-
- let s_ str =
- str
-
-
- let f_ (str: ('a, 'b, 'c, 'd) format4) =
- str
+ let ns_ str = str
+ let s_ str = str
+ let f_ (str: ('a, 'b, 'c, 'd) format4) = str
let fn_ fmt1 fmt2 n =
@@ -45,25 +38,344 @@
fmt2^^""
- let init =
- []
+ let init = []
+end
+module OASISString = struct
+(* # 22 "src/oasis/OASISString.ml" *)
-end
-module OASISExpr = struct
-(* # 22 "src/oasis/OASISExpr.ml" *)
+ (** Various string utilities.
+ Mostly inspired by extlib and batteries ExtString and BatString libraries.
+ @author Sylvain Le Gall
+ *)
+ let nsplitf str f =
+ if str = "" then
+ []
+ else
+ let buf = Buffer.create 13 in
+ let lst = ref [] in
+ let push () =
+ lst := Buffer.contents buf :: !lst;
+ Buffer.clear buf
+ in
+ let str_len = String.length str in
+ for i = 0 to str_len - 1 do
+ if f str.[i] then
+ push ()
+ else
+ Buffer.add_char buf str.[i]
+ done;
+ push ();
+ List.rev !lst
+
+
+ (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
+ separator.
+ *)
+ let nsplit str c =
+ nsplitf str ((=) c)
+
+
+ let find ~what ?(offset=0) str =
+ let what_idx = ref 0 in
+ let str_idx = ref offset in
+ while !str_idx < String.length str &&
+ !what_idx < String.length what do
+ if str.[!str_idx] = what.[!what_idx] then
+ incr what_idx
+ else
+ what_idx := 0;
+ incr str_idx
+ done;
+ if !what_idx <> String.length what then
+ raise Not_found
+ else
+ !str_idx - !what_idx
+
+
+ let sub_start str len =
+ let str_len = String.length str in
+ if len >= str_len then
+ ""
+ else
+ String.sub str len (str_len - len)
+
+
+ let sub_end ?(offset=0) str len =
+ let str_len = String.length str in
+ if len >= str_len then
+ ""
+ else
+ String.sub str 0 (str_len - len)
+
+
+ let starts_with ~what ?(offset=0) str =
+ let what_idx = ref 0 in
+ let str_idx = ref offset in
+ let ok = ref true in
+ while !ok &&
+ !str_idx < String.length str &&
+ !what_idx < String.length what do
+ if str.[!str_idx] = what.[!what_idx] then
+ incr what_idx
+ else
+ ok := false;
+ incr str_idx
+ done;
+ if !what_idx = String.length what then
+ true
+ else
+ false
+
+
+ let strip_starts_with ~what str =
+ if starts_with ~what str then
+ sub_start str (String.length what)
+ else
+ raise Not_found
+
+
+ let ends_with ~what ?(offset=0) str =
+ let what_idx = ref ((String.length what) - 1) in
+ let str_idx = ref ((String.length str) - 1) in
+ let ok = ref true in
+ while !ok &&
+ offset <= !str_idx &&
+ 0 <= !what_idx do
+ if str.[!str_idx] = what.[!what_idx] then
+ decr what_idx
+ else
+ ok := false;
+ decr str_idx
+ done;
+ if !what_idx = -1 then
+ true
+ else
+ false
+
+
+ let strip_ends_with ~what str =
+ if ends_with ~what str then
+ sub_end str (String.length what)
+ else
+ raise Not_found
+
+
+ let replace_chars f s =
+ let buf = Buffer.create (String.length s) in
+ String.iter (fun c -> Buffer.add_char buf (f c)) s;
+ Buffer.contents buf
+
+ let lowercase_ascii =
+ replace_chars
+ (fun c ->
+ if (c >= 'A' && c <= 'Z') then
+ Char.chr (Char.code c + 32)
+ else
+ c)
+
+ let uncapitalize_ascii s =
+ if s <> "" then
+ (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+ else
+ s
+
+ let uppercase_ascii =
+ replace_chars
+ (fun c ->
+ if (c >= 'a' && c <= 'z') then
+ Char.chr (Char.code c - 32)
+ else
+ c)
+
+ let capitalize_ascii s =
+ if s <> "" then
+ (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+ else
+ s
+
+end
+
+module OASISUtils = struct
+(* # 22 "src/oasis/OASISUtils.ml" *)
+
open OASISGettext
- type test = string
+ module MapExt =
+ struct
+ module type S =
+ sig
+ include Map.S
+ val add_list: 'a t -> (key * 'a) list -> 'a t
+ val of_list: (key * 'a) list -> 'a t
+ val to_list: 'a t -> (key * 'a) list
+ end
+
+ module Make (Ord: Map.OrderedType) =
+ struct
+ include Map.Make(Ord)
+
+ let rec add_list t =
+ function
+ | (k, v) :: tl -> add_list (add k v t) tl
+ | [] -> t
+
+ let of_list lst = add_list empty lst
+
+ let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
+ end
+ end
+
+
+ module MapString = MapExt.Make(String)
+
+
+ module SetExt =
+ struct
+ module type S =
+ sig
+ include Set.S
+ val add_list: t -> elt list -> t
+ val of_list: elt list -> t
+ val to_list: t -> elt list
+ end
+
+ module Make (Ord: Set.OrderedType) =
+ struct
+ include Set.Make(Ord)
+
+ let rec add_list t =
+ function
+ | e :: tl -> add_list (add e t) tl
+ | [] -> t
+
+ let of_list lst = add_list empty lst
+
+ let to_list = elements
+ end
+ end
+
+
+ module SetString = SetExt.Make(String)
+
+ let compare_csl s1 s2 =
+ String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
+
+ module HashStringCsl =
+ Hashtbl.Make
+ (struct
+ type t = string
+ let equal s1 s2 = (compare_csl s1 s2) = 0
+ let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
+ end)
+
+ module SetStringCsl =
+ SetExt.Make
+ (struct
+ type t = string
+ let compare = compare_csl
+ end)
+
+
+ let varname_of_string ?(hyphen='_') s =
+ if String.length s = 0 then
+ begin
+ invalid_arg "varname_of_string"
+ end
+ else
+ begin
+ let buf =
+ OASISString.replace_chars
+ (fun c ->
+ if ('a' <= c && c <= 'z')
+ ||
+ ('A' <= c && c <= 'Z')
+ ||
+ ('0' <= c && c <= '9') then
+ c
+ else
+ hyphen)
+ s;
+ in
+ let buf =
+ (* Start with a _ if digit *)
+ if '0' <= s.[0] && s.[0] <= '9' then
+ "_"^buf
+ else
+ buf
+ in
+ OASISString.lowercase_ascii buf
+ end
+
+
+ let varname_concat ?(hyphen='_') p s =
+ let what = String.make 1 hyphen in
+ let p =
+ try
+ OASISString.strip_ends_with ~what p
+ with Not_found ->
+ p
+ in
+ let s =
+ try
+ OASISString.strip_starts_with ~what s
+ with Not_found ->
+ s
+ in
+ p^what^s
+
+
+ let is_varname str =
+ str = varname_of_string str
+
+
+ let failwithf fmt = Printf.ksprintf failwith fmt
+
+
+ let rec file_location ?pos1 ?pos2 ?lexbuf () =
+ match pos1, pos2, lexbuf with
+ | Some p, None, _ | None, Some p, _ ->
+ file_location ~pos1:p ~pos2:p ?lexbuf ()
+ | Some p1, Some p2, _ ->
+ let open Lexing in
+ let fn, lineno = p1.pos_fname, p1.pos_lnum in
+ let c1 = p1.pos_cnum - p1.pos_bol in
+ let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
+ Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
+ | _, _, Some lexbuf ->
+ file_location
+ ~pos1:(Lexing.lexeme_start_p lexbuf)
+ ~pos2:(Lexing.lexeme_end_p lexbuf)
+ ()
+ | None, None, None ->
+ s_ ""
+
+
+ let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
+ let loc = file_location ?pos1 ?pos2 ?lexbuf () in
+ Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
+
+
+end
+
+module OASISExpr = struct
+(* # 22 "src/oasis/OASISExpr.ml" *)
+
+
+ open OASISGettext
+ open OASISUtils
+
+
+ type test = string
type flag = string
@@ -76,7 +388,6 @@
| ETest of test * string
-
type 'a choices = (t * 'a) list
@@ -151,7 +462,7 @@
end
-# 132 "myocamlbuild.ml"
+# 443 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
@@ -162,132 +473,103 @@
type t = string MapString.t
- let default_filename =
- Filename.concat
- (Sys.getcwd ())
- "setup.data"
+ let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
- let load ?(allow_empty=false) ?(filename=default_filename) () =
- if Sys.file_exists filename then
- begin
- let chn =
- open_in_bin filename
- in
- let st =
- Stream.of_channel chn
- in
- let line =
- ref 1
- in
- let st_line =
- Stream.from
- (fun _ ->
- try
- match Stream.next st with
- | '\n' -> incr line; Some '\n'
- | c -> Some c
- with Stream.Failure -> None)
- in
- let lexer =
- Genlex.make_lexer ["="] st_line
- in
- let rec read_file mp =
- match Stream.npeek 3 lexer with
- | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
- Stream.junk lexer;
- Stream.junk lexer;
- Stream.junk lexer;
- read_file (MapString.add nm value mp)
- | [] ->
- mp
- | _ ->
- failwith
- (Printf.sprintf
- "Malformed data file '%s' line %d"
- filename !line)
- in
- let mp =
- read_file MapString.empty
- in
- close_in chn;
- mp
- end
- else if allow_empty then
- begin
+ let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
+ let line = ref 1 in
+ let lexer st =
+ let st_line =
+ Stream.from
+ (fun _ ->
+ try
+ match Stream.next st with
+ | '\n' -> incr line; Some '\n'
+ | c -> Some c
+ with Stream.Failure -> None)
+ in
+ Genlex.make_lexer ["="] st_line
+ in
+ let rec read_file lxr mp =
+ match Stream.npeek 3 lxr with
+ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+ Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
+ read_file lxr (MapString.add nm value mp)
+ | [] -> mp
+ | _ ->
+ failwith
+ (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
+ in
+ match stream with
+ | Some st -> read_file (lexer st) MapString.empty
+ | None ->
+ if Sys.file_exists filename then begin
+ let chn = open_in_bin filename in
+ let st = Stream.of_channel chn in
+ try
+ let mp = read_file (lexer st) MapString.empty in
+ close_in chn; mp
+ with e ->
+ close_in chn; raise e
+ end else if allow_empty then begin
MapString.empty
- end
- else
- begin
+ end else begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
-
let rec var_expand str env =
- let buff =
- Buffer.create ((String.length str) * 2)
- in
- Buffer.add_substitute
- buff
- (fun var ->
- try
- var_expand (MapString.find var env) env
- with Not_found ->
- failwith
- (Printf.sprintf
- "No variable %s defined when trying to expand %S."
- var
- str))
- str;
- Buffer.contents buff
-
-
- let var_get name env =
- var_expand (MapString.find name env) env
-
-
- let var_choose lst env =
- OASISExpr.choose
- (fun nm -> var_get nm env)
- lst
+ let buff = Buffer.create ((String.length str) * 2) in
+ Buffer.add_substitute
+ buff
+ (fun var ->
+ try
+ var_expand (MapString.find var env) env
+ with Not_found ->
+ failwith
+ (Printf.sprintf
+ "No variable %s defined when trying to expand %S."
+ var
+ str))
+ str;
+ Buffer.contents buff
+
+
+ let var_get name env = var_expand (MapString.find name env) env
+ let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
end
-# 237 "myocamlbuild.ml"
+# 523 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
- * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
+ * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html
* by N. Pouillard and others
*
- * Updated on 2009/02/28
+ * Updated on 2016-06-02
*
* Modified by Sylvain Le Gall
- *)
+ *)
open Ocamlbuild_plugin
- type conf =
- { no_automatic_syntax: bool;
- }
- (* these functions are not really officially exported *)
- let run_and_read =
- Ocamlbuild_pack.My_unix.run_and_read
+ type conf = {no_automatic_syntax: bool}
+
+
+ let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
- let blank_sep_strings =
- Ocamlbuild_pack.Lexers.blank_sep_strings
+ let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
let exec_from_conf exec =
let exec =
- let env_filename = Pathname.basename BaseEnvLight.default_filename in
- let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
+ let env = BaseEnvLight.load ~allow_empty:true () in
try
BaseEnvLight.var_get exec env
with Not_found ->
@@ -298,7 +580,7 @@
if Sys.os_type = "Win32" then begin
let buff = Buffer.create (String.length str) in
(* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
- *)
+ *)
String.iter
(fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
str;
@@ -307,7 +589,8 @@
str
end
in
- fix_win32 exec
+ fix_win32 exec
+
let split s ch =
let buf = Buffer.create 13 in
@@ -316,15 +599,15 @@
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
- String.iter
- (fun c ->
- if c = ch then
- flush ()
- else
- Buffer.add_char buf c)
- s;
- flush ();
- List.rev !x
+ String.iter
+ (fun c ->
+ if c = ch then
+ flush ()
+ else
+ Buffer.add_char buf c)
+ s;
+ flush ();
+ List.rev !x
let split_nl s = split s '\n'
@@ -366,85 +649,89 @@
let dispatch conf =
function
| After_options ->
- (* By using Before_options one let command line options have an higher
- * priority on the contrary using After_options will guarantee to have
- * the higher priority override default commands by ocamlfind ones *)
- Options.ocamlc := ocamlfind & A"ocamlc";
- Options.ocamlopt := ocamlfind & A"ocamlopt";
- Options.ocamldep := ocamlfind & A"ocamldep";
- Options.ocamldoc := ocamlfind & A"ocamldoc";
- Options.ocamlmktop := ocamlfind & A"ocamlmktop";
- Options.ocamlmklib := ocamlfind & A"ocamlmklib"
+ (* By using Before_options one let command line options have an higher
+ * priority on the contrary using After_options will guarantee to have
+ * the higher priority override default commands by ocamlfind ones *)
+ Options.ocamlc := ocamlfind & A"ocamlc";
+ Options.ocamlopt := ocamlfind & A"ocamlopt";
+ Options.ocamldep := ocamlfind & A"ocamldep";
+ Options.ocamldoc := ocamlfind & A"ocamldoc";
+ Options.ocamlmktop := ocamlfind & A"ocamlmktop";
+ Options.ocamlmklib := ocamlfind & A"ocamlmklib"
| After_rules ->
- (* When one link an OCaml library/binary/package, one should use
- * -linkpkg *)
- flag ["ocaml"; "link"; "program"] & A"-linkpkg";
-
- if not (conf.no_automatic_syntax) then begin
- (* For each ocamlfind package one inject the -package option when
- * compiling, computing dependencies, generating documentation and
- * linking. *)
- List.iter
- begin fun pkg ->
- let base_args = [A"-package"; A pkg] in
- (* TODO: consider how to really choose camlp4o or camlp4r. *)
- let syn_args = [A"-syntax"; A "camlp4o"] in
- let (args, pargs) =
- (* Heuristic to identify syntax extensions: whether they end in
- ".syntax"; some might not.
- *)
- if Filename.check_suffix pkg "syntax" ||
- List.mem pkg well_known_syntax then
- (syn_args @ base_args, syn_args)
- else
- (base_args, [])
- in
- flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
- flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
- flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
- flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
- flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
-
- (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
- flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
- flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
- flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
- flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
- end
- (find_packages ());
- end;
-
- (* Like -package but for extensions syntax. Morover -syntax is useless
- * when linking. *)
- List.iter begin fun syntax ->
+ (* Avoid warnings for unused tag *)
+ flag ["tests"] N;
+
+ (* When one link an OCaml library/binary/package, one should use
+ * -linkpkg *)
+ flag ["ocaml"; "link"; "program"] & A"-linkpkg";
+
+ (* For each ocamlfind package one inject the -package option when
+ * compiling, computing dependencies, generating documentation and
+ * linking. *)
+ List.iter
+ begin fun pkg ->
+ let base_args = [A"-package"; A pkg] in
+ (* TODO: consider how to really choose camlp4o or camlp4r. *)
+ let syn_args = [A"-syntax"; A "camlp4o"] in
+ let (args, pargs) =
+ (* Heuristic to identify syntax extensions: whether they end in
+ ".syntax"; some might not.
+ *)
+ if not (conf.no_automatic_syntax) &&
+ (Filename.check_suffix pkg "syntax" ||
+ List.mem pkg well_known_syntax) then
+ (syn_args @ base_args, syn_args)
+ else
+ (base_args, [])
+ in
+ flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
+ flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
+
+ (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
+ flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
+ flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
+ flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
+ flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
+ end
+ (find_packages ());
+
+ (* Like -package but for extensions syntax. Morover -syntax is useless
+ * when linking. *)
+ List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
- S[A"-syntax"; A syntax];
- end (find_syntaxes ());
+ S[A"-syntax"; A syntax];
+ end (find_syntaxes ());
- (* The default "thread" tag is not compatible with ocamlfind.
- * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
- * options when using this tag. When using the "-linkpkg" option with
- * ocamlfind, this module will then be added twice on the command line.
- *
- * To solve this, one approach is to add the "-thread" option when using
- * the "threads" package using the previous plugin.
- *)
- flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
- flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
- flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
- flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
- flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
- flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
- flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
- flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
+ (* The default "thread" tag is not compatible with ocamlfind.
+ * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
+ * options when using this tag. When using the "-linkpkg" option with
+ * ocamlfind, this module will then be added twice on the command line.
+ *
+ * To solve this, one approach is to add the "-thread" option when using
+ * the "threads" package using the previous plugin.
+ *)
+ flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
+ flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
+ flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
+ flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
+ flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]);
| _ ->
- ()
+ ()
end
module MyOCamlbuildBase = struct
@@ -456,9 +743,6 @@
*)
-
-
-
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
@@ -469,9 +753,6 @@
type tag = string
-(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
-
-
type t =
{
lib_ocaml: (name * dir list * string list) list;
@@ -484,9 +765,10 @@
}
- let env_filename =
- Pathname.basename
- BaseEnvLight.default_filename
+(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+
+
+ let env_filename = Pathname.basename BaseEnvLight.default_filename
let dispatch_combine lst =
@@ -505,12 +787,7 @@
let dispatch t e =
- let env =
- BaseEnvLight.load
- ~filename:env_filename
- ~allow_empty:true
- ()
- in
+ let env = BaseEnvLight.load ~allow_empty:true () in
match e with
| Before_options ->
let no_trailing_dot s =
@@ -538,7 +815,7 @@
| nm, [], intf_modules ->
ocaml_lib nm;
let cmis =
- List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
+ List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
| nm, dir :: tl, intf_modules ->
@@ -551,7 +828,7 @@
["compile"; "infer_interface"; "doc"])
tl;
let cmis =
- List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
+ List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
cmis)
@@ -574,18 +851,19 @@
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
- flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
- (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
+ if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then
+ flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
+ (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* When ocaml link something that use the C library, then one
need that file to be up to date.
This holds both for programs and for libraries.
*)
- dep ["link"; "ocaml"; tag_libstubs lib]
- [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+ dep ["link"; "ocaml"; tag_libstubs lib]
+ [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
- dep ["compile"; "ocaml"; tag_libstubs lib]
- [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+ dep ["compile"; "ocaml"; tag_libstubs lib]
+ [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
@@ -625,24 +903,35 @@
end
-# 606 "myocamlbuild.ml"
+# 884 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
MyOCamlbuildBase.lib_ocaml =
[
- ("tyxml", ["lib"], []);
("tyxml_f",
["lib"],
- ["Xml_sigs"; "Svg_sigs"; "Svg_types"; "Html5_sigs"; "Html5_types"
- ]);
+ ["Xml_sigs"; "Svg_sigs"; "Svg_types"; "Html_sigs"; "Html_types"]);
+ ("tyxml", ["implem"], []);
+ ("tyxml_top", ["implem/top"], []);
("tyxml_tools", ["tools"], []);
("pa_tyxml", ["syntax"], []);
- ("tymlx_p", ["syntax"], [])
+ ("tymlx_p", ["syntax"], []);
+ ("ppx", ["ppx"], []);
+ ("ppx_internal", ["ppx"], ["Ppx_sigs_reflected"])
];
lib_c = [];
flags = [];
- includes = []
+ includes =
+ [
+ ("test", ["implem"]);
+ ("ppx", ["tools"]);
+ ("implem", ["lib"]);
+ ("examples/mini_website_ppx", ["implem"]);
+ ("examples/mini_website", ["implem"]);
+ ("examples/basic_website_ppx", ["implem"]);
+ ("examples/basic_website", ["implem"])
+ ]
}
;;
@@ -650,11 +939,33 @@
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
-# 632 "myocamlbuild.ml"
+# 921 "myocamlbuild.ml"
(* OASIS_STOP *)
+# 26 "myocamlbuild.ml"
open Ocamlbuild_plugin
+(* Determine extension of CompiledObject: best *)
+let native_suffix =
+ let env = BaseEnvLight.load () in
+ if BaseEnvLight.var_get "is_native" env = "true"
+ then "native" else "byte"
+
+let reflect_ppx () =
+ let ppx_reflect = "ppx/ppx_reflect."^native_suffix in
+
+ let prod = "ppx/%_reflected.ml" in
+ let dep = "lib/%.mli" in
+
+ rule "ppx_reflect: mli -> _reflected.ml" ~prod ~deps:[dep; ppx_reflect]
+ begin fun env _ ->
+ Cmd (S [A ppx_reflect ; P (env dep); P (env prod)])
+ end
+
+let tyxml_ppx () =
+ let ppx_tyxml = "ppx/ppx_tyxml_ex."^native_suffix in
+ flag_and_dep [ "ocaml" ; "compile" ; "ppx_tyxml" ] (S [A "-ppx"; P ppx_tyxml])
+
let () =
dispatch
(fun hook ->
@@ -674,9 +985,39 @@
if String.sub Sys.ocaml_version 0 4 = "4.00" then
flag ["ocaml"; "bin_annot"; "compile"] (A "-bin-annot");
+ reflect_ppx () ;
+ tyxml_ppx () ;
+
| _ ->
())
+(* Rules for testing non-typable things *)
+open Ocamlbuild_pack
+let () =
+ let toplevel env _build =
+ let arg = env "%.top.ml" and out = env "%.result" in
+ let tags = tags_of_pathname arg in
+ Cmd(S[Sh "TERM=dumb ocaml -noinit -noprompt";
+ T tags ; Sh " < " ; P arg;
+ Sh " 2>&1 | tail -n +19 >"; P out ])
+ in
+ Rule.rule
+ "toplevel: %.top.ml -> %.result"
+ ~dep:"%.top.ml"
+ ~prod:"%.result"
+ toplevel
+
+let () =
+ let diff env _build =
+ let res = env "%.result" and exp = env "%.expected" in
+ Cmd(S[A "diff"; P res ; P exp ])
+ in
+ Rule.rule
+ "diff: %.result + %.expected -> %.stamp"
+ ~stamp:"%.stamp"
+ ~deps:["%.result"; "%.expected"]
+ diff
+
(* Compile the wiki version of the Ocamldoc.
Thanks to Till Varoquaux on usenet:
diff -Nru tyxml-3.5.0/_oasis tyxml-4.1.0/_oasis
--- tyxml-3.5.0/_oasis 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/_oasis 2017-03-03 16:33:22.000000000 +0000
@@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: tyxml
-Version: 3.5.0
+Version: 4.1.0
Homepage: http://ocsigen.org/tyxml/
Authors:
Thorsten Ohl,
@@ -15,43 +15,35 @@
Plugins: META (0.3), DevFiles (0.3)
BuildTools: ocamlbuild
AlphaFeatures: pure_interface
+OCamlVersion: >= 4.02.0
-Synopsis: HTML5 pages typed with polymorphic variants
-Description:
- HTML typing based on Thorsten Ohl's XHTML.M library to validate
- xml tree at compile-time, adapted to support HTML5 and SVG.
-
- The implementation uses a XML module for generating well
- formed---but not necessarily valid with respect to some DTD---XML
- documents. The elements of type XML.elt and attributes of type
- XML.attrib are then hidden behind polymorphic phantom types type 'a
- elt = XML.elt and type 'a attrib = XML.attrib with 'a set to
- appropriate polymorphic variants.
+Synopsis: Statically correct HTML and SVG documents
Flag syntax
Description: Build the camlp4 syntax extension.
+ Default: false
+
+Flag ppx
+ Description: Build the ppx syntax extension.
Default: true
Library tyxml
FindlibName: tyxml
- Path: lib
+ Path: implem
Modules:
- Xml,
- Svg,
- Html5
- InternalModules:
- Xml_iter,
- Xml_wrap,
- Xml_print,
- Svg_f,
- Html5_f
- BuildDepends: str, uutf
+ Tyxml_xml,
+ Tyxml_svg,
+ Tyxml_html,
+ Tyxml
+ BuildDepends: tyxml.functor, re, uutf
+ XMETAExtraLines:
+ archive(byte,toploop) += "tyxml_top.cma"
Library tyxml_f
FindlibName: functor
FindlibParent: tyxml
XMETADescription:
- HTML5 pages typed with polymorphic variants (Functor version)
+ Statically correct HTML and SVG documents (Functor version)
Path: lib
Modules:
Xml_iter,
@@ -61,10 +53,20 @@
Svg_sigs,
Svg_types,
Svg_f,
- Html5_sigs,
- Html5_types,
- Html5_f
- BuildDepends: uutf
+ Html_sigs,
+ Html_types,
+ Html_f
+ BuildDepends: uchar, uutf, re
+
+Library tyxml_top
+ FindlibName: top
+ FindlibParent: tyxml
+ BuildDepends: compiler-libs.toplevel
+ Path: implem/top
+ Modules: Tyxml_top
+ XMETARequires: tyxml
+ XMETADescription:
+ Toplevel printers for HTML, SVG and XML
Library tyxml_tools
FindlibName: tools
@@ -85,7 +87,7 @@
FindlibParent: tyxml
XMETAType: syntax
XMETADescription:
- HTML5 and SVG syntax extension
+ HTML and SVG syntax extension
XMETAExtraLines: requires(toploop) = "tyxml"
Path: syntax
BuildDepends:
@@ -112,6 +114,142 @@
Modules:
Simplexmlparser
+## Ppx
+
+Library ppx
+ Build$: flag(ppx)
+ Install$: flag(ppx)
+ FindlibName: ppx
+ FindlibParent: tyxml
+ InternalModules: Ppx_tyxml_empty
+ Path: ppx
+ XMETADescription:
+ HTML and SVG syntax extension (ppx)
+ XMETARequires: tyxml
+ XMETAExtraLines: ppx = "ppx_tyxml"
+
+Library ppx_internal
+ Build$: flag(ppx)
+ Install$: flag(ppx)
+ FindlibName: internal
+ FindlibParent: ppx
+ Path: ppx
+ InternalModules:
+ Ppx_attributes, Ppx_attribute_value, Ppx_common, Ppx_namespace,
+ Ppx_element_content, Ppx_element, Ppx_sigs_reflected,
+ Html_sigs_reflected, Svg_sigs_reflected,
+ Html_types_reflected, Svg_types_reflected
+ Modules: Ppx_tyxml
+ XMETADescription:
+ HTML and SVG ppx library
+ BuildDepends:
+ re.str, ppx_tools.metaquot, markup, tyxml.tools
+
+Executable ppx_tyxml
+ Build$: flag(ppx)
+ Install$: flag(ppx)
+ Path: ppx
+ MainIs: ppx_tyxml_ex.ml
+ BuildDepends: tyxml.ppx.internal
+ CompiledObject: best
+
+Executable ppx_reflect
+ Build$: flag(ppx)
+ Install: false
+ Path: ppx
+ MainIs: ppx_reflect.ml
+ BuildDepends: ppx_tools.metaquot, tyxml.tools
+ CompiledObject: best
+
+## Tests
+
+Executable emit_big
+ Install: false
+ Build$: flag(tests) && flag(ppx)
+ Path: test
+ MainIs: emitbig.ml
+ BuildDepends: tyxml, unix
+ CompiledObject: best
+
+Executable main_test
+ Install: false
+ Build$: flag(tests) && flag(ppx)
+ Path: test
+ MainIs: main_test.ml
+ BuildDepends: tyxml, alcotest
+
+Test html
+ Command: $main_test
+ TestTools: main_test
+ Run$: flag(tests) && flag(ppx)
+
+## This test is disabled as it can't run on both 4.03 and 4.02
+## Curent oasis doesn't allow to restrict the version just for this test.
+# Test html_fail
+# Command: ocamlbuild -use-ocamlfind test/html_fail.stamp
+# TestTools: main_test
+# Run$: flag(tests) && flag(ppx)
+
+## Examples
+
+Executable basic_website
+ Install: false
+ Build$: flag(tests)
+ Path: examples/basic_website
+ MainIs: site_html.ml
+ BuildDepends: tyxml
+ CompiledObject: best
+
+Test basic_website
+ WorkingDirectory: examples/basic_website
+ Command: $basic_website
+ TestTools: basic_website
+ Run$: flag(tests)
+
+Executable basic_website_ppx
+ Install: false
+ Build$: flag(tests) && flag(ppx)
+ Path: examples/basic_website_ppx
+ MainIs: site_html.ml
+ BuildDepends: tyxml
+ CompiledObject: best
+
+Test basic_website_ppx
+ WorkingDirectory: examples/basic_website_ppx
+ Command: $basic_website_ppx
+ TestTools: basic_website_ppx
+ Run$: flag(tests) && flag(ppx)
+
+Executable mini_website
+ Install: false
+ Build$: flag(tests)
+ Path: examples/mini_website
+ MainIs: minihtml.ml
+ BuildDepends: tyxml
+ CompiledObject: best
+
+Test mini_website
+ WorkingDirectory: examples/mini_website
+ Command: $mini_website
+ TestTools: mini_website
+ Run$: flag(tests)
+
+Executable mini_website_ppx
+ Install: false
+ Build$: flag(tests) && flag(ppx)
+ Path: examples/mini_website_ppx
+ MainIs: minihtml.ml
+ BuildDepends: tyxml
+ CompiledObject: best
+
+Test mini_website_ppx
+ WorkingDirectory: examples/mini_website_ppx
+ Command: $mini_website
+ TestTools: mini_website
+ Run$: flag(tests) && flag(ppx)
+
+## Documentation
+
Document "tyxml-api"
Title: API reference for TyXML
Type: ocamlbuild (0.3)
@@ -120,4 +258,4 @@
BuildTools: ocamldoc
XOCamlbuildPath: ./
XOCamlbuildLibraries:
- tyxml, tyxml.functor, tyxml.parser, tyxml.syntax
+ tyxml, tyxml.functor, tyxml.parser, tyxml.syntax, tyxml.ppx.internal
diff -Nru tyxml-3.5.0/ppx/ppx_attributes.ml tyxml-4.1.0/ppx/ppx_attributes.ml
--- tyxml-3.5.0/ppx/ppx_attributes.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_attributes.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,142 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+let parse loc (ns, element_name) attributes =
+ let language, (module Reflected) =
+ Ppx_namespace.reflect loc ns in
+
+ (* For attribute names ["data-foo"], evaluates to [Some "foo"], otherwise
+ evaluates to [None]. *)
+ let parse_user_data local_name =
+ let prefix = "data-" in
+ let length = String.length prefix in
+
+ let is_user_data =
+ try language = Html && String.sub local_name 0 length = prefix
+ with Invalid_argument _ -> false
+ in
+
+ if not is_user_data then None
+ else Some (String.sub local_name length (String.length local_name - length))
+ in
+
+ (* Applied to each attribute. Accumulates individually labeled attributes,
+ such as img/src, in "labeled," and attributes passed in ~a in "regular." *)
+ let parse_attribute (labeled, regular) ((_, local_name), value) =
+ (* Convert the markup name of the attribute to a TyXML name without regard
+ to renamed attributes such as "a_input_max." Renaming will be accounted
+ for later. *)
+ let tyxml_name = Tyxml_name.attrib local_name in
+
+ let test_labeled (e, a, _) = e = element_name && a = local_name in
+ let test_blacklisted (a, _, _) = a = tyxml_name in
+ let test_renamed (_, a, es) = a = local_name && List.mem element_name es in
+
+ let unknown () =
+ Ppx_common.error loc "Unknown attribute in %s element: %s"
+ (Ppx_common.lang language) local_name
+ in
+
+ (* Check whether this attribute is individually labeled. Parse its argument
+ and accumulate the attribute if so. *)
+ match Ppx_common.find test_labeled Reflected.labeled_attributes with
+ | Some (_, label, parser) ->
+ let e =
+ match parser language loc local_name value with
+ | None ->
+ Ppx_common.error loc
+ "Internal error: labeled attribute %s without an argument" label
+ | Some e -> e
+ in
+
+ (Ppx_common.Label.labelled label, e)::labeled, regular
+
+ | None ->
+ (* The attribute is not individually labeled, so it is passed in ~a.
+
+ First, check if the default TyXML name of this attribute collides with
+ the TyXML name of a renamed attribute. For example, if the language is
+ HTML, and this attribute has markup name "input-max" (which is
+ invalid), then its default TyXML name will be "a_input_max", which is a
+ *valid* value in TyXML. We want to avoid mapping "input-max" to
+ "a_input_max", because "input-max" is invalid, and because
+ "a_input_max" maps to "max" instead. *)
+ if List.exists test_blacklisted Reflected.renamed_attributes then
+ unknown ()
+ else
+ (* Check if this is a "data-foo" attribute. Parse the attribute value,
+ and accumulate it in the list of attributes passed in ~a. *)
+ match parse_user_data local_name with
+ | Some tag ->
+ let tyxml_name = "a_user_data" in
+
+ let parser =
+ try List.assoc tyxml_name Reflected.attribute_parsers
+ with Not_found ->
+ Ppx_common.error loc "Internal error: no parser for %s" tyxml_name
+ in
+
+ let identifier = Ppx_common.make ~loc language tyxml_name in
+ let tag = Ppx_common.string loc tag in
+
+ let e =
+ match parser language loc local_name value with
+ | Some e' -> [%expr [%e identifier] [%e tag] [%e e']] [@metaloc loc]
+ | None ->
+ Ppx_common.error loc "Internal error: no expression for %s"
+ tyxml_name
+ in
+
+ labeled, e::regular
+
+ | None ->
+ let tyxml_name =
+ match Ppx_common.find test_renamed Reflected.renamed_attributes with
+ | Some (name, _, _) -> name
+ | None -> tyxml_name
+ in
+
+ let parser =
+ try List.assoc tyxml_name Reflected.attribute_parsers
+ with Not_found -> unknown ()
+ in
+
+ let identifier = Ppx_common.make ~loc language tyxml_name in
+
+ let e =
+ match parser language loc local_name value with
+ | None -> identifier
+ | Some e' -> [%expr [%e identifier] [%e e']] [@metaloc loc]
+ in
+
+ labeled, e::regular
+ in
+
+ let labeled, regular =
+ List.fold_left parse_attribute ([], []) attributes in
+
+ (* If there are any attributes to pass in ~a, assemble them into a parse tree
+ for a list, and prefix that with the ~a label. *)
+ if regular = [] then List.rev labeled
+ else
+ let regular =
+ Ppx_common.Label.labelled "a",
+ Ppx_common.list loc (List.rev regular)
+ in
+ List.rev (regular::labeled)
diff -Nru tyxml-3.5.0/ppx/ppx_attributes.mli tyxml-4.1.0/ppx/ppx_attributes.mli
--- tyxml-3.5.0/ppx/ppx_attributes.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_attributes.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,38 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Attribute parsing. *)
+
+
+
+val parse :
+ Location.t -> Markup.name -> (Markup.name * string Ppx_common.value) list ->
+ (Ppx_common.Label.t * Parsetree.expression) list
+(** [parse loc element_name attributes] evaluates to a list of labeled parse
+ trees, each representing an attribute argument to the element function for
+ [element_name]. For example, if called on the HTML element
+ [], this function will evaluate to
+ parse trees for the arguments:
+
+{[
+~src:(return "foo") ~alt:(return "bar") ~a:[id (return "some-image")]
+]}
+
+ This satisfies the attribute arguments in the signature of
+ [Html_sigs.T.img]. *)
diff -Nru tyxml-3.5.0/ppx/ppx_attribute_value.ml tyxml-4.1.0/ppx/ppx_attribute_value.ml
--- tyxml-3.5.0/ppx/ppx_attribute_value.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_attribute_value.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,555 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+open Ast_helper
+module Pc = Ppx_common
+
+type 'a gparser =
+ ?separated_by:string -> ?default:string -> Location.t -> string -> 'a ->
+ Parsetree.expression option
+
+type parser = string gparser
+type vparser = string Pc.value gparser
+
+(* Handle expr *)
+
+let expr (parser : parser) : vparser =
+ fun ?separated_by ?default loc name v ->
+ match v with
+ | Antiquot e -> Some e
+ | Val s -> parser ?separated_by ?default loc name s
+
+(* Options. *)
+
+let option none (parser : parser) ?separated_by:_ ?default:_ loc name s =
+ if s = none then Some [%expr None] [@metaloc loc]
+ else
+ match parser ~default:none loc name s with
+ | None -> None
+ | Some e -> Some [%expr Some [%e e]] [@metaloc loc]
+
+
+
+(* Lists. *)
+
+let filter_map f l =
+ l
+ |> List.fold_left (fun acc v ->
+ match f v with
+ | None -> acc
+ | Some v' -> v'::acc)
+ []
+ |> List.rev
+
+(* Splits the given string on the given delimiter (a regular expression), then
+ applies [element_parser] to each resulting component. Each such application
+ resulting in [Some expr] is included in the resulting expression list. *)
+let exp_list delimiter separated_by (element_parser : parser) loc name s =
+ Re_str.split delimiter s
+ |> filter_map (element_parser ~separated_by loc name)
+
+(* Behaves as _expr_list, but wraps the resulting expression list as a list
+ expression. *)
+let list
+ delimiter separated_by element_parser ?separated_by:_ ?default:_ loc name s =
+
+ exp_list delimiter separated_by element_parser loc name s
+ |> Ppx_common.list loc
+ |> fun e -> Some e
+
+let spaces = list (Re_str.regexp " +") "space"
+let commas = list (Re_str.regexp " *, *") "comma"
+let semicolons = list (Re_str.regexp " *; *") "semicolon"
+
+let spaces_or_commas_regexp = Re_str.regexp "\\( *, *\\)\\| +"
+let spaces_or_commas_ = exp_list spaces_or_commas_regexp "space- or comma"
+let spaces_or_commas = list spaces_or_commas_regexp "space- or comma"
+
+
+
+(* Wrapping. *)
+
+let wrap (parser : parser) implementation =
+ expr @@
+ fun ?separated_by:_ ?default:_ loc name s ->
+ match parser loc name s with
+ | None -> Ppx_common.error loc "wrap applied to presence; nothing to wrap"
+ | Some e -> Some (Ppx_common.wrap implementation loc e)
+
+let nowrap (parser : parser) _ =
+ expr @@
+ fun ?separated_by:_ ?default:_ loc name s ->
+ parser loc name s
+
+
+
+(* Error reporting for values in lists and options. *)
+
+let must_be_a
+ singular_description plural_description separated_by default loc name =
+
+ let description =
+ match separated_by with
+ | Some separated_by ->
+ Printf.sprintf "a %s-separated list of %s" separated_by plural_description
+ | None ->
+ match default with
+ | Some default -> Printf.sprintf "%s or %s" singular_description default
+ | None -> singular_description
+ in
+
+ Ppx_common.error loc "Value of %s must be %s" name description
+
+
+
+(* General helpers. *)
+
+(* Checks that the given string matches the given regular expression exactly,
+ i.e. the match begins at position 0 and ends at the end of the string. *)
+let does_match regexp s =
+ Re_str.string_match regexp s 0 && Re_str.match_end () = String.length s
+
+(* Checks that the group with the given index was matched in the given
+ string. *)
+let group_matched index s =
+ try Re_str.matched_group index s |> ignore; true
+ with Not_found -> false
+
+let int_exp loc s =
+ try Some (Ppx_common.int loc (int_of_string s))
+ with Failure _ -> None
+
+let float_exp loc s =
+ try
+ Some (Ppx_common.float loc @@ float_of_string s)
+ with Failure _ ->
+ None
+
+let bool_exp loc b =
+ let s = if b then "true" else "false" in
+ Exp.construct ~loc (Location.mkloc (Longident.Lident s) loc) None
+
+(* Numeric. *)
+
+let char ?separated_by:_ ?default:_ loc name s =
+ let open Markup in
+ let open Markup.Encoding in
+
+ let report _ error =
+ Ppx_common.error loc "%s in attribute %s"
+ (Markup.Error.to_string error |> String.capitalize) name
+ in
+ let decoded = string s |> decode ~report utf_8 in
+
+ let c =
+ match next decoded with
+ | None -> Ppx_common.error loc "No character in attribute %s" name
+ | Some i when i <= 255 -> Char.chr i
+ | Some _ ->
+ Ppx_common.error loc "Character out of range in attribute %s" name
+ in
+
+ begin match next decoded with
+ | None -> ()
+ | Some _ -> Ppx_common.error loc "Multiple characters in attribute %s" name
+ end;
+
+ Some (with_default_loc loc @@ fun () -> Ast_convenience.char c)
+
+let onoff ?separated_by:_ ?default:_ loc name s =
+ let b = match s with
+ | "" | "on" -> true
+ | "off" -> false
+ | _ ->
+ Ppx_common.error loc {|Value of %s must be "on", "" or "off"|} name
+ in
+ Some (bool_exp loc b)
+
+let bool ?separated_by:_ ?default:_ loc name s =
+ let b = match s with
+ | "" | "true" -> true
+ | "false" -> false
+ | _ ->
+ Ppx_common.error loc {|Value of %s must be "true", "" or "false"|} name
+ in
+ Some (bool_exp loc b)
+
+let unit ?separated_by:_ ?default:_ loc name s =
+ if s = "" || s = name then
+ Some (Ast_convenience.(with_default_loc loc unit))
+ else
+ Ppx_common.error loc
+ {|Value of %s must be %s or "".|}
+ name name
+
+let int ?separated_by ?default loc name s =
+ match int_exp loc s with
+ | Some _ as e -> e
+ | None ->
+ must_be_a "a whole number" "whole numbers" separated_by default loc name
+
+let float ?separated_by ?default loc name s =
+ match float_exp loc s with
+ | Some _ as e -> e
+ | None ->
+ must_be_a
+ "a number (decimal fraction)" "numbers (decimal fractions)"
+ separated_by default loc name
+
+let points ?separated_by:_ ?default:_ loc name s =
+ let expressions = spaces_or_commas_ float loc name s in
+
+ let rec pair acc = function
+ | [] -> List.rev acc |> Ppx_common.list loc
+ | [_] -> Ppx_common.error loc "Unpaired coordinate in %s" name
+ | ex::ey::rest -> pair (([%expr [%e ex], [%e ey]] [@metaloc loc])::acc) rest
+ in
+
+ Some (pair [] expressions)
+
+let number_pair ?separated_by:_ ?default:_ loc name s =
+ let e =
+ begin match spaces_or_commas_ float loc name s with
+ | [orderx] -> [%expr [%e orderx], None]
+ | [orderx; ordery] -> [%expr [%e orderx], Some [%e ordery]]
+ | _ -> Ppx_common.error loc "%s requires one or two numbers" name
+ end [@metaloc loc]
+ in
+
+ Some e
+
+let fourfloats ?separated_by:_ ?default:_ loc name s =
+ match spaces_or_commas_ float loc name s with
+ | [min_x; min_y; width; height] ->
+ Some [%expr ([%e min_x], [%e min_y], [%e width], [%e height])]
+ [@metaloc loc]
+ | _ -> Ppx_common.error loc "Value of %s must be four numbers" name
+
+(* These are always in a list; hence the error message. *)
+let icon_size =
+ let regexp = Re_str.regexp "\\([0-9]+\\)[xX]\\([0-9]+\\)" in
+
+ fun ?separated_by:_ ?default:_ loc name s ->
+ if not @@ does_match regexp s then
+ Ppx_common.error loc "Value of %s must be a %s, or %s"
+ name "space-separated list of icon sizes, such as 16x16" "any";
+
+ let width, height =
+ try
+ int_of_string (Re_str.matched_group 1 s),
+ int_of_string (Re_str.matched_group 2 s)
+ with Invalid_argument _ ->
+ Ppx_common.error loc "Icon dimension out of range in %s" name
+ in
+
+ Some
+ [%expr
+ [%e Ppx_common.int loc width],
+ [%e Ppx_common.int loc height]] [@metaloc loc]
+
+
+
+(* Dimensional. *)
+
+let svg_quantity =
+ let integer = "[+-]?[0-9]+" in
+ let integer_scientific = Printf.sprintf "%s\\([Ee]%s\\)?" integer integer in
+ let fraction = Printf.sprintf "[+-]?[0-9]*\\.[0-9]+\\([Ee]%s\\)?" integer in
+ let number = Printf.sprintf "%s\\|%s" integer_scientific fraction in
+ let quantity = Printf.sprintf "\\(%s\\)\\([^0-9]*\\)$" number in
+ let regexp = Re_str.regexp quantity in
+
+ fun kind_singular kind_plural parse_unit ?separated_by ?default loc name s ->
+ if not @@ does_match regexp s then
+ must_be_a kind_singular kind_plural separated_by default loc name;
+
+ let n =
+ match float_exp loc (Re_str.matched_group 1 s) with
+ | Some n -> n
+ | None -> Ppx_common.error loc "Number out of range in %s" name
+ in
+
+ let unit_string = Re_str.matched_group 4 s in
+ let unit =
+ (if unit_string = "" then [%expr None]
+ else [%expr Some [%e parse_unit loc name unit_string]]) [@metaloc loc]
+ in
+
+ [%expr [%e n], [%e unit]] [@metaloc loc]
+
+let svg_length =
+ let parse_unit loc name unit =
+ begin match unit with
+ | "cm" -> [%expr `Cm]
+ | "em" -> [%expr `Em]
+ | "ex" -> [%expr `Ex]
+ | "in" -> [%expr `In]
+ | "mm" -> [%expr `Mm]
+ | "pc" -> [%expr `Pc]
+ | "pt" -> [%expr `Pt]
+ | "px" -> [%expr `Px]
+ | "%" -> [%expr `Percent]
+ | s -> Ppx_common.error loc "Invalid length unit %s in %s" s name
+ end [@metaloc loc]
+ in
+
+ fun ?separated_by ?default loc name s ->
+ Some
+ (svg_quantity "an SVG length" "SVG lengths" parse_unit
+ ?separated_by ?default loc name s)
+
+let angle_ =
+ let parse_unit loc name unit =
+ begin match unit with
+ | "deg" -> [%expr `Deg]
+ | "rad" -> [%expr `Rad]
+ | "grad" -> [%expr `Grad]
+ | s -> Ppx_common.error loc "Invalid angle unit %s in %s" s name
+ end [@metaloc loc]
+ in
+
+ svg_quantity "an SVG angle" "SVG angles" parse_unit
+
+let angle ?separated_by ?default loc name s =
+ Some (angle_ ?separated_by ?default loc name s)
+
+let offset =
+ let bad_form name loc =
+ Ppx_common.error loc "Value of %s must be a number or percentage" name in
+
+ let regexp = Re_str.regexp "\\([-+0-9eE.]+\\)\\(%\\)?" in
+
+ fun ?separated_by:_ ?default:_ loc name s ->
+ if not @@ does_match regexp s then bad_form name loc;
+
+ begin
+ let n =
+ match float_exp loc (Re_str.matched_group 1 s) with
+ | Some n -> n
+ | None -> bad_form name loc
+ in
+
+ if group_matched 2 s then Some [%expr `Percentage [%e n]]
+ else Some [%expr `Number [%e n]]
+ end [@metaloc loc]
+
+let transform =
+ let regexp = Re_str.regexp "\\([^(]+\\)(\\([^)]*\\))" in
+
+ fun ?separated_by:_ ?default:_ loc name s ->
+ if not @@ does_match regexp s then
+ Ppx_common.error loc "Value of %s must be an SVG transform" name;
+
+ let kind = Re_str.matched_group 1 s in
+ let values = Re_str.matched_group 2 s in
+
+ let e =
+ begin match kind with
+ | "matrix" ->
+ begin match spaces_or_commas_ float loc "matrix" values with
+ | [a; b; c; d; e; f] ->
+ [%expr `Matrix ([%e a], [%e b], [%e c], [%e d], [%e e], [%e f])]
+ | _ ->
+ Ppx_common.error loc "%s: matrix requires six numbers" name
+ end
+
+ | "translate" ->
+ begin match spaces_or_commas_ float loc "translate" values with
+ | [tx; ty] -> [%expr `Translate ([%e tx], Some [%e ty])]
+ | [tx] -> [%expr `Translate ([%e tx], None)]
+ | _ ->
+ Ppx_common.error loc "%s: translate requires one or two numbers" name
+ end
+
+ | "scale" ->
+ begin match spaces_or_commas_ float loc "scale" values with
+ | [sx; sy] -> [%expr `Scale ([%e sx], Some [%e sy])]
+ | [sx] -> [%expr `Scale ([%e sx], None)]
+ | _ -> Ppx_common.error loc "%s: scale requires one or two numbers" name
+ end
+
+ | "rotate" ->
+ begin match Re_str.bounded_split spaces_or_commas_regexp values 2 with
+ | [a] -> [%expr `Rotate ([%e angle_ loc "rotate" a], None)]
+ | [a; axis] ->
+ begin match spaces_or_commas_ float loc "rotate axis" axis with
+ | [cx; cy] ->
+ [%expr `Rotate
+ ([%e angle_ loc "rotate" a], Some ([%e cx], [%e cy]))]
+ | _ ->
+ Ppx_common.error loc "%s: rotate center requires two numbers" name
+ end
+ | _ ->
+ Ppx_common.error loc
+ "%s: rotate requires an angle and an optional center" name
+ end
+
+ | "skewX" -> [%expr `SkewX [%e angle_ loc "skewX" values]]
+
+ | "skewY" -> [%expr `SkewY [%e angle_ loc "skewY" values]]
+
+ | s -> Ppx_common.error loc "%s: %s is not a valid transform type" name s
+ end [@metaloc loc]
+ in
+
+ Some e
+
+
+
+(* String-like. *)
+
+let string ?separated_by:_ ?default:_ loc _ s =
+ Some (with_default_loc loc @@ fun () -> Ast_convenience.str s)
+
+let variand s =
+ let without_backtick s =
+ let length = String.length s in
+ String.sub s 1 (length - 1)
+ in
+
+ s |> Tyxml_name.polyvar |> without_backtick
+
+let variant ?separated_by:_ ?default:_ loc _ s =
+ Some (Exp.variant ~loc (variand s) None)
+
+let total_variant (unary, nullary) ?separated_by:_ ?default:_ loc _name s =
+ let variand = variand s in
+ if List.mem variand nullary then Some (Exp.variant ~loc variand None)
+ else Some (Exp.variant ~loc unary (Some (Ppx_common.string loc s)))
+
+
+
+(* Miscellaneous. *)
+
+let presence ?separated_by:_ ?default:_ _ _ _ = None
+
+let paint_without_icc loc _name s =
+ begin match s with
+ | "none" ->
+ [%expr `None]
+
+ | "currentColor" ->
+ [%expr `CurrentColor]
+
+ | _ ->
+ let icc_color_start =
+ try Some (Re_str.search_forward (Re_str.regexp "icc-color(\\([^)]*\\))") s 0)
+ with Not_found -> None
+ in
+
+ match icc_color_start with
+ | None -> [%expr `Color ([%e Ppx_common.string loc s], None)]
+ | Some i ->
+ let icc_color = Re_str.matched_group 1 s in
+ let color = String.sub s 0 i in
+ [%expr `Color
+ ([%e Ppx_common.string loc color],
+ Some [%e Ppx_common.string loc icc_color])]
+ end [@metaloc loc]
+
+let paint ?separated_by:_ ?default:_ loc name s =
+ if not @@ Re_str.string_match (Re_str.regexp "url(\\([^)]+\\))") s 0 then
+ Some (paint_without_icc loc name s)
+ else
+ let iri = Re_str.matched_group 1 s |> Ppx_common.string loc in
+ let remainder_start = Re_str.group_end 0 in
+ let remainder_length = String.length s - remainder_start in
+ let remainder =
+ String.sub s remainder_start remainder_length |> String.trim in
+
+ begin
+ if remainder = "" then
+ Some [%expr `Icc ([%e iri], None)]
+ else
+ Some
+ [%expr
+ `Icc ([%e iri], Some [%e paint_without_icc loc name remainder])]
+ end [@metaloc loc]
+
+let srcset_element =
+ let space = Re_str.regexp " +" in
+
+ fun ?separated_by:_ ?default:_ loc name s ->
+ let e =
+ begin match Re_str.bounded_split space s 2 with
+ | [url] ->
+ [%expr `Url [%e Ppx_common.string loc url]]
+
+ | [url; descriptor] ->
+ let bad_descriptor () =
+ Ppx_common.error loc "Bad width or density descriptor in %s" name in
+
+ let url = Ppx_common.string loc url in
+ let suffix_index = String.length descriptor - 1 in
+
+ let is_width =
+ match descriptor.[suffix_index] with
+ | 'w' -> true
+ | 'x' -> false
+ | _ -> bad_descriptor ()
+ | exception Invalid_argument _ -> bad_descriptor ()
+ in
+
+ if is_width then
+ let n =
+ match int_exp loc (String.sub descriptor 0 suffix_index) with
+ | Some n -> n
+ | None ->
+ Ppx_common.error loc "Bad number for width in %s" name
+ in
+
+ [%expr `Url_width ([%e url], [%e n])]
+
+ else
+ let n =
+ match float_exp loc (String.sub descriptor 0 suffix_index) with
+ | Some n -> n
+ | None ->
+ Ppx_common.error loc "Bad number for pixel density in %s" name
+ in
+
+ [%expr `Url_pixel ([%e url], [%e n])]
+
+ | _ -> Ppx_common.error loc "Missing URL in %s" name
+ end [@metaloc loc]
+ in
+
+ Some e
+
+let number_or_datetime ?separated_by:_ ?default:_ loc _ s =
+ match int_exp loc s with
+ | Some n -> Some [%expr `Number [%e n]]
+ | None -> Some [%expr `Datetime [%e Pc.string loc s]]
+ [@metaloc loc]
+
+
+
+(* Special-cased. *)
+
+let sandbox = spaces variant
+
+let in_ = total_variant Svg_types_reflected.in_value
+
+let in2 = in_
+
+let xmlns ?separated_by:_ ?default:_ loc name s =
+ if s <> Markup.Ns.html then
+ Ppx_common.error loc "%s: namespace must be %s" name Markup.Ns.html;
+
+ Some [%expr `W3_org_1999_xhtml] [@metaloc loc]
diff -Nru tyxml-3.5.0/ppx/ppx_attribute_value.mli tyxml-4.1.0/ppx/ppx_attribute_value.mli
--- tyxml-3.5.0/ppx/ppx_attribute_value.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_attribute_value.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,211 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Attribute value parsers and parser combinators. *)
+
+
+type 'a gparser =
+ ?separated_by:string -> ?default:string -> Location.t -> string -> 'a ->
+ Parsetree.expression option
+type parser = string gparser
+type vparser = string Ppx_common.value gparser
+(** Attribute value parsers are assigned to each attribute depending on the type
+ of the attribute's argument, though some attributes have special parsers
+ based on their name, or on a [[@@reflect]] annotation. A parser is a
+ function [p] such that [p loc name value] either:
+
+ - converts the string [value] into [Some] of a parse tree representing that
+ value, for use with attributes that take an argument, or
+ - evaluates to [None], for use with attributes that take no argument (for
+ instance, [a_selected]).
+
+ For example, [int loc name "3"] converts ["3"] into the parse tree
+ [{pexp_desc = Pexp_constant (Const_int 3); ...}].
+
+ The parse tree is assigned the location [loc]. This {e should} be the
+ location of the start of the value string, but, presently, the location of
+ the element containing the value string is used.
+
+ [name] is the name of the attribute. This is used only for error reporting.
+
+ [~separated_by] and [~default] are used internally by combinators to modify
+ the error message (for example, to make nouns plural if an error occurs in a
+ list). *)
+
+
+
+(** {2 Combinators} *)
+
+val option : string -> parser -> parser
+(** [option none parser _ _ s] behaves as follows:
+
+ - if [s] = [none], evaluates to a parse tree for [None].
+ - otherwise, if [parser _ _ s] evaluates to a parse tree for [e], [option]
+ evaluates to a parse tree for [Some e]. *)
+
+val spaces : parser -> parser
+(** [spaces parser _ _ s] splits [s] on spaces, then applies [parser] to each
+ component. The resulting parse trees for [e, e', ...] are combined into a
+ parse tree fo [[e; e'; ...]]. *)
+
+val commas : parser -> parser
+(** Similar to [spaces], but splits on commas. *)
+
+val semicolons : parser -> parser
+(** Similar to [spaces], but splits on semicolons. *)
+
+val spaces_or_commas : parser -> parser
+(** Similar to [spaces], but splits on both spaces and commas. *)
+
+(** {3 Top combinators}
+ Exported parsers should always use one of those combinators last. *)
+
+val wrap : parser -> Ppx_common.lang -> vparser
+(** [wrap parser module_ _ _ s] applies [parser _ _ s] to get a parse tree for
+ [e], then evaluates to the parse tree for [module_.Xml.W.return e]. *)
+
+val nowrap : parser -> Ppx_common.lang -> vparser
+(** [nowrap parser _ _ _ s] evaluates to [parser _ _ s]. The purpose of this
+ combinator is to provide a signature similar to [wrap] in situations where
+ wrapping is not wanted. *)
+
+
+
+(** {2 Numeric} *)
+
+val char : parser
+(** [char _ _ s], where [s] is a string containing a single UTF-8 character [c],
+ produces a parse tree for [c] of type [char]. Note that this means the range
+ is restricted to the first 256 code points. *)
+
+val bool : parser
+(** [bool _ _ s] produces a parse tree for the boolean [true]
+ if [s = "true"] or [""] and [false] if [s = "false"]. *)
+
+val onoff : parser
+(** [onoff _ _ s] produces a parse tree for the boolean [true]
+ if [s = "on"] or [""] and [false] if [s = "off"]. *)
+
+val unit : parser
+(** [unit _ name s] produces a parse tree for [()]. It fails if [name <> s]. *)
+
+val int : parser
+(** [int _ _ s] produces a parse tree for [int_of_string s]. *)
+
+val float : parser
+(** [float _ _ s] produces a parse tree for [float_of_string s]. This is a
+ slight superset of HTML and SVG decimal fraction number syntax. *)
+
+val points : parser
+(** Similar to [spaces_or_commas float], but pairs consecutive numbers. *)
+
+val number_pair : parser
+(** [number_pair _ _ s] produces a parse tree for
+
+ - [n, None] if [s] = [(string_of_float n)], or
+ - [m, Some n'] if [s] is a space- or comma-separated list of representations
+ of two floats. *)
+
+val fourfloats : parser
+(** Acts as [spaces_or_commas float], but expects the list to have exactly four
+ elements. *)
+
+val icon_size : parser
+(** [icon_size _ _ s] produces a parse tree for the pair [(width, height)] when
+ [s] has the form [(string_of_int width) ^ x ^ (string_of_int height)] and
+ [x] is either ["x"] or ["X"]. *)
+
+
+
+(** {2 Dimensional} *)
+
+val svg_length : parser
+(** [svg_length _ _ s] produces a parse tree for a value of type
+ [Svg_types.Unit.(length quantity)]. [s] is expected to have form
+ [(string_of_float n) ^ unit] for some number [n] and a valid SVG length
+ unit, or no unit. *)
+
+val angle : parser
+(** Similar to [svg_length], but for SVG angles. *)
+
+val offset : parser
+(** [offset _ _ s produces a parse tree for
+
+ - [`Number n] if [s] = [string_of_float n], or
+ - [`Percentage n] if [s] has form [(string_of_float n) ^ "%"]. *)
+
+val transform : parser
+(** Parses an SVG transform attribute value. See
+ {:{https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/transform}
+ transform (MDN)}. *)
+
+
+
+(* {2 String-like} *)
+
+val string : parser
+(** [string _ _ s] produces a parse tree for [s]. This is intended for ordinary
+ attributes containing text that requires no further parsing. *)
+
+val variant : parser
+(** [variant _ _ s] produces a parse tree for the variand
+ [Tyxml_name.polyvar s]. This is intended for attributes whose argument type
+ is a polymorphic variant, none of whose constructors take arguments. *)
+
+val total_variant : (string * string list) -> parser
+(** [total_variant] is used for parsing arguments whose type is a variant with
+ the following pattern:
+
+{[
+| `A | `B | `C | `EverythingElse of string
+]}
+
+ It behaves like [variant] for strings matching the no-argument constructors.
+ Any other string [s] is mapped to the parse trees for
+ [`EverythingElse s]. *)
+
+
+
+(* {2 Miscellaneous} *)
+
+val presence : parser
+(** [presence _ _ _] evaluates to [None]. It is used as a "parser" for
+ attributes that do not take arguments. *)
+
+val paint : parser
+(* Parses SVG paint values. See
+ {:{https://www.w3.org/TR/SVG/painting.html#SpecifyingPaint} Specifying
+ paint}. *)
+
+val srcset_element : parser
+(** Used for [a_srcset]. *)
+
+val number_or_datetime : parser
+(** Used for [a_input_min] and [a_input_max]. *)
+
+
+
+(* {2 Special-cased}
+
+ These parsers are named after the attribute for which they are used. *)
+
+val sandbox : parser
+val in_ : parser
+val in2 : parser
+val xmlns : parser
diff -Nru tyxml-3.5.0/ppx/ppx_common.ml tyxml-4.1.0/ppx/ppx_common.ml
--- tyxml-3.5.0/ppx/ppx_common.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_common.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,145 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+open Ast_helper
+module Label = Ast_convenience.Label
+
+(** Lang utilities *)
+
+type lang = Html | Svg
+
+let html_implementation = ref "Html"
+let svg_implementation = ref "Svg"
+
+let implemenentation_ref = function
+ | Html -> html_implementation
+ | Svg -> svg_implementation
+
+let set_implementation lang s =
+ (implemenentation_ref lang) := s
+
+let implementation lang =
+ !(implemenentation_ref lang)
+
+let lang = function
+ | Html -> "HTML"
+ | Svg -> "SVG"
+
+let make_lid ~loc i s =
+ Location.mkloc
+ (Longident.parse @@ implementation i ^ "." ^ s)
+ loc
+
+let make ~loc i s =
+ Exp.ident ~loc @@ make_lid ~loc i s
+
+(** Generic *)
+
+let find f l =
+ try Some (List.find f l)
+ with Not_found -> None
+
+let with_loc loc f x =
+ with_default_loc loc @@ fun () -> f x
+
+let error_prefix : _ format6 = "Error: "
+(* We use a custom implementation because the type of Location.raise_errorf
+ changed in 4.03 *)
+let error loc ppf =
+ let buf = Buffer.create 17 in
+ let fmt = Format.formatter_of_buffer buf in
+ Format.kfprintf
+ (fun _ ->
+ Format.pp_print_flush fmt ();
+ Location.raise_errorf ~loc "%s@." (Buffer.contents buf))
+ fmt
+ (error_prefix^^ppf)
+
+(** Ast manipulation *)
+
+let int loc = with_loc loc Ast_convenience.int
+
+let float loc = with_loc loc Ast_convenience.float
+
+let string loc = with_loc loc Ast_convenience.str
+
+let add_constraints ~list lang e =
+ let loc = {e.Parsetree.pexp_loc with loc_ghost = true} in
+ let elt = make_lid ~loc lang "elt" in
+ let wrap =
+ if list then make_lid ~loc lang "list_wrap"
+ else make_lid ~loc lang "wrap"
+ in
+ let ty =
+ Typ.(constr ~loc wrap [ constr ~loc elt [any ~loc ()]])
+ in
+ Exp.constraint_ ~loc e ty
+
+type 'a value =
+ | Val of 'a
+ | Antiquot of Parsetree.expression
+
+let value x = Val x
+let antiquot e = Antiquot e
+let map_value f = function
+ | Val x -> Val (f x)
+ | Antiquot x -> Antiquot x
+
+let list_gen cons append nil l =
+ let f acc = function
+ | Val x -> cons acc x
+ | Antiquot e -> append acc e
+ in
+ (l |> List.rev |> List.fold_left f nil)
+
+let list loc l =
+ let nil = [%expr []][@metaloc loc] in
+ let cons acc x = [%expr [%e x]::[%e acc]][@metaloc loc] in
+ let append acc x = [%expr [%e x]@[%e acc]][@metaloc loc] in
+ list_gen cons append nil @@ List.map (fun x -> Val x) l
+
+let list_wrap_value lang loc =
+ let nil =
+ [%expr
+ [%e make ~loc lang "Xml.W.nil"]
+ ()] [@metaloc loc]
+ in
+ let cons acc x =
+ [%expr [%e make ~loc lang "Xml.W.cons"] [%e x] [%e acc]][@metaloc loc]
+ in
+ let append acc x =
+ [%expr
+ [%e make ~loc lang "Xml.W.append"]
+ [%e add_constraints ~list:true lang x] [%e acc]
+ ][@metaloc loc]
+ in
+ list_gen cons append nil
+
+let list_wrap lang loc l =
+ list_wrap_value lang loc @@ List.map (fun x -> Val x) l
+
+
+let wrap implementation loc e =
+ [%expr
+ [%e make ~loc implementation "Xml.W.return"]
+ [%e e]] [@metaloc loc]
+
+let wrap_value lang loc = function
+ | Val x -> wrap lang loc x
+ | Antiquot e -> add_constraints ~list:false lang e
diff -Nru tyxml-3.5.0/ppx/ppx_common.mli tyxml-4.1.0/ppx/ppx_common.mli
--- tyxml-3.5.0/ppx/ppx_common.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_common.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,65 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+val find : ('a -> bool) -> 'a list -> 'a option
+(** Similar to [List.find], but evaluates to an option instead of raising
+ [Not_found]. *)
+
+module Label = Ast_convenience.Label
+
+(** Markup language *)
+
+type lang = Html | Svg
+val lang : lang -> string
+val implementation : lang -> string
+val set_implementation : lang -> string -> unit
+
+val make_lid :
+ loc:Location.t -> lang -> string -> Longident.t Location.loc
+val make :
+ loc:Location.t -> lang -> string -> Parsetree.expression
+
+(** Expression helpers. *)
+
+val int : Location.t -> int -> Parsetree.expression
+val float : Location.t -> float -> Parsetree.expression
+val string : Location.t -> string -> Parsetree.expression
+val list : Location.t -> Parsetree.expression list -> Parsetree.expression
+val list_wrap : lang -> Location.t -> Parsetree.expression list -> Parsetree.expression
+
+val wrap :
+ lang -> Location.t -> Parsetree.expression -> Parsetree.expression
+(** [wrap_exp implementation loc e] creates a parse tree for
+ [implementation.Xml.W.return e]. *)
+
+type 'a value =
+ | Val of 'a
+ | Antiquot of Parsetree.expression
+
+val map_value : ('a -> 'b) -> 'a value -> 'b value
+val value : 'a -> 'a value
+val antiquot : Parsetree.expression -> _ value
+
+val wrap_value :
+ lang -> Location.t -> Parsetree.expression value -> Parsetree.expression
+val list_wrap_value :
+ lang -> Location.t -> Parsetree.expression value list -> Parsetree.expression
+
+
+val error : Location.t -> ('b, Format.formatter, unit, 'a) format4 -> 'b
diff -Nru tyxml-3.5.0/ppx/ppx_element_content.ml tyxml-4.1.0/ppx/ppx_element_content.ml
--- tyxml-3.5.0/ppx/ppx_element_content.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_element_content.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,245 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+open Asttypes
+open Parsetree
+module Pc = Ppx_common
+
+type assembler =
+ lang:Ppx_common.lang ->
+ loc:Location.t ->
+ name:string ->
+ Parsetree.expression Ppx_common.value list ->
+ (Pc.Label.t * Parsetree.expression) list
+
+
+
+(* Helpers. *)
+
+(* Given a parse tree [e], if [e] represents [_.pcdata s], where [s] is a string
+ constant, evaluates to [Some s]. Otherwise, evaluates to [None]. *)
+let to_pcdata = function
+ | [%expr [%e? {pexp_desc = Pexp_ident f; _}] [%e? arg]] -> begin
+ match Longident.last f.txt, Ast_convenience.get_str arg with
+ | "pcdata", Some s -> Some s
+ | _ -> None
+ end
+ | _ -> None
+
+(** Test if the expression is a pcdata containing only whitespaces. *)
+let is_whitespace = function
+ | Pc.Val e -> begin
+ match to_pcdata e with
+ | Some s when String.trim s = "" -> true
+ | _ -> false
+ end
+ | _ -> false
+
+(* Given a list of parse trees representing children of an element, filters out
+ all children that consist of applications of [pcdata] to strings containing
+ only whitespace. *)
+let filter_whitespace = List.filter (fun e -> not @@ is_whitespace e)
+
+let filter_surrounding_whitespace children =
+ let rec aux = function
+ | [] -> []
+ | h :: t when is_whitespace h -> aux t
+ | l -> List.rev l
+ in
+ aux @@ aux children
+
+(* Given a parse tree and a string [name], checks whether the parse tree is an
+ application of a function with name [name]. *)
+let is_element_with_name name = function
+ | Pc.Val {pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident {txt}}, _)}
+ when txt = name -> true
+ | _ -> false
+
+(* Partitions a list of elements according to [is_element_with_name name]. *)
+let partition name children =
+ List.partition (is_element_with_name name) children
+
+(* Given the name [n] of a function in [Html_sigs.T], evaluates to
+ ["Html." ^ n]. *)
+let html local_name =
+ Longident.Ldot (Lident Pc.(implementation Html), local_name)
+
+
+
+(* Generic. *)
+
+let nullary ~lang:_ ~loc ~name children =
+ if children <> [] then
+ Pc.error loc "%s should have no content" name;
+ [Pc.Label.nolabel, [%expr ()] [@metaloc loc]]
+
+let unary ~lang ~loc ~name children =
+ match children with
+ | [child] ->
+ let child = Pc.wrap_value lang loc child in
+ [Pc.Label.nolabel, child]
+ | _ -> Pc.error loc "%s should have exactly one child" name
+
+let star ~lang ~loc ~name:_ children =
+ [Pc.Label.nolabel, Pc.list_wrap_value lang loc children]
+
+
+
+(* Special-cased. *)
+
+let ul ~lang ~loc ~name children =
+ let children = filter_whitespace children in
+ star ~lang ~loc ~name children
+
+let ol ~lang ~loc ~name children =
+ let children = filter_whitespace children in
+ star ~lang ~loc ~name children
+
+let select ~lang ~loc ~name children =
+ let children = filter_whitespace children in
+ star ~lang ~loc ~name children
+
+let head ~lang ~loc ~name children =
+ let children = filter_whitespace children in
+ let title, others = partition (html "title") children in
+
+ match title with
+ | [title] ->
+ (Pc.Label.nolabel, Pc.wrap_value lang loc title) :: star ~lang ~loc ~name others
+ | _ ->
+ Pc.error loc
+ "%s element must have exactly one title child element" name
+
+let figure ~lang ~loc ~name children =
+ begin match children with
+ | [] -> star ~lang ~loc ~name children
+ | first::others ->
+ if is_element_with_name (html "figcaption") first then
+ (Pc.Label.labelled "figcaption",
+ [%expr `Top [%e Pc.wrap_value lang loc first]])::
+ (star ~lang ~loc ~name others)
+ else
+ let children_reversed = List.rev children in
+ let last = List.hd children_reversed in
+ if is_element_with_name (html "figcaption") last then
+ let others = List.rev (List.tl children_reversed) in
+ (Pc.Label.labelled "figcaption",
+ [%expr `Bottom [%e Pc.wrap_value lang loc last]])::
+ (star ~lang ~loc ~name others)
+ else
+ star ~lang ~loc ~name children
+ end [@metaloc loc]
+
+let object_ ~lang ~loc ~name children =
+ let params, others = partition (html "param") children in
+
+ if params <> [] then
+ (Pc.Label.labelled "params", Pc.list_wrap_value lang loc params) ::
+ star ~lang ~loc ~name others
+ else
+ star ~lang ~loc ~name others
+
+let audio_video ~lang ~loc ~name children =
+ let sources, others = partition (html "source") children in
+
+ if sources <> [] then
+ (Pc.Label.labelled "srcs", Pc.list_wrap_value lang loc sources) ::
+ star ~lang ~loc ~name others
+ else
+ star ~lang ~loc ~name others
+
+let table ~lang ~loc ~name children =
+ let caption, others = partition (html "caption") children in
+ let columns, others = partition (html "colgroup") others in
+ let thead, others = partition (html "thead") others in
+ let tfoot, others = partition (html "tfoot") others in
+
+ let one label = function
+ | [] -> []
+ | [child] -> [Pc.Label.labelled label, Pc.wrap_value lang loc child]
+ | _ -> Pc.error loc "%s cannot have more than one %s" name label
+ in
+
+ let columns =
+ if columns = [] then []
+ else [Pc.Label.labelled "columns", Pc.list_wrap_value lang loc columns]
+ in
+
+ (one "caption" caption) @
+ columns @
+ (one "thead" thead) @
+ (one "tfoot" tfoot) @
+ (star ~lang ~loc ~name others)
+
+let fieldset ~lang ~loc ~name children =
+ let legend, others = partition (html "legend") children in
+
+ match legend with
+ | [] -> star ~lang ~loc ~name others
+ | [legend] ->
+ (Pc.Label.labelled "legend", Pc.wrap_value lang loc legend)::
+ (star ~lang ~loc ~name others)
+ | _ -> Pc.error loc "%s cannot have more than one legend" name
+
+let datalist ~lang ~loc ~name children =
+ let options, others = partition (html "option") children in
+
+ let children =
+ begin match others with
+ | [] ->
+ Pc.Label.labelled "children",
+ [%expr `Options [%e Pc.list_wrap_value lang loc options]]
+
+ | _ ->
+ Pc.Label.labelled "children",
+ [%expr `Phras [%e Pc.list_wrap_value lang loc children]]
+ end [@metaloc loc]
+ in
+
+ children::(nullary ~lang ~loc ~name [])
+
+let details ~lang ~loc ~name children =
+ let summary, others = partition (html "summary") children in
+
+ match summary with
+ | [summary] ->
+ (Pc.Label.nolabel, Pc.wrap_value lang loc summary)::
+ (star ~lang ~loc ~name others)
+ | _ -> Pc.error loc "%s must have exactly one summary child" name
+
+let menu ~lang ~loc ~name children =
+ let children =
+ Pc.Label.labelled "child",
+ [%expr `Flows [%e Pc.list_wrap_value lang loc children]]
+ [@metaloc loc]
+ in
+ children::(nullary ~lang ~loc ~name [])
+
+let html ~lang ~loc ~name children =
+ let children = filter_whitespace children in
+ let head, others = partition (html "head") children in
+ let body, others = partition (html "body") others in
+
+ match head, body, others with
+ | [head], [body], [] ->
+ [Pc.Label.nolabel, Pc.wrap_value lang loc head;
+ Pc.Label.nolabel, Pc.wrap_value lang loc body]
+ | _ ->
+ Pc.error loc
+ "%s element must have exactly head and body child elements" name
diff -Nru tyxml-3.5.0/ppx/ppx_element_content.mli tyxml-4.1.0/ppx/ppx_element_content.mli
--- tyxml-3.5.0/ppx/ppx_element_content.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_element_content.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,90 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Element child argument assemblers. These are almost parsers, except they
+ only tell how to pass already-parsed children to element functions. *)
+
+type assembler =
+ lang:Ppx_common.lang ->
+ loc:Location.t ->
+ name:string ->
+ Parsetree.expression Ppx_common.value list ->
+ (Ppx_common.Label.t * Parsetree.expression) list
+(** Assemblers satisfy: [assembler ~lang ~loc ~name children] evaluates
+ to a list of optionally-labeled parse trees for passing [children] to the
+ the element function for element [name]. For example, for a table element
+
+{[
+
+
+ A B
+
+
+
+
+]}
+
+ The assembler [table], when called with the parsed children, will evaluate
+ to parse trees representing
+
+{[
+~thead:(* the thead element *) [(* the tbody element *)]
+]}
+
+ This satisfies the child arguments in the signature of
+ [Html_sigs.T.tablex]. The [~table] label is represented by the string
+ ["table"], and the unlabeled list argument is paired with the empty string.
+
+ The argument [implementation] is the name of the module providing the
+ run-time implementation of the element function that will be applied to the
+ children. It is either [Html] or [Svg], and is based on the element's
+ namespace. It is used for wrapping child elements, and for scoping child
+ [pcdata] elements.
+
+ The [name] argument is used for error reporting. *)
+
+(** {2 Generic} *)
+
+val nullary : assembler
+val unary : assembler
+val star : assembler
+
+(** {2 Special-cased} *)
+
+val html : assembler
+val head : assembler
+val figure : assembler
+val object_ : assembler
+val audio_video : assembler
+val table : assembler
+val fieldset : assembler
+val datalist : assembler
+val details : assembler
+val menu : assembler
+val ul : assembler
+val ol : assembler
+val select : assembler
+
+(** {1 Misc utilities} *)
+
+(** Remove pcdata containing only whitespace that are at the beginning or the end
+ of the list. *)
+val filter_surrounding_whitespace :
+ Parsetree.expression Ppx_common.value list ->
+ Parsetree.expression Ppx_common.value list
diff -Nru tyxml-3.5.0/ppx/ppx_element.ml tyxml-4.1.0/ppx/ppx_element.ml
--- tyxml-3.5.0/ppx/ppx_element.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_element.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,56 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+let parse
+ ~loc ~parent_lang
+ ~name:((ns, name) as element_name) ~attributes children =
+
+ let attributes = Ppx_attributes.parse loc element_name attributes in
+ let lang, (module Reflected) = Ppx_namespace.reflect loc ns in
+
+ let lang = match parent_lang, lang with
+ | Ppx_common.Html, Svg -> Ppx_common.Html
+ | Html, Html | Svg, Svg -> lang
+ | Svg, Html ->
+ Ppx_common.error loc
+ "Nesting of Html element inside svg element is not supported"
+ in
+
+ let name =
+ try List.assoc name Reflected.renamed_elements
+ with Not_found -> Tyxml_name.ident name
+ in
+ let element_function = Ppx_common.make ~loc lang name in
+
+ let assembler =
+ try List.assoc name Reflected.element_assemblers
+ with Not_found ->
+ Ppx_common.error loc "Unknown %s element %s" (Ppx_common.lang lang) name
+ in
+
+ let children = assembler ~lang ~loc ~name children in
+
+ Ast_helper.Exp.apply ~loc element_function (attributes @ children)
+
+let comment ~loc ~lang s =
+ let tot = Ppx_common.make ~loc lang "tot" in
+ let comment = Ppx_common.make ~loc lang "Xml.comment" in
+ let s = Ppx_common.string loc s in
+ (* Using metaquot here avoids fiddling with labels. *)
+ [%expr [%e tot] ([%e comment] [%e s])][@metaloc loc]
diff -Nru tyxml-3.5.0/ppx/ppx_element.mli tyxml-4.1.0/ppx/ppx_element.mli
--- tyxml-3.5.0/ppx/ppx_element.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_element.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,40 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Element parsing. *)
+
+val parse :
+ loc:Location.t ->
+ parent_lang:Ppx_common.lang ->
+ name:Markup.name ->
+ attributes:(Markup.name * string Ppx_common.value) list ->
+ Parsetree.expression Ppx_common.value list ->
+ Parsetree.expression
+(** [parse ~loc ~parent_lang ~name ~attributes children]
+ evaluates to a parse tree for applying the TyXML function corresponding
+ to element [name] to suitable arguments representing [attributes] and
+ [children].
+*)
+
+val comment :
+ loc:Location.t ->
+ lang:Ppx_common.lang ->
+ string ->
+ Parsetree.expression
+(** [comment ~loc ~ns s] evaluates to a parse tree that represents an XML comment. *)
diff -Nru tyxml-3.5.0/ppx/ppx_internal.mldylib tyxml-4.1.0/ppx/ppx_internal.mldylib
--- tyxml-3.5.0/ppx/ppx_internal.mldylib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_internal.mldylib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,14 @@
+# OASIS_START
+# DO NOT EDIT (digest: 548267de5cf737352b7c519559efcac3)
+Ppx_tyxml
+Ppx_attributes
+Ppx_attribute_value
+Ppx_common
+Ppx_namespace
+Ppx_element_content
+Ppx_element
+Html_sigs_reflected
+Svg_sigs_reflected
+Html_types_reflected
+Svg_types_reflected
+# OASIS_STOP
diff -Nru tyxml-3.5.0/ppx/ppx_internal.mllib tyxml-4.1.0/ppx/ppx_internal.mllib
--- tyxml-3.5.0/ppx/ppx_internal.mllib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_internal.mllib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,14 @@
+# OASIS_START
+# DO NOT EDIT (digest: 548267de5cf737352b7c519559efcac3)
+Ppx_tyxml
+Ppx_attributes
+Ppx_attribute_value
+Ppx_common
+Ppx_namespace
+Ppx_element_content
+Ppx_element
+Html_sigs_reflected
+Svg_sigs_reflected
+Html_types_reflected
+Svg_types_reflected
+# OASIS_STOP
diff -Nru tyxml-3.5.0/ppx/ppx.mldylib tyxml-4.1.0/ppx/ppx.mldylib
--- tyxml-3.5.0/ppx/ppx.mldylib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx.mldylib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: b061535feecc99ae83995880b9069872)
+Ppx_tyxml_empty
+# OASIS_STOP
diff -Nru tyxml-3.5.0/ppx/ppx.mllib tyxml-4.1.0/ppx/ppx.mllib
--- tyxml-3.5.0/ppx/ppx.mllib 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx.mllib 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: b061535feecc99ae83995880b9069872)
+Ppx_tyxml_empty
+# OASIS_STOP
diff -Nru tyxml-3.5.0/ppx/ppx_namespace.ml tyxml-4.1.0/ppx/ppx_namespace.ml
--- tyxml-3.5.0/ppx/ppx_namespace.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_namespace.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,30 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+let get : Ppx_common.lang -> (module Ppx_sigs_reflected.S) = function
+ | Html -> (module Html_sigs_reflected)
+ | Svg -> (module Svg_sigs_reflected)
+
+let to_lang loc ns =
+ if ns = Markup.Ns.html then Ppx_common.Html
+ else if ns = Markup.Ns.svg then Ppx_common.Svg
+ else Ppx_common.error loc "Unknown namespace %s" ns
+
+let reflect loc ns =
+ let l = to_lang loc ns in (l, get l)
diff -Nru tyxml-3.5.0/ppx/ppx_namespace.mli tyxml-4.1.0/ppx/ppx_namespace.mli
--- tyxml-3.5.0/ppx/ppx_namespace.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_namespace.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,35 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Namespace-specific values. *)
+
+
+
+val reflect :
+ Location.t -> string -> Ppx_common.lang * (module Ppx_sigs_reflected.S)
+(** When given either [Markup.Ns.html] or [Markup.Ns.svg] as argument, evaluates
+ to the title of the corresponding markup language, the name of the run-time
+ module containing its TyXML implementation, and a preprocessing-time module
+ containing reflection information. *)
+
+val get : Ppx_common.lang -> (module Ppx_sigs_reflected.S)
+(** Similar to {!reflect} but takes a {!Ppx_common.lang} directly. *)
+
+val to_lang : Location.t -> string -> Ppx_common.lang
+(** Takes a namespace and returns the appropriate language. *)
diff -Nru tyxml-3.5.0/ppx/ppx_reflect.ml tyxml-4.1.0/ppx/ppx_reflect.ml
--- tyxml-3.5.0/ppx/ppx_reflect.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_reflect.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,513 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(* Runs on [html_sigs.mli], [svg_sigs.mli], and [html_types.mli]. Certain type
+ and value declarations are read for type information, which is stored in
+ corresponding [_reflected] files - for example, [html_sigs.mli] results in
+ [html_sigs_reflected.ml]. See comments by functions below and in
+ [ppx_sigs_reflected.mli] for details. *)
+
+open Ast_mapper
+open Asttypes
+open Parsetree
+open Ast_helper
+module AC = Ast_convenience
+
+
+
+let is_attribute s = String.length s >= 2 && String.sub s 0 2 = "a_"
+
+let strip_a s =
+ if String.length s < 2 || String.sub s 0 2 <> "a_" then s
+ else String.sub s 2 (String.length s - 2)
+
+(** Utilities for types of functions. *)
+module FunTyp = struct
+
+ (* Extract the tuple (arguments, return) of a function type. *)
+ let get t =
+ let rec scan acc = function
+ | {ptyp_desc = Ptyp_arrow (lab, t, t')} -> scan ((lab,t)::acc) t'
+ | ret -> (List.rev acc, ret)
+ in
+ scan [] t
+
+ let arguments t = fst @@ get t
+ let result t = snd @@ get t
+
+ exception Found
+
+ (** Check if a type contains the "elt" constructor, somewhere. *)
+ let contains_elt t =
+ (* Ast_iterator is not available in 4.02, so we use a mapper. *)
+ let typ mapper = function
+ | [%type: [%t? _] elt] -> raise Found
+ | ty -> default_mapper.typ mapper ty
+ in
+ let m = {Ast_mapper.default_mapper with typ} in
+ try ignore (m.typ m t) ; false
+ with Found -> true
+
+ (** Extract the type inside [wrap]. *)
+ let unwrap = function
+ (* Optional argument are [_ wrap *predef*.option], In 4.02 *)
+ | {ptyp_desc = Ptyp_constr (lid, [[%type: [%t? _] wrap] as t])}
+ when Longident.last lid.txt = "option" ->
+ Some t
+ | [%type: [%t? _] wrap] as t -> Some t
+ | _ -> None
+
+ (** Extract the type of for html/svg attributes. *)
+ let extract_attribute_argument (lab, t) =
+ if contains_elt t then None
+ else match AC.Label.explode lab, unwrap t with
+ | Nolabel, _ | _, None -> None
+ | (Labelled lab | Optional lab), Some t -> Some (lab, t)
+
+ let rec no_constructor_arguments = function
+ | [] -> true
+ | (Rinherit _)::_
+ | (Rtag (_, _, _, _::_))::_ -> false
+ | (Rtag (_, _, _, []))::more -> no_constructor_arguments more
+
+
+(* Given the name of a TyXML attribute function and a list of its argument
+ types, selects the attribute value parser (in module [Ppx_attribute_value])
+ that should be used for that attribute. *)
+let rec to_attribute_parser lang name = function
+ | [] -> [%expr nowrap presence]
+ | [[%type: [%t? ty] wrap]] ->
+ [%expr wrap [%e to_attribute_parser lang name [ty]]]
+
+ | [[%type: character]] -> [%expr char]
+ | [[%type: bool] as ty]
+ when AC.has_attr "onoff" ty.ptyp_attributes -> [%expr onoff]
+ | [[%type: bool]] -> [%expr bool]
+ | [[%type: unit]] -> [%expr nowrap unit]
+
+ | [[%type: number]] when lang = Ppx_common.Html -> [%expr int]
+ | [[%type: pixels]]
+ | [[%type: int]] -> [%expr int]
+
+ | [[%type: numbers]] when lang = Ppx_common.Html -> [%expr commas int]
+
+ | [[%type: number]] when lang = Ppx_common.Svg -> [%expr float]
+ | [[%type: float_number]] | [[%type: float]] -> [%expr float]
+
+ | [[%type: float_number option]] ->
+ [%expr option "any" float]
+
+ | [[%type: numbers_semicolon]] ->
+ [%expr semicolons float]
+
+ | [[%type: numbers]] when lang = Ppx_common.Svg ->
+ [%expr spaces_or_commas float]
+
+ | [[%type: fourfloats]] ->
+ [%expr fourfloats]
+
+ | [[%type: number_optional_number]] ->
+ [%expr number_pair]
+
+ | [[%type: coords]] ->
+ [%expr points]
+
+ | [[%type: (number * number) list option]] ->
+ [%expr option "any" (spaces icon_size)]
+
+ | [[%type: coord]] | [[%type: Unit.length]] ->
+ [%expr svg_length]
+
+ | [[%type: Unit.length list]] ->
+ [%expr spaces_or_commas svg_length]
+
+ | [[%type: Unit.angle option]] ->
+ [%expr option "auto" angle]
+
+ | [[%type: string]]
+ | [[%type: text]]
+ | [[%type: nmtoken]]
+ | [[%type: idref]]
+ | [[%type: Xml.uri]]
+ | [[%type: contenttype]]
+ | [[%type: languagecode]]
+ | [[%type: cdata]]
+ | [[%type: charset]]
+ | [[%type: frametarget]]
+ | [[%type: iri]]
+ | [[%type: color]] -> [%expr string]
+
+ | [[%type: nmtoken]; [%type: text wrap]] -> [%expr wrap string]
+
+ | [[%type: Xml.event_handler]]
+ | [[%type: Xml.mouse_event_handler]]
+ | [[%type: Xml.keyboard_event_handler]] ->
+ [%expr nowrap string]
+
+ | [[%type: string option]] ->
+ [%expr (option "" string)]
+
+ | [{ptyp_desc = Ptyp_variant (_::_::_ as constructors, _, _)}]
+ when no_constructor_arguments constructors ->
+ [%expr variant]
+
+ | [[%type: shape]] ->
+ [%expr variant]
+
+ | [[%type: nmtokens]]
+ | [[%type: idrefs]]
+ | [[%type: charsets]]
+ | [[%type: spacestrings]]
+ | [[%type: strings]] ->
+ [%expr spaces string]
+
+ | [[%type: commastrings]]
+ | [[%type: text list]]
+ | [[%type: contenttypes]] ->
+ [%expr commas string]
+
+ | [[%type: linktypes]] ->
+ [%expr spaces (total_variant Html_types_reflected.linktype)]
+
+ | [[%type: mediadesc]] ->
+ [%expr commas (total_variant Html_types_reflected.mediadesc_token)]
+
+ | [[%type: lengths]] ->
+ [%expr spaces_or_commas svg_length]
+
+ | [[%type: transforms]] ->
+ [%expr spaces_or_commas transform]
+
+ | [[%type: paint]] ->
+ [%expr paint]
+
+ | [[%type: number_or_datetime]] ->
+ [%expr number_or_datetime]
+
+ | [[%type: image_candidate list]] ->
+ [%expr commas srcset_element]
+
+ | _ ->
+ let name = strip_a name in
+ let name = if name = "in" then "in_" else name in
+ AC.evar name
+
+end
+
+(* Given a list of attributes from a val declaration whose name begins with a_,
+ checks if the declaration has a [@@reflect.attribute] annotation. If so, the
+ declaration's name does not directly correspond to markup attribute name
+ (e.g. "a_input_max" does not directly correspond to "max"). The annotation is
+ parsed to get the markup name and the element types in which the translation
+ from markup name to TyXML name should be performed. *)
+let ocaml_attributes_to_renamed_attribute name attributes =
+ let maybe_attribute =
+ Ppx_common.find (fun attr -> (fst attr).txt = "reflect.attribute")
+ attributes
+ in
+
+ match maybe_attribute with
+ | None -> []
+ | Some ({loc}, payload) ->
+ let error () =
+ Ppx_common.error loc
+ "Payload of [@@reflect.attribute] must be a string and a string list"
+ in
+ match payload with
+ | PStr [%str
+ [%e? const]
+ [%e? element_names]] ->
+ begin match Ast_convenience.get_str const with
+ | None -> error ()
+ | Some real_name ->
+ let element_names =
+ let error loc =
+ Ppx_common.error loc
+ "List in [@@reflect.attribute] must contain strings"
+ in
+ let rec traverse acc = function
+ | [%expr [%e? e]::[%e? tail]] ->
+ begin match Ast_convenience.get_str e with
+ | Some element_name -> traverse (element_name::acc) tail
+ | None -> error e.pexp_loc
+ end
+ | [%expr []] -> acc
+ | {pexp_loc} -> error pexp_loc
+ in
+ traverse [] element_names
+ in
+ [name, real_name, element_names]
+ end
+ | _ -> error ()
+
+(* Given a val declaration, determines whether it is for an element. If so,
+ evaluates to the element's child assembler (from module
+ [Ppx_element_content]), list of attributes passed as labeled arguments, and
+ markup name, if different from its TyXML name (for example, [object_] is
+ [object] in markup).
+
+ A val declaration is for an element if it either has a [@@reflect.element]
+ attribute, or its result type is [_ nullary], [_ unary], or [_ star]. *)
+let val_item_to_element_info lang value_description =
+ let name = value_description.pval_name.txt in
+
+ let maybe_attribute =
+ Ppx_common.find (fun attr -> (fst attr).txt = "reflect.element")
+ value_description.pval_attributes
+ in
+
+ let maybe_assembler, real_name =
+ match maybe_attribute with
+ | Some ({loc}, payload) ->
+ let assembler, real_name = match payload with
+ | PStr [%str [%e? assembler] [%e? name]] ->
+ Ast_convenience.get_str assembler, Ast_convenience.get_str name
+ | PStr [%str [%e? assembler]] ->
+ Ast_convenience.get_str assembler, None
+ | _ -> None, None
+ in
+ begin match assembler with
+ | Some _ -> (assembler, real_name)
+ | None ->
+ Ppx_common.error loc
+ "Payload of [@@reflect.element] must be one or two strings"
+ end
+
+ | None ->
+ let result_type = FunTyp.result value_description.pval_type in
+ let assembler = match result_type with
+ | [%type: ([%t? _], [%t ? _]) nullary] -> Some "nullary"
+ | [%type: ([%t? _], [%t ? _], [%t ? _]) unary] -> Some "unary"
+ | [%type: ([%t? _], [%t ? _], [%t ? _]) star] -> Some "star"
+ | _ -> None
+ in assembler, None
+ in
+
+ match maybe_assembler with
+ | None -> None
+ | Some assembler ->
+
+ (* We gather all the labeled arguments that are attributes. *)
+ let arguments = FunTyp.arguments value_description.pval_type in
+ let labeled_attributes =
+ let aux x acc = match FunTyp.extract_attribute_argument x with
+ | None -> acc
+ | Some (label, ty) ->
+ let parser = FunTyp.to_attribute_parser lang label [ty] in
+ (name, label, parser) :: acc
+ in
+ List.fold_right aux arguments []
+ in
+
+ let rename =
+ match real_name with
+ | None -> []
+ | Some real_name -> [real_name, name]
+ in
+
+ Some (assembler, labeled_attributes, rename)
+
+
+
+let attribute_parsers = ref []
+let labeled_attributes = ref []
+let renamed_attributes = ref []
+let element_assemblers = ref []
+let renamed_elements = ref []
+
+(* Walks over signature items, looking for elements and attributes. Calls the
+ functions immediately above, and accumulates their results in the above
+ references. This function is relevant for [html_sigs.mli] and
+ [svg_sigs.mli]. *)
+let signature_item lang mapper item =
+ begin match item.psig_desc with
+ | Psig_value {pval_name = {txt = name}; pval_type = type_; pval_attributes}
+ when is_attribute name ->
+ (* Attribute declaration. *)
+
+ let argument_types = List.map snd @@ FunTyp.arguments type_ in
+ let attribute_parser_mapping =
+ name, FunTyp.to_attribute_parser lang name argument_types in
+ attribute_parsers := attribute_parser_mapping::!attribute_parsers;
+
+ let renaming = ocaml_attributes_to_renamed_attribute name pval_attributes in
+ renamed_attributes := renaming @ !renamed_attributes
+
+ | Psig_value v ->
+ (* Non-attribute, but potentially an element declaration. *)
+
+ begin match val_item_to_element_info lang v with
+ | None -> ()
+ | Some (assembler, labeled_attributes', rename) ->
+ element_assemblers := (v.pval_name.txt, assembler)::!element_assemblers;
+ labeled_attributes := labeled_attributes' @ !labeled_attributes;
+ renamed_elements := rename @ !renamed_elements
+ end
+
+ | _ -> ()
+ end;
+
+ default_mapper.signature_item mapper item
+
+
+
+let reflected_variants = ref []
+
+(* Walks over type declarations (which will be in signature items). For each
+ that is marked with [@@reflect.total_variant], expects it to be a polymorphic
+ variant. Splits the constructors into those that have no arguments, and one
+ constructor that has one string argument. This constructor information is
+ accumulated in [reflected_variants]. This function is relevant for
+ [html_types.mli]. *)
+let type_declaration mapper declaration =
+ let is_reflect attr = (fst attr).txt = "reflect.total_variant" in
+ if List.exists is_reflect declaration.ptype_attributes then begin
+ let name = declaration.ptype_name.txt in
+
+ match declaration.ptype_manifest with
+ | Some {ptyp_desc = Ptyp_variant (rows, _, _); ptyp_loc} ->
+ let rows =
+ rows |> List.map (function
+ | Rtag (label, _, _, types) -> label, types
+ | Rinherit {ptyp_loc} ->
+ Ppx_common.error ptyp_loc
+ "Inclusion is not supported by [@@refect.total_variant]")
+ in
+
+ let nullary, unary =
+ List.partition (fun (_, types) -> types = []) rows in
+
+ let unary =
+ match unary with
+ | [name, [[%type: string]]] -> name
+ | _ ->
+ Ppx_common.error ptyp_loc
+ "Expected exactly one non-nullary constructor `C of string"
+ in
+
+ let nullary = List.map fst nullary in
+
+ reflected_variants := (name, (unary, nullary))::!reflected_variants
+
+ | _ ->
+ Ppx_common.error declaration.ptype_loc
+ "[@@reflect.total_variant] expects a polymorphic variant type"
+ end;
+
+ default_mapper.type_declaration mapper declaration
+
+(** Small set of combinators to help {!make_module}. *)
+module Combi = struct
+ let list f l = AC.list @@ List.map f l
+ let tuple2 f1 f2 (x1, x2) = Exp.tuple [f1 x1; f2 x2]
+ let tuple3 f1 f2 f3 (x1, x2, x3) = Exp.tuple [f1 x1; f2 x2; f3 x3]
+ let str = AC.str
+ let id = AC.evar
+ let expr x = x
+ let let_ p f (x,e) = Str.value Nonrecursive [Vb.mk (p x) (f e)]
+end
+
+(** Create a module based on the various things collected while reading the file. *)
+let emit_module () =
+ default_loc := Location.(in_file !input_name) ;
+ begin if !attribute_parsers <> [] then [%str
+ open Ppx_attribute_value
+
+ let attribute_parsers =
+ [%e Combi.(list @@ tuple2 str expr) !attribute_parsers ]
+ let renamed_attributes =
+ [%e Combi.(list @@ tuple3 str str (list str)) !renamed_attributes ]
+ let labeled_attributes =
+ [%e Combi.(list @@ tuple3 str str expr) !labeled_attributes ]
+
+ open Ppx_element_content
+
+ let element_assemblers =
+ [%e Combi.(list @@ tuple2 str id) !element_assemblers ]
+ let renamed_elements =
+ [%e Combi.(list @@ tuple2 str str) !renamed_elements ]
+
+ ] else []
+ end @
+
+ List.map Combi.(let_ AC.pvar (tuple2 str (list str))) !reflected_variants
+
+
+(* Crude I/O tools to read a signature and output a structure.
+ The executable will take as first argument the name of the signature
+ and as second argument the name of the structure.
+
+*)
+
+let read_sig filename =
+ Location.input_name := filename ;
+ let handle =
+ try open_in filename
+ with Sys_error msg -> prerr_endline msg; exit 1
+ in
+ let buf = Lexing.from_channel handle in
+ Location.init buf filename ;
+ let ast = Parse.interface buf in
+ close_in handle ;
+ ast
+
+let write_struct filename ast =
+ let handle =
+ try open_out filename
+ with Sys_error msg -> prerr_endline msg; exit 1
+ in
+ let fmt = Format.formatter_of_out_channel handle in
+ Format.fprintf fmt "%a@." Pprintast.structure ast ;
+ close_out handle
+
+let () =
+ if Array.length Sys.argv < 3 then begin
+ Printf.eprintf "Usage: %s IN OUT\n" Sys.argv.(0);
+ exit 2
+ end;
+
+ let in_file = Sys.argv.(1) in
+ let out_file = Sys.argv.(2) in
+
+ let lang =
+ let basename = Filename.basename in_file in
+ let svg_prefix = "svg_" in
+ if String.length basename >= String.length svg_prefix
+ && String.sub basename 0 (String.length svg_prefix) = svg_prefix
+ then Ppx_common.Svg
+ else Ppx_common.Html
+ in
+
+ let mapper =
+ let signature_item = signature_item lang in
+ {default_mapper with signature_item; type_declaration}
+ in
+
+ let reflected_struct sig_ =
+ ignore @@ mapper.signature mapper sig_ ;
+ emit_module ()
+ in
+
+ try
+ read_sig in_file
+ |> reflected_struct
+ |> write_struct out_file
+ with exn ->
+ Location.report_exception Format.err_formatter exn;
+ exit 2
diff -Nru tyxml-3.5.0/ppx/ppx_sigs_reflected.mli tyxml-4.1.0/ppx/ppx_sigs_reflected.mli
--- tyxml-3.5.0/ppx/ppx_sigs_reflected.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_sigs_reflected.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,43 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** Signature of [Html_sigs_reflected] and [Svg_sigs_reflected] (but not
+ [Html_types_reflected]). *)
+
+
+
+module type S =
+sig
+ val attribute_parsers :
+ (string * (Ppx_common.lang -> Ppx_attribute_value.vparser)) list
+ (** Pairs [tyxml_attribute_name, wrapped_attribute_value_parser]. *)
+
+ val renamed_attributes : (string * string * string list) list
+ (** Triples [tyxml_attribute_name, markup_name, in_element_types]. *)
+
+ val labeled_attributes :
+ (string * string * (Ppx_common.lang -> Ppx_attribute_value.vparser)) list
+ (** Triples [tyxml_element_name, label, wrapped_attribute_value_parser]. *)
+
+ val element_assemblers : (string * Ppx_element_content.assembler) list
+ (** Pairs [tyxml_element_name, child_argument_assembler]. *)
+
+ val renamed_elements : (string * string) list
+ (** Pairs [markup_element_name, tyxml_name]. *)
+end
diff -Nru tyxml-3.5.0/ppx/ppx_tyxml_empty.ml tyxml-4.1.0/ppx/ppx_tyxml_empty.ml
--- tyxml-3.5.0/ppx/ppx_tyxml_empty.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_tyxml_empty.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1 @@
+(* Dummy ML file to workaround https://github.com/ocsigen/lwt/issues/91 *)
diff -Nru tyxml-3.5.0/ppx/ppx_tyxml_ex.ml tyxml-4.1.0/ppx/ppx_tyxml_ex.ml
--- tyxml-3.5.0/ppx/ppx_tyxml_ex.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_tyxml_ex.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,2 @@
+
+let () = Ast_mapper.register "tyxml" Ppx_tyxml.mapper
diff -Nru tyxml-3.5.0/ppx/ppx_tyxml.ml tyxml-4.1.0/ppx/ppx_tyxml.ml
--- tyxml-3.5.0/ppx/ppx_tyxml.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_tyxml.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,455 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+open Asttypes
+open Parsetree
+
+
+module Loc = struct
+
+ let shift (pos:Lexing.position) x = {pos with pos_cnum = pos.pos_cnum + x}
+
+ let shrink {Location. loc_start ; loc_end ; loc_ghost } ~xbegin ~xend =
+ { Location.loc_ghost ;
+ loc_start = shift loc_start xbegin ;
+ loc_end = shift loc_end xend ;
+ }
+
+ (** Returns the real (OCaml) location of the content of a string, taking
+ delimiters into account. *)
+ let string_start delimiter loc =
+ let delimiter_length = match delimiter with
+ | None -> 1
+ | Some d -> String.length d + 2
+ in
+ shift loc.Location.loc_start delimiter_length
+
+ (** 0-width locations do not show in the toplevel. We expand them to
+ one-width.
+ *)
+ let one_width ?(ghost=false) pos =
+ { Location.loc_ghost = ghost ;
+ loc_start = pos ;
+ loc_end = shift pos 1
+ }
+
+ (** Given a list of input strings for Markup.ml, evaluates to a function that
+ converts Markup.ml locations of characters within these strings to their
+ OCaml locations. *)
+ let make_location_map located_strings =
+ (* [source] is a byte stream created from the string list, which calls
+ [!starting_a_string] each time it moves on to a new string in the
+ list. *)
+ let starting_a_string = ref (fun _ -> ()) in
+ let source =
+ let strings = ref located_strings in
+ let offset = ref 0 in
+
+ let rec next_byte () = match !strings with
+ | [] -> None
+ | (s, loc)::rest ->
+ if !offset = 0 then !starting_a_string loc;
+
+ if !offset < String.length s then begin
+ offset := !offset + 1;
+ Some (s.[!offset - 1])
+ end
+ else begin
+ offset := 0;
+ strings := rest;
+ next_byte ()
+ end
+ in
+
+ Markup.fn next_byte
+ in
+
+ (* Use Markup.ml to assign locations to characters in [source], and note
+ the Markup.ml and OCaml locations of the start of each string. *)
+ let location_map =
+ let preprocessed_input_stream, get_markupml_location =
+ source
+ |> Markup.Encoding.decode Markup.Encoding.utf_8
+ |> Markup.preprocess_input_stream
+ in
+
+ let location_map = ref [] in
+ starting_a_string := begin fun ocaml_position ->
+ location_map :=
+ (get_markupml_location (), ocaml_position)::!location_map
+ end;
+
+ Markup.drain preprocessed_input_stream;
+ List.rev !location_map
+ in
+
+ (* The function proper which translates Markup.ml locations into OCaml
+ locations. *)
+ fun given_markup_location ->
+ (* [bounded_maximum None location_map] evaluates to the greatest Markup.ml
+ location (and its paired OCaml location) in [location_map] that is less
+ than or equal to [given_markup_location]. [best] is [Some] of the
+ greatest candidate found so far, or [None] on the first iteration. *)
+ let rec bounded_maximum best = function
+ | [] -> best
+ | ((noted_markup_location, _) as loc)::rest ->
+ if Markup.compare_locations
+ noted_markup_location given_markup_location > 0 then best
+ else bounded_maximum (Some loc) rest
+ in
+
+ let preceding_markup_location, preceding_ocaml_position =
+ match bounded_maximum None location_map with
+ | Some loc -> loc
+ | None -> assert false
+ in
+
+ let line, column = given_markup_location in
+ let line', column' = preceding_markup_location in
+
+ let ocaml_position =
+ let open Lexing in
+ if line = line' then
+ {preceding_ocaml_position with
+ pos_cnum = preceding_ocaml_position.pos_cnum + column - column'}
+ else
+ {preceding_ocaml_position with
+ pos_lnum = preceding_ocaml_position.pos_lnum + line - line';
+ pos_bol = 0;
+ pos_cnum = column - 1}
+ in
+
+ one_width ocaml_position
+end
+
+(** Antiquotations
+
+ We replace antiquotations expressions by a dummy token "(tyxmlX)".
+ We store a table token to expression to retrieve them after parsing.
+*)
+module Antiquot = struct
+
+ let fmt_id = Printf.sprintf "(tyxml%i)"
+ let regex_id = Re.(seq [ str "(tyxml" ; rep digit ; char ')' ])
+ let re_id = Re.compile regex_id
+
+ let make_id =
+ let r = ref 0 in
+ fun () -> incr r ; fmt_id !r
+
+ module H = Hashtbl.Make(struct
+ type t = string
+ let hash = Hashtbl.hash
+ let equal (x:string) y = x = y
+ end)
+
+ let tbl = H.create 17
+
+ let create expr =
+ let s = make_id () in
+ H.add tbl s expr ;
+ s
+
+ let get loc s =
+ if H.mem tbl s then H.find tbl s
+ else
+ Ppx_common.error loc
+ "Internal error: This expression placeholder is not registered"
+
+ let contains loc s = match Re.exec_opt re_id s with
+ | None -> `No
+ | Some g ->
+ let (i,j) = Re.Group.offset g 0 in
+ let is_whole = i = 0 && j = String.length s in
+ if is_whole
+ then `Whole (get loc s)
+ else `Yes (get loc @@ Re.Group.get g 0)
+
+ let assert_no_antiquot ~loc kind (_namespace,s) =
+ match contains loc s with
+ | `No -> ()
+ | `Yes e | `Whole e ->
+ Ppx_common.error e.pexp_loc
+ "OCaml expressions are not accepted as %s names" kind
+
+end
+
+(** Building block to rebuild the output with expressions intertwined. *)
+
+let make_pcdata ~loc ~lang s =
+ let pcdata = Ppx_common.make ~loc lang "pcdata" in
+ Ast_helper.Exp.apply ~loc pcdata
+ [Ppx_common.Label.nolabel, Ppx_common.string loc s]
+
+(** Walk the text list to replace placeholders by OCaml expressions when
+ appropriate. Use {!make_pcdata} on the rest. *)
+let make_text ~loc ~lang ss =
+ let buf = Buffer.create 17 in
+ let push_pcdata buf l =
+ let s = Buffer.contents buf in
+ Buffer.clear buf ;
+ if s = "" then l else Ppx_common.value (make_pcdata ~loc ~lang s) :: l
+ in
+ let rec aux ~loc res = function
+ | [] -> push_pcdata buf res
+ | `Text s :: t ->
+ Buffer.add_string buf s ;
+ aux ~loc res t
+ | `Delim g :: t ->
+ let e = Antiquot.get loc @@ Re.get g 0 in
+ aux ~loc (Ppx_common.antiquot e :: push_pcdata buf res) t
+ in
+ aux ~loc [] @@ Re.split_full Antiquot.re_id @@ String.concat "" ss
+
+let replace_attribute ~loc (attr,value) =
+ Antiquot.assert_no_antiquot ~loc "attribute" attr ;
+ match Antiquot.contains loc value with
+ | `No -> (attr, Ppx_common.value value)
+ | `Whole e -> (attr, Ppx_common.antiquot e)
+ | `Yes _ ->
+ Ppx_common.error loc
+ "Mixing literals and OCaml expressions is not supported in attribute values"
+
+
+(** Processing *)
+
+(** Takes the ast and transforms it into a Markup.ml char stream.
+
+ The payload [expr] is either a single token, or an application (that is, a list).
+ A token is either a string or an antiquotation. Antiquotations are replaced
+ by placeholder strings (see {!Antiquot}).
+
+ Each token is equipped with a starting (but no ending) position.
+*)
+let ast_to_stream expressions =
+
+ let strings =
+ expressions |> List.map @@ fun expr ->
+ match Ast_convenience.get_str_with_quotation_delimiter expr with
+ | Some (s, delimiter) ->
+ (s, Loc.string_start delimiter expr.pexp_loc)
+ | None ->
+ (Antiquot.create expr, expr.pexp_loc.loc_start)
+ in
+
+ let source =
+ let items = ref strings in
+ let offset = ref 0 in
+
+ let rec next_byte () = match !items with
+ | [] -> None
+ | (s, _)::rest ->
+ if !offset < String.length s then begin
+ offset := !offset + 1;
+ Some (s.[!offset - 1])
+ end
+ else begin
+ offset := 0;
+ items := rest;
+ next_byte ()
+ end
+ in
+
+ Markup.fn next_byte
+ in
+
+ source, Loc.make_location_map strings
+
+let context_of_lang = function
+ | Ppx_common.Svg -> Some (`Fragment "svg")
+ | Html -> None
+
+(** Given the payload of a [%html ...] or [%svg ...] expression,
+ converts it to a TyXML expression representing the markup
+ contained therein. *)
+let markup_to_expr lang loc expr =
+ let context = context_of_lang lang in
+
+ let input_stream, adjust_location = ast_to_stream expr in
+
+ let parser =
+ Markup.parse_html
+ ?context
+ ~encoding:Markup.Encoding.utf_8
+ ~report:(fun loc error ->
+ let loc = adjust_location loc in
+ let message = Markup.Error.to_string error |> String.capitalize in
+ Ppx_common.error loc "%s" message)
+ input_stream
+ in
+ let signals = Markup.signals parser in
+ let get_loc () = adjust_location @@ Markup.location parser in
+
+ let rec assemble lang children =
+ match Markup.next signals with
+ | None | Some `End_element -> List.rev children
+
+ | Some (`Text ss) ->
+ let loc = get_loc () in
+ let node = make_text ~loc ~lang ss in
+ assemble lang (node @ children)
+
+ | Some (`Start_element (name, attributes)) ->
+ let newlang = Ppx_namespace.to_lang loc @@ fst name in
+ let loc = get_loc () in
+
+ let sub_children = assemble newlang [] in
+ Antiquot.assert_no_antiquot ~loc "element" name ;
+ let attributes = List.map (replace_attribute ~loc) attributes in
+ let node =
+ Ppx_element.parse
+ ~parent_lang:lang ~loc ~name ~attributes sub_children
+ in
+ assemble lang (Ppx_common.Val node :: children)
+
+ | Some (`Comment s) ->
+ let loc = get_loc () in
+ let node = Ppx_common.value @@ Ppx_element.comment ~loc ~lang s in
+ assemble lang (node :: children)
+
+ | Some (`Xml _ | `Doctype _ | `PI _) ->
+ assemble lang children
+ in
+
+ let l =
+ Ppx_element_content.filter_surrounding_whitespace @@
+ assemble lang []
+ in
+
+ match l with
+ | [ Val x | Antiquot x ] -> x
+ | l -> Ppx_common.list_wrap_value lang loc l
+
+let markup_to_expr_with_implementation lang modname loc expr =
+ match modname with
+ | Some modname ->
+ let current_modname = Ppx_common.implementation lang in
+ Ppx_common.set_implementation lang modname ;
+ let res = markup_to_expr lang loc expr in
+ Ppx_common.set_implementation lang current_modname ;
+ res
+ | _ ->
+ markup_to_expr lang loc expr
+
+
+let is_capitalized s =
+ if String.length s < 0 then false
+ else match s.[0] with
+ | 'A'..'Z' -> true
+ | _ -> false
+
+(** Extract and verify the modname in the annotation [%html.Bar.Baz .. ].
+ We need to fiddle with length to provide a correct location. *)
+let get_modname ~loc len l =
+ let s = String.concat "." l in
+ let loc = Loc.shrink loc ~xbegin:(len - String.length s) ~xend:0 in
+ if l = [] then None
+ else if not (List.for_all is_capitalized l) then
+ Ppx_common.error loc "This identifier is not a module name"
+ else Some s
+
+let re_dot = Re.(compile @@ char '.')
+let dispatch_ext {txt ; loc} =
+ let l = Re.split re_dot txt in
+ let len = String.length txt in
+ match l with
+ | "html" :: l
+ | "tyxml" :: "html" :: l ->
+ Some (Ppx_common.Html, get_modname ~loc len l)
+ | "svg" :: l
+ | "tyxml" :: "svg" :: l ->
+ Some (Ppx_common.Svg, get_modname ~loc len l)
+ | _ -> None
+
+let application_to_list expr =
+ match expr.pexp_desc with
+ | Pexp_apply (f, arguments) -> f::(List.map snd arguments)
+ | _ -> [expr]
+
+
+open Ast_mapper
+open Ast_helper
+
+let error { txt ; loc } =
+ Ppx_common.error loc "Invalid payload for [%%%s]" txt
+
+let markup_cases ~lang ~modname cases =
+ let f ({pc_rhs} as case) =
+ let loc = pc_rhs.pexp_loc in
+ let pc_rhs =
+ markup_to_expr_with_implementation lang modname loc @@
+ application_to_list pc_rhs
+ in {case with pc_rhs}
+ in
+ List.map f cases
+
+let rec markup_function ~lang ~modname e =
+ let loc = e.pexp_loc in
+ match e.pexp_desc with
+ | Pexp_fun (label,def,pat,content) ->
+ let content = markup_function ~lang ~modname content in
+ {e with pexp_desc = Pexp_fun (label,def,pat,content)}
+ | Pexp_function cases ->
+ let cases = markup_cases ~lang ~modname cases in
+ {e with pexp_desc = Pexp_function cases}
+ | _ ->
+ markup_to_expr_with_implementation lang modname loc @@
+ application_to_list e
+
+let markup_bindings ~lang ~modname l =
+ let f ({pvb_expr} as b) =
+ let pvb_expr = markup_function ~lang ~modname pvb_expr in
+ {b with pvb_expr}
+ in
+ List.map f l
+
+let rec expr mapper e =
+ match e.pexp_desc with
+ | Pexp_extension (ext, payload) ->
+ begin match dispatch_ext ext, payload with
+ | Some (lang, modname), PStr [{pstr_desc = Pstr_eval (e, _)}] ->
+ begin match e.pexp_desc with
+ | Pexp_let (recflag, bindings, next) ->
+ let bindings = markup_bindings ~lang ~modname bindings in
+ {e with pexp_desc = Pexp_let (recflag, bindings, expr mapper next)}
+ | _ ->
+ markup_to_expr_with_implementation lang modname e.pexp_loc @@
+ application_to_list e
+ end
+ | Some _, _ -> error ext
+ | None, _ -> default_mapper.expr mapper e
+ end
+ | _ -> default_mapper.expr mapper e
+
+let structure_item mapper stri =
+ match stri.pstr_desc with
+ | Pstr_extension ((ext, payload), _attrs) ->
+ begin match dispatch_ext ext, payload with
+ | Some (lang, modname),
+ PStr [{pstr_desc = Pstr_value (recflag, bindings) }] ->
+ let bindings = markup_bindings ~lang ~modname bindings in
+ Str.value recflag bindings
+
+ | Some _, _ -> error ext
+ | None, _ -> default_mapper.structure_item mapper stri
+ end
+ | _ -> default_mapper.structure_item mapper stri
+
+let mapper _ =
+ {default_mapper with expr ; structure_item}
diff -Nru tyxml-3.5.0/ppx/ppx_tyxml.mli tyxml-4.1.0/ppx/ppx_tyxml.mli
--- tyxml-3.5.0/ppx/ppx_tyxml.mli 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/ppx/ppx_tyxml.mli 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,34 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2016 Anton Bachin, Gabriel Radanne
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+(** TyXML ppx library.
+
+ This is the documentation for the internal ppx library.
+ {% Documentation for the ppx itself is available
+ <>. %}
+*)
+
+val markup_to_expr :
+ Ppx_common.lang ->
+ Location.t -> Parsetree.expression list -> Parsetree.expression
+(** Given the payload of a [%html ...] or [%svg ...] expression,
+ converts it to a TyXML expression representing the markup
+ contained therein. *)
+
+val mapper : string list -> Ast_mapper.mapper
diff -Nru tyxml-3.5.0/README.md tyxml-4.1.0/README.md
--- tyxml-3.5.0/README.md 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/README.md 2017-03-03 16:33:22.000000000 +0000
@@ -1,51 +1,38 @@
-# TypedXML
+# TyXML
-TyXML allows you to build XML trees whose validity is ensured by the typechecker.
-It's based on a traduction of XML types into polymorphic variants, originally written by Thorsten Ohl.
-Currently, the transcription has been done for HTML5 and SVG.
+TyXML is a library for building statically correct HTML5 and SVG documents:
-TyXML also provides a generic printer and some low-level (and untyped) iterators over XML trees.
-The printer has options for printing HTML in more browser-friendly way when served as `"text/html"` (instead of `"text/xml"`).
-HTML5 is always printed with those options.
-
-All modules provided by TyXML are also provided in functorial interface, where every module is parameterised by the underlying XML representation.
-
-A camlp4 extension, named `Pa_tyxml`, allows to write HTML pages or HTML fragments with the usual syntax.
-For creating HTML5- or SVG-nodes, the syntax extension relies on the presence of a module called Html5 or Svg which keeps the actual implementation, e.g.
```ocaml
-let module Html5 = Eliom_content.Html5.F in
-<:html5< xyz >>
+open Tyxml
+let to_ocaml = Html.(a ~a:[a_href "ocaml.org"] [pcdata "OCaml!"])
```
-You can find the documentation [on the TyXML website](http://ocsigen.org/tyxml/api/).
-
-## How to
-
-### Installation
-
-TyXML is available in [opam](http://opam.ocamlpro.com) : `opam install tyxml`
-
-You can also use the ocsigen opam repository for the dev version :
-`opam repository add ocsigen-dev http://ocsigen.org/opam`
-
-### Manual build
+Tyxml can also be used with the standard HTML syntax, using the PPX:
-#### Requirements:
-
-* ocaml and camlp4
-* findlib
-
-#### Build instructions:
-
-```
-./configure
-make
-make install
+```ocaml
+open Tyxml
+let%html to_ocaml = "OCaml!"
```
-#### API documentation:
-
+TyXML provides a set of combinators. These combinators use the OCaml type system
+to ensure the validity of the generated document.
+They are used in various libraries, such as [Eliom][] and [Js_of_ocaml][].
+
+The documentation can be consulted
+[on the TyXML website](https://ocsigen.org/tyxml/manual/). Examples are
+available in the [examples](examples) directory.
+
+[Eliom]: https://ocsigen.org/eliom/manual/clientserver-html
+[Js_of_ocaml]: https://ocsigen.org/js_of_ocaml/api/Tyxml_js
+
+## Installation
+
+TyXML is available in [OPAM](https://opam.ocaml.org/):
+```sh
+opam install tyxml
```
-make doc
-${BROWSER} _build/tyxml-api.docdir/index.html
+
+To install the PPX:
+```sh
+opam install tyxml-ppx
```
diff -Nru tyxml-3.5.0/setup.ml tyxml-4.1.0/setup.ml
--- tyxml-3.5.0/setup.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/setup.ml 2017-03-03 16:33:22.000000000 +0000
@@ -1,9 +1,10 @@
(* setup.ml generated for the first time by OASIS v0.3.0 *)
+[@@@ocaml.warning "-3"]
(* OASIS_START *)
-(* DO NOT EDIT (digest: 0d50d507dd03de48954971f23dc2890a) *)
+(* DO NOT EDIT (digest: 341be352b891faa443d1c552cf82a9fb) *)
(*
- Regenerated by OASIS v0.4.5
+ Regenerated by OASIS v0.4.8
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
@@ -11,16 +12,9 @@
(* # 22 "src/oasis/OASISGettext.ml" *)
- let ns_ str =
- str
-
-
- let s_ str =
- str
-
-
- let f_ (str: ('a, 'b, 'c, 'd) format4) =
- str
+ let ns_ str = str
+ let s_ str = str
+ let f_ (str: ('a, 'b, 'c, 'd) format4) = str
let fn_ fmt1 fmt2 n =
@@ -30,90 +24,7 @@
fmt2^^""
- let init =
- []
-
-
-end
-
-module OASISContext = struct
-(* # 22 "src/oasis/OASISContext.ml" *)
-
-
- open OASISGettext
-
-
- type level =
- [ `Debug
- | `Info
- | `Warning
- | `Error]
-
-
- type t =
- {
- (* TODO: replace this by a proplist. *)
- quiet: bool;
- info: bool;
- debug: bool;
- ignore_plugins: bool;
- ignore_unknown_fields: bool;
- printf: level -> string -> unit;
- }
-
-
- let printf lvl str =
- let beg =
- match lvl with
- | `Error -> s_ "E: "
- | `Warning -> s_ "W: "
- | `Info -> s_ "I: "
- | `Debug -> s_ "D: "
- in
- prerr_endline (beg^str)
-
-
- let default =
- ref
- {
- quiet = false;
- info = false;
- debug = false;
- ignore_plugins = false;
- ignore_unknown_fields = false;
- printf = printf;
- }
-
-
- let quiet =
- {!default with quiet = true}
-
-
- let fspecs () =
- (* TODO: don't act on default. *)
- let ignore_plugins = ref false in
- ["-quiet",
- Arg.Unit (fun () -> default := {!default with quiet = true}),
- s_ " Run quietly";
-
- "-info",
- Arg.Unit (fun () -> default := {!default with info = true}),
- s_ " Display information message";
-
-
- "-debug",
- Arg.Unit (fun () -> default := {!default with debug = true}),
- s_ " Output debug message";
-
- "-ignore-plugins",
- Arg.Set ignore_plugins,
- s_ " Ignore plugin's field.";
-
- "-C",
- (* TODO: remove this chdir. *)
- Arg.String (fun str -> Sys.chdir str),
- s_ "dir Change directory before running."],
- fun () -> {!default with ignore_plugins = !ignore_plugins}
+ let init = []
end
module OASISString = struct
@@ -125,7 +36,7 @@
Mostly inspired by extlib and batteries ExtString and BatString libraries.
@author Sylvain Le Gall
- *)
+ *)
let nsplitf str f =
@@ -139,19 +50,19 @@
Buffer.clear buf
in
let str_len = String.length str in
- for i = 0 to str_len - 1 do
- if f str.[i] then
- push ()
- else
- Buffer.add_char buf str.[i]
- done;
- push ();
- List.rev !lst
+ for i = 0 to str_len - 1 do
+ if f str.[i] then
+ push ()
+ else
+ Buffer.add_char buf str.[i]
+ done;
+ push ();
+ List.rev !lst
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
separator.
- *)
+ *)
let nsplit str c =
nsplitf str ((=) c)
@@ -159,18 +70,18 @@
let find ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
- while !str_idx < String.length str &&
- !what_idx < String.length what do
- if str.[!str_idx] = what.[!what_idx] then
- incr what_idx
- else
- what_idx := 0;
- incr str_idx
- done;
- if !what_idx <> String.length what then
- raise Not_found
+ while !str_idx < String.length str &&
+ !what_idx < String.length what do
+ if str.[!str_idx] = what.[!what_idx] then
+ incr what_idx
else
- !str_idx - !what_idx
+ what_idx := 0;
+ incr str_idx
+ done;
+ if !what_idx <> String.length what then
+ raise Not_found
+ else
+ !str_idx - !what_idx
let sub_start str len =
@@ -193,19 +104,19 @@
let what_idx = ref 0 in
let str_idx = ref offset in
let ok = ref true in
- while !ok &&
- !str_idx < String.length str &&
- !what_idx < String.length what do
- if str.[!str_idx] = what.[!what_idx] then
- incr what_idx
- else
- ok := false;
- incr str_idx
- done;
- if !what_idx = String.length what then
- true
+ while !ok &&
+ !str_idx < String.length str &&
+ !what_idx < String.length what do
+ if str.[!str_idx] = what.[!what_idx] then
+ incr what_idx
else
- false
+ ok := false;
+ incr str_idx
+ done;
+ if !what_idx = String.length what then
+ true
+ else
+ false
let strip_starts_with ~what str =
@@ -219,19 +130,19 @@
let what_idx = ref ((String.length what) - 1) in
let str_idx = ref ((String.length str) - 1) in
let ok = ref true in
- while !ok &&
- offset <= !str_idx &&
- 0 <= !what_idx do
- if str.[!str_idx] = what.[!what_idx] then
- decr what_idx
- else
- ok := false;
- decr str_idx
- done;
- if !what_idx = -1 then
- true
+ while !ok &&
+ offset <= !str_idx &&
+ 0 <= !what_idx do
+ if str.[!str_idx] = what.[!what_idx] then
+ decr what_idx
else
- false
+ ok := false;
+ decr str_idx
+ done;
+ if !what_idx = -1 then
+ true
+ else
+ false
let strip_ends_with ~what str =
@@ -246,6 +157,33 @@
String.iter (fun c -> Buffer.add_char buf (f c)) s;
Buffer.contents buf
+ let lowercase_ascii =
+ replace_chars
+ (fun c ->
+ if (c >= 'A' && c <= 'Z') then
+ Char.chr (Char.code c + 32)
+ else
+ c)
+
+ let uncapitalize_ascii s =
+ if s <> "" then
+ (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+ else
+ s
+
+ let uppercase_ascii =
+ replace_chars
+ (fun c ->
+ if (c >= 'a' && c <= 'z') then
+ Char.chr (Char.code c - 32)
+ else
+ c)
+
+ let capitalize_ascii s =
+ if s <> "" then
+ (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+ else
+ s
end
@@ -315,19 +253,15 @@
let compare_csl s1 s2 =
- String.compare (String.lowercase s1) (String.lowercase s2)
+ String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
module HashStringCsl =
Hashtbl.Make
(struct
type t = string
-
- let equal s1 s2 =
- (String.lowercase s1) = (String.lowercase s2)
-
- let hash s =
- Hashtbl.hash (String.lowercase s)
+ let equal s1 s2 = (compare_csl s1 s2) = 0
+ let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
end)
module SetStringCsl =
@@ -365,7 +299,7 @@
else
buf
in
- String.lowercase buf
+ OASISString.lowercase_ascii buf
end
@@ -393,605 +327,952 @@
let failwithf fmt = Printf.ksprintf failwith fmt
-end
+ let rec file_location ?pos1 ?pos2 ?lexbuf () =
+ match pos1, pos2, lexbuf with
+ | Some p, None, _ | None, Some p, _ ->
+ file_location ~pos1:p ~pos2:p ?lexbuf ()
+ | Some p1, Some p2, _ ->
+ let open Lexing in
+ let fn, lineno = p1.pos_fname, p1.pos_lnum in
+ let c1 = p1.pos_cnum - p1.pos_bol in
+ let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
+ Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
+ | _, _, Some lexbuf ->
+ file_location
+ ~pos1:(Lexing.lexeme_start_p lexbuf)
+ ~pos2:(Lexing.lexeme_end_p lexbuf)
+ ()
+ | None, None, None ->
+ s_ ""
+
+
+ let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
+ let loc = file_location ?pos1 ?pos2 ?lexbuf () in
+ Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
-module PropList = struct
-(* # 22 "src/oasis/PropList.ml" *)
+end
- open OASISGettext
+module OASISUnixPath = struct
+(* # 22 "src/oasis/OASISUnixPath.ml" *)
- type name = string
+ type unix_filename = string
+ type unix_dirname = string
- exception Not_set of name * string option
- exception No_printer of name
- exception Unknown_field of name * name
+ type host_filename = string
+ type host_dirname = string
- let () =
- Printexc.register_printer
- (function
- | Not_set (nm, Some rsn) ->
- Some
- (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
- | Not_set (nm, None) ->
- Some
- (Printf.sprintf (f_ "Field '%s' is not set") nm)
- | No_printer nm ->
- Some
- (Printf.sprintf (f_ "No default printer for value %s") nm)
- | Unknown_field (nm, schm) ->
- Some
- (Printf.sprintf
- (f_ "Field %s is not defined in schema %s") nm schm)
- | _ ->
- None)
+ let current_dir_name = "."
- module Data =
- struct
- type t =
- (name, unit -> unit) Hashtbl.t
+ let parent_dir_name = ".."
- let create () =
- Hashtbl.create 13
- let clear t =
- Hashtbl.clear t
+ let is_current_dir fn =
+ fn = current_dir_name || fn = ""
-(* # 78 "src/oasis/PropList.ml" *)
- end
+ let concat f1 f2 =
+ if is_current_dir f1 then
+ f2
+ else
+ let f1' =
+ try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
+ in
+ f1'^"/"^f2
- module Schema =
- struct
- type ('ctxt, 'extra) value =
- {
- get: Data.t -> string;
- set: Data.t -> ?context:'ctxt -> string -> unit;
- help: (unit -> string) option;
- extra: 'extra;
- }
+ let make =
+ function
+ | hd :: tl ->
+ List.fold_left
+ (fun f p -> concat f p)
+ hd
+ tl
+ | [] ->
+ invalid_arg "OASISUnixPath.make"
- type ('ctxt, 'extra) t =
- {
- name: name;
- fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
- order: name Queue.t;
- name_norm: string -> string;
- }
- let create ?(case_insensitive=false) nm =
- {
- name = nm;
- fields = Hashtbl.create 13;
- order = Queue.create ();
- name_norm =
- (if case_insensitive then
- String.lowercase
- else
- fun s -> s);
- }
+ let dirname f =
+ try
+ String.sub f 0 (String.rindex f '/')
+ with Not_found ->
+ current_dir_name
- let add t nm set get extra help =
- let key =
- t.name_norm nm
- in
- if Hashtbl.mem t.fields key then
- failwith
- (Printf.sprintf
- (f_ "Field '%s' is already defined in schema '%s'")
- nm t.name);
- Hashtbl.add
- t.fields
- key
- {
- set = set;
- get = get;
- help = help;
- extra = extra;
- };
- Queue.add nm t.order
+ let basename f =
+ try
+ let pos_start =
+ (String.rindex f '/') + 1
+ in
+ String.sub f pos_start ((String.length f) - pos_start)
+ with Not_found ->
+ f
- let mem t nm =
- Hashtbl.mem t.fields nm
- let find t nm =
+ let chop_extension f =
+ try
+ let last_dot =
+ String.rindex f '.'
+ in
+ let sub =
+ String.sub f 0 last_dot
+ in
try
- Hashtbl.find t.fields (t.name_norm nm)
+ let last_slash =
+ String.rindex f '/'
+ in
+ if last_slash < last_dot then
+ sub
+ else
+ f
with Not_found ->
- raise (Unknown_field (nm, t.name))
+ sub
- let get t data nm =
- (find t nm).get data
+ with Not_found ->
+ f
- let set t data nm ?context x =
- (find t nm).set
- data
- ?context
- x
- let fold f acc t =
- Queue.fold
- (fun acc k ->
- let v =
- find t k
- in
- f acc k v.extra v.help)
- acc
- t.order
+ let capitalize_file f =
+ let dir = dirname f in
+ let base = basename f in
+ concat dir (OASISString.capitalize_ascii base)
- let iter f t =
- fold
- (fun () -> f)
- ()
- t
- let name t =
- t.name
- end
+ let uncapitalize_file f =
+ let dir = dirname f in
+ let base = basename f in
+ concat dir (OASISString.uncapitalize_ascii base)
- module Field =
- struct
- type ('ctxt, 'value, 'extra) t =
- {
- set: Data.t -> ?context:'ctxt -> 'value -> unit;
- get: Data.t -> 'value;
- sets: Data.t -> ?context:'ctxt -> string -> unit;
- gets: Data.t -> string;
- help: (unit -> string) option;
- extra: 'extra;
- }
+end
- let new_id =
- let last_id =
- ref 0
- in
- fun () -> incr last_id; !last_id
+module OASISHostPath = struct
+(* # 22 "src/oasis/OASISHostPath.ml" *)
- let create ?schema ?name ?parse ?print ?default ?update ?help extra =
- (* Default value container *)
- let v =
- ref None
- in
- (* If name is not given, create unique one *)
- let nm =
- match name with
- | Some s -> s
- | None -> Printf.sprintf "_anon_%d" (new_id ())
- in
+ open Filename
+ open OASISGettext
- (* Last chance to get a value: the default *)
- let default () =
- match default with
- | Some d -> d
- | None -> raise (Not_set (nm, Some (s_ "no default value")))
- in
- (* Get data *)
- let get data =
- (* Get value *)
- try
- (Hashtbl.find data nm) ();
- match !v with
- | Some x -> x
- | None -> default ()
- with Not_found ->
- default ()
- in
+ module Unix = OASISUnixPath
- (* Set data *)
- let set data ?context x =
- let x =
- match update with
- | Some f ->
- begin
- try
- f ?context (get data) x
- with Not_set _ ->
- x
- end
- | None ->
- x
- in
- Hashtbl.replace
- data
- nm
- (fun () -> v := Some x)
- in
- (* Parse string value, if possible *)
- let parse =
- match parse with
- | Some f ->
- f
- | None ->
- fun ?context s ->
- failwith
- (Printf.sprintf
- (f_ "Cannot parse field '%s' when setting value %S")
- nm
- s)
- in
+ let make =
+ function
+ | [] ->
+ invalid_arg "OASISHostPath.make"
+ | hd :: tl ->
+ List.fold_left Filename.concat hd tl
- (* Set data, from string *)
- let sets data ?context s =
- set ?context data (parse ?context s)
- in
- (* Output value as string, if possible *)
- let print =
- match print with
- | Some f ->
- f
- | None ->
- fun _ -> raise (No_printer nm)
- in
+ let of_unix ufn =
+ match Sys.os_type with
+ | "Unix" | "Cygwin" -> ufn
+ | "Win32" ->
+ make
+ (List.map
+ (fun p ->
+ if p = Unix.current_dir_name then
+ current_dir_name
+ else if p = Unix.parent_dir_name then
+ parent_dir_name
+ else
+ p)
+ (OASISString.nsplit ufn '/'))
+ | os_type ->
+ OASISUtils.failwithf
+ (f_ "Don't know the path format of os_type %S when translating unix \
+ filename. %S")
+ os_type ufn
- (* Get data, as a string *)
- let gets data =
- print (get data)
- in
- begin
- match schema with
- | Some t ->
- Schema.add t nm sets gets extra help
- | None ->
- ()
- end;
+end
- {
- set = set;
- get = get;
- sets = sets;
- gets = gets;
- help = help;
- extra = extra;
- }
+module OASISFileSystem = struct
+(* # 22 "src/oasis/OASISFileSystem.ml" *)
- let fset data t ?context x =
- t.set data ?context x
+ (** File System functions
- let fget data t =
- t.get data
+ @author Sylvain Le Gall
+ *)
- let fsets data t ?context s =
- t.sets data ?context s
+ type 'a filename = string
- let fgets data t =
- t.gets data
- end
+ class type closer =
+ object
+ method close: unit
+ end
+ class type reader =
+ object
+ inherit closer
+ method input: Buffer.t -> int -> unit
+ end
- module FieldRO =
- struct
- let create ?schema ?name ?parse ?print ?default ?update ?help extra =
- let fld =
- Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
- in
- fun data -> Field.fget data fld
- end
-end
+ class type writer =
+ object
+ inherit closer
+ method output: Buffer.t -> unit
+ end
-module OASISMessage = struct
-(* # 22 "src/oasis/OASISMessage.ml" *)
+ class type ['a] fs =
+ object
+ method string_of_filename: 'a filename -> string
+ method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer
+ method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader
+ method file_exists: 'a filename -> bool
+ method remove: 'a filename -> unit
+ end
- open OASISGettext
- open OASISContext
+ module Mode =
+ struct
+ let default_in = [Open_rdonly]
+ let default_out = [Open_wronly; Open_creat; Open_trunc]
+ let text_in = Open_text :: default_in
+ let text_out = Open_text :: default_out
- let generic_message ~ctxt lvl fmt =
- let cond =
- if ctxt.quiet then
- false
- else
- match lvl with
- | `Debug -> ctxt.debug
- | `Info -> ctxt.info
- | _ -> true
- in
- Printf.ksprintf
- (fun str ->
- if cond then
- begin
- ctxt.printf lvl str
- end)
- fmt
+ let binary_in = Open_binary :: default_in
+ let binary_out = Open_binary :: default_out
+ end
+ let std_length = 4096 (* Standard buffer/read length. *)
+ let binary_out = Mode.binary_out
+ let binary_in = Mode.binary_in
- let debug ~ctxt fmt =
- generic_message ~ctxt `Debug fmt
+ let of_unix_filename ufn = (ufn: 'a filename)
+ let to_unix_filename fn = (fn: string)
- let info ~ctxt fmt =
- generic_message ~ctxt `Info fmt
+ let defer_close o f =
+ try
+ let r = f o in o#close; r
+ with e ->
+ o#close; raise e
- let warning ~ctxt fmt =
- generic_message ~ctxt `Warning fmt
+ let stream_of_reader rdr =
+ let buf = Buffer.create std_length in
+ let pos = ref 0 in
+ let eof = ref false in
+ let rec next idx =
+ let bpos = idx - !pos in
+ if !eof then begin
+ None
+ end else if bpos < Buffer.length buf then begin
+ Some (Buffer.nth buf bpos)
+ end else begin
+ pos := !pos + Buffer.length buf;
+ Buffer.clear buf;
+ begin
+ try
+ rdr#input buf std_length;
+ with End_of_file ->
+ if Buffer.length buf = 0 then
+ eof := true
+ end;
+ next idx
+ end
+ in
+ Stream.from next
- let error ~ctxt fmt =
- generic_message ~ctxt `Error fmt
+ let read_all buf rdr =
+ try
+ while true do
+ rdr#input buf std_length
+ done
+ with End_of_file ->
+ ()
+
+ class ['a] host_fs rootdir : ['a] fs =
+ object (self)
+ method private host_filename fn = Filename.concat rootdir fn
+ method string_of_filename = self#host_filename
+
+ method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn =
+ let chn = open_out_gen mode perm (self#host_filename fn) in
+ object
+ method close = close_out chn
+ method output buf = Buffer.output_buffer chn buf
+ end
+
+ method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn =
+ (* TODO: use Buffer.add_channel when minimal version of OCaml will
+ * be >= 4.03.0 (previous version was discarding last chars).
+ *)
+ let chn = open_in_gen mode perm (self#host_filename fn) in
+ let strm = Stream.of_channel chn in
+ object
+ method close = close_in chn
+ method input buf len =
+ let read = ref 0 in
+ try
+ for _i = 0 to len do
+ Buffer.add_char buf (Stream.next strm);
+ incr read
+ done
+ with Stream.Failure ->
+ if !read = 0 then
+ raise End_of_file
+ end
+
+ method file_exists fn = Sys.file_exists (self#host_filename fn)
+ method remove fn = Sys.remove (self#host_filename fn)
+ end
end
-module OASISVersion = struct
-(* # 22 "src/oasis/OASISVersion.ml" *)
+module OASISContext = struct
+(* # 22 "src/oasis/OASISContext.ml" *)
open OASISGettext
+ type level =
+ [ `Debug
+ | `Info
+ | `Warning
+ | `Error]
+ type source
+ type source_filename = source OASISFileSystem.filename
- type s = string
+ let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn
- type t = string
+ type t =
+ {
+ (* TODO: replace this by a proplist. *)
+ quiet: bool;
+ info: bool;
+ debug: bool;
+ ignore_plugins: bool;
+ ignore_unknown_fields: bool;
+ printf: level -> string -> unit;
+ srcfs: source OASISFileSystem.fs;
+ load_oasis_plugin: string -> bool;
+ }
- type comparator =
- | VGreater of t
- | VGreaterEqual of t
- | VEqual of t
- | VLesser of t
- | VLesserEqual of t
- | VOr of comparator * comparator
- | VAnd of comparator * comparator
+ let printf lvl str =
+ let beg =
+ match lvl with
+ | `Error -> s_ "E: "
+ | `Warning -> s_ "W: "
+ | `Info -> s_ "I: "
+ | `Debug -> s_ "D: "
+ in
+ prerr_endline (beg^str)
- (* Range of allowed characters *)
- let is_digit c =
- '0' <= c && c <= '9'
+ let default =
+ ref
+ {
+ quiet = false;
+ info = false;
+ debug = false;
+ ignore_plugins = false;
+ ignore_unknown_fields = false;
+ printf = printf;
+ srcfs = new OASISFileSystem.host_fs(Sys.getcwd ());
+ load_oasis_plugin = (fun _ -> false);
+ }
- let is_alpha c =
- ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
+ let quiet =
+ {!default with quiet = true}
- let is_special =
- function
- | '.' | '+' | '-' | '~' -> true
- | _ -> false
+ let fspecs () =
+ (* TODO: don't act on default. *)
+ let ignore_plugins = ref false in
+ ["-quiet",
+ Arg.Unit (fun () -> default := {!default with quiet = true}),
+ s_ " Run quietly";
+ "-info",
+ Arg.Unit (fun () -> default := {!default with info = true}),
+ s_ " Display information message";
- let rec version_compare v1 v2 =
- if v1 <> "" || v2 <> "" then
- begin
- (* Compare ascii string, using special meaning for version
- * related char
- *)
- let val_ascii c =
- if c = '~' then -1
- else if is_digit c then 0
- else if c = '\000' then 0
- else if is_alpha c then Char.code c
- else (Char.code c) + 256
- in
- let len1 = String.length v1 in
- let len2 = String.length v2 in
+ "-debug",
+ Arg.Unit (fun () -> default := {!default with debug = true}),
+ s_ " Output debug message";
- let p = ref 0 in
+ "-ignore-plugins",
+ Arg.Set ignore_plugins,
+ s_ " Ignore plugin's field.";
- (** Compare ascii part *)
- let compare_vascii () =
- let cmp = ref 0 in
- while !cmp = 0 &&
- !p < len1 && !p < len2 &&
- not (is_digit v1.[!p] && is_digit v2.[!p]) do
- cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
- incr p
- done;
- if !cmp = 0 && !p < len1 && !p = len2 then
- val_ascii v1.[!p]
- else if !cmp = 0 && !p = len1 && !p < len2 then
- - (val_ascii v2.[!p])
- else
- !cmp
- in
+ "-C",
+ Arg.String
+ (fun str ->
+ Sys.chdir str;
+ default := {!default with srcfs = new OASISFileSystem.host_fs str}),
+ s_ "dir Change directory before running (affects setup.{data,log})."],
+ fun () -> {!default with ignore_plugins = !ignore_plugins}
+end
- (** Compare digit part *)
- let compare_digit () =
- let extract_int v p =
- let start_p = !p in
- while !p < String.length v && is_digit v.[!p] do
- incr p
- done;
- let substr =
- String.sub v !p ((String.length v) - !p)
- in
- let res =
- match String.sub v start_p (!p - start_p) with
- | "" -> 0
- | s -> int_of_string s
- in
- res, substr
- in
- let i1, tl1 = extract_int v1 (ref !p) in
- let i2, tl2 = extract_int v2 (ref !p) in
- i1 - i2, tl1, tl2
- in
+module PropList = struct
+(* # 22 "src/oasis/PropList.ml" *)
- match compare_vascii () with
- | 0 ->
- begin
- match compare_digit () with
- | 0, tl1, tl2 ->
- if tl1 <> "" && is_digit tl1.[0] then
- 1
- else if tl2 <> "" && is_digit tl2.[0] then
- -1
- else
- version_compare tl1 tl2
- | n, _, _ ->
- n
- end
- | n ->
- n
- end
- else
- begin
- 0
- end
+ open OASISGettext
- let version_of_string str = str
+ type name = string
- let string_of_version t = t
+ exception Not_set of name * string option
+ exception No_printer of name
+ exception Unknown_field of name * name
- let version_compare_string s1 s2 =
- version_compare (version_of_string s1) (version_of_string s2)
+ let () =
+ Printexc.register_printer
+ (function
+ | Not_set (nm, Some rsn) ->
+ Some
+ (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
+ | Not_set (nm, None) ->
+ Some
+ (Printf.sprintf (f_ "Field '%s' is not set") nm)
+ | No_printer nm ->
+ Some
+ (Printf.sprintf (f_ "No default printer for value %s") nm)
+ | Unknown_field (nm, schm) ->
+ Some
+ (Printf.sprintf
+ (f_ "Field %s is not defined in schema %s") nm schm)
+ | _ ->
+ None)
- let chop t =
- try
- let pos =
- String.rindex t '.'
- in
- String.sub t 0 pos
- with Not_found ->
- t
+ module Data =
+ struct
+ type t =
+ (name, unit -> unit) Hashtbl.t
- let rec comparator_apply v op =
- match op with
- | VGreater cv ->
- (version_compare v cv) > 0
- | VGreaterEqual cv ->
- (version_compare v cv) >= 0
- | VLesser cv ->
- (version_compare v cv) < 0
- | VLesserEqual cv ->
- (version_compare v cv) <= 0
- | VEqual cv ->
- (version_compare v cv) = 0
- | VOr (op1, op2) ->
- (comparator_apply v op1) || (comparator_apply v op2)
- | VAnd (op1, op2) ->
- (comparator_apply v op1) && (comparator_apply v op2)
+ let create () =
+ Hashtbl.create 13
+ let clear t =
+ Hashtbl.clear t
- let rec string_of_comparator =
- function
- | VGreater v -> "> "^(string_of_version v)
- | VEqual v -> "= "^(string_of_version v)
- | VLesser v -> "< "^(string_of_version v)
- | VGreaterEqual v -> ">= "^(string_of_version v)
- | VLesserEqual v -> "<= "^(string_of_version v)
- | VOr (c1, c2) ->
- (string_of_comparator c1)^" || "^(string_of_comparator c2)
- | VAnd (c1, c2) ->
- (string_of_comparator c1)^" && "^(string_of_comparator c2)
+(* # 77 "src/oasis/PropList.ml" *)
+ end
- let rec varname_of_comparator =
- let concat p v =
- OASISUtils.varname_concat
- p
- (OASISUtils.varname_of_string
- (string_of_version v))
- in
- function
- | VGreater v -> concat "gt" v
- | VLesser v -> concat "lt" v
- | VEqual v -> concat "eq" v
- | VGreaterEqual v -> concat "ge" v
- | VLesserEqual v -> concat "le" v
- | VOr (c1, c2) ->
- (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
- | VAnd (c1, c2) ->
- (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
+ module Schema =
+ struct
+ type ('ctxt, 'extra) value =
+ {
+ get: Data.t -> string;
+ set: Data.t -> ?context:'ctxt -> string -> unit;
+ help: (unit -> string) option;
+ extra: 'extra;
+ }
- let rec comparator_ge v' =
- let cmp v = version_compare v v' >= 0 in
- function
- | VEqual v
- | VGreaterEqual v
- | VGreater v -> cmp v
- | VLesserEqual _
- | VLesser _ -> false
- | VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2
- | VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2
+ type ('ctxt, 'extra) t =
+ {
+ name: name;
+ fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
+ order: name Queue.t;
+ name_norm: string -> string;
+ }
+ let create ?(case_insensitive=false) nm =
+ {
+ name = nm;
+ fields = Hashtbl.create 13;
+ order = Queue.create ();
+ name_norm =
+ (if case_insensitive then
+ OASISString.lowercase_ascii
+ else
+ fun s -> s);
+ }
-end
+ let add t nm set get extra help =
+ let key =
+ t.name_norm nm
+ in
-module OASISLicense = struct
-(* # 22 "src/oasis/OASISLicense.ml" *)
+ if Hashtbl.mem t.fields key then
+ failwith
+ (Printf.sprintf
+ (f_ "Field '%s' is already defined in schema '%s'")
+ nm t.name);
+ Hashtbl.add
+ t.fields
+ key
+ {
+ set = set;
+ get = get;
+ help = help;
+ extra = extra;
+ };
+ Queue.add nm t.order
+ let mem t nm =
+ Hashtbl.mem t.fields nm
- (** License for _oasis fields
- @author Sylvain Le Gall
- *)
+ let find t nm =
+ try
+ Hashtbl.find t.fields (t.name_norm nm)
+ with Not_found ->
+ raise (Unknown_field (nm, t.name))
+ let get t data nm =
+ (find t nm).get data
+ let set t data nm ?context x =
+ (find t nm).set
+ data
+ ?context
+ x
+ let fold f acc t =
+ Queue.fold
+ (fun acc k ->
+ let v =
+ find t k
+ in
+ f acc k v.extra v.help)
+ acc
+ t.order
+ let iter f t =
+ fold
+ (fun () -> f)
+ ()
+ t
- type license = string
+ let name t =
+ t.name
+ end
- type license_exception = string
+ module Field =
+ struct
+ type ('ctxt, 'value, 'extra) t =
+ {
+ set: Data.t -> ?context:'ctxt -> 'value -> unit;
+ get: Data.t -> 'value;
+ sets: Data.t -> ?context:'ctxt -> string -> unit;
+ gets: Data.t -> string;
+ help: (unit -> string) option;
+ extra: 'extra;
+ }
+ let new_id =
+ let last_id =
+ ref 0
+ in
+ fun () -> incr last_id; !last_id
- type license_version =
- | Version of OASISVersion.t
- | VersionOrLater of OASISVersion.t
- | NoVersion
+ let create ?schema ?name ?parse ?print ?default ?update ?help extra =
+ (* Default value container *)
+ let v =
+ ref None
+ in
+ (* If name is not given, create unique one *)
+ let nm =
+ match name with
+ | Some s -> s
+ | None -> Printf.sprintf "_anon_%d" (new_id ())
+ in
+ (* Last chance to get a value: the default *)
+ let default () =
+ match default with
+ | Some d -> d
+ | None -> raise (Not_set (nm, Some (s_ "no default value")))
+ in
- type license_dep_5_unit =
- {
- license: license;
- excption: license_exception option;
- version: license_version;
- }
+ (* Get data *)
+ let get data =
+ (* Get value *)
+ try
+ (Hashtbl.find data nm) ();
+ match !v with
+ | Some x -> x
+ | None -> default ()
+ with Not_found ->
+ default ()
+ in
+ (* Set data *)
+ let set data ?context x =
+ let x =
+ match update with
+ | Some f ->
+ begin
+ try
+ f ?context (get data) x
+ with Not_set _ ->
+ x
+ end
+ | None ->
+ x
+ in
+ Hashtbl.replace
+ data
+ nm
+ (fun () -> v := Some x)
+ in
+ (* Parse string value, if possible *)
+ let parse =
+ match parse with
+ | Some f ->
+ f
+ | None ->
+ fun ?context s ->
+ failwith
+ (Printf.sprintf
+ (f_ "Cannot parse field '%s' when setting value %S")
+ nm
+ s)
+ in
- type license_dep_5 =
- | DEP5Unit of license_dep_5_unit
- | DEP5Or of license_dep_5 list
- | DEP5And of license_dep_5 list
+ (* Set data, from string *)
+ let sets data ?context s =
+ set ?context data (parse ?context s)
+ in
+ (* Output value as string, if possible *)
+ let print =
+ match print with
+ | Some f ->
+ f
+ | None ->
+ fun _ -> raise (No_printer nm)
+ in
- type t =
- | DEP5License of license_dep_5
- | OtherLicense of string (* URL *)
+ (* Get data, as a string *)
+ let gets data =
+ print (get data)
+ in
+ begin
+ match schema with
+ | Some t ->
+ Schema.add t nm sets gets extra help
+ | None ->
+ ()
+ end;
+ {
+ set = set;
+ get = get;
+ sets = sets;
+ gets = gets;
+ help = help;
+ extra = extra;
+ }
-end
+ let fset data t ?context x =
+ t.set data ?context x
-module OASISExpr = struct
-(* # 22 "src/oasis/OASISExpr.ml" *)
+ let fget data t =
+ t.get data
+ let fsets data t ?context s =
+ t.sets data ?context s
+ let fgets data t =
+ t.gets data
+ end
+ module FieldRO =
+ struct
+ let create ?schema ?name ?parse ?print ?default ?update ?help extra =
+ let fld =
+ Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
+ in
+ fun data -> Field.fget data fld
+ end
+end
- open OASISGettext
+module OASISMessage = struct
+(* # 22 "src/oasis/OASISMessage.ml" *)
- type test = string
+ open OASISGettext
+ open OASISContext
+ let generic_message ~ctxt lvl fmt =
+ let cond =
+ if ctxt.quiet then
+ false
+ else
+ match lvl with
+ | `Debug -> ctxt.debug
+ | `Info -> ctxt.info
+ | _ -> true
+ in
+ Printf.ksprintf
+ (fun str ->
+ if cond then
+ begin
+ ctxt.printf lvl str
+ end)
+ fmt
+
+
+ let debug ~ctxt fmt =
+ generic_message ~ctxt `Debug fmt
+
+
+ let info ~ctxt fmt =
+ generic_message ~ctxt `Info fmt
+
+
+ let warning ~ctxt fmt =
+ generic_message ~ctxt `Warning fmt
+
+
+ let error ~ctxt fmt =
+ generic_message ~ctxt `Error fmt
+
+end
+
+module OASISVersion = struct
+(* # 22 "src/oasis/OASISVersion.ml" *)
+
+
+ open OASISGettext
+
+
+ type t = string
+
+
+ type comparator =
+ | VGreater of t
+ | VGreaterEqual of t
+ | VEqual of t
+ | VLesser of t
+ | VLesserEqual of t
+ | VOr of comparator * comparator
+ | VAnd of comparator * comparator
+
+
+ (* Range of allowed characters *)
+ let is_digit c = '0' <= c && c <= '9'
+ let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
+ let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false
+
+
+ let rec version_compare v1 v2 =
+ if v1 <> "" || v2 <> "" then
+ begin
+ (* Compare ascii string, using special meaning for version
+ * related char
+ *)
+ let val_ascii c =
+ if c = '~' then -1
+ else if is_digit c then 0
+ else if c = '\000' then 0
+ else if is_alpha c then Char.code c
+ else (Char.code c) + 256
+ in
+
+ let len1 = String.length v1 in
+ let len2 = String.length v2 in
+
+ let p = ref 0 in
+
+ (** Compare ascii part *)
+ let compare_vascii () =
+ let cmp = ref 0 in
+ while !cmp = 0 &&
+ !p < len1 && !p < len2 &&
+ not (is_digit v1.[!p] && is_digit v2.[!p]) do
+ cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
+ incr p
+ done;
+ if !cmp = 0 && !p < len1 && !p = len2 then
+ val_ascii v1.[!p]
+ else if !cmp = 0 && !p = len1 && !p < len2 then
+ - (val_ascii v2.[!p])
+ else
+ !cmp
+ in
+
+ (** Compare digit part *)
+ let compare_digit () =
+ let extract_int v p =
+ let start_p = !p in
+ while !p < String.length v && is_digit v.[!p] do
+ incr p
+ done;
+ let substr =
+ String.sub v !p ((String.length v) - !p)
+ in
+ let res =
+ match String.sub v start_p (!p - start_p) with
+ | "" -> 0
+ | s -> int_of_string s
+ in
+ res, substr
+ in
+ let i1, tl1 = extract_int v1 (ref !p) in
+ let i2, tl2 = extract_int v2 (ref !p) in
+ i1 - i2, tl1, tl2
+ in
+
+ match compare_vascii () with
+ | 0 ->
+ begin
+ match compare_digit () with
+ | 0, tl1, tl2 ->
+ if tl1 <> "" && is_digit tl1.[0] then
+ 1
+ else if tl2 <> "" && is_digit tl2.[0] then
+ -1
+ else
+ version_compare tl1 tl2
+ | n, _, _ ->
+ n
+ end
+ | n ->
+ n
+ end
+ else begin
+ 0
+ end
+
+
+ let version_of_string str = str
+
+
+ let string_of_version t = t
+
+
+ let chop t =
+ try
+ let pos =
+ String.rindex t '.'
+ in
+ String.sub t 0 pos
+ with Not_found ->
+ t
+
+
+ let rec comparator_apply v op =
+ match op with
+ | VGreater cv ->
+ (version_compare v cv) > 0
+ | VGreaterEqual cv ->
+ (version_compare v cv) >= 0
+ | VLesser cv ->
+ (version_compare v cv) < 0
+ | VLesserEqual cv ->
+ (version_compare v cv) <= 0
+ | VEqual cv ->
+ (version_compare v cv) = 0
+ | VOr (op1, op2) ->
+ (comparator_apply v op1) || (comparator_apply v op2)
+ | VAnd (op1, op2) ->
+ (comparator_apply v op1) && (comparator_apply v op2)
+
+
+ let rec string_of_comparator =
+ function
+ | VGreater v -> "> "^(string_of_version v)
+ | VEqual v -> "= "^(string_of_version v)
+ | VLesser v -> "< "^(string_of_version v)
+ | VGreaterEqual v -> ">= "^(string_of_version v)
+ | VLesserEqual v -> "<= "^(string_of_version v)
+ | VOr (c1, c2) ->
+ (string_of_comparator c1)^" || "^(string_of_comparator c2)
+ | VAnd (c1, c2) ->
+ (string_of_comparator c1)^" && "^(string_of_comparator c2)
+
+
+ let rec varname_of_comparator =
+ let concat p v =
+ OASISUtils.varname_concat
+ p
+ (OASISUtils.varname_of_string
+ (string_of_version v))
+ in
+ function
+ | VGreater v -> concat "gt" v
+ | VLesser v -> concat "lt" v
+ | VEqual v -> concat "eq" v
+ | VGreaterEqual v -> concat "ge" v
+ | VLesserEqual v -> concat "le" v
+ | VOr (c1, c2) ->
+ (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
+ | VAnd (c1, c2) ->
+ (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
+
+
+end
+
+module OASISLicense = struct
+(* # 22 "src/oasis/OASISLicense.ml" *)
+
+
+ (** License for _oasis fields
+ @author Sylvain Le Gall
+ *)
+
+
+ type license = string
+ type license_exception = string
+
+
+ type license_version =
+ | Version of OASISVersion.t
+ | VersionOrLater of OASISVersion.t
+ | NoVersion
+
+
+ type license_dep_5_unit =
+ {
+ license: license;
+ excption: license_exception option;
+ version: license_version;
+ }
+
+
+ type license_dep_5 =
+ | DEP5Unit of license_dep_5_unit
+ | DEP5Or of license_dep_5 list
+ | DEP5And of license_dep_5 list
+
+
+ type t =
+ | DEP5License of license_dep_5
+ | OtherLicense of string (* URL *)
+
+
+end
+
+module OASISExpr = struct
+(* # 22 "src/oasis/OASISExpr.ml" *)
+
+
+ open OASISGettext
+ open OASISUtils
+
+
+ type test = string
type flag = string
@@ -1004,7 +1285,6 @@
| ETest of test * string
-
type 'a choices = (t * 'a) list
@@ -1081,61 +1361,183 @@
module OASISText = struct
(* # 22 "src/oasis/OASISText.ml" *)
-
-
type elt =
| Para of string
| Verbatim of string
| BlankLine
-
type t = elt list
end
-module OASISTypes = struct
-(* # 22 "src/oasis/OASISTypes.ml" *)
+module OASISSourcePatterns = struct
+(* # 22 "src/oasis/OASISSourcePatterns.ml" *)
+ open OASISUtils
+ open OASISGettext
+ module Templater =
+ struct
+ (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *)
+ type t =
+ {
+ atoms: atom list;
+ origin: string
+ }
+ and atom =
+ | Text of string
+ | Expr of expr
+ and expr =
+ | Ident of string
+ | String of string
+ | Call of string * expr
+ type env =
+ {
+ variables: string MapString.t;
+ functions: (string -> string) MapString.t;
+ }
- type name = string
- type package_name = string
- type url = string
- type unix_dirname = string
- type unix_filename = string
- type host_dirname = string
- type host_filename = string
- type prog = string
- type arg = string
- type args = string list
- type command_line = (prog * arg list)
+ let eval env t =
+ let rec eval_expr env =
+ function
+ | String str -> str
+ | Ident nm ->
+ begin
+ try
+ MapString.find nm env.variables
+ with Not_found ->
+ (* TODO: add error location within the string. *)
+ failwithf
+ (f_ "Unable to find variable %S in source pattern %S")
+ nm t.origin
+ end
- type findlib_name = string
- type findlib_full = string
+ | Call (fn, expr) ->
+ begin
+ try
+ (MapString.find fn env.functions) (eval_expr env expr)
+ with Not_found ->
+ (* TODO: add error location within the string. *)
+ failwithf
+ (f_ "Unable to find function %S in source pattern %S")
+ fn t.origin
+ end
+ in
+ String.concat ""
+ (List.map
+ (function
+ | Text str -> str
+ | Expr expr -> eval_expr env expr)
+ t.atoms)
+
+
+ let parse env s =
+ let lxr = Genlex.make_lexer [] in
+ let parse_expr s =
+ let st = lxr (Stream.of_string s) in
+ match Stream.npeek 3 st with
+ | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm)
+ | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str)
+ | [Genlex.String str] -> String str
+ | [Genlex.Ident nm] -> Ident nm
+ (* TODO: add error location within the string. *)
+ | _ -> failwithf (f_ "Unable to parse expression %S") s
+ in
+ let parse s =
+ let lst_exprs = ref [] in
+ let ss =
+ let buff = Buffer.create (String.length s) in
+ Buffer.add_substitute
+ buff
+ (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000")
+ s;
+ Buffer.contents buff
+ in
+ let rec join =
+ function
+ | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2)
+ | [], tl -> List.map (fun e -> Expr e) tl
+ | tl, [] -> List.map (fun e -> Text e) tl
+ in
+ join (OASISString.nsplit ss '\000', List.rev (!lst_exprs))
+ in
+ let t = {atoms = parse s; origin = s} in
+ (* We rely on a simple evaluation for checking variables/functions.
+ It works because there is no if/loop statement.
+ *)
+ let _s : string = eval env t in
+ t
+(* # 144 "src/oasis/OASISSourcePatterns.ml" *)
+ end
- type compiled_object =
- | Byte
- | Native
- | Best
+ type t = Templater.t
- type dependency =
- | FindlibPackage of findlib_full * OASISVersion.comparator option
- | InternalLibrary of name
+ let env ~modul () =
+ {
+ Templater.
+ variables = MapString.of_list ["module", modul];
+ functions = MapString.of_list
+ [
+ "capitalize_file", OASISUnixPath.capitalize_file;
+ "uncapitalize_file", OASISUnixPath.uncapitalize_file;
+ ];
+ }
+
+ let all_possible_files lst ~path ~modul =
+ let eval = Templater.eval (env ~modul ()) in
+ List.fold_left
+ (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc)
+ [] lst
+
+
+ let to_string t = t.Templater.origin
+
+
+end
+
+module OASISTypes = struct
+(* # 22 "src/oasis/OASISTypes.ml" *)
+
+
+ type name = string
+ type package_name = string
+ type url = string
+ type unix_dirname = string
+ type unix_filename = string (* TODO: replace everywhere. *)
+ type host_dirname = string (* TODO: replace everywhere. *)
+ type host_filename = string (* TODO: replace everywhere. *)
+ type prog = string
+ type arg = string
+ type args = string list
+ type command_line = (prog * arg list)
+
+
+ type findlib_name = string
+ type findlib_full = string
+
+
+ type compiled_object =
+ | Byte
+ | Native
+ | Best
+ type dependency =
+ | FindlibPackage of findlib_full * OASISVersion.comparator option
+ | InternalLibrary of name
+
type tool =
| ExternalTool of name
| InternalExecutable of name
-
type vcs =
| Darcs
| Git
@@ -1148,30 +1550,29 @@
| OtherVCS of url
-
type plugin_kind =
- [ `Configure
- | `Build
- | `Doc
- | `Test
- | `Install
- | `Extra
- ]
+ [ `Configure
+ | `Build
+ | `Doc
+ | `Test
+ | `Install
+ | `Extra
+ ]
type plugin_data_purpose =
- [ `Configure
- | `Build
- | `Install
- | `Clean
- | `Distclean
- | `Install
- | `Uninstall
- | `Test
- | `Doc
- | `Extra
- | `Other of string
- ]
+ [ `Configure
+ | `Build
+ | `Install
+ | `Clean
+ | `Distclean
+ | `Install
+ | `Uninstall
+ | `Test
+ | `Doc
+ | `Extra
+ | `Other of string
+ ]
type 'a plugin = 'a * name * OASISVersion.t option
@@ -1183,129 +1584,128 @@
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
-(* # 115 "src/oasis/OASISTypes.ml" *)
-
-
type 'a conditional = 'a OASISExpr.choices
type custom =
- {
- pre_command: (command_line option) conditional;
- post_command: (command_line option) conditional;
- }
-
+ {
+ pre_command: (command_line option) conditional;
+ post_command: (command_line option) conditional;
+ }
type common_section =
- {
- cs_name: name;
- cs_data: PropList.Data.t;
- cs_plugin_data: plugin_data;
- }
-
+ {
+ cs_name: name;
+ cs_data: PropList.Data.t;
+ cs_plugin_data: plugin_data;
+ }
type build_section =
- {
- bs_build: bool conditional;
- bs_install: bool conditional;
- bs_path: unix_dirname;
- bs_compiled_object: compiled_object;
- bs_build_depends: dependency list;
- bs_build_tools: tool list;
- bs_c_sources: unix_filename list;
- bs_data_files: (unix_filename * unix_filename option) list;
- bs_ccopt: args conditional;
- bs_cclib: args conditional;
- bs_dlllib: args conditional;
- bs_dllpath: args conditional;
- bs_byteopt: args conditional;
- bs_nativeopt: args conditional;
- }
-
+ {
+ bs_build: bool conditional;
+ bs_install: bool conditional;
+ bs_path: unix_dirname;
+ bs_compiled_object: compiled_object;
+ bs_build_depends: dependency list;
+ bs_build_tools: tool list;
+ bs_interface_patterns: OASISSourcePatterns.t list;
+ bs_implementation_patterns: OASISSourcePatterns.t list;
+ bs_c_sources: unix_filename list;
+ bs_data_files: (unix_filename * unix_filename option) list;
+ bs_findlib_extra_files: unix_filename list;
+ bs_ccopt: args conditional;
+ bs_cclib: args conditional;
+ bs_dlllib: args conditional;
+ bs_dllpath: args conditional;
+ bs_byteopt: args conditional;
+ bs_nativeopt: args conditional;
+ }
type library =
- {
- lib_modules: string list;
- lib_pack: bool;
- lib_internal_modules: string list;
- lib_findlib_parent: findlib_name option;
- lib_findlib_name: findlib_name option;
- lib_findlib_containers: findlib_name list;
- }
+ {
+ lib_modules: string list;
+ lib_pack: bool;
+ lib_internal_modules: string list;
+ lib_findlib_parent: findlib_name option;
+ lib_findlib_name: findlib_name option;
+ lib_findlib_directory: unix_dirname option;
+ lib_findlib_containers: findlib_name list;
+ }
type object_ =
- {
- obj_modules: string list;
- obj_findlib_fullname: findlib_name list option;
- }
+ {
+ obj_modules: string list;
+ obj_findlib_fullname: findlib_name list option;
+ obj_findlib_directory: unix_dirname option;
+ }
type executable =
- {
- exec_custom: bool;
- exec_main_is: unix_filename;
- }
+ {
+ exec_custom: bool;
+ exec_main_is: unix_filename;
+ }
type flag =
- {
- flag_description: string option;
- flag_default: bool conditional;
- }
+ {
+ flag_description: string option;
+ flag_default: bool conditional;
+ }
type source_repository =
- {
- src_repo_type: vcs;
- src_repo_location: url;
- src_repo_browser: url option;
- src_repo_module: string option;
- src_repo_branch: string option;
- src_repo_tag: string option;
- src_repo_subdir: unix_filename option;
- }
+ {
+ src_repo_type: vcs;
+ src_repo_location: url;
+ src_repo_browser: url option;
+ src_repo_module: string option;
+ src_repo_branch: string option;
+ src_repo_tag: string option;
+ src_repo_subdir: unix_filename option;
+ }
type test =
- {
- test_type: [`Test] plugin;
- test_command: command_line conditional;
- test_custom: custom;
- test_working_directory: unix_filename option;
- test_run: bool conditional;
- test_tools: tool list;
- }
+ {
+ test_type: [`Test] plugin;
+ test_command: command_line conditional;
+ test_custom: custom;
+ test_working_directory: unix_filename option;
+ test_run: bool conditional;
+ test_tools: tool list;
+ }
type doc_format =
- | HTML of unix_filename
+ | HTML of unix_filename (* TODO: source filename. *)
| DocText
| PDF
| PostScript
- | Info of unix_filename
+ | Info of unix_filename (* TODO: source filename. *)
| DVI
| OtherDoc
-
type doc =
- {
- doc_type: [`Doc] plugin;
- doc_custom: custom;
- doc_build: bool conditional;
- doc_install: bool conditional;
- doc_install_dir: unix_filename;
- doc_title: string;
- doc_authors: string list;
- doc_abstract: string option;
- doc_format: doc_format;
- doc_data_files: (unix_filename * unix_filename option) list;
- doc_build_tools: tool list;
- }
+ {
+ doc_type: [`Doc] plugin;
+ doc_custom: custom;
+ doc_build: bool conditional;
+ doc_install: bool conditional;
+ doc_install_dir: unix_filename; (* TODO: dest filename ?. *)
+ doc_title: string;
+ doc_authors: string list;
+ doc_abstract: string option;
+ doc_format: doc_format;
+ (* TODO: src filename. *)
+ doc_data_files: (unix_filename * unix_filename option) list;
+ doc_build_tools: tool list;
+ }
type section =
@@ -1318,50 +1718,51 @@
| Doc of common_section * doc
-
type section_kind =
- [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
+ [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
type package =
- {
- oasis_version: OASISVersion.t;
- ocaml_version: OASISVersion.comparator option;
- findlib_version: OASISVersion.comparator option;
- alpha_features: string list;
- beta_features: string list;
- name: package_name;
- version: OASISVersion.t;
- license: OASISLicense.t;
- license_file: unix_filename option;
- copyrights: string list;
- maintainers: string list;
- authors: string list;
- homepage: url option;
- synopsis: string;
- description: OASISText.t option;
- categories: url list;
-
- conf_type: [`Configure] plugin;
- conf_custom: custom;
-
- build_type: [`Build] plugin;
- build_custom: custom;
-
- install_type: [`Install] plugin;
- install_custom: custom;
- uninstall_custom: custom;
-
- clean_custom: custom;
- distclean_custom: custom;
-
- files_ab: unix_filename list;
- sections: section list;
- plugins: [`Extra] plugin list;
- disable_oasis_section: unix_filename list;
- schema_data: PropList.Data.t;
- plugin_data: plugin_data;
- }
+ {
+ oasis_version: OASISVersion.t;
+ ocaml_version: OASISVersion.comparator option;
+ findlib_version: OASISVersion.comparator option;
+ alpha_features: string list;
+ beta_features: string list;
+ name: package_name;
+ version: OASISVersion.t;
+ license: OASISLicense.t;
+ license_file: unix_filename option; (* TODO: source filename. *)
+ copyrights: string list;
+ maintainers: string list;
+ authors: string list;
+ homepage: url option;
+ bugreports: url option;
+ synopsis: string;
+ description: OASISText.t option;
+ tags: string list;
+ categories: url list;
+
+ conf_type: [`Configure] plugin;
+ conf_custom: custom;
+
+ build_type: [`Build] plugin;
+ build_custom: custom;
+
+ install_type: [`Install] plugin;
+ install_custom: custom;
+ uninstall_custom: custom;
+
+ clean_custom: custom;
+ distclean_custom: custom;
+
+ files_ab: unix_filename list; (* TODO: source filename. *)
+ sections: section list;
+ plugins: [`Extra] plugin list;
+ disable_oasis_section: unix_filename list; (* TODO: source filename. *)
+ schema_data: PropList.Data.t;
+ plugin_data: plugin_data;
+ }
end
@@ -1377,19 +1778,19 @@
module MapPlugin =
Map.Make
(struct
- type t = plugin_kind * name
- let compare = Pervasives.compare
- end)
+ type t = plugin_kind * name
+ let compare = Pervasives.compare
+ end)
module Data =
struct
type t =
- {
- oasis_version: OASISVersion.t;
- plugin_versions: OASISVersion.t option MapPlugin.t;
- alpha_features: string list;
- beta_features: string list;
- }
+ {
+ oasis_version: OASISVersion.t;
+ plugin_versions: OASISVersion.t option MapPlugin.t;
+ alpha_features: string list;
+ beta_features: string list;
+ }
let create oasis_version alpha_features beta_features =
{
@@ -1407,10 +1808,10 @@
let add_plugin (plugin_kind, plugin_name, plugin_version) t =
{t with
- plugin_versions = MapPlugin.add
- (plugin_kind, plugin_name)
- plugin_version
- t.plugin_versions}
+ plugin_versions = MapPlugin.add
+ (plugin_kind, plugin_name)
+ plugin_version
+ t.plugin_versions}
let plugin_version plugin_kind plugin_name t =
MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
@@ -1419,17 +1820,17 @@
Printf.sprintf
"oasis_version: %s; alpha_features: %s; beta_features: %s; \
plugins_version: %s"
- (OASISVersion.string_of_version t.oasis_version)
+ (OASISVersion.string_of_version (t:t).oasis_version)
(String.concat ", " t.alpha_features)
(String.concat ", " t.beta_features)
(String.concat ", "
(MapPlugin.fold
(fun (_, plg) ver_opt acc ->
(plg^
- (match ver_opt with
- | Some v ->
- " "^(OASISVersion.string_of_version v)
- | None -> ""))
+ (match ver_opt with
+ | Some v ->
+ " "^(OASISVersion.string_of_version v)
+ | None -> ""))
:: acc)
t.plugin_versions []))
end
@@ -1444,24 +1845,24 @@
let string_of_stage =
function
- | Alpha -> "alpha"
- | Beta -> "beta"
+ | Alpha -> "alpha"
+ | Beta -> "beta"
let field_of_stage =
function
- | Alpha -> "AlphaFeatures"
- | Beta -> "BetaFeatures"
+ | Alpha -> "AlphaFeatures"
+ | Beta -> "BetaFeatures"
type publication = InDev of stage | SinceVersion of OASISVersion.t
type t =
- {
- name: string;
- plugin: all_plugin option;
- publication: publication;
- description: unit -> string;
- }
+ {
+ name: string;
+ plugin: all_plugin option;
+ publication: publication;
+ description: unit -> string;
+ }
(* TODO: mutex protect this. *)
let all_features = Hashtbl.create 13
@@ -1475,35 +1876,35 @@
let to_string t =
Printf.sprintf
"feature: %s; plugin: %s; publication: %s"
- t.name
+ (t:t).name
(match t.plugin with
- | None -> ""
- | Some (_, nm, _) -> nm)
+ | None -> ""
+ | Some (_, nm, _) -> nm)
(match t.publication with
- | InDev stage -> string_of_stage stage
- | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
+ | InDev stage -> string_of_stage stage
+ | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
let data_check t data origin =
let no_message = "no message" in
let check_feature features stage =
- let has_feature = List.mem t.name features in
+ let has_feature = List.mem (t:t).name features in
if not has_feature then
- match origin with
- | Field (fld, where) ->
- Some
- (Printf.sprintf
- (f_ "Field %s in %s is only available when feature %s \
- is in field %s.")
- fld where t.name (field_of_stage stage))
- | Section sct ->
- Some
- (Printf.sprintf
- (f_ "Section %s is only available when features %s \
- is in field %s.")
- sct t.name (field_of_stage stage))
- | NoOrigin ->
- Some no_message
+ match (origin:origin) with
+ | Field (fld, where) ->
+ Some
+ (Printf.sprintf
+ (f_ "Field %s in %s is only available when feature %s \
+ is in field %s.")
+ fld where t.name (field_of_stage stage))
+ | Section sct ->
+ Some
+ (Printf.sprintf
+ (f_ "Section %s is only available when features %s \
+ is in field %s.")
+ sct t.name (field_of_stage stage))
+ | NoOrigin ->
+ Some no_message
else
None
in
@@ -1513,132 +1914,128 @@
OASISVersion.comparator_apply
version (OASISVersion.VGreaterEqual min_version)
in
- Printf.ksprintf
- (fun str ->
- if version_is_good then
- None
- else
- Some str)
- fmt
+ Printf.ksprintf
+ (fun str -> if version_is_good then None else Some str)
+ fmt
in
match origin, t.plugin, t.publication with
- | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
- | _, _, InDev Beta -> check_feature data.Data.beta_features Beta
- | Field(fld, where), None, SinceVersion min_version ->
- version_is_good ~min_version data.Data.oasis_version
- (f_ "Field %s in %s is only valid since OASIS v%s, update \
- OASISFormat field from '%s' to '%s' after checking \
- OASIS changelog.")
- fld where (string_of_version min_version)
- (string_of_version data.Data.oasis_version)
- (string_of_version min_version)
+ | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
+ | _, _, InDev Beta -> check_feature data.Data.beta_features Beta
+ | Field(fld, where), None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version
+ (f_ "Field %s in %s is only valid since OASIS v%s, update \
+ OASISFormat field from '%s' to '%s' after checking \
+ OASIS changelog.")
+ fld where (string_of_version min_version)
+ (string_of_version data.Data.oasis_version)
+ (string_of_version min_version)
- | Field(fld, where), Some(plugin_knd, plugin_name, _),
- SinceVersion min_version ->
- begin
+ | Field(fld, where), Some(plugin_knd, plugin_name, _),
+ SinceVersion min_version ->
+ begin
+ try
+ let plugin_version_current =
try
- let plugin_version_current =
- try
- match Data.plugin_version plugin_knd plugin_name data with
- | Some ver -> ver
- | None ->
- failwithf
- (f_ "Field %s in %s is only valid for the OASIS \
- plugin %s since v%s, but no plugin version is \
- defined in the _oasis file, change '%s' to \
- '%s (%s)' in your _oasis file.")
- fld where plugin_name (string_of_version min_version)
- plugin_name
- plugin_name (string_of_version min_version)
- with Not_found ->
- failwithf
- (f_ "Field %s in %s is only valid when the OASIS plugin %s \
- is defined.")
- fld where plugin_name
- in
- version_is_good ~min_version plugin_version_current
- (f_ "Field %s in %s is only valid for the OASIS plugin %s \
- since v%s, update your plugin from '%s (%s)' to \
- '%s (%s)' after checking the plugin's changelog.")
- fld where plugin_name (string_of_version min_version)
- plugin_name (string_of_version plugin_version_current)
- plugin_name (string_of_version min_version)
- with Failure msg ->
- Some msg
- end
+ match Data.plugin_version plugin_knd plugin_name data with
+ | Some ver -> ver
+ | None ->
+ failwithf
+ (f_ "Field %s in %s is only valid for the OASIS \
+ plugin %s since v%s, but no plugin version is \
+ defined in the _oasis file, change '%s' to \
+ '%s (%s)' in your _oasis file.")
+ fld where plugin_name (string_of_version min_version)
+ plugin_name
+ plugin_name (string_of_version min_version)
+ with Not_found ->
+ failwithf
+ (f_ "Field %s in %s is only valid when the OASIS plugin %s \
+ is defined.")
+ fld where plugin_name
+ in
+ version_is_good ~min_version plugin_version_current
+ (f_ "Field %s in %s is only valid for the OASIS plugin %s \
+ since v%s, update your plugin from '%s (%s)' to \
+ '%s (%s)' after checking the plugin's changelog.")
+ fld where plugin_name (string_of_version min_version)
+ plugin_name (string_of_version plugin_version_current)
+ plugin_name (string_of_version min_version)
+ with Failure msg ->
+ Some msg
+ end
- | Section sct, None, SinceVersion min_version ->
- version_is_good ~min_version data.Data.oasis_version
- (f_ "Section %s is only valid for since OASIS v%s, update \
- OASISFormat field from '%s' to '%s' after checking OASIS \
- changelog.")
- sct (string_of_version min_version)
- (string_of_version data.Data.oasis_version)
- (string_of_version min_version)
+ | Section sct, None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version
+ (f_ "Section %s is only valid for since OASIS v%s, update \
+ OASISFormat field from '%s' to '%s' after checking OASIS \
+ changelog.")
+ sct (string_of_version min_version)
+ (string_of_version data.Data.oasis_version)
+ (string_of_version min_version)
- | Section sct, Some(plugin_knd, plugin_name, _),
- SinceVersion min_version ->
- begin
+ | Section sct, Some(plugin_knd, plugin_name, _),
+ SinceVersion min_version ->
+ begin
+ try
+ let plugin_version_current =
try
- let plugin_version_current =
- try
- match Data.plugin_version plugin_knd plugin_name data with
- | Some ver -> ver
- | None ->
- failwithf
- (f_ "Section %s is only valid for the OASIS \
- plugin %s since v%s, but no plugin version is \
- defined in the _oasis file, change '%s' to \
- '%s (%s)' in your _oasis file.")
- sct plugin_name (string_of_version min_version)
- plugin_name
- plugin_name (string_of_version min_version)
- with Not_found ->
- failwithf
- (f_ "Section %s is only valid when the OASIS plugin %s \
- is defined.")
- sct plugin_name
- in
- version_is_good ~min_version plugin_version_current
- (f_ "Section %s is only valid for the OASIS plugin %s \
- since v%s, update your plugin from '%s (%s)' to \
- '%s (%s)' after checking the plugin's changelog.")
- sct plugin_name (string_of_version min_version)
- plugin_name (string_of_version plugin_version_current)
- plugin_name (string_of_version min_version)
- with Failure msg ->
- Some msg
- end
+ match Data.plugin_version plugin_knd plugin_name data with
+ | Some ver -> ver
+ | None ->
+ failwithf
+ (f_ "Section %s is only valid for the OASIS \
+ plugin %s since v%s, but no plugin version is \
+ defined in the _oasis file, change '%s' to \
+ '%s (%s)' in your _oasis file.")
+ sct plugin_name (string_of_version min_version)
+ plugin_name
+ plugin_name (string_of_version min_version)
+ with Not_found ->
+ failwithf
+ (f_ "Section %s is only valid when the OASIS plugin %s \
+ is defined.")
+ sct plugin_name
+ in
+ version_is_good ~min_version plugin_version_current
+ (f_ "Section %s is only valid for the OASIS plugin %s \
+ since v%s, update your plugin from '%s (%s)' to \
+ '%s (%s)' after checking the plugin's changelog.")
+ sct plugin_name (string_of_version min_version)
+ plugin_name (string_of_version plugin_version_current)
+ plugin_name (string_of_version min_version)
+ with Failure msg ->
+ Some msg
+ end
- | NoOrigin, None, SinceVersion min_version ->
- version_is_good ~min_version data.Data.oasis_version "%s" no_message
+ | NoOrigin, None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version "%s" no_message
- | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
- begin
- try
- let plugin_version_current =
- match Data.plugin_version plugin_knd plugin_name data with
- | Some ver -> ver
- | None -> raise Not_found
- in
- version_is_good ~min_version plugin_version_current
- "%s" no_message
- with Not_found ->
- Some no_message
- end
+ | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
+ begin
+ try
+ let plugin_version_current =
+ match Data.plugin_version plugin_knd plugin_name data with
+ | Some ver -> ver
+ | None -> raise Not_found
+ in
+ version_is_good ~min_version plugin_version_current
+ "%s" no_message
+ with Not_found ->
+ Some no_message
+ end
let data_assert t data origin =
match data_check t data origin with
- | None -> ()
- | Some str -> failwith str
+ | None -> ()
+ | Some str -> failwith str
let data_test t data =
match data_check t data NoOrigin with
- | None -> true
- | Some str -> false
+ | None -> true
+ | Some _ -> false
let package_test t pkg =
@@ -1658,8 +2055,8 @@
description = description;
}
in
- Hashtbl.add all_features name t;
- t
+ Hashtbl.add all_features name t;
+ t
let get_stage name =
@@ -1688,14 +2085,14 @@
create "flag_docs"
(since_version "0.3")
(fun () ->
- s_ "Building docs require '-docs' flag at configure.")
+ s_ "Make building docs require '-docs' flag at configure.")
let flag_tests =
create "flag_tests"
(since_version "0.3")
(fun () ->
- s_ "Running tests require '-tests' flag at configure.")
+ s_ "Make running tests require '-tests' flag at configure.")
let pack =
@@ -1720,13 +2117,13 @@
let compiled_setup_ml =
create "compiled_setup_ml" alpha
(fun () ->
- s_ "It compiles the setup.ml and speed-up actions done with it.")
+ s_ "Compile the setup.ml and speed-up actions done with it.")
let disable_oasis_section =
create "disable_oasis_section" alpha
(fun () ->
- s_ "Allows the OASIS section comments and digest to be omitted in \
- generated files.")
+ s_ "Allow the OASIS section comments and digests to be omitted in \
+ generated files.")
let no_automatic_syntax =
create "no_automatic_syntax" alpha
@@ -1734,236 +2131,146 @@
s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
that matches the internal heuristic (if a dependency ends with \
a .syntax or is a well known syntax).")
-end
-module OASISUnixPath = struct
-(* # 22 "src/oasis/OASISUnixPath.ml" *)
+ let findlib_directory =
+ create "findlib_directory" beta
+ (fun () ->
+ s_ "Allow to install findlib libraries in sub-directories of the target \
+ findlib directory.")
+ let findlib_extra_files =
+ create "findlib_extra_files" beta
+ (fun () ->
+ s_ "Allow to install extra files for findlib libraries.")
- type unix_filename = string
- type unix_dirname = string
+ let source_patterns =
+ create "source_patterns" alpha
+ (fun () ->
+ s_ "Customize mapping between module name and source file.")
+end
+module OASISSection = struct
+(* # 22 "src/oasis/OASISSection.ml" *)
- type host_filename = string
- type host_dirname = string
+ open OASISTypes
- let current_dir_name = "."
+ let section_kind_common =
+ function
+ | Library (cs, _, _) ->
+ `Library, cs
+ | Object (cs, _, _) ->
+ `Object, cs
+ | Executable (cs, _, _) ->
+ `Executable, cs
+ | Flag (cs, _) ->
+ `Flag, cs
+ | SrcRepo (cs, _) ->
+ `SrcRepo, cs
+ | Test (cs, _) ->
+ `Test, cs
+ | Doc (cs, _) ->
+ `Doc, cs
- let parent_dir_name = ".."
+ let section_common sct =
+ snd (section_kind_common sct)
- let is_current_dir fn =
- fn = current_dir_name || fn = ""
+ let section_common_set cs =
+ function
+ | Library (_, bs, lib) -> Library (cs, bs, lib)
+ | Object (_, bs, obj) -> Object (cs, bs, obj)
+ | Executable (_, bs, exec) -> Executable (cs, bs, exec)
+ | Flag (_, flg) -> Flag (cs, flg)
+ | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
+ | Test (_, tst) -> Test (cs, tst)
+ | Doc (_, doc) -> Doc (cs, doc)
- let concat f1 f2 =
- if is_current_dir f1 then
- f2
- else
- let f1' =
- try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
- in
- f1'^"/"^f2
+ (** Key used to identify section
+ *)
+ let section_id sct =
+ let k, cs =
+ section_kind_common sct
+ in
+ k, cs.cs_name
- let make =
+
+ let string_of_section_kind =
function
- | hd :: tl ->
- List.fold_left
- (fun f p -> concat f p)
- hd
- tl
- | [] ->
- invalid_arg "OASISUnixPath.make"
+ | `Library -> "library"
+ | `Object -> "object"
+ | `Executable -> "executable"
+ | `Flag -> "flag"
+ | `SrcRepo -> "src repository"
+ | `Test -> "test"
+ | `Doc -> "doc"
- let dirname f =
- try
- String.sub f 0 (String.rindex f '/')
- with Not_found ->
- current_dir_name
+ let string_of_section sct =
+ let k, nm = section_id sct in
+ (string_of_section_kind k)^" "^nm
- let basename f =
- try
- let pos_start =
- (String.rindex f '/') + 1
- in
- String.sub f pos_start ((String.length f) - pos_start)
- with Not_found ->
- f
+ let section_find id scts =
+ List.find
+ (fun sct -> id = section_id sct)
+ scts
- let chop_extension f =
- try
- let last_dot =
- String.rindex f '.'
- in
- let sub =
- String.sub f 0 last_dot
- in
- try
- let last_slash =
- String.rindex f '/'
- in
- if last_slash < last_dot then
- sub
- else
- f
- with Not_found ->
- sub
+ module CSection =
+ struct
+ type t = section
- with Not_found ->
- f
+ let id = section_id
+
+ let compare t1 t2 =
+ compare (id t1) (id t2)
+ let equal t1 t2 =
+ (id t1) = (id t2)
- let capitalize_file f =
- let dir = dirname f in
- let base = basename f in
- concat dir (String.capitalize base)
+ let hash t =
+ Hashtbl.hash (id t)
+ end
- let uncapitalize_file f =
- let dir = dirname f in
- let base = basename f in
- concat dir (String.uncapitalize base)
+ module MapSection = Map.Make(CSection)
+ module SetSection = Set.Make(CSection)
end
-module OASISHostPath = struct
-(* # 22 "src/oasis/OASISHostPath.ml" *)
-
-
- open Filename
-
-
- module Unix = OASISUnixPath
-
-
- let make =
- function
- | [] ->
- invalid_arg "OASISHostPath.make"
- | hd :: tl ->
- List.fold_left Filename.concat hd tl
-
-
- let of_unix ufn =
- if Sys.os_type = "Unix" then
- ufn
- else
- make
- (List.map
- (fun p ->
- if p = Unix.current_dir_name then
- current_dir_name
- else if p = Unix.parent_dir_name then
- parent_dir_name
- else
- p)
- (OASISString.nsplit ufn '/'))
-
-
-end
-
-module OASISSection = struct
-(* # 22 "src/oasis/OASISSection.ml" *)
-
+module OASISBuildSection = struct
+(* # 22 "src/oasis/OASISBuildSection.ml" *)
open OASISTypes
-
- let section_kind_common =
- function
- | Library (cs, _, _) ->
- `Library, cs
- | Object (cs, _, _) ->
- `Object, cs
- | Executable (cs, _, _) ->
- `Executable, cs
- | Flag (cs, _) ->
- `Flag, cs
- | SrcRepo (cs, _) ->
- `SrcRepo, cs
- | Test (cs, _) ->
- `Test, cs
- | Doc (cs, _) ->
- `Doc, cs
-
-
- let section_common sct =
- snd (section_kind_common sct)
-
-
- let section_common_set cs =
- function
- | Library (_, bs, lib) -> Library (cs, bs, lib)
- | Object (_, bs, obj) -> Object (cs, bs, obj)
- | Executable (_, bs, exec) -> Executable (cs, bs, exec)
- | Flag (_, flg) -> Flag (cs, flg)
- | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
- | Test (_, tst) -> Test (cs, tst)
- | Doc (_, doc) -> Doc (cs, doc)
-
-
- (** Key used to identify section
- *)
- let section_id sct =
- let k, cs =
- section_kind_common sct
- in
- k, cs.cs_name
-
-
- let string_of_section sct =
- let k, nm =
- section_id sct
- in
- (match k with
- | `Library -> "library"
- | `Object -> "object"
- | `Executable -> "executable"
- | `Flag -> "flag"
- | `SrcRepo -> "src repository"
- | `Test -> "test"
- | `Doc -> "doc")
- ^" "^nm
-
-
- let section_find id scts =
- List.find
- (fun sct -> id = section_id sct)
- scts
-
-
- module CSection =
- struct
- type t = section
-
- let id = section_id
-
- let compare t1 t2 =
- compare (id t1) (id t2)
-
- let equal t1 t2 =
- (id t1) = (id t2)
-
- let hash t =
- Hashtbl.hash (id t)
- end
-
-
- module MapSection = Map.Make(CSection)
- module SetSection = Set.Make(CSection)
-
-
-end
-
-module OASISBuildSection = struct
-(* # 22 "src/oasis/OASISBuildSection.ml" *)
+ (* Look for a module file, considering capitalization or not. *)
+ let find_module source_file_exists bs modul =
+ let possible_lst =
+ OASISSourcePatterns.all_possible_files
+ (bs.bs_interface_patterns @ bs.bs_implementation_patterns)
+ ~path:bs.bs_path
+ ~modul
+ in
+ match List.filter source_file_exists possible_lst with
+ | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst)
+ | [] ->
+ let open OASISUtils in
+ let _, rev_lst =
+ List.fold_left
+ (fun (set, acc) fn ->
+ let base_fn = OASISUnixPath.chop_extension fn in
+ if SetString.mem base_fn set then
+ set, acc
+ else
+ SetString.add base_fn set, base_fn :: acc)
+ (SetString.empty, []) possible_lst
+ in
+ `No_sources (List.rev rev_lst)
end
@@ -1988,16 +2295,16 @@
| Byte -> false
in
- OASISUnixPath.concat
- dir
- (cs.cs_name^(suffix_program ())),
-
- if not is_native_exec &&
- not exec.exec_custom &&
- bs.bs_c_sources <> [] then
- Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
- else
- None
+ OASISUnixPath.concat
+ dir
+ (cs.cs_name^(suffix_program ())),
+
+ if not is_native_exec &&
+ not exec.exec_custom &&
+ bs.bs_c_sources <> [] then
+ Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
+ else
+ None
end
@@ -2007,99 +2314,57 @@
open OASISTypes
- open OASISUtils
open OASISGettext
- open OASISSection
-
-
- (* Look for a module file, considering capitalization or not. *)
- let find_module source_file_exists bs modul =
- let possible_base_fn =
- List.map
- (OASISUnixPath.concat bs.bs_path)
- [modul;
- OASISUnixPath.uncapitalize_file modul;
- OASISUnixPath.capitalize_file modul]
- in
- (* TODO: we should be able to be able to determine the source for every
- * files. Hence we should introduce a Module(source: fn) for the fields
- * Modules and InternalModules
- *)
- List.fold_left
- (fun acc base_fn ->
- match acc with
- | `No_sources _ ->
- begin
- let file_found =
- List.fold_left
- (fun acc ext ->
- if source_file_exists (base_fn^ext) then
- (base_fn^ext) :: acc
- else
- acc)
- []
- [".ml"; ".mli"; ".mll"; ".mly"]
- in
- match file_found with
- | [] ->
- acc
- | lst ->
- `Sources (base_fn, lst)
- end
- | `Sources _ ->
- acc)
- (`No_sources possible_base_fn)
- possible_base_fn
+ let find_module ~ctxt source_file_exists cs bs modul =
+ match OASISBuildSection.find_module source_file_exists bs modul with
+ | `Sources _ as res -> res
+ | `No_sources _ as res ->
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Cannot find source file matching module '%s' in library %s.")
+ modul cs.cs_name;
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Use InterfacePatterns or ImplementationPatterns to define \
+ this file with feature %S.")
+ (OASISFeatures.source_patterns.OASISFeatures.name);
+ res
let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
List.fold_left
(fun acc modul ->
- match find_module source_file_exists bs modul with
- | `Sources (base_fn, lst) ->
- (base_fn, lst) :: acc
- | `No_sources _ ->
- OASISMessage.warning
- ~ctxt
- (f_ "Cannot find source file matching \
- module '%s' in library %s")
- modul cs.cs_name;
- acc)
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
+ | `No_sources _ -> acc)
[]
(lib.lib_modules @ lib.lib_internal_modules)
let generated_unix_files
- ~ctxt
- ~is_native
- ~has_native_dynlink
- ~ext_lib
- ~ext_dll
- ~source_file_exists
- (cs, bs, lib) =
+ ~ctxt
+ ~is_native
+ ~has_native_dynlink
+ ~ext_lib
+ ~ext_dll
+ ~source_file_exists
+ (cs, bs, lib) =
let find_modules lst ext =
let find_module modul =
- match find_module source_file_exists bs modul with
- | `Sources (base_fn, [fn]) when ext <> "cmi"
- && Filename.check_suffix fn ".mli" ->
- None (* No implementation files for pure interface. *)
- | `Sources (base_fn, _) ->
- Some [base_fn]
- | `No_sources lst ->
- OASISMessage.warning
- ~ctxt
- (f_ "Cannot find source file matching \
- module '%s' in library %s")
- modul cs.cs_name;
- Some lst
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (_, [fn]) when ext <> "cmi"
+ && Filename.check_suffix fn ".mli" ->
+ None (* No implementation files for pure interface. *)
+ | `Sources (base_fn, _) -> Some [base_fn]
+ | `No_sources lst -> Some lst
in
List.fold_left
(fun acc nm ->
- match find_module nm with
- | None -> acc
- | Some base_fns ->
- List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
+ match find_module nm with
+ | None -> acc
+ | Some base_fns ->
+ List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
[]
lst
in
@@ -2108,21 +2373,21 @@
let cmxs =
let should_be_built =
match bs.bs_compiled_object with
- | Native -> true
- | Best -> is_native
- | Byte -> false
- in
- if should_be_built then
- if lib.lib_pack then
- find_modules
- [cs.cs_name]
- "cmx"
- else
- find_modules
- (lib.lib_modules @ lib.lib_internal_modules)
- "cmx"
+ | Native -> true
+ | Best -> is_native
+ | Byte -> false
+ in
+ if should_be_built then
+ if lib.lib_pack then
+ find_modules
+ [cs.cs_name]
+ "cmx"
else
- []
+ find_modules
+ (lib.lib_modules @ lib.lib_internal_modules)
+ "cmx"
+ else
+ []
in
let acc_nopath =
@@ -2137,15 +2402,12 @@
else [".cmi"; ".cmti"; ".cmt"; ".annot"]
in
List.map
- begin
- List.fold_left
- begin fun accu s ->
+ (List.fold_left
+ (fun accu s ->
let dot = String.rindex s '.' in
let base = String.sub s 0 dot in
- List.map ((^) base) sufx @ accu
- end
- []
- end
+ List.map ((^) base) sufx @ accu)
+ [])
(find_modules lib.lib_modules "cmi")
in
@@ -2168,38 +2430,35 @@
[cs.cs_name^".cmxs"] :: acc
else acc)
in
- [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
+ [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
in
- match bs.bs_compiled_object with
- | Native ->
- byte (native acc_nopath)
- | Best when is_native ->
- byte (native acc_nopath)
- | Byte | Best ->
- byte acc_nopath
+ match bs.bs_compiled_object with
+ | Native -> byte (native acc_nopath)
+ | Best when is_native -> byte (native acc_nopath)
+ | Byte | Best -> byte acc_nopath
in
(* Add C library to be built *)
let acc_nopath =
- if bs.bs_c_sources <> [] then
- begin
- ["lib"^cs.cs_name^"_stubs"^ext_lib]
- ::
- ["dll"^cs.cs_name^"_stubs"^ext_dll]
- ::
+ if bs.bs_c_sources <> [] then begin
+ ["lib"^cs.cs_name^"_stubs"^ext_lib]
+ ::
+ if has_native_dynlink then
+ ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath
+ else
acc_nopath
- end
- else
+ end else begin
acc_nopath
+ end
in
- (* All the files generated *)
- List.rev_append
- (List.rev_map
- (List.rev_map
- (OASISUnixPath.concat bs.bs_path))
- acc_nopath)
- (headers @ cmxs)
+ (* All the files generated *)
+ List.rev_append
+ (List.rev_map
+ (List.rev_map
+ (OASISUnixPath.concat bs.bs_path))
+ acc_nopath)
+ (headers @ cmxs)
end
@@ -2212,62 +2471,64 @@
open OASISGettext
+ let find_module ~ctxt source_file_exists cs bs modul =
+ match OASISBuildSection.find_module source_file_exists bs modul with
+ | `Sources _ as res -> res
+ | `No_sources _ as res ->
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Cannot find source file matching module '%s' in object %s.")
+ modul cs.cs_name;
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Use InterfacePatterns or ImplementationPatterns to define \
+ this file with feature %S.")
+ (OASISFeatures.source_patterns.OASISFeatures.name);
+ res
+
let source_unix_files ~ctxt (cs, bs, obj) source_file_exists =
List.fold_left
(fun acc modul ->
- match OASISLibrary.find_module source_file_exists bs modul with
- | `Sources (base_fn, lst) ->
- (base_fn, lst) :: acc
- | `No_sources _ ->
- OASISMessage.warning
- ~ctxt
- (f_ "Cannot find source file matching \
- module '%s' in object %s")
- modul cs.cs_name;
- acc)
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
+ | `No_sources _ -> acc)
[]
obj.obj_modules
let generated_unix_files
- ~ctxt
- ~is_native
- ~source_file_exists
- (cs, bs, obj) =
+ ~ctxt
+ ~is_native
+ ~source_file_exists
+ (cs, bs, obj) =
let find_module ext modul =
- match OASISLibrary.find_module source_file_exists bs modul with
- | `Sources (base_fn, _) -> [base_fn ^ ext]
- | `No_sources lst ->
- OASISMessage.warning
- ~ctxt
- (f_ "Cannot find source file matching \
- module '%s' in object %s")
- modul cs.cs_name ;
- lst
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (base_fn, _) -> [base_fn ^ ext]
+ | `No_sources lst -> lst
in
let header, byte, native, c_object, f =
match obj.obj_modules with
| [ m ] -> (find_module ".cmi" m,
- find_module ".cmo" m,
- find_module ".cmx" m,
- find_module ".o" m,
- fun x -> x)
+ find_module ".cmo" m,
+ find_module ".cmx" m,
+ find_module ".o" m,
+ fun x -> x)
| _ -> ([cs.cs_name ^ ".cmi"],
- [cs.cs_name ^ ".cmo"],
- [cs.cs_name ^ ".cmx"],
- [cs.cs_name ^ ".o"],
- OASISUnixPath.concat bs.bs_path)
+ [cs.cs_name ^ ".cmo"],
+ [cs.cs_name ^ ".cmx"],
+ [cs.cs_name ^ ".o"],
+ OASISUnixPath.concat bs.bs_path)
in
- List.map (List.map f) (
- match bs.bs_compiled_object with
- | Native ->
- native :: c_object :: byte :: header :: []
- | Best when is_native ->
- native :: c_object :: byte :: header :: []
- | Byte | Best ->
- byte :: header :: [])
+ List.map (List.map f) (
+ match bs.bs_compiled_object with
+ | Native ->
+ native :: c_object :: byte :: header :: []
+ | Best when is_native ->
+ native :: c_object :: byte :: header :: []
+ | Byte | Best ->
+ byte :: header :: [])
end
@@ -2279,7 +2540,6 @@
open OASISTypes
open OASISUtils
open OASISGettext
- open OASISSection
type library_name = name
@@ -2297,12 +2557,13 @@
common_section *
build_section *
[`Library of library | `Object of object_] *
+ unix_dirname option *
group_t list)
type data = common_section *
- build_section *
- [`Library of library | `Object of object_]
+ build_section *
+ [`Library of library | `Object of object_]
type tree =
| Node of (data option) * (tree MapString.t)
| Leaf of data
@@ -2320,53 +2581,53 @@
let name =
String.concat "." (lib.lib_findlib_containers @ [name])
in
- name
+ name
in
- List.fold_left
- (fun mp ->
- function
- | Library (cs, _, lib) ->
- begin
- let lib_name = cs.cs_name in
- let fndlb_parts = fndlb_parts cs lib in
- if MapString.mem lib_name mp then
- failwithf
- (f_ "The library name '%s' is used more than once.")
- lib_name;
- match lib.lib_findlib_parent with
- | Some lib_name_parent ->
- MapString.add
- lib_name
- (`Unsolved (lib_name_parent, fndlb_parts))
- mp
- | None ->
- MapString.add
- lib_name
- (`Solved fndlb_parts)
- mp
- end
-
- | Object (cs, _, obj) ->
- begin
- let obj_name = cs.cs_name in
- if MapString.mem obj_name mp then
- failwithf
- (f_ "The object name '%s' is used more than once.")
- obj_name;
- let findlib_full_name = match obj.obj_findlib_fullname with
- | Some ns -> String.concat "." ns
- | None -> obj_name
- in
+ List.fold_left
+ (fun mp ->
+ function
+ | Library (cs, _, lib) ->
+ begin
+ let lib_name = cs.cs_name in
+ let fndlb_parts = fndlb_parts cs lib in
+ if MapString.mem lib_name mp then
+ failwithf
+ (f_ "The library name '%s' is used more than once.")
+ lib_name;
+ match lib.lib_findlib_parent with
+ | Some lib_name_parent ->
MapString.add
- obj_name
- (`Solved findlib_full_name)
+ lib_name
+ (`Unsolved (lib_name_parent, fndlb_parts))
mp
- end
+ | None ->
+ MapString.add
+ lib_name
+ (`Solved fndlb_parts)
+ mp
+ end
- | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
- mp)
- MapString.empty
- pkg.sections
+ | Object (cs, _, obj) ->
+ begin
+ let obj_name = cs.cs_name in
+ if MapString.mem obj_name mp then
+ failwithf
+ (f_ "The object name '%s' is used more than once.")
+ obj_name;
+ let findlib_full_name = match obj.obj_findlib_fullname with
+ | Some ns -> String.concat "." ns
+ | None -> obj_name
+ in
+ MapString.add
+ obj_name
+ (`Solved findlib_full_name)
+ mp
+ end
+
+ | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
+ mp)
+ MapString.empty
+ pkg.sections
in
(* Solve the above graph to be only library name to full findlib name. *)
@@ -2378,40 +2639,40 @@
with regard to findlib naming.")
lib_name;
let visited = SetString.add lib_name visited in
- try
- match MapString.find lib_name mp with
- | `Solved fndlb_nm ->
- fndlb_nm, mp
- | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
- let pre_fndlb_nm, mp =
- solve visited mp lib_nm_parent lib_name
- in
- let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
- fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
- with Not_found ->
- failwithf
- (f_ "Library '%s', which is defined as the findlib parent of \
- library '%s', doesn't exist.")
- lib_name lib_name_child
+ try
+ match MapString.find lib_name mp with
+ | `Solved fndlb_nm ->
+ fndlb_nm, mp
+ | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
+ let pre_fndlb_nm, mp =
+ solve visited mp lib_nm_parent lib_name
+ in
+ let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
+ fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
+ with Not_found ->
+ failwithf
+ (f_ "Library '%s', which is defined as the findlib parent of \
+ library '%s', doesn't exist.")
+ lib_name lib_name_child
in
let mp =
MapString.fold
(fun lib_name status mp ->
match status with
| `Solved _ ->
- (* Solved initialy, no need to go further *)
- mp
+ (* Solved initialy, no need to go further *)
+ mp
| `Unsolved _ ->
- let _, mp = solve SetString.empty mp lib_name "" in
- mp)
+ let _, mp = solve SetString.empty mp lib_name "" in
+ mp)
fndlb_parts_of_lib_name
fndlb_parts_of_lib_name
in
- MapString.map
- (function
- | `Solved fndlb_nm -> fndlb_nm
- | `Unsolved _ -> assert false)
- mp
+ MapString.map
+ (function
+ | `Solved fndlb_nm -> fndlb_nm
+ | `Unsolved _ -> assert false)
+ mp
in
(* Convert an internal library name to a findlib name. *)
@@ -2423,75 +2684,89 @@
in
(* Add a library to the tree.
- *)
+ *)
let add sct mp =
let fndlb_fullname =
let cs, _, _ = sct in
let lib_name = cs.cs_name in
- findlib_name_of_library_name lib_name
+ findlib_name_of_library_name lib_name
in
let rec add_children nm_lst (children: tree MapString.t) =
match nm_lst with
| (hd :: tl) ->
- begin
- let node =
- try
- add_node tl (MapString.find hd children)
- with Not_found ->
- (* New node *)
- new_node tl
- in
- MapString.add hd node children
- end
+ begin
+ let node =
+ try
+ add_node tl (MapString.find hd children)
+ with Not_found ->
+ (* New node *)
+ new_node tl
+ in
+ MapString.add hd node children
+ end
| [] ->
- (* Should not have a nameless library. *)
- assert false
+ (* Should not have a nameless library. *)
+ assert false
and add_node tl node =
if tl = [] then
begin
match node with
| Node (None, children) ->
- Node (Some sct, children)
+ Node (Some sct, children)
| Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
- (* TODO: allow to merge Package, i.e.
- * archive(byte) = "foo.cma foo_init.cmo"
- *)
- let cs, _, _ = sct in
- failwithf
- (f_ "Library '%s' and '%s' have the same findlib name '%s'")
- cs.cs_name cs'.cs_name fndlb_fullname
+ (* TODO: allow to merge Package, i.e.
+ * archive(byte) = "foo.cma foo_init.cmo"
+ *)
+ let cs, _, _ = sct in
+ failwithf
+ (f_ "Library '%s' and '%s' have the same findlib name '%s'")
+ cs.cs_name cs'.cs_name fndlb_fullname
end
else
begin
match node with
| Leaf data ->
- Node (Some data, add_children tl MapString.empty)
+ Node (Some data, add_children tl MapString.empty)
| Node (data_opt, children) ->
- Node (data_opt, add_children tl children)
+ Node (data_opt, add_children tl children)
end
and new_node =
function
| [] ->
- Leaf sct
+ Leaf sct
| hd :: tl ->
- Node (None, MapString.add hd (new_node tl) MapString.empty)
+ Node (None, MapString.add hd (new_node tl) MapString.empty)
in
- add_children (OASISString.nsplit fndlb_fullname '.') mp
+ add_children (OASISString.nsplit fndlb_fullname '.') mp
in
- let rec group_of_tree mp =
+ let unix_directory dn lib =
+ let directory =
+ match lib with
+ | `Library lib -> lib.lib_findlib_directory
+ | `Object obj -> obj.obj_findlib_directory
+ in
+ match dn, directory with
+ | None, None -> None
+ | None, Some dn | Some dn, None -> Some dn
+ | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2)
+ in
+
+ let rec group_of_tree dn mp =
MapString.fold
(fun nm node acc ->
let cur =
match node with
- | Node (Some (cs, bs, lib), children) ->
- Package (nm, cs, bs, lib, group_of_tree children)
- | Node (None, children) ->
- Container (nm, group_of_tree children)
- | Leaf (cs, bs, lib) ->
- Package (nm, cs, bs, lib, [])
+ | Node (Some (cs, bs, lib), children) ->
+ let current_dn = unix_directory dn lib in
+ Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children)
+ | Node (None, children) ->
+ Container (nm, group_of_tree dn children)
+ | Leaf (cs, bs, lib) ->
+ let current_dn = unix_directory dn lib in
+ Package (nm, cs, bs, lib, current_dn, [])
in
- cur :: acc)
+ cur :: acc)
mp []
in
@@ -2500,18 +2775,16 @@
(fun mp ->
function
| Library (cs, bs, lib) ->
- add (cs, bs, `Library lib) mp
+ add (cs, bs, `Library lib) mp
| Object (cs, bs, obj) ->
- add (cs, bs, `Object obj) mp
+ add (cs, bs, `Object obj) mp
| _ ->
- mp)
+ mp)
MapString.empty
pkg.sections
in
- let groups =
- group_of_tree group_mp
- in
+ let groups = group_of_tree None group_mp in
let library_name_of_findlib_name =
lazy begin
@@ -2529,15 +2802,15 @@
raise (FindlibPackageNotFound fndlb_nm)
in
- groups,
- findlib_name_of_library_name,
- library_name_of_findlib_name
+ groups,
+ findlib_name_of_library_name,
+ library_name_of_findlib_name
let findlib_of_group =
function
| Container (fndlb_nm, _)
- | Package (fndlb_nm, _, _, _, _) -> fndlb_nm
+ | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm
let root_of_group grp =
@@ -2545,24 +2818,24 @@
(* We do a DFS in the group. *)
function
| Container (_, children) ->
- List.fold_left
- (fun res grp ->
- if res = None then
- root_lib_aux grp
- else
- res)
- None
- children
- | Package (_, cs, bs, lib, _) ->
- Some (cs, bs, lib)
- in
- match root_lib_aux grp with
- | Some res ->
- res
- | None ->
- failwithf
- (f_ "Unable to determine root library of findlib library '%s'")
- (findlib_of_group grp)
+ List.fold_left
+ (fun res grp ->
+ if res = None then
+ root_lib_aux grp
+ else
+ res)
+ None
+ children
+ | Package (_, cs, bs, lib, _, _) ->
+ Some (cs, bs, lib)
+ in
+ match root_lib_aux grp with
+ | Some res ->
+ res
+ | None ->
+ failwithf
+ (f_ "Unable to determine root library of findlib library '%s'")
+ (findlib_of_group grp)
end
@@ -2608,7 +2881,7 @@
(* TODO: I don't like this quote, it is there because $(rm) foo expands to
* 'rm -f' foo...
- *)
+ *)
let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
let cmd =
if quote then
@@ -2626,57 +2899,57 @@
let cmdline =
String.concat " " (cmd :: args)
in
- info ~ctxt (f_ "Running command '%s'") cmdline;
- match f_exit_code, Sys.command cmdline with
- | None, 0 -> ()
- | None, i ->
- failwithf
- (f_ "Command '%s' terminated with error code %d")
- cmdline i
- | Some f, i ->
- f i
+ info ~ctxt (f_ "Running command '%s'") cmdline;
+ match f_exit_code, Sys.command cmdline with
+ | None, 0 -> ()
+ | None, i ->
+ failwithf
+ (f_ "Command '%s' terminated with error code %d")
+ cmdline i
+ | Some f, i ->
+ f i
let run_read_output ~ctxt ?f_exit_code cmd args =
let fn =
Filename.temp_file "oasis-" ".txt"
in
- try
+ try
+ begin
+ let () =
+ run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
+ in
+ let chn =
+ open_in fn
+ in
+ let routput =
+ ref []
+ in
begin
- let () =
- run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
- in
- let chn =
- open_in fn
- in
- let routput =
- ref []
- in
- begin
- try
- while true do
- routput := (input_line chn) :: !routput
- done
- with End_of_file ->
- ()
- end;
- close_in chn;
- Sys.remove fn;
- List.rev !routput
- end
- with e ->
- (try Sys.remove fn with _ -> ());
- raise e
+ try
+ while true do
+ routput := (input_line chn) :: !routput
+ done
+ with End_of_file ->
+ ()
+ end;
+ close_in chn;
+ Sys.remove fn;
+ List.rev !routput
+ end
+ with e ->
+ (try Sys.remove fn with _ -> ());
+ raise e
let run_read_one_line ~ctxt ?f_exit_code cmd args =
match run_read_output ~ctxt ?f_exit_code cmd args with
| [fst] ->
- fst
+ fst
| lst ->
- failwithf
- (f_ "Command return unexpected output %S")
- (String.concat "\n" lst)
+ failwithf
+ (f_ "Command return unexpected output %S")
+ (String.concat "\n" lst)
end
module OASISFileUtil = struct
@@ -2689,15 +2962,15 @@
let file_exists_case fn =
let dirname = Filename.dirname fn in
let basename = Filename.basename fn in
- if Sys.file_exists dirname then
- if basename = Filename.current_dir_name then
- true
- else
- List.mem
- basename
- (Array.to_list (Sys.readdir dirname))
+ if Sys.file_exists dirname then
+ if basename = Filename.current_dir_name then
+ true
else
- false
+ List.mem
+ basename
+ (Array.to_list (Sys.readdir dirname))
+ else
+ false
let find_file ?(case_sensitive=true) paths exts =
@@ -2716,16 +2989,16 @@
let rec combined_paths lst =
match lst with
| p1 :: p2 :: tl ->
- let acc =
- (List.map
- (fun (a, b) -> Filename.concat a b)
- (p1 * p2))
- in
- combined_paths (acc :: tl)
+ let acc =
+ (List.map
+ (fun (a, b) -> Filename.concat a b)
+ (p1 * p2))
+ in
+ combined_paths (acc :: tl)
| [e] ->
- e
+ e
| [] ->
- []
+ []
in
let alternatives =
@@ -2737,46 +3010,46 @@
p ^ e)
((combined_paths paths) * exts)
in
- List.find (fun file ->
- (if case_sensitive then
- file_exists_case file
- else
- Sys.file_exists file)
- && not (Sys.is_directory file)
- ) alternatives
+ List.find (fun file ->
+ (if case_sensitive then
+ file_exists_case file
+ else
+ Sys.file_exists file)
+ && not (Sys.is_directory file)
+ ) alternatives
let which ~ctxt prg =
let path_sep =
match Sys.os_type with
| "Win32" ->
- ';'
+ ';'
| _ ->
- ':'
+ ':'
in
let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
let exec_ext =
match Sys.os_type with
| "Win32" ->
- "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
+ "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
| _ ->
- [""]
+ [""]
in
- find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
+ find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
(**/**)
let rec fix_dir dn =
(* Windows hack because Sys.file_exists "src\\" = false when
* Sys.file_exists "src" = true
- *)
+ *)
let ln =
String.length dn
in
- if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
- fix_dir (String.sub dn 0 (ln - 1))
- else
- dn
+ if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
+ fix_dir (String.sub dn 0 (ln - 1))
+ else
+ dn
let q = Filename.quote
@@ -2787,24 +3060,24 @@
if recurse then
match Sys.os_type with
| "Win32" ->
- OASISExec.run ~ctxt
- "xcopy" [q src; q tgt; "/E"]
+ OASISExec.run ~ctxt
+ "xcopy" [q src; q tgt; "/E"]
| _ ->
- OASISExec.run ~ctxt
- "cp" ["-r"; q src; q tgt]
+ OASISExec.run ~ctxt
+ "cp" ["-r"; q src; q tgt]
else
OASISExec.run ~ctxt
(match Sys.os_type with
- | "Win32" -> "copy"
- | _ -> "cp")
+ | "Win32" -> "copy"
+ | _ -> "cp")
[q src; q tgt]
let mkdir ~ctxt tgt =
OASISExec.run ~ctxt
(match Sys.os_type with
- | "Win32" -> "md"
- | _ -> "mkdir")
+ | "Win32" -> "md"
+ | _ -> "mkdir")
[q tgt]
@@ -2812,32 +3085,32 @@
let tgt =
fix_dir tgt
in
- if Sys.file_exists tgt then
- begin
- if not (Sys.is_directory tgt) then
- OASISUtils.failwithf
- (f_ "Cannot create directory '%s', a file of the same name already \
- exists")
- tgt
- end
- else
- begin
- mkdir_parent ~ctxt f (Filename.dirname tgt);
- if not (Sys.file_exists tgt) then
- begin
- f tgt;
- mkdir ~ctxt tgt
- end
- end
+ if Sys.file_exists tgt then
+ begin
+ if not (Sys.is_directory tgt) then
+ OASISUtils.failwithf
+ (f_ "Cannot create directory '%s', a file of the same name already \
+ exists")
+ tgt
+ end
+ else
+ begin
+ mkdir_parent ~ctxt f (Filename.dirname tgt);
+ if not (Sys.file_exists tgt) then
+ begin
+ f tgt;
+ mkdir ~ctxt tgt
+ end
+ end
let rmdir ~ctxt tgt =
if Sys.readdir tgt = [||] then begin
match Sys.os_type with
| "Win32" ->
- OASISExec.run ~ctxt "rd" [q tgt]
+ OASISExec.run ~ctxt "rd" [q tgt]
| _ ->
- OASISExec.run ~ctxt "rm" ["-r"; q tgt]
+ OASISExec.run ~ctxt "rm" ["-r"; q tgt]
end else begin
OASISMessage.error ~ctxt
(f_ "Cannot remove directory '%s': not empty.")
@@ -2846,51 +3119,51 @@
let glob ~ctxt fn =
- let basename =
- Filename.basename fn
- in
- if String.length basename >= 2 &&
- basename.[0] = '*' &&
- basename.[1] = '.' then
- begin
- let ext_len =
- (String.length basename) - 2
- in
- let ext =
- String.sub basename 2 ext_len
- in
- let dirname =
- Filename.dirname fn
- in
- Array.fold_left
- (fun acc fn ->
- try
- let fn_ext =
- String.sub
- fn
- ((String.length fn) - ext_len)
- ext_len
- in
- if fn_ext = ext then
- (Filename.concat dirname fn) :: acc
- else
- acc
- with Invalid_argument _ ->
- acc)
- []
- (Sys.readdir dirname)
- end
- else
- begin
- if file_exists_case fn then
- [fn]
- else
- []
- end
+ let basename =
+ Filename.basename fn
+ in
+ if String.length basename >= 2 &&
+ basename.[0] = '*' &&
+ basename.[1] = '.' then
+ begin
+ let ext_len =
+ (String.length basename) - 2
+ in
+ let ext =
+ String.sub basename 2 ext_len
+ in
+ let dirname =
+ Filename.dirname fn
+ in
+ Array.fold_left
+ (fun acc fn ->
+ try
+ let fn_ext =
+ String.sub
+ fn
+ ((String.length fn) - ext_len)
+ ext_len
+ in
+ if fn_ext = ext then
+ (Filename.concat dirname fn) :: acc
+ else
+ acc
+ with Invalid_argument _ ->
+ acc)
+ []
+ (Sys.readdir dirname)
+ end
+ else
+ begin
+ if file_exists_case fn then
+ [fn]
+ else
+ []
+ end
end
-# 2893 "setup.ml"
+# 3165 "setup.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
@@ -2901,101 +3174,76 @@
type t = string MapString.t
- let default_filename =
- Filename.concat
- (Sys.getcwd ())
- "setup.data"
+ let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
- let load ?(allow_empty=false) ?(filename=default_filename) () =
- if Sys.file_exists filename then
- begin
- let chn =
- open_in_bin filename
- in
- let st =
- Stream.of_channel chn
- in
- let line =
- ref 1
- in
- let st_line =
- Stream.from
- (fun _ ->
- try
- match Stream.next st with
- | '\n' -> incr line; Some '\n'
- | c -> Some c
- with Stream.Failure -> None)
- in
- let lexer =
- Genlex.make_lexer ["="] st_line
- in
- let rec read_file mp =
- match Stream.npeek 3 lexer with
- | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
- Stream.junk lexer;
- Stream.junk lexer;
- Stream.junk lexer;
- read_file (MapString.add nm value mp)
- | [] ->
- mp
- | _ ->
- failwith
- (Printf.sprintf
- "Malformed data file '%s' line %d"
- filename !line)
- in
- let mp =
- read_file MapString.empty
- in
- close_in chn;
- mp
- end
- else if allow_empty then
- begin
+ let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
+ let line = ref 1 in
+ let lexer st =
+ let st_line =
+ Stream.from
+ (fun _ ->
+ try
+ match Stream.next st with
+ | '\n' -> incr line; Some '\n'
+ | c -> Some c
+ with Stream.Failure -> None)
+ in
+ Genlex.make_lexer ["="] st_line
+ in
+ let rec read_file lxr mp =
+ match Stream.npeek 3 lxr with
+ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+ Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
+ read_file lxr (MapString.add nm value mp)
+ | [] -> mp
+ | _ ->
+ failwith
+ (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
+ in
+ match stream with
+ | Some st -> read_file (lexer st) MapString.empty
+ | None ->
+ if Sys.file_exists filename then begin
+ let chn = open_in_bin filename in
+ let st = Stream.of_channel chn in
+ try
+ let mp = read_file (lexer st) MapString.empty in
+ close_in chn; mp
+ with e ->
+ close_in chn; raise e
+ end else if allow_empty then begin
MapString.empty
- end
- else
- begin
+ end else begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
-
let rec var_expand str env =
- let buff =
- Buffer.create ((String.length str) * 2)
- in
- Buffer.add_substitute
- buff
- (fun var ->
- try
- var_expand (MapString.find var env) env
- with Not_found ->
- failwith
- (Printf.sprintf
- "No variable %s defined when trying to expand %S."
- var
- str))
- str;
- Buffer.contents buff
-
-
- let var_get name env =
- var_expand (MapString.find name env) env
+ let buff = Buffer.create ((String.length str) * 2) in
+ Buffer.add_substitute
+ buff
+ (fun var ->
+ try
+ var_expand (MapString.find var env) env
+ with Not_found ->
+ failwith
+ (Printf.sprintf
+ "No variable %s defined when trying to expand %S."
+ var
+ str))
+ str;
+ Buffer.contents buff
- let var_choose lst env =
- OASISExpr.choose
- (fun nm -> var_get nm env)
- lst
+ let var_get name env = var_expand (MapString.find name env) env
+ let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
end
-# 2998 "setup.ml"
+# 3245 "setup.ml"
module BaseContext = struct
(* # 22 "src/base/BaseContext.ml" *)
@@ -3016,7 +3264,7 @@
(** Message to user, overrid for Base
@author Sylvain Le Gall
- *)
+ *)
open OASISMessage
open BaseContext
@@ -3039,6 +3287,7 @@
open OASISGettext
open OASISUtils
+ open OASISContext
open PropList
@@ -3061,83 +3310,79 @@
type definition_t =
- {
- hide: bool;
- dump: bool;
- cli: cli_handle_t;
- arg_help: string option;
- group: string option;
- }
+ {
+ hide: bool;
+ dump: bool;
+ cli: cli_handle_t;
+ arg_help: string option;
+ group: string option;
+ }
- let schema =
- Schema.create "environment"
+ let schema = Schema.create "environment"
(* Environment data *)
- let env =
- Data.create ()
+ let env = Data.create ()
(* Environment data from file *)
- let env_from_file =
- ref MapString.empty
+ let env_from_file = ref MapString.empty
(* Lexer for var *)
- let var_lxr =
- Genlex.make_lexer []
+ let var_lxr = Genlex.make_lexer []
let rec var_expand str =
let buff =
Buffer.create ((String.length str) * 2)
in
- Buffer.add_substitute
- buff
- (fun var ->
- try
- (* TODO: this is a quick hack to allow calling Test.Command
- * without defining executable name really. I.e. if there is
- * an exec Executable toto, then $(toto) should be replace
- * by its real name. It is however useful to have this function
- * for other variable that depend on the host and should be
- * written better than that.
- *)
- let st =
- var_lxr (Stream.of_string var)
- in
- match Stream.npeek 3 st with
- | [Genlex.Ident "utoh"; Genlex.Ident nm] ->
- OASISHostPath.of_unix (var_get nm)
- | [Genlex.Ident "utoh"; Genlex.String s] ->
- OASISHostPath.of_unix s
- | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
- String.escaped (var_get nm)
- | [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
- String.escaped s
- | [Genlex.Ident nm] ->
- var_get nm
- | _ ->
- failwithf
- (f_ "Unknown expression '%s' in variable expansion of %s.")
- var
- str
- with
- | Unknown_field (_, _) ->
- failwithf
- (f_ "No variable %s defined when trying to expand %S.")
- var
- str
- | Stream.Error e ->
- failwithf
- (f_ "Syntax error when parsing '%s' when trying to \
- expand %S: %s")
- var
- str
- e)
- str;
- Buffer.contents buff
+ Buffer.add_substitute
+ buff
+ (fun var ->
+ try
+ (* TODO: this is a quick hack to allow calling Test.Command
+ * without defining executable name really. I.e. if there is
+ * an exec Executable toto, then $(toto) should be replace
+ * by its real name. It is however useful to have this function
+ * for other variable that depend on the host and should be
+ * written better than that.
+ *)
+ let st =
+ var_lxr (Stream.of_string var)
+ in
+ match Stream.npeek 3 st with
+ | [Genlex.Ident "utoh"; Genlex.Ident nm] ->
+ OASISHostPath.of_unix (var_get nm)
+ | [Genlex.Ident "utoh"; Genlex.String s] ->
+ OASISHostPath.of_unix s
+ | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
+ String.escaped (var_get nm)
+ | [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
+ String.escaped s
+ | [Genlex.Ident nm] ->
+ var_get nm
+ | _ ->
+ failwithf
+ (f_ "Unknown expression '%s' in variable expansion of %s.")
+ var
+ str
+ with
+ | Unknown_field (_, _) ->
+ failwithf
+ (f_ "No variable %s defined when trying to expand %S.")
+ var
+ str
+ | Stream.Error e ->
+ failwithf
+ (f_ "Syntax error when parsing '%s' when trying to \
+ expand %S: %s")
+ var
+ str
+ e)
+ str;
+ Buffer.contents buff
and var_get name =
@@ -3152,7 +3397,7 @@
raise e
end
in
- var_expand vl
+ var_expand vl
let var_choose ?printer ?name lst =
@@ -3167,24 +3412,24 @@
let buff =
Buffer.create (String.length vl)
in
- String.iter
- (function
- | '$' -> Buffer.add_string buff "\\$"
- | c -> Buffer.add_char buff c)
- vl;
- Buffer.contents buff
+ String.iter
+ (function
+ | '$' -> Buffer.add_string buff "\\$"
+ | c -> Buffer.add_char buff c)
+ vl;
+ Buffer.contents buff
let var_define
- ?(hide=false)
- ?(dump=true)
- ?short_desc
- ?(cli=CLINone)
- ?arg_help
- ?group
- name (* TODO: type constraint on the fact that name must be a valid OCaml
- id *)
- dflt =
+ ?(hide=false)
+ ?(dump=true)
+ ?short_desc
+ ?(cli=CLINone)
+ ?arg_help
+ ?group
+ name (* TODO: type constraint on the fact that name must be a valid OCaml
+ id *)
+ dflt =
let default =
[
@@ -3205,22 +3450,22 @@
in
(* Try to find a value that can be defined
- *)
+ *)
let var_get_low lst =
let errors, res =
List.fold_left
- (fun (errors, res) (o, v) ->
+ (fun (errors, res) (_, v) ->
if res = None then
begin
try
errors, Some (v ())
with
| Not_found ->
- errors, res
+ errors, res
| Failure rsn ->
- (rsn :: errors), res
+ (rsn :: errors), res
| e ->
- (Printexc.to_string e) :: errors, res
+ (Printexc.to_string e) :: errors, res
end
else
errors, res)
@@ -3230,13 +3475,13 @@
Pervasives.compare o2 o1)
lst)
in
- match res, errors with
- | Some v, _ ->
- v
- | None, [] ->
- raise (Not_set (name, None))
- | None, lst ->
- raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
+ match res, errors with
+ | Some v, _ ->
+ v
+ | None, [] ->
+ raise (Not_set (name, None))
+ | None, lst ->
+ raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
in
let help =
@@ -3252,24 +3497,24 @@
~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
~print:var_get_low
~default
- ~update:(fun ?context x old_x -> x @ old_x)
+ ~update:(fun ?context:_ x old_x -> x @ old_x)
?help
extra
in
- fun () ->
- var_expand (var_get_low (var_get_lst env))
+ fun () ->
+ var_expand (var_get_low (var_get_lst env))
let var_redefine
- ?hide
- ?dump
- ?short_desc
- ?cli
- ?arg_help
- ?group
- name
- dflt =
+ ?hide
+ ?dump
+ ?short_desc
+ ?cli
+ ?arg_help
+ ?group
+ name
+ dflt =
if Schema.mem schema name then
begin
(* TODO: look suspsicious, we want to memorize dflt not dflt () *)
@@ -3290,7 +3535,7 @@
end
- let var_ignore (e: unit -> string) = ()
+ let var_ignore (_: unit -> string) = ()
let print_hidden =
@@ -3315,12 +3560,34 @@
schema)
- let default_filename =
- BaseEnvLight.default_filename
+ let default_filename = in_srcdir "setup.data"
- let load ?allow_empty ?filename () =
- env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
+ let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () =
+ let open OASISFileSystem in
+ env_from_file :=
+ let repr_filename = ctxt.srcfs#string_of_filename filename in
+ if ctxt.srcfs#file_exists filename then begin
+ let buf = Buffer.create 13 in
+ defer_close
+ (ctxt.srcfs#open_in ~mode:binary_in filename)
+ (read_all buf);
+ defer_close
+ (ctxt.srcfs#open_in ~mode:binary_in filename)
+ (fun rdr ->
+ OASISMessage.info ~ctxt "Loading environment from %S." repr_filename;
+ BaseEnvLight.load ~allow_empty
+ ~filename:(repr_filename)
+ ~stream:(stream_of_reader rdr)
+ ())
+ end else if allow_empty then begin
+ BaseEnvLight.MapString.empty
+ end else begin
+ failwith
+ (Printf.sprintf
+ (f_ "Unable to load environment, the file '%s' doesn't exist.")
+ repr_filename)
+ end
let unload () =
@@ -3328,40 +3595,32 @@
Data.clear env
- let dump ?(filename=default_filename) () =
- let chn =
- open_out_bin filename
- in
- let output nm value =
- Printf.fprintf chn "%s=%S\n" nm value
- in
- let mp_todo =
- (* Dump data from schema *)
- Schema.fold
- (fun mp_todo nm def _ ->
- if def.dump then
- begin
- try
- let value =
- Schema.get
- schema
- env
- nm
- in
- output nm value
- with Not_set _ ->
- ()
- end;
- MapString.remove nm mp_todo)
- !env_from_file
- schema
- in
- (* Dump data defined outside of schema *)
- MapString.iter output mp_todo;
-
- (* End of the dump *)
- close_out chn
-
+ let dump ~ctxt ?(filename=default_filename) () =
+ let open OASISFileSystem in
+ defer_close
+ (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename)
+ (fun wrtr ->
+ let buf = Buffer.create 63 in
+ let output nm value =
+ Buffer.add_string buf (Printf.sprintf "%s=%S\n" nm value)
+ in
+ let mp_todo =
+ (* Dump data from schema *)
+ Schema.fold
+ (fun mp_todo nm def _ ->
+ if def.dump then begin
+ try
+ output nm (Schema.get schema env nm)
+ with Not_set _ ->
+ ()
+ end;
+ MapString.remove nm mp_todo)
+ !env_from_file
+ schema
+ in
+ (* Dump data defined outside of schema *)
+ MapString.iter output mp_todo;
+ wrtr#output buf)
let print () =
let printable_vars =
@@ -3370,20 +3629,15 @@
if not def.hide || bool_of_string (print_hidden ()) then
begin
try
- let value =
- Schema.get
- schema
- env
- nm
- in
+ let value = Schema.get schema env nm in
let txt =
match short_descr_opt with
| Some s -> s ()
| None -> nm
in
- (txt, value) :: acc
+ (txt, value) :: acc
with Not_set _ ->
- acc
+ acc
end
else
acc)
@@ -3395,123 +3649,122 @@
(List.rev_map String.length
(List.rev_map fst printable_vars))
in
- let dot_pad str =
- String.make ((max_length - (String.length str)) + 3) '.'
- in
-
- Printf.printf "\nConfiguration: \n";
+ let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in
+ Printf.printf "\nConfiguration:\n";
List.iter
(fun (name, value) ->
- Printf.printf "%s: %s %s\n" name (dot_pad name) value)
+ Printf.printf "%s: %s" name (dot_pad name);
+ if value = "" then
+ Printf.printf "\n"
+ else
+ Printf.printf " %s\n" value)
(List.rev printable_vars);
Printf.printf "\n%!"
let args () =
- let arg_concat =
- OASISUtils.varname_concat ~hyphen:'-'
- in
- [
- "--override",
- Arg.Tuple
- (
- let rvr = ref ""
- in
- let rvl = ref ""
- in
- [
- Arg.Set_string rvr;
- Arg.Set_string rvl;
- Arg.Unit
- (fun () ->
- Schema.set
- schema
- env
- ~context:OCommandLine
- !rvr
- !rvl)
- ]
- ),
- "var+val Override any configuration variable.";
+ let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in
+ [
+ "--override",
+ Arg.Tuple
+ (
+ let rvr = ref ""
+ in
+ let rvl = ref ""
+ in
+ [
+ Arg.Set_string rvr;
+ Arg.Set_string rvl;
+ Arg.Unit
+ (fun () ->
+ Schema.set
+ schema
+ env
+ ~context:OCommandLine
+ !rvr
+ !rvl)
+ ]
+ ),
+ "var+val Override any configuration variable.";
- ]
- @
+ ]
+ @
List.flatten
(Schema.fold
- (fun acc name def short_descr_opt ->
- let var_set s =
- Schema.set
- schema
- env
- ~context:OCommandLine
- name
- s
- in
+ (fun acc name def short_descr_opt ->
+ let var_set s =
+ Schema.set
+ schema
+ env
+ ~context:OCommandLine
+ name
+ s
+ in
- let arg_name =
- OASISUtils.varname_of_string ~hyphen:'-' name
- in
+ let arg_name =
+ OASISUtils.varname_of_string ~hyphen:'-' name
+ in
- let hlp =
- match short_descr_opt with
- | Some txt -> txt ()
- | None -> ""
- in
+ let hlp =
+ match short_descr_opt with
+ | Some txt -> txt ()
+ | None -> ""
+ in
- let arg_hlp =
- match def.arg_help with
- | Some s -> s
- | None -> "str"
- in
+ let arg_hlp =
+ match def.arg_help with
+ | Some s -> s
+ | None -> "str"
+ in
- let default_value =
- try
- Printf.sprintf
- (f_ " [%s]")
- (Schema.get
- schema
- env
- name)
- with Not_set _ ->
- ""
- in
+ let default_value =
+ try
+ Printf.sprintf
+ (f_ " [%s]")
+ (Schema.get
+ schema
+ env
+ name)
+ with Not_set _ ->
+ ""
+ in
- let args =
- match def.cli with
- | CLINone ->
- []
- | CLIAuto ->
- [
- arg_concat "--" arg_name,
- Arg.String var_set,
- Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
- ]
- | CLIWith ->
- [
- arg_concat "--with-" arg_name,
- Arg.String var_set,
- Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
- ]
- | CLIEnable ->
- let dflt =
- if default_value = " [true]" then
- s_ " [default: enabled]"
- else
- s_ " [default: disabled]"
- in
- [
- arg_concat "--enable-" arg_name,
- Arg.Unit (fun () -> var_set "true"),
- Printf.sprintf (f_ " %s%s") hlp dflt;
-
- arg_concat "--disable-" arg_name,
- Arg.Unit (fun () -> var_set "false"),
- Printf.sprintf (f_ " %s%s") hlp dflt
- ]
- | CLIUser lst ->
- lst
- in
- args :: acc)
+ let args =
+ match def.cli with
+ | CLINone ->
+ []
+ | CLIAuto ->
+ [
+ arg_concat "--" arg_name,
+ Arg.String var_set,
+ Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
+ ]
+ | CLIWith ->
+ [
+ arg_concat "--with-" arg_name,
+ Arg.String var_set,
+ Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
+ ]
+ | CLIEnable ->
+ let dflt =
+ if default_value = " [true]" then
+ s_ " [default: enabled]"
+ else
+ s_ " [default: disabled]"
+ in
+ [
+ arg_concat "--enable-" arg_name,
+ Arg.Unit (fun () -> var_set "true"),
+ Printf.sprintf (f_ " %s%s") hlp dflt;
+
+ arg_concat "--disable-" arg_name,
+ Arg.Unit (fun () -> var_set "false"),
+ Printf.sprintf (f_ " %s%s") hlp dflt
+ ]
+ | CLIUser lst ->
+ lst
+ in
+ args :: acc)
[]
schema)
end
@@ -3525,25 +3778,25 @@
let parse argv args =
- (* Simulate command line for Arg *)
- let current =
- ref 0
- in
+ (* Simulate command line for Arg *)
+ let current =
+ ref 0
+ in
- try
- Arg.parse_argv
- ~current:current
- (Array.concat [[|"none"|]; argv])
- (Arg.align args)
- (failwithf (f_ "Don't know what to do with arguments: '%s'"))
- (s_ "configure options:")
- with
- | Arg.Help txt ->
- print_endline txt;
- exit 0
- | Arg.Bad txt ->
- prerr_endline txt;
- exit 1
+ try
+ Arg.parse_argv
+ ~current:current
+ (Array.concat [[|"none"|]; argv])
+ (Arg.align args)
+ (failwithf (f_ "Don't know what to do with arguments: '%s'"))
+ (s_ "configure options:")
+ with
+ | Arg.Help txt ->
+ print_endline txt;
+ exit 0
+ | Arg.Bad txt ->
+ prerr_endline txt;
+ exit 1
end
module BaseCheck = struct
@@ -3565,18 +3818,18 @@
(fun res e ->
match res with
| Some _ ->
- res
+ res
| None ->
- try
- Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
- with Not_found ->
- None)
+ try
+ Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
+ with Not_found ->
+ None)
None
prg_lst
in
- match alternate with
- | Some prg -> prg
- | None -> raise Not_found)
+ match alternate with
+ | Some prg -> prg
+ | None -> raise Not_found)
let prog prg =
@@ -3592,45 +3845,45 @@
let version
- var_prefix
- cmp
- fversion
- () =
+ var_prefix
+ cmp
+ fversion
+ () =
(* Really compare version provided *)
let var =
var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
in
- var_redefine
- ~hide:true
- var
- (fun () ->
- let version_str =
- match fversion () with
- | "[Distributed with OCaml]" ->
- begin
- try
- (var_get "ocaml_version")
- with Not_found ->
- warning
- (f_ "Variable ocaml_version not defined, fallback \
- to default");
- Sys.ocaml_version
- end
- | res ->
- res
- in
- let version =
- OASISVersion.version_of_string version_str
- in
- if OASISVersion.comparator_apply version cmp then
- version_str
- else
- failwithf
- (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
- var_prefix
- (OASISVersion.string_of_comparator cmp)
- version_str)
- ()
+ var_redefine
+ ~hide:true
+ var
+ (fun () ->
+ let version_str =
+ match fversion () with
+ | "[Distributed with OCaml]" ->
+ begin
+ try
+ (var_get "ocaml_version")
+ with Not_found ->
+ warning
+ (f_ "Variable ocaml_version not defined, fallback \
+ to default");
+ Sys.ocaml_version
+ end
+ | res ->
+ res
+ in
+ let version =
+ OASISVersion.version_of_string version_str
+ in
+ if OASISVersion.comparator_apply version cmp then
+ version_str
+ else
+ failwithf
+ (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
+ var_prefix
+ (OASISVersion.string_of_comparator cmp)
+ version_str)
+ ()
let package_version pkg =
@@ -3651,13 +3904,13 @@
(ocamlfind ())
["query"; "-format"; "%d"; pkg]
in
- if Sys.file_exists dir && Sys.is_directory dir then
- dir
- else
- failwithf
- (f_ "When looking for findlib package %s, \
- directory %s return doesn't exist")
- pkg dir
+ if Sys.file_exists dir && Sys.is_directory dir then
+ dir
+ else
+ failwithf
+ (f_ "When looking for findlib package %s, \
+ directory %s return doesn't exist")
+ pkg dir
in
let vl =
var_redefine
@@ -3665,19 +3918,19 @@
(fun () -> findlib_dir pkg)
()
in
- (
- match version_comparator with
- | Some ver_cmp ->
- ignore
- (version
- var
- ver_cmp
- (fun _ -> package_version pkg)
- ())
- | None ->
- ()
- );
- vl
+ (
+ match version_comparator with
+ | Some ver_cmp ->
+ ignore
+ (version
+ var
+ ver_cmp
+ (fun _ -> package_version pkg)
+ ())
+ | None ->
+ ()
+ );
+ vl
end
module BaseOCamlcConfig = struct
@@ -3699,46 +3952,46 @@
let ocamlc_config_map =
(* Map name to value for ocamlc -config output
(name ^": "^value)
- *)
+ *)
let rec split_field mp lst =
match lst with
| line :: tl ->
- let mp =
- try
- let pos_semicolon =
- String.index line ':'
- in
- if pos_semicolon > 1 then
- (
- let name =
- String.sub line 0 pos_semicolon
- in
- let linelen =
- String.length line
- in
- let value =
- if linelen > pos_semicolon + 2 then
- String.sub
- line
- (pos_semicolon + 2)
- (linelen - pos_semicolon - 2)
- else
- ""
- in
- SMap.add name value mp
- )
- else
- (
- mp
- )
- with Not_found ->
+ let mp =
+ try
+ let pos_semicolon =
+ String.index line ':'
+ in
+ if pos_semicolon > 1 then
+ (
+ let name =
+ String.sub line 0 pos_semicolon
+ in
+ let linelen =
+ String.length line
+ in
+ let value =
+ if linelen > pos_semicolon + 2 then
+ String.sub
+ line
+ (pos_semicolon + 2)
+ (linelen - pos_semicolon - 2)
+ else
+ ""
+ in
+ SMap.add name value mp
+ )
+ else
(
mp
)
- in
- split_field mp tl
+ with Not_found ->
+ (
+ mp
+ )
+ in
+ split_field mp tl
| [] ->
- mp
+ mp
in
let cache =
@@ -3752,13 +4005,13 @@
(ocamlc ()) ["-config"]))
[]))
in
- var_redefine
- "ocamlc_config_map"
- ~hide:true
- ~dump:false
- (fun () ->
- (* TODO: update if ocamlc change !!! *)
- Lazy.force cache)
+ var_redefine
+ "ocamlc_config_map"
+ ~hide:true
+ ~dump:false
+ (fun () ->
+ (* TODO: update if ocamlc change !!! *)
+ Lazy.force cache)
let var_define nm =
@@ -3773,30 +4026,30 @@
String.sub s 0 (String.index s '+')
with _ ->
s
- in
+ in
let nm_config, value_config =
match nm with
| "ocaml_version" ->
- "version", chop_version_suffix
+ "version", chop_version_suffix
| _ -> nm, (fun x -> x)
in
- var_redefine
- nm
- (fun () ->
- try
- let map =
- avlbl_config_get ()
- in
- let value =
- SMap.find nm_config map
- in
- value_config value
- with Not_found ->
- failwithf
- (f_ "Cannot find field '%s' in '%s -config' output")
- nm
- (ocamlc ()))
+ var_redefine
+ nm
+ (fun () ->
+ try
+ let map =
+ avlbl_config_get ()
+ in
+ let value =
+ SMap.find nm_config map
+ in
+ value_config value
+ with Not_found ->
+ failwithf
+ (f_ "Cannot find field '%s' in '%s -config' output")
+ nm
+ (ocamlc ()))
end
@@ -3806,7 +4059,6 @@
open OASISGettext
open OASISTypes
- open OASISExpr
open BaseCheck
open BaseEnv
@@ -3836,11 +4088,11 @@
let since_version =
OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
in
- var_cond :=
+ var_cond :=
(fun ver ->
if OASISVersion.comparator_apply ver since_version then
holder := f ()) :: !var_cond;
- fun () -> !holder ()
+ fun () -> !holder ()
(**/**)
@@ -3901,11 +4153,11 @@
OASISExec.run_read_output ~ctxt:!BaseContext.default
(flexlink ()) ["-help"]
in
- match lst with
- | line :: _ ->
- Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
- | [] ->
- raise Not_found)
+ match lst with
+ | line :: _ ->
+ Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
+ | [] ->
+ raise Not_found)
(**/**)
@@ -3921,7 +4173,7 @@
let (/) a b =
if os_type () = Sys.os_type then
Filename.concat a b
- else if os_type () = "Unix" then
+ else if os_type () = "Unix" || os_type () = "Cygwin" then
OASISUnixPath.concat a b
else
OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
@@ -3935,12 +4187,12 @@
(fun () ->
match os_type () with
| "Win32" ->
- let program_files =
- Sys.getenv "PROGRAMFILES"
- in
- program_files/(pkg_name ())
+ let program_files =
+ Sys.getenv "PROGRAMFILES"
+ in
+ program_files/(pkg_name ())
| _ ->
- "/usr/local")
+ "/usr/local")
let exec_prefix =
@@ -4076,12 +4328,12 @@
let _s: string =
ocamlopt ()
in
- "true"
+ "true"
with PropList.Not_set _ ->
let _s: string =
ocamlc ()
in
- "false")
+ "false")
let ext_program =
@@ -4134,7 +4386,7 @@
(fun () ->
var_define
~short_desc:(fun () ->
- s_ "Compile tests executable and library and run them")
+ s_ "Compile tests executable and library and run them")
~cli:CLIEnable
"tests"
(fun () -> "false"))
@@ -4173,35 +4425,35 @@
in
let has_native_dynlink =
let ocamlfind = ocamlfind () in
- try
- let fn =
- OASISExec.run_read_one_line
- ~ctxt:!BaseContext.default
- ocamlfind
- ["query"; "-predicates"; "native"; "dynlink";
- "-format"; "%d/%a"]
- in
- Sys.file_exists fn
- with _ ->
- false
- in
- if not has_native_dynlink then
+ try
+ let fn =
+ OASISExec.run_read_one_line
+ ~ctxt:!BaseContext.default
+ ocamlfind
+ ["query"; "-predicates"; "native"; "dynlink";
+ "-format"; "%d/%a"]
+ in
+ Sys.file_exists fn
+ with _ ->
false
- else if ocaml_lt_312 () then
+ in
+ if not has_native_dynlink then
+ false
+ else if ocaml_lt_312 () then
+ false
+ else if (os_type () = "Win32" || os_type () = "Cygwin")
+ && flexdll_lt_030 () then
+ begin
+ BaseMessage.warning
+ (f_ ".cmxs generation disabled because FlexDLL needs to be \
+ at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
+ (flexdll_version ());
false
- else if (os_type () = "Win32" || os_type () = "Cygwin")
- && flexdll_lt_030 () then
- begin
- BaseMessage.warning
- (f_ ".cmxs generation disabled because FlexDLL needs to be \
- at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
- (flexdll_version ());
- false
- end
- else
- true
+ end
+ else
+ true
in
- string_of_bool res)
+ string_of_bool res)
let init pkg =
@@ -4217,48 +4469,29 @@
open BaseEnv
open OASISGettext
open BaseMessage
+ open OASISContext
let to_filename fn =
- let fn =
- OASISHostPath.of_unix fn
- in
- if not (Filename.check_suffix fn ".ab") then
- warning
- (f_ "File '%s' doesn't have '.ab' extension")
- fn;
- Filename.chop_extension fn
+ if not (Filename.check_suffix fn ".ab") then
+ warning (f_ "File '%s' doesn't have '.ab' extension") fn;
+ OASISFileSystem.of_unix_filename (Filename.chop_extension fn)
- let replace fn_lst =
- let buff =
- Buffer.create 13
- in
- List.iter
- (fun fn ->
- let fn =
- OASISHostPath.of_unix fn
- in
- let chn_in =
- open_in fn
- in
- let chn_out =
- open_out (to_filename fn)
- in
- (
- try
- while true do
- Buffer.add_string buff (var_expand (input_line chn_in));
- Buffer.add_char buff '\n'
- done
- with End_of_file ->
- ()
- );
- Buffer.output_buffer chn_out buff;
- Buffer.clear buff;
- close_in chn_in;
- close_out chn_out)
- fn_lst
+ let replace ~ctxt fn_lst =
+ let open OASISFileSystem in
+ let ibuf, obuf = Buffer.create 13, Buffer.create 13 in
+ List.iter
+ (fun fn ->
+ Buffer.clear ibuf; Buffer.clear obuf;
+ defer_close
+ (ctxt.srcfs#open_in (of_unix_filename fn))
+ (read_all ibuf);
+ Buffer.add_string obuf (var_expand (Buffer.contents ibuf));
+ defer_close
+ (ctxt.srcfs#open_out (to_filename fn))
+ (fun wrtr -> wrtr#output obuf))
+ fn_lst
end
module BaseLog = struct
@@ -4266,126 +4499,92 @@
open OASISUtils
+ open OASISContext
+ open OASISGettext
+ open OASISFileSystem
- let default_filename =
- Filename.concat
- (Filename.dirname BaseEnv.default_filename)
- "setup.log"
-
-
- module SetTupleString =
- Set.Make
- (struct
- type t = string * string
- let compare (s11, s12) (s21, s22) =
- match String.compare s11 s21 with
- | 0 -> String.compare s12 s22
- | n -> n
- end)
+ let default_filename = in_srcdir "setup.log"
- let load () =
- if Sys.file_exists default_filename then
- begin
- let chn =
- open_in default_filename
- in
- let scbuf =
- Scanf.Scanning.from_file default_filename
- in
- let rec read_aux (st, lst) =
- if not (Scanf.Scanning.end_of_input scbuf) then
- begin
- let acc =
- try
- Scanf.bscanf scbuf "%S %S\n"
- (fun e d ->
- let t =
- e, d
- in
- if SetTupleString.mem t st then
- st, lst
- else
- SetTupleString.add t st,
- t :: lst)
- with Scanf.Scan_failure _ ->
- failwith
- (Scanf.bscanf scbuf
- "%l"
- (fun line ->
- Printf.sprintf
- "Malformed log file '%s' at line %d"
- default_filename
- line))
- in
- read_aux acc
- end
- else
- begin
- close_in chn;
- List.rev lst
- end
- in
- read_aux (SetTupleString.empty, [])
- end
- else
- begin
- []
- end
+ let load ~ctxt () =
+ let module SetTupleString =
+ Set.Make
+ (struct
+ type t = string * string
+ let compare (s11, s12) (s21, s22) =
+ match String.compare s11 s21 with
+ | 0 -> String.compare s12 s22
+ | n -> n
+ end)
+ in
+ if ctxt.srcfs#file_exists default_filename then begin
+ defer_close
+ (ctxt.srcfs#open_in default_filename)
+ (fun rdr ->
+ let line = ref 1 in
+ let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in
+ let rec read_aux (st, lst) =
+ match Stream.npeek 2 lxr with
+ | [Genlex.String e; Genlex.String d] ->
+ let t = e, d in
+ Stream.junk lxr; Stream.junk lxr;
+ if SetTupleString.mem t st then
+ read_aux (st, lst)
+ else
+ read_aux (SetTupleString.add t st, t :: lst)
+ | [] -> List.rev lst
+ | _ ->
+ failwithf
+ (f_ "Malformed log file '%s' at line %d")
+ (ctxt.srcfs#string_of_filename default_filename)
+ !line
+ in
+ read_aux (SetTupleString.empty, []))
+ end else begin
+ []
+ end
- let register event data =
- let chn_out =
- open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename
- in
- Printf.fprintf chn_out "%S %S\n" event data;
- close_out chn_out
+ let register ~ctxt event data =
+ defer_close
+ (ctxt.srcfs#open_out
+ ~mode:[Open_append; Open_creat; Open_text]
+ ~perm:0o644
+ default_filename)
+ (fun wrtr ->
+ let buf = Buffer.create 13 in
+ Printf.bprintf buf "%S %S\n" event data;
+ wrtr#output buf)
- let unregister event data =
- if Sys.file_exists default_filename then
- begin
- let lst =
- load ()
- in
- let chn_out =
- open_out default_filename
- in
- let write_something =
- ref false
- in
- List.iter
- (fun (e, d) ->
- if e <> event || d <> data then
- begin
- write_something := true;
- Printf.fprintf chn_out "%S %S\n" e d
- end)
- lst;
- close_out chn_out;
- if not !write_something then
- Sys.remove default_filename
- end
+ let unregister ~ctxt event data =
+ let lst = load ~ctxt () in
+ let buf = Buffer.create 13 in
+ List.iter
+ (fun (e, d) ->
+ if e <> event || d <> data then
+ Printf.bprintf buf "%S %S\n" e d)
+ lst;
+ if Buffer.length buf > 0 then
+ defer_close
+ (ctxt.srcfs#open_out default_filename)
+ (fun wrtr -> wrtr#output buf)
+ else
+ ctxt.srcfs#remove default_filename
- let filter events =
- let st_events =
- List.fold_left
- (fun st e ->
- SetString.add e st)
- SetString.empty
- events
- in
- List.filter
- (fun (e, _) -> SetString.mem e st_events)
- (load ())
+ let filter ~ctxt events =
+ let st_events = SetString.of_list events in
+ List.filter
+ (fun (e, _) -> SetString.mem e st_events)
+ (load ~ctxt ())
- let exists event data =
+ let exists ~ctxt event data =
List.exists
(fun v -> (event, data) = v)
- (load ())
+ (load ~ctxt ())
end
module BaseBuilt = struct
@@ -4408,100 +4607,81 @@
let to_log_event_file t nm =
"built_"^
- (match t with
- | BExec -> "exec"
- | BExecLib -> "exec_lib"
- | BLib -> "lib"
- | BObj -> "obj"
- | BDoc -> "doc")^
- "_"^nm
+ (match t with
+ | BExec -> "exec"
+ | BExecLib -> "exec_lib"
+ | BLib -> "lib"
+ | BObj -> "obj"
+ | BDoc -> "doc")^
+ "_"^nm
let to_log_event_done t nm =
"is_"^(to_log_event_file t nm)
- let register t nm lst =
- BaseLog.register
- (to_log_event_done t nm)
- "true";
+ let register ~ctxt t nm lst =
+ BaseLog.register ~ctxt (to_log_event_done t nm) "true";
List.iter
(fun alt ->
let registered =
List.fold_left
(fun registered fn ->
- if OASISFileUtil.file_exists_case fn then
- begin
- BaseLog.register
- (to_log_event_file t nm)
- (if Filename.is_relative fn then
- Filename.concat (Sys.getcwd ()) fn
- else
- fn);
- true
- end
- else
- registered)
+ if OASISFileUtil.file_exists_case fn then begin
+ BaseLog.register ~ctxt
+ (to_log_event_file t nm)
+ (if Filename.is_relative fn then
+ Filename.concat (Sys.getcwd ()) fn
+ else
+ fn);
+ true
+ end else begin
+ registered
+ end)
false
alt
in
- if not registered then
- warning
- (f_ "Cannot find an existing alternative files among: %s")
- (String.concat (s_ ", ") alt))
+ if not registered then
+ warning
+ (f_ "Cannot find an existing alternative files among: %s")
+ (String.concat (s_ ", ") alt))
lst
- let unregister t nm =
+ let unregister ~ctxt t nm =
List.iter
- (fun (e, d) ->
- BaseLog.unregister e d)
- (BaseLog.filter
- [to_log_event_file t nm;
- to_log_event_done t nm])
+ (fun (e, d) -> BaseLog.unregister ~ctxt e d)
+ (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm])
- let fold t nm f acc =
+ let fold ~ctxt t nm f acc =
List.fold_left
(fun acc (_, fn) ->
- if OASISFileUtil.file_exists_case fn then
- begin
- f acc fn
- end
- else
- begin
- warning
- (f_ "File '%s' has been marked as built \
+ if OASISFileUtil.file_exists_case fn then begin
+ f acc fn
+ end else begin
+ warning
+ (f_ "File '%s' has been marked as built \
for %s but doesn't exist")
- fn
- (Printf.sprintf
- (match t with
- | BExec | BExecLib ->
- (f_ "executable %s")
- | BLib ->
- (f_ "library %s")
- | BObj ->
- (f_ "object %s")
- | BDoc ->
- (f_ "documentation %s"))
- nm);
- acc
- end)
+ fn
+ (Printf.sprintf
+ (match t with
+ | BExec | BExecLib -> (f_ "executable %s")
+ | BLib -> (f_ "library %s")
+ | BObj -> (f_ "object %s")
+ | BDoc -> (f_ "documentation %s"))
+ nm);
+ acc
+ end)
acc
- (BaseLog.filter
- [to_log_event_file t nm])
+ (BaseLog.filter ~ctxt [to_log_event_file t nm])
- let is_built t nm =
+ let is_built ~ctxt t nm =
List.fold_left
- (fun is_built (_, d) ->
- (try
- bool_of_string d
- with _ ->
- false))
+ (fun _ (_, d) -> try bool_of_string d with _ -> false)
false
- (BaseLog.filter
- [to_log_event_done t nm])
+ (BaseLog.filter ~ctxt [to_log_event_done t nm])
let of_executable ffn (cs, bs, exec) =
@@ -4517,15 +4697,15 @@
let evs =
(BExec, cs.cs_name, [[ffn unix_exec_is]])
::
- (match unix_dll_opt with
- | Some fn ->
- [BExecLib, cs.cs_name, [[ffn fn]]]
- | None ->
- [])
- in
- evs,
- unix_exec_is,
- unix_dll_opt
+ (match unix_dll_opt with
+ | Some fn ->
+ [BExecLib, cs.cs_name, [[ffn fn]]]
+ | None ->
+ [])
+ in
+ evs,
+ unix_exec_is,
+ unix_dll_opt
let of_library ffn (cs, bs, lib) =
@@ -4533,7 +4713,7 @@
OASISLibrary.generated_unix_files
~ctxt:!BaseContext.default
~source_file_exists:(fun fn ->
- OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
~is_native:(bool_of_string (is_native ()))
~has_native_dynlink:(bool_of_string (native_dynlink ()))
~ext_lib:(ext_lib ())
@@ -4545,7 +4725,7 @@
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
- evs, unix_lst
+ evs, unix_lst
let of_object ffn (cs, bs, obj) =
@@ -4553,7 +4733,7 @@
OASISObject.generated_unix_files
~ctxt:!BaseContext.default
~source_file_exists:(fun fn ->
- OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
~is_native:(bool_of_string (is_native ()))
(cs, bs, obj)
in
@@ -4562,7 +4742,7 @@
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
- evs, unix_lst
+ evs, unix_lst
end
@@ -4591,32 +4771,32 @@
| Some (cmd, args) -> String.concat " " (cmd :: args)
| None -> s_ "No command"
in
- match
- var_choose
- ~name:(s_ "Pre/Post Command")
- ~printer
- lst with
- | Some (cmd, args) ->
- begin
- try
- run cmd args [||]
- with e when failsafe ->
- warning
- (f_ "Command '%s' fail with error: %s")
- (String.concat " " (cmd :: args))
- (match e with
- | Failure msg -> msg
- | e -> Printexc.to_string e)
- end
- | None ->
- ()
+ match
+ var_choose
+ ~name:(s_ "Pre/Post Command")
+ ~printer
+ lst with
+ | Some (cmd, args) ->
+ begin
+ try
+ run cmd args [||]
+ with e when failsafe ->
+ warning
+ (f_ "Command '%s' fail with error: %s")
+ (String.concat " " (cmd :: args))
+ (match e with
+ | Failure msg -> msg
+ | e -> Printexc.to_string e)
+ end
+ | None ->
+ ()
in
let res =
optional_command cstm.pre_command;
f e
in
- optional_command cstm.post_command;
- res
+ optional_command cstm.post_command;
+ res
end
module BaseDynVar = struct
@@ -4629,41 +4809,38 @@
open BaseBuilt
- let init pkg =
+ let init ~ctxt pkg =
(* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
(* TODO: provide compile option for library libary_byte_args_VARNAME... *)
List.iter
(function
- | Executable (cs, bs, exec) ->
- if var_choose bs.bs_build then
- var_ignore
- (var_redefine
- (* We don't save this variable *)
- ~dump:false
- ~short_desc:(fun () ->
- Printf.sprintf
- (f_ "Filename of executable '%s'")
- cs.cs_name)
- (OASISUtils.varname_of_string cs.cs_name)
- (fun () ->
- let fn_opt =
- fold
- BExec cs.cs_name
- (fun _ fn -> Some fn)
- None
- in
- match fn_opt with
- | Some fn -> fn
- | None ->
- raise
- (PropList.Not_set
- (cs.cs_name,
- Some (Printf.sprintf
- (f_ "Executable '%s' not yet built.")
- cs.cs_name)))))
+ | Executable (cs, bs, _) ->
+ if var_choose bs.bs_build then
+ var_ignore
+ (var_redefine
+ (* We don't save this variable *)
+ ~dump:false
+ ~short_desc:(fun () ->
+ Printf.sprintf
+ (f_ "Filename of executable '%s'")
+ cs.cs_name)
+ (OASISUtils.varname_of_string cs.cs_name)
+ (fun () ->
+ let fn_opt =
+ fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None
+ in
+ match fn_opt with
+ | Some fn -> fn
+ | None ->
+ raise
+ (PropList.Not_set
+ (cs.cs_name,
+ Some (Printf.sprintf
+ (f_ "Executable '%s' not yet built.")
+ cs.cs_name)))))
- | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
- ())
+ | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
+ ())
pkg.sections
end
@@ -4674,53 +4851,48 @@
open BaseEnv
open BaseMessage
open OASISTypes
- open OASISExpr
open OASISGettext
- let test lst pkg extra_args =
+ let test ~ctxt lst pkg extra_args =
let one_test (failure, n) (test_plugin, cs, test) =
if var_choose
- ~name:(Printf.sprintf
- (f_ "test %s run")
- cs.cs_name)
- ~printer:string_of_bool
- test.test_run then
+ ~name:(Printf.sprintf
+ (f_ "test %s run")
+ cs.cs_name)
+ ~printer:string_of_bool
+ test.test_run then
begin
- let () =
- info (f_ "Running test '%s'") cs.cs_name
- in
+ let () = info (f_ "Running test '%s'") cs.cs_name in
let back_cwd =
match test.test_working_directory with
| Some dir ->
- let cwd =
- Sys.getcwd ()
- in
- let chdir d =
- info (f_ "Changing directory to '%s'") d;
- Sys.chdir d
- in
- chdir dir;
- fun () -> chdir cwd
+ let cwd = Sys.getcwd () in
+ let chdir d =
+ info (f_ "Changing directory to '%s'") d;
+ Sys.chdir d
+ in
+ chdir dir;
+ fun () -> chdir cwd
| None ->
- fun () -> ()
+ fun () -> ()
in
- try
- let failure_percent =
- BaseCustom.hook
- test.test_custom
- (test_plugin pkg (cs, test))
- extra_args
- in
- back_cwd ();
- (failure_percent +. failure, n + 1)
- with e ->
- begin
- back_cwd ();
- raise e
- end
+ try
+ let failure_percent =
+ BaseCustom.hook
+ test.test_custom
+ (test_plugin ~ctxt pkg (cs, test))
+ extra_args
+ in
+ back_cwd ();
+ (failure_percent +. failure, n + 1)
+ with e ->
+ begin
+ back_cwd ();
+ raise e
+ end
end
else
begin
@@ -4728,35 +4900,25 @@
(failure, n)
end
in
- let failed, n =
- List.fold_left
- one_test
- (0.0, 0)
- lst
- in
- let failure_percent =
- if n = 0 then
- 0.0
- else
- failed /. (float_of_int n)
- in
+ let failed, n = List.fold_left one_test (0.0, 0) lst in
+ let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in
let msg =
Printf.sprintf
(f_ "Tests had a %.2f%% failure rate")
(100. *. failure_percent)
in
- if failure_percent > 0.0 then
- failwith msg
- else
- info "%s" msg;
+ if failure_percent > 0.0 then
+ failwith msg
+ else
+ info "%s" msg;
- (* Possible explanation why the tests where not run. *)
- if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
- not (bool_of_string (BaseStandardVar.tests ())) &&
- lst <> [] then
- BaseMessage.warning
- "Tests are turned off, consider enabling with \
- 'ocaml setup.ml -configure --enable-tests'"
+ (* Possible explanation why the tests where not run. *)
+ if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
+ not (bool_of_string (BaseStandardVar.tests ())) &&
+ lst <> [] then
+ BaseMessage.warning
+ "Tests are turned off, consider enabling with \
+ 'ocaml setup.ml -configure --enable-tests'"
end
module BaseDoc = struct
@@ -4769,74 +4931,79 @@
open OASISGettext
- let doc lst pkg extra_args =
+ let doc ~ctxt lst pkg extra_args =
let one_doc (doc_plugin, cs, doc) =
if var_choose
- ~name:(Printf.sprintf
- (f_ "documentation %s build")
- cs.cs_name)
- ~printer:string_of_bool
- doc.doc_build then
+ ~name:(Printf.sprintf
+ (f_ "documentation %s build")
+ cs.cs_name)
+ ~printer:string_of_bool
+ doc.doc_build then
begin
info (f_ "Building documentation '%s'") cs.cs_name;
BaseCustom.hook
doc.doc_custom
- (doc_plugin pkg (cs, doc))
+ (doc_plugin ~ctxt pkg (cs, doc))
extra_args
end
in
- List.iter one_doc lst;
+ List.iter one_doc lst;
- if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
- not (bool_of_string (BaseStandardVar.docs ())) &&
- lst <> [] then
- BaseMessage.warning
- "Docs are turned off, consider enabling with \
- 'ocaml setup.ml -configure --enable-docs'"
+ if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
+ not (bool_of_string (BaseStandardVar.docs ())) &&
+ lst <> [] then
+ BaseMessage.warning
+ "Docs are turned off, consider enabling with \
+ 'ocaml setup.ml -configure --enable-docs'"
end
module BaseSetup = struct
(* # 22 "src/base/BaseSetup.ml" *)
+ open OASISContext
open BaseEnv
open BaseMessage
open OASISTypes
- open OASISSection
open OASISGettext
open OASISUtils
type std_args_fun =
- package -> string array -> unit
+ ctxt:OASISContext.t -> package -> string array -> unit
type ('a, 'b) section_args_fun =
- name * (package -> (common_section * 'a) -> string array -> 'b)
+ name *
+ (ctxt:OASISContext.t ->
+ package ->
+ (common_section * 'a) ->
+ string array ->
+ 'b)
type t =
- {
- configure: std_args_fun;
- build: std_args_fun;
- doc: ((doc, unit) section_args_fun) list;
- test: ((test, float) section_args_fun) list;
- install: std_args_fun;
- uninstall: std_args_fun;
- clean: std_args_fun list;
- clean_doc: (doc, unit) section_args_fun list;
- clean_test: (test, unit) section_args_fun list;
- distclean: std_args_fun list;
- distclean_doc: (doc, unit) section_args_fun list;
- distclean_test: (test, unit) section_args_fun list;
- package: package;
- oasis_fn: string option;
- oasis_version: string;
- oasis_digest: Digest.t option;
- oasis_exec: string option;
- oasis_setup_args: string list;
- setup_update: bool;
- }
+ {
+ configure: std_args_fun;
+ build: std_args_fun;
+ doc: ((doc, unit) section_args_fun) list;
+ test: ((test, float) section_args_fun) list;
+ install: std_args_fun;
+ uninstall: std_args_fun;
+ clean: std_args_fun list;
+ clean_doc: (doc, unit) section_args_fun list;
+ clean_test: (test, unit) section_args_fun list;
+ distclean: std_args_fun list;
+ distclean_doc: (doc, unit) section_args_fun list;
+ distclean_test: (test, unit) section_args_fun list;
+ package: package;
+ oasis_fn: string option;
+ oasis_version: string;
+ oasis_digest: Digest.t option;
+ oasis_exec: string option;
+ oasis_setup_args: string list;
+ setup_update: bool;
+ }
(* Associate a plugin function with data from package *)
@@ -4846,9 +5013,9 @@
(fun acc sct ->
match filter_map sct with
| Some e ->
- e :: acc
+ e :: acc
| None ->
- acc)
+ acc)
[]
lst)
@@ -4865,7 +5032,7 @@
action
- let configure t args =
+ let configure ~ctxt t args =
(* Run configure *)
BaseCustom.hook
t.package.conf_custom
@@ -4874,154 +5041,137 @@
begin
try
unload ();
- load ();
+ load ~ctxt ();
with _ ->
()
end;
(* Run plugin's configure *)
- t.configure t.package args;
+ t.configure ~ctxt t.package args;
(* Dump to allow postconf to change it *)
- dump ())
+ dump ~ctxt ())
();
(* Reload environment *)
unload ();
- load ();
+ load ~ctxt ();
(* Save environment *)
print ();
(* Replace data in file *)
- BaseFileAB.replace t.package.files_ab
+ BaseFileAB.replace ~ctxt t.package.files_ab
- let build t args =
+ let build ~ctxt t args =
BaseCustom.hook
t.package.build_custom
- (t.build t.package)
+ (t.build ~ctxt t.package)
args
- let doc t args =
+ let doc ~ctxt t args =
BaseDoc.doc
+ ~ctxt
(join_plugin_sections
(function
- | Doc (cs, e) ->
- Some
- (lookup_plugin_section
- "documentation"
- (s_ "build")
- cs.cs_name
- t.doc,
- cs,
- e)
- | _ ->
- None)
+ | Doc (cs, e) ->
+ Some
+ (lookup_plugin_section
+ "documentation"
+ (s_ "build")
+ cs.cs_name
+ t.doc,
+ cs,
+ e)
+ | _ ->
+ None)
t.package.sections)
t.package
args
- let test t args =
+ let test ~ctxt t args =
BaseTest.test
+ ~ctxt
(join_plugin_sections
(function
- | Test (cs, e) ->
- Some
- (lookup_plugin_section
- "test"
- (s_ "run")
- cs.cs_name
- t.test,
- cs,
- e)
- | _ ->
- None)
+ | Test (cs, e) ->
+ Some
+ (lookup_plugin_section
+ "test"
+ (s_ "run")
+ cs.cs_name
+ t.test,
+ cs,
+ e)
+ | _ ->
+ None)
t.package.sections)
t.package
args
- let all t args =
- let rno_doc =
- ref false
- in
- let rno_test =
- ref false
- in
- let arg_rest =
- ref []
- in
- Arg.parse_argv
- ~current:(ref 0)
- (Array.of_list
- ((Sys.executable_name^" all") ::
+ let all ~ctxt t args =
+ let rno_doc = ref false in
+ let rno_test = ref false in
+ let arg_rest = ref [] in
+ Arg.parse_argv
+ ~current:(ref 0)
+ (Array.of_list
+ ((Sys.executable_name^" all") ::
(Array.to_list args)))
- [
- "-no-doc",
- Arg.Set rno_doc,
- s_ "Don't run doc target";
-
- "-no-test",
- Arg.Set rno_test,
- s_ "Don't run test target";
-
- "--",
- Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
- s_ "All arguments for configure.";
- ]
- (failwithf (f_ "Don't know what to do with '%s'"))
- "";
-
- info "Running configure step";
- configure t (Array.of_list (List.rev !arg_rest));
+ [
+ "-no-doc",
+ Arg.Set rno_doc,
+ s_ "Don't run doc target";
+
+ "-no-test",
+ Arg.Set rno_test,
+ s_ "Don't run test target";
+
+ "--",
+ Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
+ s_ "All arguments for configure.";
+ ]
+ (failwithf (f_ "Don't know what to do with '%s'"))
+ "";
- info "Running build step";
- build t [||];
+ info "Running configure step";
+ configure ~ctxt t (Array.of_list (List.rev !arg_rest));
- (* Load setup.log dynamic variables *)
- BaseDynVar.init t.package;
+ info "Running build step";
+ build ~ctxt t [||];
- if not !rno_doc then
- begin
- info "Running doc step";
- doc t [||];
- end
- else
- begin
- info "Skipping doc step"
- end;
+ (* Load setup.log dynamic variables *)
+ BaseDynVar.init ~ctxt t.package;
- if not !rno_test then
- begin
- info "Running test step";
- test t [||]
- end
- else
- begin
- info "Skipping test step"
- end
+ if not !rno_doc then begin
+ info "Running doc step";
+ doc ~ctxt t [||]
+ end else begin
+ info "Skipping doc step"
+ end;
+ if not !rno_test then begin
+ info "Running test step";
+ test ~ctxt t [||]
+ end else begin
+ info "Skipping test step"
+ end
- let install t args =
- BaseCustom.hook
- t.package.install_custom
- (t.install t.package)
- args
+ let install ~ctxt t args =
+ BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args
- let uninstall t args =
- BaseCustom.hook
- t.package.uninstall_custom
- (t.uninstall t.package)
- args
+ let uninstall ~ctxt t args =
+ BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args
- let reinstall t args =
- uninstall t args;
- install t args
+ let reinstall ~ctxt t args =
+ uninstall ~ctxt t args;
+ install ~ctxt t args
let clean, distclean =
@@ -5032,11 +5182,11 @@
warning
(f_ "Action fail with error: %s")
(match e with
- | Failure msg -> msg
- | e -> Printexc.to_string e)
+ | Failure msg -> msg
+ | e -> Printexc.to_string e)
in
- let generic_clean t cstm mains docs tests args =
+ let generic_clean ~ctxt t cstm mains docs tests args =
BaseCustom.hook
~failsafe:true
cstm
@@ -5044,45 +5194,32 @@
(* Clean section *)
List.iter
(function
- | Test (cs, test) ->
- let f =
- try
- List.assoc cs.cs_name tests
- with Not_found ->
- fun _ _ _ -> ()
- in
- failsafe
- (f t.package (cs, test))
- args
- | Doc (cs, doc) ->
- let f =
- try
- List.assoc cs.cs_name docs
- with Not_found ->
- fun _ _ _ -> ()
- in
- failsafe
- (f t.package (cs, doc))
- args
- | Library _
- | Object _
- | Executable _
- | Flag _
- | SrcRepo _ ->
- ())
+ | Test (cs, test) ->
+ let f =
+ try
+ List.assoc cs.cs_name tests
+ with Not_found ->
+ fun ~ctxt:_ _ _ _ -> ()
+ in
+ failsafe (f ~ctxt t.package (cs, test)) args
+ | Doc (cs, doc) ->
+ let f =
+ try
+ List.assoc cs.cs_name docs
+ with Not_found ->
+ fun ~ctxt:_ _ _ _ -> ()
+ in
+ failsafe (f ~ctxt t.package (cs, doc)) args
+ | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ())
t.package.sections;
(* Clean whole package *)
- List.iter
- (fun f ->
- failsafe
- (f t.package)
- args)
- mains)
+ List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains)
()
in
- let clean t args =
+ let clean ~ctxt t args =
generic_clean
+ ~ctxt
t
t.package.clean_custom
t.clean
@@ -5091,12 +5228,13 @@
args
in
- let distclean t args =
+ let distclean ~ctxt t args =
(* Call clean *)
- clean t args;
+ clean ~ctxt t args;
(* Call distclean code *)
generic_clean
+ ~ctxt
t
t.package.distclean_custom
t.distclean
@@ -5104,36 +5242,31 @@
t.distclean_test
args;
- (* Remove generated file *)
+ (* Remove generated source files. *)
List.iter
(fun fn ->
- if Sys.file_exists fn then
- begin
- info (f_ "Remove '%s'") fn;
- Sys.remove fn
- end)
- (BaseEnv.default_filename
- ::
- BaseLog.default_filename
- ::
- (List.rev_map BaseFileAB.to_filename t.package.files_ab))
+ if ctxt.srcfs#file_exists fn then begin
+ info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn);
+ ctxt.srcfs#remove fn
+ end)
+ ([BaseEnv.default_filename; BaseLog.default_filename]
+ @ (List.rev_map BaseFileAB.to_filename t.package.files_ab))
in
- clean, distclean
+ clean, distclean
- let version t _ =
- print_endline t.oasis_version
+ let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version
let update_setup_ml, no_update_setup_ml_cli =
let b = ref true in
- b,
- ("-no-update-setup-ml",
- Arg.Clear b,
- s_ " Don't try to update setup.ml, even if _oasis has changed.")
-
+ b,
+ ("-no-update-setup-ml",
+ Arg.Clear b,
+ s_ " Don't try to update setup.ml, even if _oasis has changed.")
+ (* TODO: srcfs *)
let default_oasis_fn = "_oasis"
@@ -5154,16 +5287,16 @@
let setup_ml, args =
match Array.to_list Sys.argv with
| setup_ml :: args ->
- setup_ml, args
+ setup_ml, args
| [] ->
- failwith
- (s_ "Expecting non-empty command line arguments.")
+ failwith
+ (s_ "Expecting non-empty command line arguments.")
in
let ocaml, setup_ml =
if Sys.executable_name = Sys.argv.(0) then
(* We are not running in standard mode, probably the script
* is precompiled.
- *)
+ *)
"ocaml", "setup.ml"
else
ocaml, setup_ml
@@ -5174,64 +5307,62 @@
OASISExec.run_read_one_line
~ctxt:!BaseContext.default
~f_exit_code:
- (function
- | 0 ->
- ()
- | 1 ->
- failwithf
- (f_ "Executable '%s' is probably an old version \
- of oasis (< 0.3.0), please update to version \
- v%s.")
- oasis_exec t.oasis_version
- | 127 ->
- failwithf
- (f_ "Cannot find executable '%s', please install \
- oasis v%s.")
- oasis_exec t.oasis_version
- | n ->
- failwithf
- (f_ "Command '%s version' exited with code %d.")
- oasis_exec n)
+ (function
+ | 0 ->
+ ()
+ | 1 ->
+ failwithf
+ (f_ "Executable '%s' is probably an old version \
+ of oasis (< 0.3.0), please update to version \
+ v%s.")
+ oasis_exec t.oasis_version
+ | 127 ->
+ failwithf
+ (f_ "Cannot find executable '%s', please install \
+ oasis v%s.")
+ oasis_exec t.oasis_version
+ | n ->
+ failwithf
+ (f_ "Command '%s version' exited with code %d.")
+ oasis_exec n)
oasis_exec ["version"]
in
- if OASISVersion.comparator_apply
- (OASISVersion.version_of_string oasis_exec_version)
- (OASISVersion.VGreaterEqual
- (OASISVersion.version_of_string t.oasis_version)) then
- begin
- (* We have a version >= for the executable oasis, proceed with
- * update.
- *)
- (* TODO: delegate this check to 'oasis setup'. *)
- if Sys.os_type = "Win32" then
- failwithf
- (f_ "It is not possible to update the running script \
- setup.ml on Windows. Please update setup.ml by \
- running '%s'.")
- (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
- else
- begin
- OASISExec.run
- ~ctxt:!BaseContext.default
- ~f_exit_code:
- (function
- | 0 ->
- ()
- | n ->
- failwithf
- (f_ "Unable to update setup.ml using '%s', \
- please fix the problem and retry.")
- oasis_exec)
- oasis_exec ("setup" :: t.oasis_setup_args);
- OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
- end
- end
- else
- failwithf
- (f_ "The version of '%s' (v%s) doesn't match the version of \
- oasis used to generate the %s file. Please install at \
- least oasis v%s.")
- oasis_exec oasis_exec_version setup_ml t.oasis_version
+ if OASISVersion.comparator_apply
+ (OASISVersion.version_of_string oasis_exec_version)
+ (OASISVersion.VGreaterEqual
+ (OASISVersion.version_of_string t.oasis_version)) then
+ begin
+ (* We have a version >= for the executable oasis, proceed with
+ * update.
+ *)
+ (* TODO: delegate this check to 'oasis setup'. *)
+ if Sys.os_type = "Win32" then
+ failwithf
+ (f_ "It is not possible to update the running script \
+ setup.ml on Windows. Please update setup.ml by \
+ running '%s'.")
+ (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
+ else
+ begin
+ OASISExec.run
+ ~ctxt:!BaseContext.default
+ ~f_exit_code:
+ (fun n ->
+ if n <> 0 then
+ failwithf
+ (f_ "Unable to update setup.ml using '%s', \
+ please fix the problem and retry.")
+ oasis_exec)
+ oasis_exec ("setup" :: t.oasis_setup_args);
+ OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
+ end
+ end
+ else
+ failwithf
+ (f_ "The version of '%s' (v%s) doesn't match the version of \
+ oasis used to generate the %s file. Please install at \
+ least oasis v%s.")
+ oasis_exec oasis_exec_version setup_ml t.oasis_version
in
if !update_setup_ml then
@@ -5248,7 +5379,7 @@
else
false
| None ->
- false
+ false
with e ->
error
(f_ "Error when updating setup.ml. If you want to avoid this error, \
@@ -5262,158 +5393,287 @@
let setup t =
- let catch_exn =
- ref true
- in
- try
- let act_ref =
- ref (fun _ ->
- failwithf
- (f_ "No action defined, run '%s %s -help'")
- Sys.executable_name
- Sys.argv.(0))
-
- in
- let extra_args_ref =
- ref []
- in
- let allow_empty_env_ref =
- ref false
- in
- let arg_handle ?(allow_empty_env=false) act =
- Arg.Tuple
- [
- Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
-
- Arg.Unit
- (fun () ->
- allow_empty_env_ref := allow_empty_env;
- act_ref := act);
- ]
- in
+ let catch_exn = ref true in
+ let act_ref =
+ ref (fun ~ctxt:_ _ ->
+ failwithf
+ (f_ "No action defined, run '%s %s -help'")
+ Sys.executable_name
+ Sys.argv.(0))
- Arg.parse
- (Arg.align
- ([
- "-configure",
- arg_handle ~allow_empty_env:true configure,
- s_ "[options*] Configure the whole build process.";
-
- "-build",
- arg_handle build,
- s_ "[options*] Build executables and libraries.";
-
- "-doc",
- arg_handle doc,
- s_ "[options*] Build documents.";
-
- "-test",
- arg_handle test,
- s_ "[options*] Run tests.";
-
- "-all",
- arg_handle ~allow_empty_env:true all,
- s_ "[options*] Run configure, build, doc and test targets.";
-
- "-install",
- arg_handle install,
- s_ "[options*] Install libraries, data, executables \
- and documents.";
-
- "-uninstall",
- arg_handle uninstall,
- s_ "[options*] Uninstall libraries, data, executables \
- and documents.";
-
- "-reinstall",
- arg_handle reinstall,
- s_ "[options*] Uninstall and install libraries, data, \
- executables and documents.";
-
- "-clean",
- arg_handle ~allow_empty_env:true clean,
- s_ "[options*] Clean files generated by a build.";
-
- "-distclean",
- arg_handle ~allow_empty_env:true distclean,
- s_ "[options*] Clean files generated by a build and configure.";
-
- "-version",
- arg_handle ~allow_empty_env:true version,
- s_ " Display version of OASIS used to generate this setup.ml.";
-
- "-no-catch-exn",
- Arg.Clear catch_exn,
- s_ " Don't catch exception, useful for debugging.";
- ]
- @
+ in
+ let extra_args_ref = ref [] in
+ let allow_empty_env_ref = ref false in
+ let arg_handle ?(allow_empty_env=false) act =
+ Arg.Tuple
+ [
+ Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
+ Arg.Unit
+ (fun () ->
+ allow_empty_env_ref := allow_empty_env;
+ act_ref := act);
+ ]
+ in
+ try
+ let () =
+ Arg.parse
+ (Arg.align
+ ([
+ "-configure",
+ arg_handle ~allow_empty_env:true configure,
+ s_ "[options*] Configure the whole build process.";
+
+ "-build",
+ arg_handle build,
+ s_ "[options*] Build executables and libraries.";
+
+ "-doc",
+ arg_handle doc,
+ s_ "[options*] Build documents.";
+
+ "-test",
+ arg_handle test,
+ s_ "[options*] Run tests.";
+
+ "-all",
+ arg_handle ~allow_empty_env:true all,
+ s_ "[options*] Run configure, build, doc and test targets.";
+
+ "-install",
+ arg_handle install,
+ s_ "[options*] Install libraries, data, executables \
+ and documents.";
+
+ "-uninstall",
+ arg_handle uninstall,
+ s_ "[options*] Uninstall libraries, data, executables \
+ and documents.";
+
+ "-reinstall",
+ arg_handle reinstall,
+ s_ "[options*] Uninstall and install libraries, data, \
+ executables and documents.";
+
+ "-clean",
+ arg_handle ~allow_empty_env:true clean,
+ s_ "[options*] Clean files generated by a build.";
+
+ "-distclean",
+ arg_handle ~allow_empty_env:true distclean,
+ s_ "[options*] Clean files generated by a build and configure.";
+
+ "-version",
+ arg_handle ~allow_empty_env:true version,
+ s_ " Display version of OASIS used to generate this setup.ml.";
+
+ "-no-catch-exn",
+ Arg.Clear catch_exn,
+ s_ " Don't catch exception, useful for debugging.";
+ ]
+ @
(if t.setup_update then
[no_update_setup_ml_cli]
else
[])
- @ (BaseContext.args ())))
- (failwithf (f_ "Don't know what to do with '%s'"))
- (s_ "Setup and run build process current package\n");
+ @ (BaseContext.args ())))
+ (failwithf (f_ "Don't know what to do with '%s'"))
+ (s_ "Setup and run build process current package\n")
+ in
- (* Build initial environment *)
- load ~allow_empty:!allow_empty_env_ref ();
+ (* Instantiate the context. *)
+ let ctxt = !BaseContext.default in
- (** Initialize flags *)
- List.iter
- (function
- | Flag (cs, {flag_description = hlp;
- flag_default = choices}) ->
- begin
- let apply ?short_desc () =
- var_ignore
- (var_define
- ~cli:CLIEnable
- ?short_desc
- (OASISUtils.varname_of_string cs.cs_name)
- (fun () ->
- string_of_bool
- (var_choose
- ~name:(Printf.sprintf
- (f_ "default value of flag %s")
- cs.cs_name)
- ~printer:string_of_bool
- choices)))
- in
- match hlp with
- | Some hlp ->
- apply ~short_desc:(fun () -> hlp) ()
- | None ->
- apply ()
- end
- | _ ->
- ())
- t.package.sections;
+ (* Build initial environment *)
+ load ~ctxt ~allow_empty:!allow_empty_env_ref ();
- BaseStandardVar.init t.package;
+ (** Initialize flags *)
+ List.iter
+ (function
+ | Flag (cs, {flag_description = hlp;
+ flag_default = choices}) ->
+ begin
+ let apply ?short_desc () =
+ var_ignore
+ (var_define
+ ~cli:CLIEnable
+ ?short_desc
+ (OASISUtils.varname_of_string cs.cs_name)
+ (fun () ->
+ string_of_bool
+ (var_choose
+ ~name:(Printf.sprintf
+ (f_ "default value of flag %s")
+ cs.cs_name)
+ ~printer:string_of_bool
+ choices)))
+ in
+ match hlp with
+ | Some hlp -> apply ~short_desc:(fun () -> hlp) ()
+ | None -> apply ()
+ end
+ | _ ->
+ ())
+ t.package.sections;
- BaseDynVar.init t.package;
+ BaseStandardVar.init t.package;
- if t.setup_update && update_setup_ml t then
- ()
- else
- !act_ref t (Array.of_list (List.rev !extra_args_ref))
+ BaseDynVar.init ~ctxt t.package;
- with e when !catch_exn ->
- error "%s" (Printexc.to_string e);
- exit 1
+ if not (t.setup_update && update_setup_ml t) then
+ !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref))
+
+ with e when !catch_exn ->
+ error "%s" (Printexc.to_string e);
+ exit 1
+
+
+end
+
+module BaseCompat = struct
+(* # 22 "src/base/BaseCompat.ml" *)
+
+ (** Compatibility layer to provide a stable API inside setup.ml.
+ This layer allows OASIS to change in between minor versions
+ (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This
+ enables to write functions that manipulate setup_t inside setup.ml. See
+ deps.ml for an example.
+
+ The module opened by default will depend on the version of the _oasis. E.g.
+ if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and
+ the function Compat_0_3 will be called. If setup.ml is generated with the
+ -nocompat, no module will be opened.
+
+ @author Sylvain Le Gall
+ *)
+
+ module Compat_0_4 =
+ struct
+ let rctxt = ref !BaseContext.default
+
+ module BaseSetup =
+ struct
+ module Original = BaseSetup
+
+ open OASISTypes
+
+ type std_args_fun = package -> string array -> unit
+ type ('a, 'b) section_args_fun =
+ name * (package -> (common_section * 'a) -> string array -> 'b)
+ type t =
+ {
+ configure: std_args_fun;
+ build: std_args_fun;
+ doc: ((doc, unit) section_args_fun) list;
+ test: ((test, float) section_args_fun) list;
+ install: std_args_fun;
+ uninstall: std_args_fun;
+ clean: std_args_fun list;
+ clean_doc: (doc, unit) section_args_fun list;
+ clean_test: (test, unit) section_args_fun list;
+ distclean: std_args_fun list;
+ distclean_doc: (doc, unit) section_args_fun list;
+ distclean_test: (test, unit) section_args_fun list;
+ package: package;
+ oasis_fn: string option;
+ oasis_version: string;
+ oasis_digest: Digest.t option;
+ oasis_exec: string option;
+ oasis_setup_args: string list;
+ setup_update: bool;
+ }
+
+ let setup t =
+ let mk_std_args_fun f =
+ fun ~ctxt pkg args -> rctxt := ctxt; f pkg args
+ in
+ let mk_section_args_fun l =
+ List.map
+ (fun (nm, f) ->
+ nm,
+ (fun ~ctxt pkg sct args ->
+ rctxt := ctxt;
+ f pkg sct args))
+ l
+ in
+ let t' =
+ {
+ Original.
+ configure = mk_std_args_fun t.configure;
+ build = mk_std_args_fun t.build;
+ doc = mk_section_args_fun t.doc;
+ test = mk_section_args_fun t.test;
+ install = mk_std_args_fun t.install;
+ uninstall = mk_std_args_fun t.uninstall;
+ clean = List.map mk_std_args_fun t.clean;
+ clean_doc = mk_section_args_fun t.clean_doc;
+ clean_test = mk_section_args_fun t.clean_test;
+ distclean = List.map mk_std_args_fun t.distclean;
+ distclean_doc = mk_section_args_fun t.distclean_doc;
+ distclean_test = mk_section_args_fun t.distclean_test;
+
+ package = t.package;
+ oasis_fn = t.oasis_fn;
+ oasis_version = t.oasis_version;
+ oasis_digest = t.oasis_digest;
+ oasis_exec = t.oasis_exec;
+ oasis_setup_args = t.oasis_setup_args;
+ setup_update = t.setup_update;
+ }
+ in
+ Original.setup t'
+
+ end
+
+ let adapt_setup_t setup_t =
+ let module O = BaseSetup.Original in
+ let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in
+ let mk_section_args_fun l =
+ List.map
+ (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args))
+ l
+ in
+ {
+ BaseSetup.
+ configure = mk_std_args_fun setup_t.O.configure;
+ build = mk_std_args_fun setup_t.O.build;
+ doc = mk_section_args_fun setup_t.O.doc;
+ test = mk_section_args_fun setup_t.O.test;
+ install = mk_std_args_fun setup_t.O.install;
+ uninstall = mk_std_args_fun setup_t.O.uninstall;
+ clean = List.map mk_std_args_fun setup_t.O.clean;
+ clean_doc = mk_section_args_fun setup_t.O.clean_doc;
+ clean_test = mk_section_args_fun setup_t.O.clean_test;
+ distclean = List.map mk_std_args_fun setup_t.O.distclean;
+ distclean_doc = mk_section_args_fun setup_t.O.distclean_doc;
+ distclean_test = mk_section_args_fun setup_t.O.distclean_test;
+
+ package = setup_t.O.package;
+ oasis_fn = setup_t.O.oasis_fn;
+ oasis_version = setup_t.O.oasis_version;
+ oasis_digest = setup_t.O.oasis_digest;
+ oasis_exec = setup_t.O.oasis_exec;
+ oasis_setup_args = setup_t.O.oasis_setup_args;
+ setup_update = setup_t.O.setup_update;
+ }
+ end
+ module Compat_0_3 =
+ struct
+ include Compat_0_4
+ end
+
end
-# 5409 "setup.ml"
+# 5668 "setup.ml"
module InternalConfigurePlugin = struct
(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
(** Configure using internal scheme
@author Sylvain Le Gall
- *)
+ *)
open BaseEnv
@@ -5424,9 +5684,9 @@
(** Configure build using provided series of check to be done
- * and then output corresponding file.
- *)
- let configure pkg argv =
+ and then output corresponding file.
+ *)
+ let configure ~ctxt:_ pkg argv =
let var_ignore_eval var = let _s: string = var () in () in
let errors = ref SetString.empty in
let buff = Buffer.create 13 in
@@ -5448,29 +5708,29 @@
let check_tools lst =
List.iter
(function
- | ExternalTool tool ->
- begin
- try
- var_ignore_eval (BaseCheck.prog tool)
- with e ->
- warn_exception e;
- add_errors (f_ "Cannot find external tool '%s'") tool
- end
- | InternalExecutable nm1 ->
- (* Check that matching tool is built *)
- List.iter
- (function
- | Executable ({cs_name = nm2},
- {bs_build = build},
- _) when nm1 = nm2 ->
- if not (var_choose build) then
- add_errors
- (f_ "Cannot find buildable internal executable \
- '%s' when checking build depends")
- nm1
- | _ ->
- ())
- pkg.sections)
+ | ExternalTool tool ->
+ begin
+ try
+ var_ignore_eval (BaseCheck.prog tool)
+ with e ->
+ warn_exception e;
+ add_errors (f_ "Cannot find external tool '%s'") tool
+ end
+ | InternalExecutable nm1 ->
+ (* Check that matching tool is built *)
+ List.iter
+ (function
+ | Executable ({cs_name = nm2; _},
+ {bs_build = build; _},
+ _) when nm1 = nm2 ->
+ if not (var_choose build) then
+ add_errors
+ (f_ "Cannot find buildable internal executable \
+ '%s' when checking build depends")
+ nm1
+ | _ ->
+ ())
+ pkg.sections)
lst
in
@@ -5494,39 +5754,39 @@
(* Check depends *)
List.iter
(function
- | FindlibPackage (findlib_pkg, version_comparator) ->
- begin
- try
- var_ignore_eval
- (BaseCheck.package ?version_comparator findlib_pkg)
- with e ->
- warn_exception e;
- match version_comparator with
- | None ->
- add_errors
- (f_ "Cannot find findlib package %s")
- findlib_pkg
- | Some ver_cmp ->
- add_errors
- (f_ "Cannot find findlib package %s (%s)")
- findlib_pkg
- (OASISVersion.string_of_comparator ver_cmp)
- end
- | InternalLibrary nm1 ->
- (* Check that matching library is built *)
- List.iter
- (function
- | Library ({cs_name = nm2},
- {bs_build = build},
- _) when nm1 = nm2 ->
- if not (var_choose build) then
- add_errors
- (f_ "Cannot find buildable internal library \
- '%s' when checking build depends")
- nm1
- | _ ->
- ())
- pkg.sections)
+ | FindlibPackage (findlib_pkg, version_comparator) ->
+ begin
+ try
+ var_ignore_eval
+ (BaseCheck.package ?version_comparator findlib_pkg)
+ with e ->
+ warn_exception e;
+ match version_comparator with
+ | None ->
+ add_errors
+ (f_ "Cannot find findlib package %s")
+ findlib_pkg
+ | Some ver_cmp ->
+ add_errors
+ (f_ "Cannot find findlib package %s (%s)")
+ findlib_pkg
+ (OASISVersion.string_of_comparator ver_cmp)
+ end
+ | InternalLibrary nm1 ->
+ (* Check that matching library is built *)
+ List.iter
+ (function
+ | Library ({cs_name = nm2; _},
+ {bs_build = build; _},
+ _) when nm1 = nm2 ->
+ if not (var_choose build) then
+ add_errors
+ (f_ "Cannot find buildable internal library \
+ '%s' when checking build depends")
+ nm1
+ | _ ->
+ ())
+ pkg.sections)
bs.bs_build_depends
end
in
@@ -5538,50 +5798,50 @@
begin
match pkg.ocaml_version with
| Some ver_cmp ->
- begin
- try
- var_ignore_eval
- (BaseCheck.version
- "ocaml"
- ver_cmp
- BaseStandardVar.ocaml_version)
- with e ->
- warn_exception e;
- add_errors
- (f_ "OCaml version %s doesn't match version constraint %s")
- (BaseStandardVar.ocaml_version ())
- (OASISVersion.string_of_comparator ver_cmp)
- end
+ begin
+ try
+ var_ignore_eval
+ (BaseCheck.version
+ "ocaml"
+ ver_cmp
+ BaseStandardVar.ocaml_version)
+ with e ->
+ warn_exception e;
+ add_errors
+ (f_ "OCaml version %s doesn't match version constraint %s")
+ (BaseStandardVar.ocaml_version ())
+ (OASISVersion.string_of_comparator ver_cmp)
+ end
| None ->
- ()
+ ()
end;
(* Findlib version *)
begin
match pkg.findlib_version with
| Some ver_cmp ->
- begin
- try
- var_ignore_eval
- (BaseCheck.version
- "findlib"
- ver_cmp
- BaseStandardVar.findlib_version)
- with e ->
- warn_exception e;
- add_errors
- (f_ "Findlib version %s doesn't match version constraint %s")
- (BaseStandardVar.findlib_version ())
- (OASISVersion.string_of_comparator ver_cmp)
- end
+ begin
+ try
+ var_ignore_eval
+ (BaseCheck.version
+ "findlib"
+ ver_cmp
+ BaseStandardVar.findlib_version)
+ with e ->
+ warn_exception e;
+ add_errors
+ (f_ "Findlib version %s doesn't match version constraint %s")
+ (BaseStandardVar.findlib_version ())
+ (OASISVersion.string_of_comparator ver_cmp)
+ end
| None ->
- ()
+ ()
end;
(* Make sure the findlib version is fine for the OCaml compiler. *)
begin
let ocaml_ge4 =
OASISVersion.version_compare
- (OASISVersion.version_of_string (BaseStandardVar.ocaml_version()))
+ (OASISVersion.version_of_string (BaseStandardVar.ocaml_version ()))
(OASISVersion.version_of_string "4.0.0") >= 0 in
if ocaml_ge4 then
let findlib_lt132 =
@@ -5606,37 +5866,37 @@
(* Check build depends *)
List.iter
(function
- | Executable (_, bs, _)
- | Library (_, bs, _) as sct ->
- build_checks sct bs
- | Doc (_, doc) ->
- if var_choose doc.doc_build then
- check_tools doc.doc_build_tools
- | Test (_, test) ->
- if var_choose test.test_run then
- check_tools test.test_tools
- | _ ->
- ())
+ | Executable (_, bs, _)
+ | Library (_, bs, _) as sct ->
+ build_checks sct bs
+ | Doc (_, doc) ->
+ if var_choose doc.doc_build then
+ check_tools doc.doc_build_tools
+ | Test (_, test) ->
+ if var_choose test.test_run then
+ check_tools test.test_tools
+ | _ ->
+ ())
pkg.sections;
(* Check if we need native dynlink (presence of libraries that compile to
- * native)
- *)
+ native)
+ *)
begin
let has_cmxa =
List.exists
(function
- | Library (_, bs, _) ->
- var_choose bs.bs_build &&
- (bs.bs_compiled_object = Native ||
- (bs.bs_compiled_object = Best &&
- bool_of_string (BaseStandardVar.is_native ())))
- | _ ->
- false)
+ | Library (_, bs, _) ->
+ var_choose bs.bs_build &&
+ (bs.bs_compiled_object = Native ||
+ (bs.bs_compiled_object = Best &&
+ bool_of_string (BaseStandardVar.is_native ())))
+ | _ ->
+ false)
pkg.sections
in
- if has_cmxa then
- var_ignore_eval BaseStandardVar.native_dynlink
+ if has_cmxa then
+ var_ignore_eval BaseStandardVar.native_dynlink
end;
(* Check errors *)
@@ -5665,6 +5925,8 @@
*)
+ (* TODO: rewrite this module with OASISFileSystem. *)
+
open BaseEnv
open BaseStandardVar
open BaseMessage
@@ -5674,34 +5936,17 @@
open OASISUtils
- let exec_hook =
- ref (fun (cs, bs, exec) -> cs, bs, exec)
-
-
- let lib_hook =
- ref (fun (cs, bs, lib) -> cs, bs, lib, [])
-
-
- let obj_hook =
- ref (fun (cs, bs, obj) -> cs, bs, obj, [])
-
-
- let doc_hook =
- ref (fun (cs, doc) -> cs, doc)
+ let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec)
+ let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, [])
+ let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, [])
+ let doc_hook = ref (fun (cs, doc) -> cs, doc)
-
- let install_file_ev =
- "install-file"
-
-
- let install_dir_ev =
- "install-dir"
-
-
- let install_findlib_ev =
- "install-findlib"
+ let install_file_ev = "install-file"
+ let install_dir_ev = "install-dir"
+ let install_findlib_ev = "install-findlib"
+ (* TODO: this can be more generic and used elsewhere. *)
let win32_max_command_line_length = 8000
@@ -5770,7 +6015,7 @@
["install" :: findlib_name :: meta :: files]
- let install pkg argv =
+ let install =
let in_destdir =
try
@@ -5785,9 +6030,9 @@
fun fn -> fn
in
- let install_file ?tgt_fn src_file envdir =
+ let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
let tgt_dir =
- in_destdir (envdir ())
+ if prepend_destdir then in_destdir (envdir ()) else envdir ()
in
let tgt_file =
Filename.concat
@@ -5800,20 +6045,48 @@
in
(* Create target directory if needed *)
OASISFileUtil.mkdir_parent
- ~ctxt:!BaseContext.default
+ ~ctxt
(fun dn ->
info (f_ "Creating directory '%s'") dn;
- BaseLog.register install_dir_ev dn)
- tgt_dir;
+ BaseLog.register ~ctxt install_dir_ev dn)
+ (Filename.dirname tgt_file);
(* Really install files *)
info (f_ "Copying file '%s' to '%s'") src_file tgt_file;
- OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file;
- BaseLog.register install_file_ev tgt_file
+ OASISFileUtil.cp ~ctxt src_file tgt_file;
+ BaseLog.register ~ctxt install_file_ev tgt_file
+ in
+
+ (* Install the files for a library. *)
+
+ let install_lib_files ~ctxt findlib_name files =
+ let findlib_dir =
+ let dn =
+ let findlib_destdir =
+ OASISExec.run_read_one_line ~ctxt (ocamlfind ())
+ ["printconf" ; "destdir"]
+ in
+ Filename.concat findlib_destdir findlib_name
+ in
+ fun () -> dn
+ in
+ let () =
+ if not (OASISFileUtil.file_exists_case (findlib_dir ())) then
+ failwithf
+ (f_ "Directory '%s' doesn't exist for findlib library %s")
+ (findlib_dir ()) findlib_name
+ in
+ let f dir file =
+ let basename = Filename.basename file in
+ let tgt_fn = Filename.concat dir basename in
+ (* Destdir is already include in printconf. *)
+ install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir
+ in
+ List.iter (fun (dir, files) -> List.iter (f dir) files) files ;
in
(* Install data into defined directory *)
- let install_data srcdir lst tgtdir =
+ let install_data ~ctxt srcdir lst tgtdir =
let tgtdir =
OASISHostPath.of_unix (var_expand tgtdir)
in
@@ -5830,7 +6103,7 @@
src;
List.iter
(fun fn ->
- install_file
+ install_file ~ctxt
fn
(fun () ->
match tgt_opt with
@@ -5845,8 +6118,8 @@
let make_fnames modul sufx =
List.fold_right
begin fun sufx accu ->
- (String.capitalize modul ^ sufx) ::
- (String.uncapitalize modul ^ sufx) ::
+ (OASISString.capitalize_ascii modul ^ sufx) ::
+ (OASISString.uncapitalize_ascii modul ^ sufx) ::
accu
end
sufx
@@ -5854,149 +6127,146 @@
in
(** Install all libraries *)
- let install_libs pkg =
-
- let files_of_library (f_data, acc) data_lib =
- let cs, bs, lib, lib_extra =
- !lib_hook data_lib
- in
- if var_choose bs.bs_install &&
- BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then
- begin
- let acc =
- (* Start with acc + lib_extra *)
- List.rev_append lib_extra acc
- in
- let acc =
- (* Add uncompiled header from the source tree *)
- let path =
- OASISHostPath.of_unix bs.bs_path
- in
- List.fold_left
- begin fun acc modul ->
- begin
- try
- [List.find
- OASISFileUtil.file_exists_case
- (List.map
- (Filename.concat path)
- (make_fnames modul [".mli"; ".ml"]))]
- with Not_found ->
- warning
- (f_ "Cannot find source header for module %s \
- in library %s")
- modul cs.cs_name;
- []
- end
- @
- List.filter
- OASISFileUtil.file_exists_case
- (List.map
- (Filename.concat path)
- (make_fnames modul [".annot";".cmti";".cmt"]))
- @ acc
- end
- acc
- lib.lib_modules
- in
+ let install_libs ~ctxt pkg =
- let acc =
- (* Get generated files *)
- BaseBuilt.fold
- BaseBuilt.BLib
- cs.cs_name
- (fun acc fn -> fn :: acc)
- acc
- in
+ let find_first_existing_files_in_path bs lst =
+ let path = OASISHostPath.of_unix bs.bs_path in
+ List.find
+ OASISFileUtil.file_exists_case
+ (List.map (Filename.concat path) lst)
+ in
- let f_data () =
- (* Install data associated with the library *)
- install_data
- bs.bs_path
- bs.bs_data_files
- (Filename.concat
- (datarootdir ())
- pkg.name);
- f_data ()
- in
+ let files_of_modules new_files typ cs bs modules =
+ List.fold_left
+ (fun acc modul ->
+ begin
+ try
+ (* Add uncompiled header from the source tree *)
+ [find_first_existing_files_in_path
+ bs (make_fnames modul [".mli"; ".ml"])]
+ with Not_found ->
+ warning
+ (f_ "Cannot find source header for module %s \
+ in %s %s")
+ typ modul cs.cs_name;
+ []
+ end
+ @
+ List.fold_left
+ (fun acc fn ->
+ try
+ find_first_existing_files_in_path bs [fn] :: acc
+ with Not_found ->
+ acc)
+ acc (make_fnames modul [".annot";".cmti";".cmt"]))
+ new_files
+ modules
+ in
- (f_data, acc)
- end
- else
- begin
- (f_data, acc)
- end
- and files_of_object (f_data, acc) data_obj =
- let cs, bs, obj, obj_extra =
- !obj_hook data_obj
+ let files_of_build_section (f_data, new_files) typ cs bs =
+ let extra_files =
+ List.map
+ (fun fn ->
+ try
+ find_first_existing_files_in_path bs [fn]
+ with Not_found ->
+ failwithf
+ (f_ "Cannot find extra findlib file %S in %s %s ")
+ fn
+ typ
+ cs.cs_name)
+ bs.bs_findlib_extra_files
in
- if var_choose bs.bs_install &&
- BaseBuilt.is_built BaseBuilt.BObj cs.cs_name then
- begin
- let acc =
- (* Start with acc + obj_extra *)
- List.rev_append obj_extra acc
- in
- let acc =
- (* Add uncompiled header from the source tree *)
- let path =
- OASISHostPath.of_unix bs.bs_path
- in
- List.fold_left
- begin fun acc modul ->
- begin
- try
- [List.find
- OASISFileUtil.file_exists_case
- (List.map
- (Filename.concat path)
- (make_fnames modul [".mli"; ".ml"]))]
- with Not_found ->
- warning
- (f_ "Cannot find source header for module %s \
- in object %s")
- modul cs.cs_name;
- []
- end
- @
- List.filter
- OASISFileUtil.file_exists_case
- (List.map
- (Filename.concat path)
- (make_fnames modul [".annot";".cmti";".cmt"]))
- @ acc
- end
- acc
- obj.obj_modules
- in
+ let f_data () =
+ (* Install data associated with the library *)
+ install_data
+ ~ctxt
+ bs.bs_path
+ bs.bs_data_files
+ (Filename.concat
+ (datarootdir ())
+ pkg.name);
+ f_data ()
+ in
+ f_data, new_files @ extra_files
+ in
- let acc =
- (* Get generated files *)
- BaseBuilt.fold
- BaseBuilt.BObj
- cs.cs_name
- (fun acc fn -> fn :: acc)
- acc
- in
+ let files_of_library (f_data, acc) data_lib =
+ let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in
+ if var_choose bs.bs_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin
+ (* Start with lib_extra *)
+ let new_files = lib_extra in
+ let new_files =
+ files_of_modules new_files "library" cs bs lib.lib_modules
+ in
+ let f_data, new_files =
+ files_of_build_section (f_data, new_files) "library" cs bs
+ in
+ let new_files =
+ (* Get generated files *)
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BLib
+ cs.cs_name
+ (fun acc fn -> fn :: acc)
+ new_files
+ in
+ let acc = (dn, new_files) :: acc in
- let f_data () =
- (* Install data associated with the object *)
- install_data
- bs.bs_path
- bs.bs_data_files
- (Filename.concat
- (datarootdir ())
- pkg.name);
- f_data ()
- in
+ let f_data () =
+ (* Install data associated with the library *)
+ install_data
+ ~ctxt
+ bs.bs_path
+ bs.bs_data_files
+ (Filename.concat
+ (datarootdir ())
+ pkg.name);
+ f_data ()
+ in
- (f_data, acc)
- end
- else
- begin
- (f_data, acc)
- end
+ (f_data, acc)
+ end else begin
+ (f_data, acc)
+ end
+ and files_of_object (f_data, acc) data_obj =
+ let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in
+ if var_choose bs.bs_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin
+ (* Start with obj_extra *)
+ let new_files = obj_extra in
+ let new_files =
+ files_of_modules new_files "object" cs bs obj.obj_modules
+ in
+ let f_data, new_files =
+ files_of_build_section (f_data, new_files) "object" cs bs
+ in
+
+ let new_files =
+ (* Get generated files *)
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BObj
+ cs.cs_name
+ (fun acc fn -> fn :: acc)
+ new_files
+ in
+ let acc = (dn, new_files) :: acc in
+ let f_data () =
+ (* Install data associated with the object *)
+ install_data
+ ~ctxt
+ bs.bs_path
+ bs.bs_data_files
+ (Filename.concat (datarootdir ()) pkg.name);
+ f_data ()
+ in
+ (f_data, acc)
+ end else begin
+ (f_data, acc)
+ end
in
(* Install one group of library *)
@@ -6007,10 +6277,10 @@
match grp with
| Container (_, children) ->
data_and_files, children
- | Package (_, cs, bs, `Library lib, children) ->
- files_of_library data_and_files (cs, bs, lib), children
- | Package (_, cs, bs, `Object obj, children) ->
- files_of_object data_and_files (cs, bs, obj), children
+ | Package (_, cs, bs, `Library lib, dn, children) ->
+ files_of_library data_and_files (cs, bs, lib, dn), children
+ | Package (_, cs, bs, `Object obj, dn, children) ->
+ files_of_object data_and_files (cs, bs, obj, dn), children
in
List.fold_left
install_group_lib_aux
@@ -6019,264 +6289,196 @@
in
(* Findlib name of the root library *)
- let findlib_name =
- findlib_of_group grp
- in
+ let findlib_name = findlib_of_group grp in
(* Determine root library *)
- let root_lib =
- root_of_group grp
- in
+ let root_lib = root_of_group grp in
(* All files to install for this library *)
- let f_data, files =
- install_group_lib_aux (ignore, []) grp
- in
+ let f_data, files = install_group_lib_aux (ignore, []) grp in
(* Really install, if there is something to install *)
- if files = [] then
- begin
- warning
- (f_ "Nothing to install for findlib library '%s'")
- findlib_name
- end
- else
- begin
- let meta =
- (* Search META file *)
- let _, bs, _ =
- root_lib
- in
- let res =
- Filename.concat bs.bs_path "META"
- in
- if not (OASISFileUtil.file_exists_case res) then
- failwithf
- (f_ "Cannot find file '%s' for findlib library %s")
- res
- findlib_name;
- res
- in
- let files =
- (* Make filename shorter to avoid hitting command max line length
- * too early, esp. on Windows.
- *)
- let remove_prefix p n =
- let plen = String.length p in
- let nlen = String.length n in
- if plen <= nlen && String.sub n 0 plen = p then
- begin
- let fn_sep =
- if Sys.os_type = "Win32" then
- '\\'
- else
- '/'
- in
- let cutpoint = plen +
- (if plen < nlen && n.[plen] = fn_sep then
- 1
- else
- 0)
- in
- String.sub n cutpoint (nlen - cutpoint)
- end
- else
- n
- in
- List.map (remove_prefix (Sys.getcwd ())) files
- in
- info
- (f_ "Installing findlib library '%s'")
- findlib_name;
- let ocamlfind = ocamlfind () in
- let commands =
- split_install_command
- ocamlfind
- findlib_name
- meta
- files
+ if files = [] then begin
+ warning
+ (f_ "Nothing to install for findlib library '%s'") findlib_name
+ end else begin
+ let meta =
+ (* Search META file *)
+ let _, bs, _ = root_lib in
+ let res = Filename.concat bs.bs_path "META" in
+ if not (OASISFileUtil.file_exists_case res) then
+ failwithf
+ (f_ "Cannot find file '%s' for findlib library %s")
+ res
+ findlib_name;
+ res
+ in
+ let files =
+ (* Make filename shorter to avoid hitting command max line length
+ * too early, esp. on Windows.
+ *)
+ (* TODO: move to OASISHostPath as make_relative. *)
+ let remove_prefix p n =
+ let plen = String.length p in
+ let nlen = String.length n in
+ if plen <= nlen && String.sub n 0 plen = p then begin
+ let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in
+ let cutpoint =
+ plen +
+ (if plen < nlen && n.[plen] = fn_sep then 1 else 0)
in
- List.iter
- (OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
- commands;
- BaseLog.register install_findlib_ev findlib_name
- end;
-
- (* Install data files *)
- f_data ();
+ String.sub n cutpoint (nlen - cutpoint)
+ end else begin
+ n
+ end
+ in
+ List.map
+ (fun (dir, fn) ->
+ (dir, List.map (remove_prefix (Sys.getcwd ())) fn))
+ files
+ in
+ let ocamlfind = ocamlfind () in
+ let nodir_files, dir_files =
+ List.fold_left
+ (fun (nodir, dir) (dn, lst) ->
+ match dn with
+ | Some dn -> nodir, (dn, lst) :: dir
+ | None -> lst @ nodir, dir)
+ ([], [])
+ (List.rev files)
+ in
+ info (f_ "Installing findlib library '%s'") findlib_name;
+ List.iter
+ (OASISExec.run ~ctxt ocamlfind)
+ (split_install_command ocamlfind findlib_name meta nodir_files);
+ install_lib_files ~ctxt findlib_name dir_files;
+ BaseLog.register ~ctxt install_findlib_ev findlib_name
+ end;
+ (* Install data files *)
+ f_data ();
in
- let group_libs, _, _ =
- findlib_mapping pkg
- in
+ let group_libs, _, _ = findlib_mapping pkg in
(* We install libraries in groups *)
List.iter install_group_lib group_libs
in
- let install_execs pkg =
+ let install_execs ~ctxt pkg =
let install_exec data_exec =
- let cs, bs, exec =
- !exec_hook data_exec
- in
- if var_choose bs.bs_install &&
- BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then
- begin
- let exec_libdir () =
- Filename.concat
- (libdir ())
- pkg.name
- in
- BaseBuilt.fold
- BaseBuilt.BExec
- cs.cs_name
- (fun () fn ->
- install_file
- ~tgt_fn:(cs.cs_name ^ ext_program ())
- fn
- bindir)
- ();
- BaseBuilt.fold
- BaseBuilt.BExecLib
- cs.cs_name
- (fun () fn ->
- install_file
- fn
- exec_libdir)
- ();
- install_data
- bs.bs_path
- bs.bs_data_files
- (Filename.concat
- (datarootdir ())
- pkg.name)
- end
+ let cs, bs, _ = !exec_hook data_exec in
+ if var_choose bs.bs_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin
+ let exec_libdir () = Filename.concat (libdir ()) pkg.name in
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BExec
+ cs.cs_name
+ (fun () fn ->
+ install_file ~ctxt
+ ~tgt_fn:(cs.cs_name ^ ext_program ())
+ fn
+ bindir)
+ ();
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BExecLib
+ cs.cs_name
+ (fun () fn -> install_file ~ctxt fn exec_libdir)
+ ();
+ install_data ~ctxt
+ bs.bs_path
+ bs.bs_data_files
+ (Filename.concat (datarootdir ()) pkg.name)
+ end
in
- List.iter
- (function
- | Executable (cs, bs, exec)->
- install_exec (cs, bs, exec)
- | _ ->
- ())
+ List.iter
+ (function
+ | Executable (cs, bs, exec)-> install_exec (cs, bs, exec)
+ | _ -> ())
pkg.sections
in
- let install_docs pkg =
+ let install_docs ~ctxt pkg =
let install_doc data =
- let cs, doc =
- !doc_hook data
- in
- if var_choose doc.doc_install &&
- BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then
- begin
- let tgt_dir =
- OASISHostPath.of_unix (var_expand doc.doc_install_dir)
- in
- BaseBuilt.fold
- BaseBuilt.BDoc
- cs.cs_name
- (fun () fn ->
- install_file
- fn
- (fun () -> tgt_dir))
- ();
- install_data
- Filename.current_dir_name
- doc.doc_data_files
- doc.doc_install_dir
- end
+ let cs, doc = !doc_hook data in
+ if var_choose doc.doc_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin
+ let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BDoc
+ cs.cs_name
+ (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir))
+ ();
+ install_data ~ctxt
+ Filename.current_dir_name
+ doc.doc_data_files
+ doc.doc_install_dir
+ end
in
- List.iter
- (function
- | Doc (cs, doc) ->
- install_doc (cs, doc)
- | _ ->
- ())
- pkg.sections
+ List.iter
+ (function
+ | Doc (cs, doc) -> install_doc (cs, doc)
+ | _ -> ())
+ pkg.sections
in
-
- install_libs pkg;
- install_execs pkg;
- install_docs pkg
+ fun ~ctxt pkg _ ->
+ install_libs ~ctxt pkg;
+ install_execs ~ctxt pkg;
+ install_docs ~ctxt pkg
(* Uninstall already installed data *)
- let uninstall _ argv =
- List.iter
- (fun (ev, data) ->
- if ev = install_file_ev then
- begin
- if OASISFileUtil.file_exists_case data then
- begin
- info
- (f_ "Removing file '%s'")
- data;
- Sys.remove data
- end
- else
- begin
- warning
- (f_ "File '%s' doesn't exist anymore")
- data
- end
- end
- else if ev = install_dir_ev then
- begin
- if Sys.file_exists data && Sys.is_directory data then
- begin
- if Sys.readdir data = [||] then
- begin
- info
- (f_ "Removing directory '%s'")
- data;
- OASISFileUtil.rmdir ~ctxt:!BaseContext.default data
- end
- else
- begin
- warning
- (f_ "Directory '%s' is not empty (%s)")
- data
- (String.concat
- ", "
- (Array.to_list
- (Sys.readdir data)))
- end
- end
- else
- begin
- warning
- (f_ "Directory '%s' doesn't exist anymore")
- data
- end
- end
- else if ev = install_findlib_ev then
- begin
- info (f_ "Removing findlib library '%s'") data;
- OASISExec.run ~ctxt:!BaseContext.default
- (ocamlfind ()) ["remove"; data]
- end
- else
- failwithf (f_ "Unknown log event '%s'") ev;
- BaseLog.unregister ev data)
- (* We process event in reverse order *)
+ let uninstall ~ctxt _ _ =
+ let uninstall_aux (ev, data) =
+ if ev = install_file_ev then begin
+ if OASISFileUtil.file_exists_case data then begin
+ info (f_ "Removing file '%s'") data;
+ Sys.remove data
+ end else begin
+ warning (f_ "File '%s' doesn't exist anymore") data
+ end
+ end else if ev = install_dir_ev then begin
+ if Sys.file_exists data && Sys.is_directory data then begin
+ if Sys.readdir data = [||] then begin
+ info (f_ "Removing directory '%s'") data;
+ OASISFileUtil.rmdir ~ctxt data
+ end else begin
+ warning
+ (f_ "Directory '%s' is not empty (%s)")
+ data
+ (String.concat ", " (Array.to_list (Sys.readdir data)))
+ end
+ end else begin
+ warning (f_ "Directory '%s' doesn't exist anymore") data
+ end
+ end else if ev = install_findlib_ev then begin
+ info (f_ "Removing findlib library '%s'") data;
+ OASISExec.run ~ctxt (ocamlfind ()) ["remove"; data]
+ end else begin
+ failwithf (f_ "Unknown log event '%s'") ev;
+ end;
+ BaseLog.unregister ~ctxt ev data
+ in
+ (* We process event in reverse order *)
+ List.iter uninstall_aux
(List.rev
- (BaseLog.filter
- [install_file_ev;
- install_dir_ev;
- install_findlib_ev]))
-
+ (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev]));
+ List.iter uninstall_aux
+ (List.rev (BaseLog.filter ~ctxt [install_findlib_ev]))
end
-# 6273 "setup.ml"
+# 6474 "setup.ml"
module OCamlbuildCommon = struct
(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
(** Functions common to OCamlbuild build and doc plugin
- *)
+ *)
open OASISGettext
@@ -6285,8 +6487,6 @@
open OASISTypes
-
-
type extra_args = string list
@@ -6309,6 +6509,14 @@
"-classic-display";
"-no-log";
"-no-links";
+ ]
+ else
+ [];
+
+ if OASISVersion.comparator_apply
+ (OASISVersion.version_of_string (ocaml_version ()))
+ (OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then
+ [
"-install-lib-dir";
(Filename.concat (standard_library ()) "ocamlbuild")
]
@@ -6345,35 +6553,32 @@
(** Run 'ocamlbuild -clean' if not already done *)
- let run_clean extra_argv =
+ let run_clean ~ctxt extra_argv =
let extra_cli =
String.concat " " (Array.to_list extra_argv)
in
- (* Run if never called with these args *)
- if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then
- begin
- OASISExec.run ~ctxt:!BaseContext.default
- (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
- BaseLog.register ocamlbuild_clean_ev extra_cli;
- at_exit
- (fun () ->
- try
- BaseLog.unregister ocamlbuild_clean_ev extra_cli
- with _ ->
- ())
- end
+ (* Run if never called with these args *)
+ if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then
+ begin
+ OASISExec.run ~ctxt (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
+ BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli;
+ at_exit
+ (fun () ->
+ try
+ BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli
+ with _ -> ())
+ end
(** Run ocamlbuild, unregister all clean events *)
- let run_ocamlbuild args extra_argv =
+ let run_ocamlbuild ~ctxt args extra_argv =
(* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
- *)
- OASISExec.run ~ctxt:!BaseContext.default
- (ocamlbuild ()) (fix_args args extra_argv);
+ *)
+ OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv);
(* Remove any clean event, we must run it again *)
List.iter
- (fun (e, d) -> BaseLog.unregister e d)
- (BaseLog.filter [ocamlbuild_clean_ev])
+ (fun (e, d) -> BaseLog.unregister ~ctxt e d)
+ (BaseLog.filter ~ctxt [ocamlbuild_clean_ev])
(** Determine real build directory *)
@@ -6381,13 +6586,13 @@
let rec search_args dir =
function
| "-build-dir" :: dir :: tl ->
- search_args dir tl
+ search_args dir tl
| _ :: tl ->
- search_args dir tl
+ search_args dir tl
| [] ->
- dir
+ dir
in
- search_args "_build" (fix_args [] extra_argv)
+ search_args "_build" (fix_args [] extra_argv)
end
@@ -6408,17 +6613,12 @@
open BaseEnv
open OCamlbuildCommon
open BaseStandardVar
- open BaseMessage
-
-
+ let cond_targets_hook = ref (fun lst -> lst)
- let cond_targets_hook =
- ref (fun lst -> lst)
-
- let build extra_args pkg argv =
+ let build ~ctxt extra_args pkg argv =
(* Return the filename in build directory *)
let in_build_dir fn =
Filename.concat
@@ -6482,8 +6682,8 @@
(List.map
(List.filter
(fun fn ->
- ends_with ".cmo" fn
- || ends_with ".cmx" fn))
+ ends_with ~what:".cmo" fn
+ || ends_with ~what:".cmx" fn))
unix_files))
in
@@ -6498,10 +6698,8 @@
| Executable (cs, bs, exec) when var_choose bs.bs_build ->
begin
- let evs, unix_exec_is, unix_dll_opt =
- BaseBuilt.of_executable
- in_build_dir_of_unix
- (cs, bs, exec)
+ let evs, _, _ =
+ BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec)
in
let target ext =
@@ -6515,7 +6713,7 @@
(* Fix evs, we want to use the unix_tgt, without copying *)
List.map
(function
- | BaseBuilt.BExec, nm, lst when nm = cs.cs_name ->
+ | BaseBuilt.BExec, nm, _ when nm = cs.cs_name ->
BaseBuilt.BExec, nm,
[[in_build_dir_of_unix unix_tgt]]
| ev ->
@@ -6559,27 +6757,30 @@
(List.length fns))
(String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns)))
lst;
- (BaseBuilt.register bt bnm lst)
+ (BaseBuilt.register ~ctxt bt bnm lst)
in
(* Run the hook *)
let cond_targets = !cond_targets_hook cond_targets in
(* Run a list of target... *)
- run_ocamlbuild (List.flatten (List.map snd cond_targets) @ extra_args) argv;
+ run_ocamlbuild
+ ~ctxt
+ (List.flatten (List.map snd cond_targets) @ extra_args)
+ argv;
(* ... and register events *)
List.iter check_and_register (List.flatten (List.map fst cond_targets))
- let clean pkg extra_args =
- run_clean extra_args;
+ let clean ~ctxt pkg extra_args =
+ run_clean ~ctxt extra_args;
List.iter
(function
| Library (cs, _, _) ->
- BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
+ BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
| Executable (cs, _, _) ->
- BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
- BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
+ BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
+ BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
| _ ->
())
pkg.sections
@@ -6593,16 +6794,12 @@
(* Create documentation using ocamlbuild .odocl files
@author Sylvain Le Gall
- *)
+ *)
open OASISTypes
open OASISGettext
- open OASISMessage
open OCamlbuildCommon
- open BaseStandardVar
-
-
type run_t =
@@ -6612,7 +6809,7 @@
}
- let doc_build run pkg (cs, doc) argv =
+ let doc_build ~ctxt run _ (cs, _) argv =
let index_html =
OASISUnixPath.make
[
@@ -6629,125 +6826,353 @@
cs.cs_name^".docdir";
]
in
- run_ocamlbuild (index_html :: run.extra_args) argv;
- List.iter
- (fun glb ->
- BaseBuilt.register
- BaseBuilt.BDoc
- cs.cs_name
- [OASISFileUtil.glob ~ctxt:!BaseContext.default
- (Filename.concat tgt_dir glb)])
- ["*.html"; "*.css"]
+ run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv;
+ List.iter
+ (fun glb ->
+ BaseBuilt.register
+ ~ctxt
+ BaseBuilt.BDoc
+ cs.cs_name
+ [OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb)])
+ ["*.html"; "*.css"]
- let doc_clean run pkg (cs, doc) argv =
- run_clean argv;
- BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
+ let doc_clean ~ctxt _ _ (cs, _) argv =
+ run_clean ~ctxt argv;
+ BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
end
-# 6651 "setup.ml"
-open OASISTypes;;
+# 6847 "setup.ml"
+module CustomPlugin = struct
+(* # 22 "src/plugins/custom/CustomPlugin.ml" *)
-let setup_t =
- {
- BaseSetup.configure = InternalConfigurePlugin.configure;
- build = OCamlbuildPlugin.build [];
- test = [];
- doc =
- [
- ("tyxml-api",
- OCamlbuildDocPlugin.doc_build
- {OCamlbuildDocPlugin.extra_args = []; run_path = "./"})
- ];
- install = InternalInstallPlugin.install;
- uninstall = InternalInstallPlugin.uninstall;
- clean = [OCamlbuildPlugin.clean];
- clean_test = [];
- clean_doc =
- [
- ("tyxml-api",
- OCamlbuildDocPlugin.doc_clean
- {OCamlbuildDocPlugin.extra_args = []; run_path = "./"})
- ];
- distclean = [];
- distclean_test = [];
- distclean_doc = [];
- package =
- {
- oasis_version = "0.4";
- ocaml_version = None;
- findlib_version = None;
- alpha_features = ["pure_interface"];
- beta_features = [];
- name = "tyxml";
- version = "3.5.0";
- license =
- OASISLicense.DEP5License
- (OASISLicense.DEP5Unit
- {
- OASISLicense.license = "LGPL";
- excption = Some "OCaml linking";
- version = OASISLicense.Version "2.1"
- });
- license_file = None;
- copyrights = [];
- maintainers = [];
- authors =
- [
- "Thorsten Ohl";
- "Vincent Balat";
- "Gabriel Kerneis";
- "Cecile Herbelin";
- "Simon Castellan";
- "Boris Yakobowski";
- "Pierre Chambart";
- "Gr\195\169goire Henry"
- ];
- homepage = Some "http://ocsigen.org/tyxml/";
- synopsis = "HTML5 pages typed with polymorphic variants";
- description =
- Some
- [
- OASISText.Para
- "HTML typing based on Thorsten Ohl's XHTML.M library to validate xml tree at compile-time, adapted to support HTML5 and SVG. The implementation uses a XML module for generating well formed---but not necessarily valid with respect to some DTD---XML documents. The elements of type XML.elt and attributes of type XML.attrib are then hidden behind polymorphic phantom types type 'a elt = XML.elt and type 'a attrib = XML.attrib with 'a set to appropriate polymorphic variants."
- ];
+
+ (** Generate custom configure/build/doc/test/install system
+ @author
+ *)
+
+
+ open BaseEnv
+ open OASISGettext
+ open OASISTypes
+
+ type t =
+ {
+ cmd_main: command_line conditional;
+ cmd_clean: (command_line option) conditional;
+ cmd_distclean: (command_line option) conditional;
+ }
+
+
+ let run = BaseCustom.run
+
+
+ let main ~ctxt:_ t _ extra_args =
+ let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in
+ run cmd args extra_args
+
+
+ let clean ~ctxt:_ t _ extra_args =
+ match var_choose t.cmd_clean with
+ | Some (cmd, args) -> run cmd args extra_args
+ | _ -> ()
+
+
+ let distclean ~ctxt:_ t _ extra_args =
+ match var_choose t.cmd_distclean with
+ | Some (cmd, args) -> run cmd args extra_args
+ | _ -> ()
+
+
+ module Build =
+ struct
+ let main ~ctxt t pkg extra_args =
+ main ~ctxt t pkg extra_args;
+ List.iter
+ (fun sct ->
+ let evs =
+ match sct with
+ | Library (cs, bs, lib) when var_choose bs.bs_build ->
+ begin
+ let evs, _ =
+ BaseBuilt.of_library
+ OASISHostPath.of_unix
+ (cs, bs, lib)
+ in
+ evs
+ end
+ | Executable (cs, bs, exec) when var_choose bs.bs_build ->
+ begin
+ let evs, _, _ =
+ BaseBuilt.of_executable
+ OASISHostPath.of_unix
+ (cs, bs, exec)
+ in
+ evs
+ end
+ | _ ->
+ []
+ in
+ List.iter
+ (fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst)
+ evs)
+ pkg.sections
+
+ let clean ~ctxt t pkg extra_args =
+ clean ~ctxt t pkg extra_args;
+ (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild
+ * considering moving this to BaseSetup?
+ *)
+ List.iter
+ (function
+ | Library (cs, _, _) ->
+ BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
+ | Executable (cs, _, _) ->
+ BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
+ BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
+ | _ ->
+ ())
+ pkg.sections
+
+ let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args
+ end
+
+
+ module Test =
+ struct
+ let main ~ctxt t pkg (cs, _) extra_args =
+ try
+ main ~ctxt t pkg extra_args;
+ 0.0
+ with Failure s ->
+ BaseMessage.warning
+ (f_ "Test '%s' fails: %s")
+ cs.cs_name
+ s;
+ 1.0
+
+ let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args
+
+ let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
+ end
+
+
+ module Doc =
+ struct
+ let main ~ctxt t pkg (cs, _) extra_args =
+ main ~ctxt t pkg extra_args;
+ BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name []
+
+ let clean ~ctxt t pkg (cs, _) extra_args =
+ clean ~ctxt t pkg extra_args;
+ BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
+
+ let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
+ end
+
+
+end
+
+
+# 6979 "setup.ml"
+open OASISTypes;;
+
+let setup_t =
+ {
+ BaseSetup.configure = InternalConfigurePlugin.configure;
+ build = OCamlbuildPlugin.build ["-use-ocamlfind"];
+ test =
+ [
+ ("html",
+ CustomPlugin.Test.main
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$main_test", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("basic_website",
+ CustomPlugin.Test.main
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$basic_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("basic_website_ppx",
+ CustomPlugin.Test.main
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$basic_website_ppx", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("mini_website",
+ CustomPlugin.Test.main
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("mini_website_ppx",
+ CustomPlugin.Test.main
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ })
+ ];
+ doc =
+ [
+ ("tyxml-api",
+ OCamlbuildDocPlugin.doc_build
+ {
+ OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
+ run_path = "./"
+ })
+ ];
+ install = InternalInstallPlugin.install;
+ uninstall = InternalInstallPlugin.uninstall;
+ clean = [OCamlbuildPlugin.clean];
+ clean_test =
+ [
+ ("html",
+ CustomPlugin.Test.clean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$main_test", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("basic_website",
+ CustomPlugin.Test.clean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$basic_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("basic_website_ppx",
+ CustomPlugin.Test.clean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$basic_website_ppx", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("mini_website",
+ CustomPlugin.Test.clean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("mini_website_ppx",
+ CustomPlugin.Test.clean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ })
+ ];
+ clean_doc =
+ [
+ ("tyxml-api",
+ OCamlbuildDocPlugin.doc_clean
+ {
+ OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
+ run_path = "./"
+ })
+ ];
+ distclean = [];
+ distclean_test =
+ [
+ ("html",
+ CustomPlugin.Test.distclean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$main_test", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("basic_website",
+ CustomPlugin.Test.distclean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$basic_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("basic_website_ppx",
+ CustomPlugin.Test.distclean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$basic_website_ppx", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("mini_website",
+ CustomPlugin.Test.distclean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ });
+ ("mini_website_ppx",
+ CustomPlugin.Test.distclean
+ {
+ CustomPlugin.cmd_main =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ cmd_clean = [(OASISExpr.EBool true, None)];
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ })
+ ];
+ distclean_doc = [];
+ package =
+ {
+ oasis_version = "0.4";
+ ocaml_version = Some (OASISVersion.VGreaterEqual "4.02.0");
+ version = "4.1.0";
+ license =
+ OASISLicense.DEP5License
+ (OASISLicense.DEP5Unit
+ {
+ OASISLicense.license = "LGPL";
+ excption = Some "OCaml linking";
+ version = OASISLicense.Version "2.1"
+ });
+ findlib_version = None;
+ alpha_features = ["pure_interface"];
+ beta_features = [];
+ name = "tyxml";
+ license_file = None;
+ copyrights = [];
+ maintainers = [];
+ authors =
+ [
+ "Thorsten Ohl";
+ "Vincent Balat";
+ "Gabriel Kerneis";
+ "Cecile Herbelin";
+ "Simon Castellan";
+ "Boris Yakobowski";
+ "Pierre Chambart";
+ "Gr\195\169goire Henry"
+ ];
+ homepage = Some "http://ocsigen.org/tyxml/";
+ bugreports = None;
+ synopsis = "Statically correct HTML and SVG documents";
+ description = None;
+ tags = [];
categories = [];
- conf_type = (`Configure, "internal", Some "0.4");
- conf_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)]
- };
- build_type = (`Build, "ocamlbuild", Some "0.4");
- build_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)]
- };
- install_type = (`Install, "internal", Some "0.4");
- install_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)]
- };
- uninstall_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)]
- };
- clean_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)]
- };
- distclean_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)]
- };
files_ab = [];
sections =
[
@@ -6760,27 +7185,1646 @@
{
flag_description =
Some "Build the camlp4 syntax extension.";
+ flag_default = [(OASISExpr.EBool true, false)]
+ });
+ Flag
+ ({
+ cs_name = "ppx";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ flag_description =
+ Some "Build the ppx syntax extension.";
flag_default = [(OASISExpr.EBool true, true)]
});
Library
({
- cs_name = "tyxml";
+ cs_name = "tyxml_f";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "lib";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ FindlibPackage ("uchar", None);
+ FindlibPackage ("uutf", None);
+ FindlibPackage ("re", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules =
+ [
+ "Xml_iter";
+ "Xml_sigs";
+ "Xml_wrap";
+ "Xml_print";
+ "Svg_sigs";
+ "Svg_types";
+ "Svg_f";
+ "Html_sigs";
+ "Html_types";
+ "Html_f"
+ ];
+ lib_pack = false;
+ lib_internal_modules = [];
+ lib_findlib_parent = Some "tyxml";
+ lib_findlib_name = Some "functor";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Library
+ ({
+ cs_name = "tyxml";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "implem";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ InternalLibrary "tyxml_f";
+ FindlibPackage ("re", None);
+ FindlibPackage ("uutf", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules =
+ ["Tyxml_xml"; "Tyxml_svg"; "Tyxml_html"; "Tyxml"];
+ lib_pack = false;
+ lib_internal_modules = [];
+ lib_findlib_parent = None;
+ lib_findlib_name = Some "tyxml";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Library
+ ({
+ cs_name = "tyxml_top";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "implem/top";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [FindlibPackage ("compiler-libs.toplevel", None)];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules = ["Tyxml_top"];
+ lib_pack = false;
+ lib_internal_modules = [];
+ lib_findlib_parent = Some "tyxml";
+ lib_findlib_name = Some "top";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Library
+ ({
+ cs_name = "tyxml_tools";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "tools";
+ bs_compiled_object = Best;
+ bs_build_depends = [FindlibPackage ("bytes", None)];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules = ["Tyxml_name"];
+ lib_pack = false;
+ lib_internal_modules = [];
+ lib_findlib_parent = Some "tyxml";
+ lib_findlib_name = Some "tools";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Executable
+ ({
+ cs_name = "autoname";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "tools";
+ bs_compiled_object = Byte;
+ bs_build_depends = [InternalLibrary "tyxml_tools"];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {exec_custom = false; exec_main_is = "autoname.ml"});
+ Library
+ ({
+ cs_name = "pa_tyxml";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "syntax", true)
+ ];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "syntax";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ FindlibPackage ("bytes", None);
+ FindlibPackage ("camlp4", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules = ["Pa_tyxml"];
+ lib_pack = false;
+ lib_internal_modules =
+ [
+ "Xmllexer";
+ "Basic_types";
+ "Camllexer";
+ "Xhtmlparser"
+ ];
+ lib_findlib_parent = Some "tyxml";
+ lib_findlib_name = Some "syntax";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Library
+ ({
+ cs_name = "tymlx_p";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "syntax", true)
+ ];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "syntax";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ FindlibPackage ("bytes", None);
+ FindlibPackage ("camlp4.lib", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules = ["Simplexmlparser"];
+ lib_pack = false;
+ lib_internal_modules = ["Xmllexer"];
+ lib_findlib_parent = Some "tyxml";
+ lib_findlib_name = Some "parser";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Library
+ ({
+ cs_name = "ppx";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_install =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_path = "ppx";
+ bs_compiled_object = Best;
+ bs_build_depends = [];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules = [];
+ lib_pack = false;
+ lib_internal_modules = ["Ppx_tyxml_empty"];
+ lib_findlib_parent = Some "tyxml";
+ lib_findlib_name = Some "ppx";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Library
+ ({
+ cs_name = "ppx_internal";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_install =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_path = "ppx";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ FindlibPackage ("re.str", None);
+ FindlibPackage ("ppx_tools.metaquot", None);
+ FindlibPackage ("markup", None);
+ InternalLibrary "tyxml_tools"
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {
+ lib_modules = ["Ppx_tyxml"];
+ lib_pack = false;
+ lib_internal_modules =
+ [
+ "Ppx_attributes";
+ "Ppx_attribute_value";
+ "Ppx_common";
+ "Ppx_namespace";
+ "Ppx_element_content";
+ "Ppx_element";
+ "Ppx_sigs_reflected";
+ "Html_sigs_reflected";
+ "Svg_sigs_reflected";
+ "Html_types_reflected";
+ "Svg_types_reflected"
+ ];
+ lib_findlib_parent = Some "ppx";
+ lib_findlib_name = Some "internal";
+ lib_findlib_directory = None;
+ lib_findlib_containers = []
+ });
+ Executable
+ ({
+ cs_name = "ppx_tyxml";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_install =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_path = "ppx";
+ bs_compiled_object = Best;
+ bs_build_depends = [InternalLibrary "ppx_internal"];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {exec_custom = false; exec_main_is = "ppx_tyxml_ex.ml"});
+ Executable
+ ({
+ cs_name = "ppx_reflect";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
- bs_build = [(OASISExpr.EBool true, true)];
- bs_install = [(OASISExpr.EBool true, true)];
- bs_path = "lib";
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "ppx", true)
+ ];
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "ppx";
bs_compiled_object = Best;
bs_build_depends =
[
- FindlibPackage ("str", None);
- FindlibPackage ("uutf", None)
+ FindlibPackage ("ppx_tools.metaquot", None);
+ InternalLibrary "tyxml_tools"
];
bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
@@ -6788,36 +8832,289 @@
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
+ {exec_custom = false; exec_main_is = "ppx_reflect.ml"});
+ Executable
+ ({
+ cs_name = "emit_big";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
{
- lib_modules = ["Xml"; "Svg"; "Html5"];
- lib_pack = false;
- lib_internal_modules =
+ bs_build =
[
- "Xml_iter";
- "Xml_wrap";
- "Xml_print";
- "Svg_f";
- "Html5_f"
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx"),
+ true)
];
- lib_findlib_parent = None;
- lib_findlib_name = Some "tyxml";
- lib_findlib_containers = []
- });
- Library
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "test";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ InternalLibrary "tyxml";
+ FindlibPackage ("unix", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {exec_custom = false; exec_main_is = "emitbig.ml"});
+ Executable
({
- cs_name = "tyxml_f";
+ cs_name = "main_test";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
- bs_build = [(OASISExpr.EBool true, true)];
- bs_install = [(OASISExpr.EBool true, true)];
- bs_path = "lib";
- bs_compiled_object = Best;
- bs_build_depends = [FindlibPackage ("uutf", None)];
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx"),
+ true)
+ ];
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "test";
+ bs_compiled_object = Byte;
+ bs_build_depends =
+ [
+ InternalLibrary "tyxml";
+ FindlibPackage ("alcotest", None)
+ ];
bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
@@ -6825,41 +9122,170 @@
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
+ {exec_custom = false; exec_main_is = "main_test.ml"});
+ Test
+ ({
+ cs_name = "html";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
{
- lib_modules =
+ test_type = (`Test, "custom", Some "0.4");
+ test_command =
+ [(OASISExpr.EBool true, ("$main_test", []))];
+ test_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ test_working_directory = None;
+ test_run =
[
- "Xml_iter";
- "Xml_sigs";
- "Xml_wrap";
- "Xml_print";
- "Svg_sigs";
- "Svg_types";
- "Svg_f";
- "Html5_sigs";
- "Html5_types";
- "Html5_f"
+ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
+ (OASISExpr.EFlag "tests", false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx")),
+ true)
];
- lib_pack = false;
- lib_internal_modules = [];
- lib_findlib_parent = Some "tyxml";
- lib_findlib_name = Some "functor";
- lib_findlib_containers = []
+ test_tools =
+ [
+ ExternalTool "ocamlbuild";
+ InternalExecutable "main_test"
+ ]
});
- Library
+ Executable
({
- cs_name = "tyxml_tools";
+ cs_name = "basic_website";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
- bs_build = [(OASISExpr.EBool true, true)];
- bs_install = [(OASISExpr.EBool true, true)];
- bs_path = "tools";
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EFlag "tests", true)
+ ];
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "examples/basic_website";
bs_compiled_object = Best;
- bs_build_depends = [FindlibPackage ("bytes", None)];
+ bs_build_depends = [InternalLibrary "tyxml"];
bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
@@ -6867,29 +9293,171 @@
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
+ {exec_custom = false; exec_main_is = "site_html.ml"});
+ Test
+ ({
+ cs_name = "basic_website";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
{
- lib_modules = ["Tyxml_name"];
- lib_pack = false;
- lib_internal_modules = [];
- lib_findlib_parent = Some "tyxml";
- lib_findlib_name = Some "tools";
- lib_findlib_containers = []
+ test_type = (`Test, "custom", Some "0.4");
+ test_command =
+ [(OASISExpr.EBool true, ("$basic_website", []))];
+ test_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ test_working_directory = Some "examples/basic_website";
+ test_run =
+ [
+ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
+ (OASISExpr.EFlag "tests", false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "tests"),
+ true)
+ ];
+ test_tools =
+ [
+ ExternalTool "ocamlbuild";
+ InternalExecutable "basic_website"
+ ]
});
Executable
({
- cs_name = "autoname";
+ cs_name = "basic_website_ppx";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
- bs_build = [(OASISExpr.EBool true, true)];
+ bs_build =
+ [
+ (OASISExpr.EBool true, false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx"),
+ true)
+ ];
bs_install = [(OASISExpr.EBool true, false)];
- bs_path = "tools";
- bs_compiled_object = Byte;
- bs_build_depends = [InternalLibrary "tyxml_tools"];
+ bs_path = "examples/basic_website_ppx";
+ bs_compiled_object = Best;
+ bs_build_depends = [InternalLibrary "tyxml"];
bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
@@ -6897,10 +9465,44 @@
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
- {exec_custom = false; exec_main_is = "autoname.ml"});
- Library
+ {exec_custom = false; exec_main_is = "site_html.ml"});
+ Test
({
- cs_name = "pa_tyxml";
+ cs_name = "basic_website_ppx";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
+ {
+ test_type = (`Test, "custom", Some "0.4");
+ test_command =
+ [(OASISExpr.EBool true, ("$basic_website_ppx", []))];
+ test_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ test_working_directory =
+ Some "examples/basic_website_ppx";
+ test_run =
+ [
+ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
+ (OASISExpr.EFlag "tests", false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx")),
+ true)
+ ];
+ test_tools =
+ [
+ ExternalTool "ocamlbuild";
+ InternalExecutable "basic_website_ppx"
+ ]
+ });
+ Executable
+ ({
+ cs_name = "mini_website";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
@@ -6908,19 +9510,126 @@
bs_build =
[
(OASISExpr.EBool true, false);
- (OASISExpr.EFlag "syntax", true)
+ (OASISExpr.EFlag "tests", true)
];
- bs_install = [(OASISExpr.EBool true, true)];
- bs_path = "syntax";
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "examples/mini_website";
bs_compiled_object = Best;
- bs_build_depends =
+ bs_build_depends = [InternalLibrary "tyxml"];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
[
- FindlibPackage ("bytes", None);
- FindlibPackage ("camlp4", None)
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
];
- bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
@@ -6928,23 +9637,41 @@
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
+ {exec_custom = false; exec_main_is = "minihtml.ml"});
+ Test
+ ({
+ cs_name = "mini_website";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
{
- lib_modules = ["Pa_tyxml"];
- lib_pack = false;
- lib_internal_modules =
+ test_type = (`Test, "custom", Some "0.4");
+ test_command =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ test_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ test_working_directory = Some "examples/mini_website";
+ test_run =
[
- "Xmllexer";
- "Basic_types";
- "Camllexer";
- "Xhtmlparser"
+ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
+ (OASISExpr.EFlag "tests", false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "tests"),
+ true)
];
- lib_findlib_parent = Some "tyxml";
- lib_findlib_name = Some "syntax";
- lib_findlib_containers = []
+ test_tools =
+ [
+ ExternalTool "ocamlbuild";
+ InternalExecutable "mini_website"
+ ]
});
- Library
+ Executable
({
- cs_name = "tymlx_p";
+ cs_name = "mini_website_ppx";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
@@ -6952,19 +9679,129 @@
bs_build =
[
(OASISExpr.EBool true, false);
- (OASISExpr.EFlag "syntax", true)
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx"),
+ true)
];
- bs_install = [(OASISExpr.EBool true, true)];
- bs_path = "syntax";
+ bs_install = [(OASISExpr.EBool true, false)];
+ bs_path = "examples/mini_website_ppx";
bs_compiled_object = Best;
- bs_build_depends =
+ bs_build_depends = [InternalLibrary "tyxml"];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
[
- FindlibPackage ("bytes", None);
- FindlibPackage ("camlp4.lib", None)
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
];
- bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
@@ -6972,13 +9809,40 @@
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
+ {exec_custom = false; exec_main_is = "minihtml.ml"});
+ Test
+ ({
+ cs_name = "mini_website_ppx";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = []
+ },
{
- lib_modules = ["Simplexmlparser"];
- lib_pack = false;
- lib_internal_modules = ["Xmllexer"];
- lib_findlib_parent = Some "tyxml";
- lib_findlib_name = Some "parser";
- lib_findlib_containers = []
+ test_type = (`Test, "custom", Some "0.4");
+ test_command =
+ [(OASISExpr.EBool true, ("$mini_website", []))];
+ test_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ test_working_directory =
+ Some "examples/mini_website_ppx";
+ test_run =
+ [
+ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
+ (OASISExpr.EFlag "tests", false);
+ (OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EAnd
+ (OASISExpr.EFlag "tests",
+ OASISExpr.EFlag "ppx")),
+ true)
+ ];
+ test_tools =
+ [
+ ExternalTool "ocamlbuild";
+ InternalExecutable "mini_website"
+ ]
});
Doc
({
@@ -7009,15 +9873,48 @@
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
})
];
+ disable_oasis_section = [];
+ conf_type = (`Configure, "internal", Some "0.4");
+ conf_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ build_type = (`Build, "ocamlbuild", Some "0.4");
+ build_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ install_type = (`Install, "internal", Some "0.4");
+ install_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ uninstall_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ clean_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ distclean_custom =
+ {
+ pre_command = [(OASISExpr.EBool true, None)];
+ post_command = [(OASISExpr.EBool true, None)]
+ };
plugins =
[(`Extra, "META", Some "0.3"); (`Extra, "DevFiles", Some "0.3")];
- disable_oasis_section = [];
schema_data = PropList.Data.create ();
plugin_data = []
};
oasis_fn = Some "_oasis";
- oasis_version = "0.4.5";
- oasis_digest = Some "xw\176\185k\203\012\021%\167S\236\224\127\128`";
+ oasis_version = "0.4.8";
+ oasis_digest = Some "\1443`\169S\132[\175\188\241\150\164Tcu%";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
@@ -7025,6 +9922,8 @@
let setup () = BaseSetup.setup setup_t;;
-# 7029 "setup.ml"
+# 9925 "setup.ml"
+let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
+open BaseCompat.Compat_0_4
(* OASIS_STOP *)
let () = setup ();;
diff -Nru tyxml-3.5.0/syntax/pa_tyxml.ml tyxml-4.1.0/syntax/pa_tyxml.ml
--- tyxml-3.5.0/syntax/pa_tyxml.ml 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/syntax/pa_tyxml.ml 2017-03-03 16:33:22.000000000 +0000
@@ -24,15 +24,15 @@
open Camlp4.PreCast;
module Parser5 = Xhtmlparser.Make(Syntax)(struct
- value xml_encodedpcdata _loc = <:expr< Html5.Xml.encodedpcdata >>;
- value xml_pcdata _loc = <:expr< Html5.Xml.pcdata >>;
- value xml_comment _loc = <:expr< Html5.Xml.comment >>;
- value xml_node _loc = <:expr< Html5.Xml.node >>;
- value xml_string_attrib _loc = <:expr< Html5.Xml.string_attrib >>;
- value tot _loc = <:expr< Html5.tot >>;
- value toeltl _loc = <:expr< Html5.toeltl >>;
- value to_xmlattribs _loc = <:expr< Html5.to_xmlattribs >>;
- value to_attrib _loc = <:expr< Html5.to_attrib >>;
+ value xml_encodedpcdata _loc = <:expr< Html.Xml.encodedpcdata >>;
+ value xml_pcdata _loc = <:expr< Html.Xml.pcdata >>;
+ value xml_comment _loc = <:expr< Html.Xml.comment >>;
+ value xml_node _loc = <:expr< Html.Xml.node >>;
+ value xml_string_attrib _loc = <:expr< Html.Xml.string_attrib >>;
+ value tot _loc = <:expr< Html.tot >>;
+ value toeltl _loc = <:expr< Html.toeltl >>;
+ value to_xmlattribs _loc = <:expr< Html.to_xmlattribs >>;
+ value to_attrib _loc = <:expr< Html.to_attrib >>;
value make_type _loc tag =
let tag = match String.lowercase tag with
[ "object" -> "object__"
@@ -45,10 +45,10 @@
| "ins_" -> "del_"
| x -> x ] in
match tag with
- [ "a" -> <:ctyp< Html5.elt [> Html5_types.a 'a ] >>
- | tag -> <:ctyp< Html5.elt [> Html5_types.$lid:tag$ ] >> ];
+ [ "a" -> <:ctyp< Html.elt [> Html_types.a 'a ] >>
+ | tag -> <:ctyp< Html.elt [> Html_types.$lid:tag$ ] >> ];
value make_content_type _loc tag =
- <:ctyp< Html5.elt [< Html5_types.$lid:String.lowercase tag^"_content"$] >>;
+ <:ctyp< Html.elt [< Html_types.$lid:String.lowercase tag^"_content"$] >>;
value make_attrib_type _loc tag =
let tag = match String.lowercase tag with
[ "button_type" -> "Button_Type"
@@ -134,11 +134,11 @@
| "onwaiting" -> "OnWaiting"
| "onebeforeunload" -> "OneBeforeUnload"
| tag -> String.capitalize tag ] in
- <:ctyp< Html5.attrib [> `$uid:tag$ ] >>;
+ <:ctyp< Html.attrib [> `$uid:tag$ ] >>;
value make_attribs_type _loc tag =
match String.lowercase tag with
- [ "img" -> <:ctyp< Html5.attrib [< `Alt | `Src | Html5_types.img_attrib] >>
- | tag -> <:ctyp< Html5.attrib [< Html5_types.$lid:tag^"_attrib"$] >>
+ [ "img" -> <:ctyp< Html.attrib [< `Alt | `Src | Html_types.img_attrib] >>
+ | tag -> <:ctyp< Html.attrib [< Html_types.$lid:tag^"_attrib"$] >>
] ;
end);
@@ -313,10 +313,10 @@
end);
do {
- Syntax.Quotation.add "html5" Syntax.Quotation.DynAst.expr_tag Parser5.xml_exp ;
- Syntax.Quotation.add "html5list" Syntax.Quotation.DynAst.expr_tag
+ Syntax.Quotation.add "html" Syntax.Quotation.DynAst.expr_tag Parser5.xml_exp ;
+ Syntax.Quotation.add "htmllist" Syntax.Quotation.DynAst.expr_tag
Parser5.xml_expl;
- Syntax.Quotation.default.val := "html5";
+ Syntax.Quotation.default.val := "html";
Syntax.Quotation.add "svg" Syntax.Quotation.DynAst.expr_tag ParserSvg.xml_exp ;
Syntax.Quotation.add "svglist" Syntax.Quotation.DynAst.expr_tag
ParserSvg.xml_expl
diff -Nru tyxml-3.5.0/syntax/pa_tyxml.mli tyxml-4.1.0/syntax/pa_tyxml.mli
--- tyxml-3.5.0/syntax/pa_tyxml.mli 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/syntax/pa_tyxml.mli 2017-03-03 16:33:22.000000000 +0000
@@ -1,24 +1,24 @@
-(** Syntax extension for HTML5 or SVG tree creation. *)
+(** Syntax extension for HTML or SVG tree creation. *)
(**
-To choose actual XML-implementation you have to provide a module named [Html5]
+To choose actual XML-implementation you have to provide a module named [Html]
(or [Svg]):
For example, the following code:
{[
- let module Html5 = Html5.M in
+ let open Tyxml in
<<
plop
>>
)
]}
-is a caml value of type {v Html5_types.html Html5.elt v}.
+is a caml value of type {v Html_types.html Html.elt v}.
-In the following, [Html5] is assumed to be an HTML5 implementation, such as
-[Html5.M], but this could for example also be Eliom's [Eliom_content.Html5.F].
+In the following, [Html] is assumed to be an HTML implementation, such as
+{!Tyxml.Html}, but this could for example also be Eliom's [Eliom_content.Html.F].
To compile a module containing this syntax, you need the camlp4 preprocessor:
{[
@@ -29,21 +29,21 @@
ocamlc -pp "camlp4o -I pa_tyxml.cmo" -c your_module.ml
]}
-You can insert OCaml expressions of type {v 'a Html5.M.elt v} inside html using {v $...$ v}, like this:
+You can insert OCaml expressions of type {v 'a Html.elt v} inside html using {v $...$ v}, like this:
{[
let oc = << Ocsigen >> in
<< $oc$ will revolutionize web programming.
>>
]}
-You can insert OCaml expressions of type string inside html using {v $str:... $ v}, like this:
+You can insert OCaml expressions of type string inside HTML using {v $str:... $ v}, like this:
{[
let i = 4 in
<< i is equal to $str:string_of_int i$
>>
]}
If you want to use a dollar in your page, just write it twice.
-You can write a list of html5 expressions using the syntax {v <:html5list<...>> v}, for example:
+You can write a list of HTML expressions using the syntax {v <:htmllist<...>> v}, for example:
{[
-<:html5list< hello
>>
+<:htmllist< hello
>>
]}
Here are some other examples showing what you can do:
diff -Nru tyxml-3.5.0/_tags tyxml-4.1.0/_tags
--- tyxml-3.5.0/_tags 2015-08-05 14:36:46.000000000 +0000
+++ tyxml-4.1.0/_tags 2017-03-03 16:33:22.000000000 +0000
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: fa14ee70b6a48b09ce560d188d71cf18)
+# DO NOT EDIT (digest: 08f84ccdfdae22f07b05e65caebf94cb)
# Ignore VCS directories, you can use the same kind of rule outside
# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
@@ -14,30 +14,134 @@
".git": not_hygienic
"_darcs": -traverse
"_darcs": not_hygienic
-# Library tyxml
-"lib/tyxml.cmxs": use_tyxml
-: pkg_str
# Library tyxml_f
"lib/tyxml_f.cmxs": use_tyxml_f
-: pkg_uutf
+: package(re)
+: package(uchar)
+: package(uutf)
+# Library tyxml
+"implem/tyxml.cmxs": use_tyxml
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml_f
+# Library tyxml_top
+"implem/top/tyxml_top.cmxs": use_tyxml_top
+: package(compiler-libs.toplevel)
# Library tyxml_tools
"tools/tyxml_tools.cmxs": use_tyxml_tools
# Executable autoname
-"tools/autoname.byte": pkg_bytes
+"tools/autoname.byte": package(bytes)
"tools/autoname.byte": use_tyxml_tools
-: pkg_bytes
+: package(bytes)
: use_tyxml_tools
# Library pa_tyxml
"syntax/pa_tyxml.cmxs": use_pa_tyxml
-: pkg_camlp4
+: package(camlp4)
# Library tymlx_p
"syntax/tymlx_p.cmxs": use_tymlx_p
-: pkg_bytes
-: pkg_camlp4.lib
+: package(bytes)
+: package(camlp4.lib)
+# Library ppx
+"ppx/ppx.cmxs": use_ppx
+# Library ppx_internal
+"ppx/ppx_internal.cmxs": use_ppx_internal
+# Executable ppx_tyxml
+: package(bytes)
+: package(markup)
+: package(ppx_tools.metaquot)
+: package(re.str)
+: use_ppx_internal
+: use_tyxml_tools
+: package(markup)
+: package(re.str)
+: use_ppx_internal
+# Executable ppx_reflect
+: package(bytes)
+: package(ppx_tools.metaquot)
+: use_tyxml_tools
+: package(bytes)
+: package(ppx_tools.metaquot)
+: use_tyxml_tools
+# Executable emit_big
+: package(re)
+: package(uchar)
+: package(unix)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+: package(unix)
+# Executable main_test
+"test/main_test.byte": package(alcotest)
+"test/main_test.byte": package(re)
+"test/main_test.byte": package(uchar)
+"test/main_test.byte": package(uutf)
+"test/main_test.byte": use_tyxml
+"test/main_test.byte": use_tyxml_f
+: package(alcotest)
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+# Executable basic_website
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+# Executable basic_website_ppx
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+# Executable mini_website
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+# Executable mini_website_ppx
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
+: package(re)
+: package(uchar)
+: package(uutf)
+: use_tyxml
+: use_tyxml_f
# OASIS_STOP
"syntax/basic_types.ml": camlp4rf
"syntax/xhtmlparser.ml": camlp4rf
"syntax/pa_tyxml.ml": camlp4rf
"syntax/simplexmlparser.ml": camlp4rf
-<**/*.ml{,i}>: bin_annot
-true: safe_string
+true: bin_annot
+
+not : warn(A-4-9-40-42-44-48)
+not : warn_error(+1..49), warn_error(-45-3)
+not : strict_sequence, safe_string, short_paths
+
+true: keep_locs
+
+# Tests use the tyxml ppx
+: ppx_tyxml
+
+: ppx_tyxml
diff -Nru tyxml-3.5.0/test/emitbig.ml tyxml-4.1.0/test/emitbig.ml
--- tyxml-3.5.0/test/emitbig.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/emitbig.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,38 @@
+(* This is an absurd website to stress the printer.
+ It creates fibonacci(22) nested divs.
+*)
+
+open Tyxml
+
+let rec unfold n =
+ let l =
+ if n = 1 then []
+ else if n = 2 then []
+ else[
+ unfold (n-1) ;
+ unfold (n-2) ;
+ ]
+ in
+ Html.(div ~a:[a_class ["fibo" ^ string_of_int n]] l)
+
+let emit_page_pp page =
+ let file_handle = open_out "fibo.html" in
+ let fmt = Format.formatter_of_out_channel file_handle in
+ Html.pp () fmt page;
+ close_out file_handle
+
+let () =
+ let p = Html.(
+ html (head (title (pcdata "fibo")) []) (body [unfold 22])
+ ) in
+ let time_pp = ref 0. in
+ let n = 10 in
+ for _ = 1 to n do
+ let t = Unix.gettimeofday () in
+ emit_page_pp p ;
+ let tpp = Unix.gettimeofday () -. t in
+ time_pp := !time_pp +. tpp ;
+ done ;
+ Printf.printf
+ "Time: %f\n%!"
+ (!time_pp /. float n)
diff -Nru tyxml-3.5.0/test/html_fail.expected tyxml-4.1.0/test/html_fail.expected
--- tyxml-3.5.0/test/html_fail.expected 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/html_fail.expected 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,173 @@
+Characters 6-14:
+ div [a [a []]] ;;
+ ^^^^^^^^
+Error: This expression has type
+ ([> `A of [> `A of 'c ] as 'b ] as 'a) Tyxml.Html.elt =
+ 'a Tyxml_html.elt
+ but an expression was expected of type
+ ([< Html_types.div_content_fun ] as 'd) Tyxml.Html.elt =
+ 'd Tyxml_html.elt
+ Type [> `A of 'b ] as 'a is not compatible with type
+ 'd =
+ [< `A of Html_types.flow5_without_interactive
+ | `Abbr
+ | `Address
+ | `Article
+ | `Aside
+ | `Audio of Html_types.flow5_without_media
+ | `Audio_interactive of Html_types.flow5_without_media
+ | `B
+ | `Bdo
+ | `Blockquote
+ | `Br
+ | `Button
+ | `Canvas of Html_types.flow5
+ | `Cite
+ | `Code
+ | `Command
+ | `Datalist
+ | `Del of Html_types.flow5
+ | `Details
+ | `Dfn
+ | `Div
+ | `Dl
+ | `Em
+ | `Embed
+ | `Fieldset
+ | `Figure
+ | `Footer
+ | `Form
+ | `H1
+ | `H2
+ | `H3
+ | `H4
+ | `H5
+ | `H6
+ | `Header
+ | `Hgroup
+ | `Hr
+ | `I
+ | `Iframe
+ | `Img
+ | `Img_interactive
+ | `Input
+ | `Ins of Html_types.flow5
+ | `Kbd
+ | `Keygen
+ | `Label
+ | `Main
+ | `Map of Html_types.flow5
+ | `Mark
+ | `Menu
+ | `Meter
+ | `Nav
+ | `Noscript of Html_types.flow5_without_noscript
+ | `Object of Html_types.flow5
+ | `Object_interactive of Html_types.flow5
+ | `Ol
+ | `Output
+ | `P
+ | `PCDATA
+ | `Pre
+ | `Progress
+ | `Q
+ | `Ruby
+ | `Samp
+ | `Script
+ | `Section
+ | `Select
+ | `Small
+ | `Span
+ | `Strong
+ | `Style
+ | `Sub
+ | `Sup
+ | `Svg
+ | `Table
+ | `Textarea
+ | `Time
+ | `U
+ | `Ul
+ | `Var
+ | `Video of Html_types.flow5_without_media
+ | `Video_interactive of Html_types.flow5_without_media
+ | `Wbr ]
+ Type [> `A of 'c ] as 'b is not compatible with type
+ Html_types.flow5_without_interactive =
+ [ `Abbr
+ | `Address
+ | `Article
+ | `Aside
+ | `Audio of Html_types.flow5_without_media
+ | `B
+ | `Bdo
+ | `Blockquote
+ | `Br
+ | `Button
+ | `Canvas of Html_types.flow5
+ | `Cite
+ | `Code
+ | `Command
+ | `Datalist
+ | `Del of Html_types.flow5
+ | `Dfn
+ | `Div
+ | `Dl
+ | `Em
+ | `Fieldset
+ | `Figure
+ | `Footer
+ | `Form
+ | `H1
+ | `H2
+ | `H3
+ | `H4
+ | `H5
+ | `H6
+ | `Header
+ | `Hgroup
+ | `Hr
+ | `I
+ | `Img
+ | `Input
+ | `Ins of Html_types.flow5
+ | `Kbd
+ | `Keygen
+ | `Label
+ | `Main
+ | `Map of Html_types.flow5
+ | `Mark
+ | `Menu
+ | `Meter
+ | `Nav
+ | `Noscript of Html_types.flow5_without_noscript
+ | `Object of Html_types.flow5
+ | `Ol
+ | `Output
+ | `P
+ | `PCDATA
+ | `Pre
+ | `Progress
+ | `Q
+ | `Ruby
+ | `Samp
+ | `Script
+ | `Section
+ | `Select
+ | `Small
+ | `Span
+ | `Strong
+ | `Style
+ | `Sub
+ | `Sup
+ | `Svg
+ | `Table
+ | `Textarea
+ | `Time
+ | `U
+ | `Ul
+ | `Var
+ | `Video of Html_types.flow5_without_media
+ | `Wbr ]
+ The second variant type does not allow tag(s) `A
+
diff -Nru tyxml-3.5.0/test/html_fail.top.ml tyxml-4.1.0/test/html_fail.top.ml
--- tyxml-3.5.0/test/html_fail.top.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/html_fail.top.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,11 @@
+#use "topfind" ;;
+#require "uutf" ;;
+#require "re" ;;
+#directory "lib" ;;
+#directory "implem" ;;
+#load "tyxml_f.cma" ;;
+#load "tyxml.cma" ;;
+
+open Tyxml.Html ;;
+
+div [a [a []]] ;;
diff -Nru tyxml-3.5.0/test/main_test.ml tyxml-4.1.0/test/main_test.ml
--- tyxml-3.5.0/test/main_test.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/main_test.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,6 @@
+
+
+let () = Alcotest.run "tyxml" (
+ Test_html.tests
+ @ Test_ppx.tests
+)
diff -Nru tyxml-3.5.0/test/.merlin tyxml-4.1.0/test/.merlin
--- tyxml-3.5.0/test/.merlin 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/.merlin 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,3 @@
+PKG alcotest
+FLG -ppx ../_build/ppx/ppx_tyxml_ex.native
+REC
\ No newline at end of file
diff -Nru tyxml-3.5.0/test/test_html.ml tyxml-4.1.0/test/test_html.ml
--- tyxml-3.5.0/test/test_html.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/test_html.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,88 @@
+open Tyxml
+
+let to_string = Format.asprintf "%a" (Html.pp_elt ())
+
+let tyxml_tests l =
+ let f (name, (ty : Html_types.body_content Html.elt), s) =
+ name, `Quick, fun () -> Alcotest.(check string) name (to_string ty) s
+ in
+ List.map f l
+
+let html_elements = "html elements", tyxml_tests Html.[
+
+ "div",
+ div [a []],
+ "" ;
+
+ "a",
+ canvas [a []],
+ "";
+
+]
+
+let escaping = "html escaping", tyxml_tests Html.[
+
+ "cdata",
+ cdata "]]>foo ",
+ {|
+foo
+]]>
+|} ;
+
+ "cdata multi",
+ cdata "]]>fooar/>",
+ {|
+foo
+]]>
+|} ;
+
+ "cdata_script" ,
+ cdata_script "]]>foo " ,
+ {|
+//foo
+//]]>
+|} ;
+
+ "cdata_style" ,
+ cdata_style "]]>foo " ,
+ {|
+/* foo
+/* ]]> */
+|} ;
+
+ "comment",
+ tot (Xml.comment
+ {|[if IE 8]> |} ;
+
+ "dodgy comment 1",
+ tot (Xml.comment {|>|}),
+ {||} ;
+
+ "dodgy comment 2",
+ tot (Xml.comment {|->|}),
+ {||} ;
+
+ "dodgy comment 3",
+ tot (Xml.comment {|foo-->|}),
+ {||} ;
+
+ "dodgy comment 4",
+ tot (Xml.comment {|foo--!>|}),
+ {||} ;
+
+ "utf8",
+ a ~a:[a_href "/text/λαμδα"] [pcdata "λαμδα"],
+ {|λαμδα|} ;
+
+]
+
+
+let tests = [
+ html_elements ;
+ escaping ;
+]
diff -Nru tyxml-3.5.0/test/test_ppx.ml tyxml-4.1.0/test/test_ppx.ml
--- tyxml-3.5.0/test/test_ppx.ml 1970-01-01 00:00:00.000000000 +0000
+++ tyxml-4.1.0/test/test_ppx.ml 2017-03-03 16:33:22.000000000 +0000
@@ -0,0 +1,345 @@
+(** Ppx Tests
+
+ This file is here to torture the ppx. Tests that are directly related to
+ html or svg should go to the other files.
+*)
+
+open Tyxml
+
+module type LANGUAGE = sig
+ include Xml_sigs.Typed_pp
+ type 'a list_wrap = 'a Xml_wrap.NoWrap.tlist
+ val totl : Xml.elt list_wrap -> ('a elt) list_wrap
+ val toeltl : ('a elt) list_wrap -> Xml.elt list_wrap
+end
+
+module TyTests (Language : LANGUAGE) = struct
+ module Testable = struct
+ type t = Xml.elt list
+ let pp fmt x =
+ Format.pp_print_list ~pp_sep:(fun _ () -> ())
+ (Language.pp_elt ())
+ fmt (Language.totl x)
+ let equal = (=)
+ end
+
+ let make l =
+ let f (name, ty1, ty2) =
+ name, `Quick, fun () ->
+ Alcotest.(check (module Testable)) name
+ (Language.toeltl ty1) (Language.toeltl ty2)
+ in
+ List.map f l
+end
+
+module HtmlTests = TyTests (Html)
+module SvgTests = TyTests (Svg)
+
+let basics = "ppx basics", HtmlTests.make Html.[
+
+ "elems",
+ [[%html ""]],
+ [p []] ;
+
+ "child",
+ [[%html "foo
"]],
+ [p [span [pcdata "foo"]]] ;
+
+ "list",
+ [%html "foo"],
+ [p [] ; span [pcdata "foo"]] ;
+
+ "attrib",
+ [[%html ""]],
+ [p ~a:[a_id "foo"] []] ;
+
+ "attribs",
+ [[%html ""]],
+ [p ~a:[a_id "foo"; a_class ["bar"] ] []] ;
+
+ "comment",
+ [[%html ""]],
+ [tot @@ Xml.comment "foo"] ;
+
+ "pcdata",
+ [[%html "foo"]],
+ [pcdata "foo"] ;
+
+ "document",
+ [[%html "foo "]],
+ [html (head (title (pcdata "foo")) []) (body [])] ;
+
+ "let",
+ [let%html x = "" in x],
+ [p []] ;
+
+ "nested let",
+ [let%html _ = "" in
+ let%html y = "" in
+ y],
+ [p []] ;
+
+ "let and",
+ (let%html x = "" and y = "" in [x;y]),
+ [p []; a []] ;
+
+ "let fun",
+ [let%html f x = ""x"
" in f [a []]],
+ [p [a []]] ;
+
+ "whitespace in html element",
+ [[%html "foo "]],
+ [html (head (title (pcdata "foo")) []) (body [])] ;
+
+ "whitespace around html element",
+ [[%html " foo "]],
+ [html (head (title (pcdata "foo")) []) (body [])] ;
+
+ "whitespace around element",
+ [[%html " "]],
+ [p []] ;
+
+ "whitespace in element",
+ [[%html "
"]],
+ [p [pcdata " "]] ;
+
+ "whitespace around lists",
+ [%html " "],
+ [p [] ; span []] ;
+
+ "whitespace around pcdata",
+ [%html " barfoo "],
+ [pcdata " bar" ; p [] ; pcdata "foo " ] ;
+
+ "whitespace in ul",
+ [[%html " - foo
- bar
"]],
+ [ul [li [pcdata "foo"] ; li [pcdata "bar"]]] ;
+
+ "whitespace in ol",
+ [[%html " - foo
- bar
"]],
+ [ol [li [pcdata "foo"] ; li [pcdata "bar"]]] ;
+
+ "whitespace in select",
+ [[%html {||}]],
+ [select [option ~a:[a_value "bar"] @@ pcdata "bar"]] ;
+
+ "comments",
+ [[%html {|a
|}]],
+ [div [p [pcdata "a"]; tot (Xml.comment " b "); hr ()]] ;
+
+]
+
+let attribs = "ppx attribs", HtmlTests.make Html.[
+
+ "unit absent",
+ [[%html ""]],
+ [div ~a:[a_hidden ()] []] ;
+
+ "unit present",
+ [[%html ""]],
+ [div ~a:[a_hidden ()] []] ;
+
+ "bool default",
+ [[%html ""]],
+ [div ~a:[a_draggable true] []] ;
+
+ "bool true",
+ [[%html ""]],
+ [div ~a:[a_draggable true] []] ;
+
+ "bool false",
+ [[%html ""]],
+ [div ~a:[a_draggable false] []] ;
+
+ "onoff default",
+ [[%html ""]],
+ [form ~a:[a_autocomplete true] []] ;
+
+ "bool true",
+ [[%html ""]],
+ [form ~a:[a_autocomplete true] []] ;
+
+ "bool false",
+ [[%html ""]],
+ [form ~a:[a_autocomplete false] []] ;
+
+ "link rel=canonical",
+ [[%html ""]],
+ [link ~rel:[`Canonical] ~href:"/" ()] ;
+
+ "embed type",
+ [[%html "