This is an automated email from the git hooks/post-receive script. mehdi pushed a commit to branch master in repository tyxml.
commit 64b54d37acee18147ce7536d98528c942ed25122 Author: Mehdi Dogguy <[email protected]> Date: Sun Oct 18 11:16:15 2015 +0200 Imported Upstream version 3.4.0 --- CHANGES | 15 ++++- Makefile | 33 +++++----- RELEASE.md | 15 +++++ _oasis | 8 +-- _tags | 13 ++-- configure | 4 +- lib/META | 14 ++--- lib/html5_f.ml | 35 ++++++++++- lib/html5_sigs.mli | 18 ++++-- lib/html5_types.mli | 4 +- lib/svg_f.ml | 26 +++++--- lib/svg_sigs.mli | 16 ++--- lib/svg_types.mli | 18 +++--- lib/xml_print.ml | 128 +++++++++++++++++++++------------------ lib/xml_print.mli | 7 --- myocamlbuild.ml | 4 +- setup.exe | Bin 0 -> 3510843 bytes setup.ml | 163 ++++++++++++++++++++++++++++++-------------------- syntax/pa_tyxml.ml | 5 +- syntax/xhtmlparser.ml | 7 ++- syntax/xmllexer.mll | 2 +- 21 files changed, 327 insertions(+), 208 deletions(-) diff --git a/CHANGES b/CHANGES index a1269e4..ecf01b5 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,17 @@ -===== dev ==== +===== 3.4.0 ==== + + * Add `a_lang` for HTML. Deprecate `a_srclang` in favor of `a_xml_lang`. + * Fix a performance issue with `Xml_print.Utf8.{normalize, normalize_html}. + * Remove `Xml_print.Utf8.normalize_from`. + The function was not useful and not optimizable easily. + * Add missing parameters for the attributes xlink:actuate and xml:space. + * Svg elements use the xlink namespace (contribution by Florent Becker). + * Do not use the `url(...)` form when inappropriate (contribution by Florent Becker). + * Fix a typo in the `spellcheck` attribute (contribution by Kevin Brubeck Unhammer). + * Fix the `sizes` attributes and add missing attributes for the `sandbox` tag (contributions by Eyyüb Sari). + * Fix the `img` tag in the syntax extension. + * Fix compilation of the opam package under freeBSD. + * Fix typing for the various `font_` svg attributes. ===== 3.3.0 ==== diff --git a/Makefile b/Makefile index f5b37a2..f47ef93 100644 --- a/Makefile +++ b/Makefile @@ -1,49 +1,44 @@ # OASIS_START -# DO NOT EDIT (digest: 46f8bd9984975bd4727bed22d0876cd2) +# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) -SETUP = ./setup.exe +SETUP = ocaml setup.ml -build: setup.data $(SETUP) +build: setup.data $(SETUP) -build $(BUILDFLAGS) -doc: setup.data $(SETUP) build +doc: setup.data build $(SETUP) -doc $(DOCFLAGS) -test: setup.data $(SETUP) build +test: setup.data build $(SETUP) -test $(TESTFLAGS) -all: $(SETUP) +all: $(SETUP) -all $(ALLFLAGS) -install: setup.data $(SETUP) +install: setup.data $(SETUP) -install $(INSTALLFLAGS) -uninstall: setup.data $(SETUP) +uninstall: setup.data $(SETUP) -uninstall $(UNINSTALLFLAGS) -reinstall: setup.data $(SETUP) +reinstall: setup.data $(SETUP) -reinstall $(REINSTALLFLAGS) -clean: $(SETUP) +clean: $(SETUP) -clean $(CLEANFLAGS) -distclean: $(SETUP) +distclean: $(SETUP) -distclean $(DISTCLEANFLAGS) - $(RM) $(SETUP) -setup.data: $(SETUP) +setup.data: $(SETUP) -configure $(CONFIGUREFLAGS) -configure: $(SETUP) +configure: $(SETUP) -configure $(CONFIGUREFLAGS) -setup.exe: setup.ml - ocamlfind ocamlopt -o $@ $< || ocamlfind ocamlc -o $@ $< || true - $(RM) setup.cmi setup.cmo setup.cmx setup.o - .PHONY: build doc test all install uninstall reinstall clean distclean configure # OASIS_STOP -wikidoc: $(SETUP) setup.data build +wikidoc: setup.data build $(SETUP) -build tyxml-api.wikidocdir/index.wiki diff --git a/RELEASE.md b/RELEASE.md new file mode 100644 index 0000000..6bfa22b --- /dev/null +++ b/RELEASE.md @@ -0,0 +1,15 @@ +# How to make a release. + + +- Bump the relevant version numbers: + - Oasis + - CHANGES +- `sh dist.sh`. It creates a tag and a branch numbered by the version. +- Push **only the tag and not the branch**. You obtain a tag with no branch. +- Let github create a tarball. +- Delete the local branch. + +- In [ocsigen.org-data](https://github.com/ocsigen/ocsigen.org-data), copy `tyxml/dev` to the new version number. +- Add the new version in the [download page](http://ocsigen.org/tyxml/install). + +- Publish on opam. diff --git a/_oasis b/_oasis index 7dedb20..54032aa 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: tyxml -Version: 3.3.0 +Version: 3.4.0 Homepage: http://ocsigen.org/tyxml/ Authors: Thorsten Ohl, @@ -14,7 +14,7 @@ Authors: License: LGPL-2.1 with OCaml linking exception Plugins: META (0.3), DevFiles (0.3) BuildTools: ocamlbuild -AlphaFeatures: pure_interface, compiled_setup_ml +AlphaFeatures: pure_interface Synopsis: HTML5 pages typed with polymorphic variants Description: @@ -76,7 +76,7 @@ Library pa_tyxml XMETAExtraLines: requires(toploop) = "tyxml" Path: syntax BuildDepends: - camlp4 + bytes, camlp4 Modules: Pa_tyxml InternalModules: @@ -93,7 +93,7 @@ Library tymlx_p Simple XML parser Path: syntax BuildDepends: - camlp4.lib + bytes, camlp4.lib InternalModules: Xmllexer Modules: diff --git a/_tags b/_tags index 0f090b9..30b56a6 100644 --- a/_tags +++ b/_tags @@ -1,8 +1,9 @@ # OASIS_START -# DO NOT EDIT (digest: 9b16479512c40fcf68605f52a13f8d62) +# DO NOT EDIT (digest: eb1c70f2a41e1c055bc2a938a29a8397) # 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 +true: annot, bin_annot <**/.svn>: -traverse <**/.svn>: not_hygienic ".bzr": -traverse @@ -15,19 +16,21 @@ "_darcs": not_hygienic # Library tyxml "lib/tyxml.cmxs": use_tyxml -<lib/*.ml{,i}>: pkg_str +<lib/*.ml{,i,y}>: pkg_str # Library tyxml_f "lib/tyxml_f.cmxs": use_tyxml_f -<lib/*.ml{,i}>: pkg_uutf +<lib/*.ml{,i,y}>: pkg_uutf # Library pa_tyxml "syntax/pa_tyxml.cmxs": use_pa_tyxml -<syntax/*.ml{,i}>: pkg_camlp4 +<syntax/*.ml{,i,y}>: pkg_camlp4 # Library tymlx_p "syntax/tymlx_p.cmxs": use_tymlx_p -<syntax/*.ml{,i}>: pkg_camlp4.lib +<syntax/*.ml{,i,y}>: pkg_bytes +<syntax/*.ml{,i,y}>: pkg_camlp4.lib # 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 diff --git a/configure b/configure index d2a26d1..6acfaeb 100755 --- a/configure +++ b/configure @@ -1,7 +1,7 @@ #!/bin/sh # OASIS_START -# DO NOT EDIT (digest: 6f7b8221311e800a7093dc3b793f67ca) +# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) set -e FST=true @@ -23,5 +23,5 @@ for i in "$@"; do esac done -make configure CONFIGUREFLAGS="$*" +ocaml setup.ml -configure "$@" # OASIS_STOP diff --git a/lib/META b/lib/META index 44d9fba..6a94602 100644 --- a/lib/META +++ b/lib/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: c97aacbecdef7d92d60ce4f8423803b4) -version = "3.3.0" +# DO NOT EDIT (digest: 21543140a2f275b8126768fe97e820fa) +version = "3.4.0" description = "HTML5 pages typed with polymorphic variants" requires = "str uutf" archive(byte) = "tyxml.cma" @@ -9,9 +9,9 @@ archive(native) = "tyxml.cmxa" archive(native, plugin) = "tyxml.cmxs" exists_if = "tyxml.cma" package "syntax" ( - version = "3.3.0" + version = "3.4.0" description = "HTML5 and SVG syntax extension" - requires = "camlp4" + requires = "bytes camlp4" archive(syntax, preprocessor) = "pa_tyxml.cma" archive(syntax, toploop) = "pa_tyxml.cma" archive(syntax, preprocessor, native) = "pa_tyxml.cmxa" @@ -21,9 +21,9 @@ package "syntax" ( ) package "parser" ( - version = "3.3.0" + version = "3.4.0" description = "Simple XML parser" - requires = "camlp4.lib" + requires = "bytes camlp4.lib" archive(byte) = "tymlx_p.cma" archive(byte, plugin) = "tymlx_p.cma" archive(native) = "tymlx_p.cmxa" @@ -32,7 +32,7 @@ package "parser" ( ) package "functor" ( - version = "3.3.0" + version = "3.4.0" description = "HTML5 pages typed with polymorphic variants (Functor version)" requires = "uutf" diff --git a/lib/html5_f.ml b/lib/html5_f.ml index 39cf66c..e2e248e 100644 --- a/lib/html5_f.ml +++ b/lib/html5_f.ml @@ -169,6 +169,7 @@ module MakeWrapped (* I18N: *) let a_xml_lang = string_attrib "xml:lang" + let a_lang = string_attrib "lang" (* Style: *) let a_style = string_attrib "style" @@ -265,6 +266,7 @@ module MakeWrapped let a_xml_space x = let f = function | `Preserve -> "preserve" + | `Default -> "default" in user_attrib f "xml:space" x let a_accesskey c = @@ -498,11 +500,14 @@ module MakeWrapped | `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 "spellckeck" sc + bool_attrib "spellcheck" sc let a_scoped x = let f = function @@ -515,7 +520,26 @@ module MakeWrapped in user_attrib f "seamless" x let a_sizes sizes = - let f sizes = String.concat " " (List.map string_of_int 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" @@ -898,7 +922,12 @@ module MakeWrapped let form = star "form" let svg ?(xmlns = "http://www.w3.org/2000/svg";) ?(a = []) children = - star ~a:(string_attrib "xmlns" (W.return xmlns) ::(Svg.to_xmlattribs a)) + let attribs = + string_attrib "xmlns" (W.return xmlns) + :: string_attrib "xmlns:xlink" (W.return "http://www.w3.org/1999/xlink";) + :: Svg.to_xmlattribs a + in + star ~a:(attribs) "svg" (W.map Svg.toelt children) let input = terminal "input" diff --git a/lib/html5_sigs.mli b/lib/html5_sigs.mli index 7580149..ab69c02 100644 --- a/lib/html5_sigs.mli +++ b/lib/html5_sigs.mli @@ -134,7 +134,13 @@ module type T = sig val a_reversed : [< | `Reversed] wrap -> [> | `Reversed] attrib val a_sandbox : - [< | `AllowSameOrigin | `AllowForms | `AllowScript] list wrap -> + [< + | `AllowSameOrigin + | `AllowForms + | `AllowScript + | `AllowPointerLock + | `AllowPopups + | `AllowTopNavigation ] list wrap -> [> | `Sandbox] attrib val a_spellcheck : bool wrap -> [> | `Spellcheck] attrib @@ -143,11 +149,11 @@ module type T = sig val a_seamless : [< | `Seamless] wrap -> [> | `Seamless] attrib - val a_sizes : numbers wrap -> [> | `Sizes] attrib + val a_sizes : [< | `Sizes of (number * number) list | `Any] wrap -> [> | `Sizes] attrib val a_span : number wrap -> [> | `Span] attrib - (*val a_srcdoc*) + (** 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 @@ -188,7 +194,9 @@ module type T = sig (** {2 I18N} *) - val a_xml_lang : nmtoken wrap -> [> | `XML_lang] attrib + val a_xml_lang : languagecode wrap -> [> | `XML_lang] attrib + + val a_lang : languagecode wrap -> [> | `Lang] attrib (** {2 Events} *) @@ -276,7 +284,7 @@ module type T = sig val a_cite : Xml.uri wrap -> [> | `Cite] attrib - val a_xml_space : [< | `Preserve] wrap -> [> | `XML_space] 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 diff --git a/lib/html5_types.mli b/lib/html5_types.mli index 635da5a..0c3cf0b 100644 --- a/lib/html5_types.mli +++ b/lib/html5_types.mli @@ -105,7 +105,7 @@ type frametarget = string (** Frame name used as destination for results of certain actions. *) type languagecode = string -(** A language code, as per RFC5646. +(** A language code, as per RFC5646/BCP47. @see <http://tools.ietf.org/html/rfc5646> RFC5646 *) type length = [ | `Pixels of int | `Percent of int ] @@ -284,7 +284,7 @@ type text = string (** {2 Core} *) -type i18n = [ | `XML_lang ] +type i18n = [ | `XML_lang | `Lang ] type core = [ diff --git a/lib/svg_f.ml b/lib/svg_f.ml index 28d2eda..13d8c68 100644 --- a/lib/svg_f.ml +++ b/lib/svg_f.ml @@ -257,7 +257,7 @@ struct let f = function `Disable -> "disable" | `Magnify -> "magnify" in user_attrib f "zoomAndSpan" x - let a_xlink_href = user_attrib string_of_iri "xlink:href" + let a_xlink_href = string_attrib "xlink:href" let a_requiredfeatures = Xml.space_sep_attrib "requiredFeatures" @@ -273,9 +273,9 @@ struct let a_id = string_attrib "id" - let a_xml_base = user_attrib string_of_iri "xml:base" + let a_xml_base = string_attrib "xml:base" - let a_xml_lang = user_attrib string_of_iri "xml:lang" + let a_xml_lang = string_attrib "xml:lang" let a_xml_space x = let f = function `Default -> "default" | `Preserve -> "preserve" in @@ -623,8 +623,11 @@ struct let a_xlinkactuate x = let f = function - | `OnRequest -> "onRequest" in - user_attrib f "xlink:actuate" x + | `OnRequest -> "onRequest" + | `OnLoad -> "onLoad" + | `Other -> "other" + | `None -> "none" + in user_attrib f "xlink:actuate" x let a_target = string_attrib "xlink:target" @@ -888,9 +891,18 @@ struct let a_strokeopacity = user_attrib string_of_number "stroke-opacity" - (* also generated *) - let svg = star "svg" + (* xlink namespace given a nickname since some attributes mandated by + the svg standard such as xlink:href live in that namespace, and we + refer to them as "xlink:whatever" (see a_xlink_href or a_xlinkshow) + *) + let svg ?(a = []) children = + let attribs = + string_attrib "xmlns:xlink" (W.return "http://www.w3.org/1999/xlink";) + :: to_xmlattribs a + in + star ~a:(attribs) "svg" (W.map toeltl children) + (* also generated *) let g = star "g" let defs = star "defs" diff --git a/lib/svg_sigs.mli b/lib/svg_sigs.mli index 9a19671..1cd564a 100644 --- a/lib/svg_sigs.mli +++ b/lib/svg_sigs.mli @@ -357,7 +357,9 @@ module type T = sig val a_xlinkshow : [< | `New | `Replace ] wrap -> [> | `Xlink_show ] attrib - val a_xlinkactuate : [< | `OnRequest ] wrap -> [> | `Xlink_actuate ] attrib + val a_xlinkactuate : + [< | `OnRequest | `OnLoad | `Other | `None ] wrap + -> [> | `Xlink_actuate ] attrib val a_target : string wrap -> [> | `Xlink_target ] attrib @@ -453,17 +455,17 @@ module type T = sig val a_k : string wrap -> [> | `K ] attrib - val a_fontfamily : string wrap -> [> | `FontFamily ] attrib + val a_fontfamily : string wrap -> [> | `Font_Family ] attrib - val a_fontstyle : string wrap -> [> | `FontStyle ] attrib + val a_fontstyle : string wrap -> [> | `Font_Style ] attrib - val a_fontvariant : string wrap -> [> | `FontVariant ] attrib + val a_fontvariant : string wrap -> [> | `Font_Variant ] attrib - val a_fontweight : string wrap -> [> | `FontWeight ] attrib + val a_fontweight : string wrap -> [> | `Font_Weight ] attrib - val a_fontstretch : string wrap -> [> | `FontStretch ] attrib + val a_fontstretch : string wrap -> [> | `Font_Stretch ] attrib - val a_fontsize : string wrap -> [> | `FontSize ] attrib + val a_fontsize : string wrap -> [> | `Font_Size ] attrib val a_unicoderange : string wrap -> [> | `UnicodeRange ] attrib diff --git a/lib/svg_types.mli b/lib/svg_types.mli index b6d87d2..3289e7f 100644 --- a/lib/svg_types.mli +++ b/lib/svg_types.mli @@ -1788,7 +1788,7 @@ type missingglyph_content = | `Cursor | `Filter | `Font - | `FontFace + | `Font_Face | `ForeignObject | `Image | `Marker @@ -1824,7 +1824,7 @@ type vkern = [ | `Vkern ] (* nullary *) type vkern_attr = [ | core_attr | `U1 | `G1 | `U2 | `G2 | `K ] -type fontface = [ | `FontFace ] +type fontface = [ | `Font_Face ] (* nullary *) type fontface_content = [ | descriptive_element | `Font_Face_Src ] @@ -1832,12 +1832,12 @@ type fontface_content = [ | descriptive_element | `Font_Face_Src ] type fontface_attr = [ | core_attr - | `FontFamily - | `FontStyle - | `FontVariant - | `FontWeight - | `FontStretch - | `FontSize + | `Font_Family + | `Font_Style + | `Font_Variant + | `Font_Weight + | `Font_Stretch + | `Font_Size | `UnicodeRange | `UnitsPerEm | `Panose1 @@ -1881,7 +1881,7 @@ type fontfaceuri_content = [ | `Font_Face_Format ] type fontfaceuri_attr = [ | core_attr | xlink_attr | `Xlink_href ] -type fontfaceformat = [ | `Font_Face_Uri ] +type fontfaceformat = [ | `Font_Face_Format ] (* nullary *) type fontfaceformat_attr = [ | core_attr | `String ] diff --git a/lib/xml_print.ml b/lib/xml_print.ml index 65a0d16..e016654 100644 --- a/lib/xml_print.ml +++ b/lib/xml_print.ml @@ -93,69 +93,79 @@ let string_of_number v = module Utf8 = struct type utf8 = string - type encoding = [ `UTF_16 | `UTF_16BE | `UTF_16LE | `UTF_8 | `US_ASCII | `ISO_8859_1] - let normalize_from ~encoding src = + + let normalize src = let warn = ref false in - let rec loop d e = match Uutf.decode d with - | `Uchar _ as u -> ignore (Uutf.encode e u); loop d e - | `End -> ignore (Uutf.encode e `End) - | `Malformed _ -> ignore (Uutf.encode e (`Uchar Uutf.u_rep)); warn:=true;loop d e - | `Await -> assert false - in - let d = Uutf.decoder ~encoding (`String src) in let buffer = Buffer.create (String.length src) in - let e = Uutf.encoder `UTF_8 (`Buffer buffer) in - loop d e; - Buffer.contents buffer, !warn - - let normalize src = normalize_from ~encoding:`UTF_8 src + Uutf.String.fold_utf_8 + (fun _ i d -> + match d with + | `Uchar code -> Uutf.Buffer.add_utf_8 buffer code + | `Malformed _ -> + Uutf.Buffer.add_utf_8 buffer Uutf.u_rep; + warn:=true) + () src; + (Buffer.contents buffer, !warn) + + let normalization_needed src = + let rec loop src i l = + i < l && + match src.[i] with + (* Characters that need to be encoded in HTML *) + | '\034' | '\038' | '\060' |'\062' -> + true + (* ASCII characters *) + | '\009' | '\010' | '\013' | '\032'..'\126' -> + loop src (i + 1) l + | _ -> + true + in + loop src 0 (String.length src) let normalize_html src = - let warn = ref false in - let str e s = - for i = 0 to String.length s - 1 do - ignore (Uutf.encode e (`Uchar (Char.code s.[i]))) - done in - let rec loop d e = match Uutf.decode d with - | `Uchar 34 -> str e """; loop d e - | `Uchar 38 -> str e "&"; loop d e - | `Uchar 60 -> str e "<"; loop d e - | `Uchar 62 -> str e ">"; loop d e - | `Uchar code as u -> - 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; - exept 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;`Uchar Uutf.u_rep) - else u in - ignore (Uutf.encode e u); - loop d e - | `End -> ignore (Uutf.encode e `End) - | `Malformed _ -> - ignore (Uutf.encode e (`Uchar Uutf.u_rep)); - warn:=true; - loop d e - | `Await -> assert false - in - let d = Uutf.decoder ~encoding:`UTF_8 (`String src) in - let buffer = Buffer.create (String.length src) in - let e = Uutf.encoder `UTF_8 (`Buffer buffer) in - loop d e; - Buffer.contents buffer, !warn + if normalization_needed src then begin + let warn = ref false in + let buffer = Buffer.create (String.length src) in + Uutf.String.fold_utf_8 + (fun _ i 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 + | `Malformed _ -> + Uutf.Buffer.add_utf_8 buffer Uutf.u_rep; + warn:=true) + () src; + (Buffer.contents buffer, !warn) + end else + (src, false) end diff --git a/lib/xml_print.mli b/lib/xml_print.mli index f254231..500e03e 100644 --- a/lib/xml_print.mli +++ b/lib/xml_print.mli @@ -68,13 +68,6 @@ module Utf8 : sig character by [U+FFFD] *) val normalize_html : string -> utf8 * bool - type encoding = [ `UTF_16 | `UTF_16BE | `UTF_16LE | `UTF_8 | `US_ASCII | `ISO_8859_1] - - (** [normalize_from ~encoding str] convert the string [str] into an uft-8 string. - It assumes the [encoding] encoding and replace invalid bytes by - the replacement character [U+FFFD]. - The returned boolean is true if invalid bytes were found *) - val normalize_from : encoding:[<encoding] -> string -> utf8 * bool end module Make diff --git a/myocamlbuild.ml b/myocamlbuild.ml index cdc361a..b7cce16 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -21,7 +21,7 @@ *) (* OASIS_START *) -(* DO NOT EDIT (digest: ee14852636c3e742f61f4cb1005b7b4a) *) +(* DO NOT EDIT (digest: db419e06c9afbb186094601c7cf28f8c) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -340,7 +340,7 @@ module MyOCamlbuildFindlib = struct (* This lists all supported packages. *) let find_packages () = - List.map before_space (split_nl & run_and_read "ocamlfind list") + List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) (* Mock to list available syntaxes. *) diff --git a/setup.exe b/setup.exe new file mode 100755 index 0000000..3df5dfe Binary files /dev/null and b/setup.exe differ diff --git a/setup.ml b/setup.ml index 67af621..bfbf8ab 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 100e0c44c6c608ca72769bcd6b2a90c8) *) +(* DO NOT EDIT (digest: 3193bf1324398724957ef0574221635f) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -2104,16 +2104,6 @@ module OASISLibrary = struct lst in - (* The headers that should be compiled along *) - let headers = - if lib.lib_pack then - [] - else - find_modules - lib.lib_modules - "cmi" - in - (* The .cmx that be compiled along *) let cmxs = let should_be_built = @@ -2139,12 +2129,32 @@ module OASISLibrary = struct [] in + (* The headers and annot/cmt files that should be compiled along *) + let headers = + let sufx = + if lib.lib_pack + then [".cmti"; ".cmt"; ".annot"] + else [".cmi"; ".cmti"; ".cmt"; ".annot"] + in + List.map + begin + List.fold_left + begin fun accu s -> + let dot = String.rindex s '.' in + let base = String.sub s 0 dot in + List.map ((^) base) sufx @ accu + end + [] + end + (find_modules lib.lib_modules "cmi") + in + (* Compute what libraries should be built *) let acc_nopath = (* Add the packed header file if required *) let add_pack_header acc = if lib.lib_pack then - [cs.cs_name^".cmi"] :: acc + [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc else acc in @@ -2880,7 +2890,7 @@ module OASISFileUtil = struct end -# 2883 "setup.ml" +# 2893 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -2985,7 +2995,7 @@ module BaseEnvLight = struct end -# 2988 "setup.ml" +# 2998 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5396,7 +5406,7 @@ module BaseSetup = struct end -# 5399 "setup.ml" +# 5409 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -5832,6 +5842,17 @@ module InternalInstallPlugin = struct lst in + let make_fnames modul sufx = + List.fold_right + begin fun sufx accu -> + (String.capitalize modul ^ sufx) :: + (String.uncapitalize modul ^ sufx) :: + accu + end + sufx + [] + in + (** Install all libraries *) let install_libs pkg = @@ -5852,27 +5873,29 @@ module InternalInstallPlugin = struct OASISHostPath.of_unix bs.bs_path in List.fold_left - (fun acc modul -> - try - List.find - OASISFileUtil.file_exists_case - (List.map - (Filename.concat path) - [modul^".mli"; - modul^".ml"; - String.uncapitalize modul^".mli"; - String.capitalize modul^".mli"; - String.uncapitalize modul^".ml"; - String.capitalize modul^".ml"]) - :: acc - with Not_found -> - begin - warning - (f_ "Cannot find source header for module %s \ - in library %s") - modul cs.cs_name; - acc - end) + 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 @@ -5920,27 +5943,29 @@ module InternalInstallPlugin = struct OASISHostPath.of_unix bs.bs_path in List.fold_left - (fun acc modul -> - try - List.find - OASISFileUtil.file_exists_case - (List.map - (Filename.concat path) - [modul^".mli"; - modul^".ml"; - String.uncapitalize modul^".mli"; - String.capitalize modul^".mli"; - String.uncapitalize modul^".ml"; - String.capitalize modul^".ml"]) - :: acc - with Not_found -> - begin - warning - (f_ "Cannot find source header for module %s \ - in object %s") - modul cs.cs_name; - acc - end) + 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 @@ -6245,7 +6270,7 @@ module InternalInstallPlugin = struct end -# 6248 "setup.ml" +# 6273 "setup.ml" module OCamlbuildCommon = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) @@ -6623,7 +6648,7 @@ module OCamlbuildDocPlugin = struct end -# 6626 "setup.ml" +# 6651 "setup.ml" open OASISTypes;; let setup_t = @@ -6655,10 +6680,10 @@ let setup_t = oasis_version = "0.4"; ocaml_version = None; findlib_version = None; - alpha_features = ["pure_interface"; "compiled_setup_ml"]; + alpha_features = ["pure_interface"]; beta_features = []; name = "tyxml"; - version = "3.3.0"; + version = "3.4.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -6835,7 +6860,11 @@ let setup_t = bs_install = [(OASISExpr.EBool true, true)]; bs_path = "syntax"; bs_compiled_object = Best; - bs_build_depends = [FindlibPackage ("camlp4", None)]; + bs_build_depends = + [ + FindlibPackage ("bytes", None); + FindlibPackage ("camlp4", None) + ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; bs_data_files = []; @@ -6876,7 +6905,10 @@ let setup_t = bs_path = "syntax"; bs_compiled_object = Best; bs_build_depends = - [FindlibPackage ("camlp4.lib", None)]; + [ + FindlibPackage ("bytes", None); + FindlibPackage ("camlp4.lib", None) + ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; bs_data_files = []; @@ -6932,7 +6964,8 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "/V\255V\170\176\b\196k\227\178\026+\158\224\254"; + oasis_digest = + Some "\158\131\248\226\223\138\143\134\238\212#1S\016\246]"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -6940,6 +6973,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 6944 "setup.ml" +# 6977 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/syntax/pa_tyxml.ml b/syntax/pa_tyxml.ml index 857d45b..dff35c1 100644 --- a/syntax/pa_tyxml.ml +++ b/syntax/pa_tyxml.ml @@ -136,7 +136,10 @@ module Parser5 = Xhtmlparser.Make(Syntax)(struct | tag -> String.capitalize tag ] in <:ctyp< Html5.attrib [> `$uid:tag$ ] >>; value make_attribs_type _loc tag = - <:ctyp< Html5.attrib [< Html5_types.$lid:String.lowercase tag^"_attrib"$] >>; + match String.lowercase tag with + [ "img" -> <:ctyp< Html5.attrib [< `Alt | `Src | Html5_types.img_attrib] >> + | tag -> <:ctyp< Html5.attrib [< Html5_types.$lid:tag^"_attrib"$] >> + ] ; end); diff --git a/syntax/xhtmlparser.ml b/syntax/xhtmlparser.ml index 3cbdf39..a4a068e 100644 --- a/syntax/xhtmlparser.ml +++ b/syntax/xhtmlparser.ml @@ -120,8 +120,11 @@ module Make ]; value to_string x = - let b = Buffer.create 50 in - let () = bprintf b "%a" print x in Buffer.contents b ; + (* sprintf doesn't work with "%a", + asprintf is not compatible with OCaml 3.12 + *) + let () = print str_formatter x in + flush_str_formatter () ; end; diff --git a/syntax/xmllexer.mll b/syntax/xmllexer.mll index 39fa3fc..0679412 100644 --- a/syntax/xmllexer.mll +++ b/syntax/xmllexer.mll @@ -382,7 +382,7 @@ let lexing_store s buff max = match Stream.peek s with | Some x -> Stream.junk s; - buff.[n] <- x; + Bytes.set buff n x; succ n | _ -> n in -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/tyxml.git _______________________________________________ Pkg-ocaml-maint-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits
