pax_global_header00006660000000000000000000000064152465476550014535gustar00rootroot0000000000000052 comment=309ba6d2bea1212c884a98b95b3b1bc6f4b4fd38 tyxml-5.0.0/000077500000000000000000000000001524654765500127145ustar00rootroot00000000000000tyxml-5.0.0/.github/000077500000000000000000000000001524654765500142545ustar00rootroot00000000000000tyxml-5.0.0/.github/dependabot.yml000066400000000000000000000001601524654765500171010ustar00rootroot00000000000000version: 2 updates: - package-ecosystem: github-actions directory: / schedule: interval: weekly tyxml-5.0.0/.github/workflows/000077500000000000000000000000001524654765500163115ustar00rootroot00000000000000tyxml-5.0.0/.github/workflows/doc.yml000066400000000000000000000122111524654765500175760ustar00rootroot00000000000000# Build the TyXML documentation (manual + API) with odoc, theme it with the # Ocsigen chrome (wodoc), and publish it on the project's gh-pages branch, served # at https://ocsigen.org/tyxml/. See doc/README.md for the full picture. # # CI deploys ONLY the "dev" docs and ONLY from master. Stable versions are built # by hand and committed to gh-pages at release time, so there is no dispatch / # release path here. Each run replaces only the dev/ directory; the other version # directories already on gh-pages are PRESERVED. name: Documentation on: push: branches: [master] workflow_dispatch: inputs: version: description: "Publish a stable version: freeze the dev docs now on gh-pages as // and repoint `latest` (e.g. 1.2.3). Leave empty to just rebuild dev." required: false default: "" concurrency: # This workflow only runs on master and on manual dispatch, and it pushes # to gh-pages: never cancel a deployment in flight. group: ${{ github.workflow }}-${{ github.ref }} cancel-in-progress: false jobs: build-deploy: if: github.repository == 'ocsigen/tyxml' && (github.event_name != 'workflow_dispatch' || github.event.inputs.version == '') runs-on: ubuntu-latest permissions: contents: write steps: - name: Checkout uses: actions/checkout@v7 - name: Set up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: "5.4.0" # The bottleneck of this job is compiling the dependency tree plus wodoc and # odoc from source; setup-ocaml only caches the base switch (the compiler), # so they recompiled on every push. Cache the whole _opam switch keyed on the # *.opam files (the dep set) and wodoc's HEAD commit; on a cache hit the # install is skipped and only the project itself is (re)built by the doc step # below. The key changes -- and the deps/wodoc rebuild once -- only when an # *.opam file or wodoc move. - name: Resolve wodoc HEAD commit id: wodoc run: echo "sha=$(git ls-remote https://github.com/ocsigen/wodoc.git HEAD | cut -f1)" >> "$GITHUB_OUTPUT" - name: Cache the opam switch (deps + wodoc) id: switch-cache uses: actions/cache@v6 with: path: _opam key: opam-switch-${{ runner.os }}-ocaml5.4.0-${{ hashFiles('*.opam') }}-wodoc-${{ steps.wodoc.outputs.sha }} - name: Install dependencies if: steps.switch-cache.outputs.cache-hit != 'true' run: | opam install . --deps-only --with-doc # odoc is a with-doc dep # wodoc: the odoc driver that themes the pages with the Ocsigen chrome. opam pin add -n wodoc https://github.com/ocsigen/wodoc.git opam install wodoc - name: Build documentation (dev) # wodoc build runs `dune build @doc --profile release`, assembles the # themed site from doc/wodoc, and fetches the shared menu from its single # canonical copy in ocsigen.github.io. run: >- opam exec -- wodoc build --config doc/wodoc --menu https://ocsigen.org/doc/menu.html --out "$PWD/_doc-site/dev" --label dev --strict-refs - name: Deploy to gh-pages (replace only dev/, keep the rest) uses: JamesIves/github-pages-deploy-action@v4 with: branch: gh-pages folder: _doc-site/dev target-folder: dev clean: true release: # Manual run with a version: freeze the dev docs currently on gh-pages as the # stable // and repoint `latest` at it (refreshing versions.json). # No rebuild -- the docs of a release are exactly the dev docs at that point. if: github.repository == 'ocsigen/tyxml' && github.event_name == 'workflow_dispatch' && github.event.inputs.version != '' runs-on: ubuntu-latest # Pass the user-supplied version through the environment; never interpolate # it directly into a run: shell (avoids command injection from the input). env: VERSION: ${{ github.event.inputs.version }} permissions: contents: write steps: - name: Set up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: "5.4.0" - name: Install wodoc run: | opam pin add -n wodoc https://github.com/ocsigen/wodoc.git opam install wodoc - name: Checkout gh-pages uses: actions/checkout@v7 with: ref: gh-pages path: site fetch-depth: 0 - name: Freeze dev as the stable version and repoint latest # wodoc release: cp -a site/dev site/, ln -sfn latest, # write the root index.html redirect if missing, refresh versions.json. run: >- opam exec -- wodoc release --site site --from dev --version "$VERSION" - name: Commit and push gh-pages run: | cd site git config user.name "github-actions[bot]" git config user.email "github-actions[bot]@users.noreply.github.com" git add -A git diff --cached --quiet \ || git commit -m "Release doc $VERSION (freeze dev, repoint latest)" git push tyxml-5.0.0/.github/workflows/workflow.yml000066400000000000000000000034471524654765500207160ustar00rootroot00000000000000name: Builds, tests & co on: push: branches: - master pull_request: schedule: # Prime the caches every Monday - cron: 0 1 * * MON concurrency: group: ${{ github.workflow }}-${{ github.head_ref || github.ref }} cancel-in-progress: ${{ github.event_name == 'pull_request' }} jobs: build: strategy: fail-fast: false matrix: os: - ubuntu-latest - macos-latest - windows-latest ocaml-compiler: - 5 - 4 runs-on: ${{ matrix.os }} steps: - name: Checkout tree uses: actions/checkout@v7 - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - run: opam install . --deps-only --with-test - run: opam exec -- make build - run: opam exec -- make test # TyXML is upstream of odoc, which names content types such as # Html_types.div_content in its own signatures. Widening one of those types # is invisible to callers of the element functions but breaks code that names # it, so build the most sensitive reverse dependency against this revision. reverse-deps: runs-on: ubuntu-latest steps: - name: Checkout tree uses: actions/checkout@v7 - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: 5 - name: Pin this revision of TyXML run: opam pin add --no-action --yes tyxml . - name: Build odoc against it run: opam install --yes odoc lint-opam: runs-on: ubuntu-latest steps: - name: Checkout tree uses: actions/checkout@v7 - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: 4 - uses: ocaml/setup-ocaml/lint-opam@v3 tyxml-5.0.0/.gitignore000066400000000000000000000002761524654765500147110ustar00rootroot00000000000000_build/ _opam/ .vscode/ **/*.mlpack **/*.mllib **/*.odocl **/*.docdir lib/META setup.data setup.log **/*~ setup.exe setup-dev.exe *.byte *.native _tests .merlin *.install docs/api/ _wikidoc tyxml-5.0.0/.ocp-indent000066400000000000000000000000511524654765500147510ustar00rootroot00000000000000normal with=0 syntax=lwt mll max_indent=2tyxml-5.0.0/CHANGES.md000066400000000000000000000573561524654765500143260ustar00rootroot00000000000000# 5.0.0 TyXML now follows the current specifications: the WHATWG living standard for HTML, and SVG 2 with the Filter Effects module for SVG, whose support had not moved since SVG 1.1. ## Breaking changes * The `hidden` attribute takes an enumerated argument (`` [`Hidden | `Until_found] ``) instead of no argument, and `contenteditable` takes an enumerated argument (`` [`True | `False | `Plaintext_only] ``) instead of a boolean, so that the until-found and plaintext-only states can be expressed * `a_itemtype` and `a_ping` take an `Xml.uri list` instead of a `string list` and go through `Xml.uris_attrib`, like every other URL-valued attribute. `Tyxml.Html` is unaffected, its `Xml.uri` is `string` * The SVG attributes whose value is a URL follow the same rule: `a_href`, `a_xlink_href`, `a_xml_base`, `a_xlink_role`, `a_xlink_arcrole` and the `a_ping` this release adds to the SVG `a` element take an `Xml.uri`, where they used to take the `iri` type, which is `string`. The presentation attributes that accept a funciri such as `url(#id)` or a keyword such as `none`, that is `clip-path`, `mask` and the `marker-*` ones, keep `iri` * SVG documents are printed without a doctype. `Svg.Info` declared SVG 1.1 and every printed document carried the SVG 1.1 DTD, which forbids the SVG 2 elements and attributes TyXML now emits, and SVG 2 defines no DTD. `Info.version` and `Info.standard` name SVG 2 * Unlike their HTML counterparts, the `Svg_types.*_content` types are widened along with the content models they describe: the SVG element functions use them directly, there is no `_content_fun` on that side. Code that names one of them and constrains it with `=` has to be updated * Misspelled names are corrected: `a_baseFrenquency` becomes `a_baseFrequency`, `a_externalRessourcesRequired` becomes `a_externalResourcesRequired`, the `stroke-linejoin` value `` `Bever `` becomes `` `Bevel ``, and the types `Html_types.subressource_integrity` and `Svg_types.paint_whitout_icc` become `subresource_integrity` and `paint_without_icc` * The newly deprecated elements and attributes are an error, and not a warning, for the users of the PPX and the JSX syntax who build in dune's dev profile, where alerts are fatal. The alert is reported on the markup literal, so it has to be silenced on the enclosing definition * The `Wrapped_functions` module type has four new functions, which the implementations of the functorial interface must provide: `string_of_blocking` and `string_of_ol_type` for HTML, `unoption_string` and `string_of_semicolonstrings` for SVG * The build now requires OCaml 4.08, dune 3.18 and ppxlib 0.36 (Sora Morimoto, and #340 by Patrick Ferris for the OCaml 5.2 AST) * The test matrix covers OCaml 4.14 and the 5.x series. The lower bound stays at 4.08, but the versions from 4.08 to 4.13 are no longer tested ## HTML * New elements: `s`, `bdi`, `search`, `data`, `slot`, and `track` with its `kind`, `srclang` (as `a_track_srclang`) and `default` attributes, `audio` and `video` taking an optional `?tracks` argument. `meta_itemprop` is the form of `meta` carrying an `itemprop` attribute, which the specification allows wherever phrasing content is expected and not only in the head (#343 by toastal) * New global attributes: `popover`, `inert`, `enterkeyhint`, `autocapitalize`, `autocorrect`, `writingsuggestions`, `nonce`, `slot` and `is`, the microdata attributes `itemscope`, `itemtype`, `itemid`, `itemprop` and `itemref`, the CSS shadow parts attributes `part` and `exportparts`, and the `` `Auto `` value of `dir` (#341 by @SylvainBoilard for popover, #343 by toastal for microdata) * New attributes on elements: `popovertarget` and `popovertargetaction` on buttons and inputs, `command` and `commandfor` (invoker commands) on buttons, `loading`, `decoding` and `fetchpriority` on images, `srcdoc`, `allow` and `loading` on iframes, `as`, `imagesrcset` and `imagesizes` on links (`a_as`), `nomodule` on scripts, `blocking` on links, scripts and styles, `ping` on `a` and `area`, `dirname` on inputs and textareas, `capture` (W3C HTML Media Capture) on inputs, `a_ol_type` on ordered lists, `abbr` on th cells, `closedby` on dialogs, `media` on meta, `name` on `details`, `playsinline` and `disablepictureinpicture` on videos, `disableremoteplayback` on audios and videos, and the declarative shadow DOM attributes on templates (`shadowrootmode`, `shadowrootdelegatesfocus`, `shadowrootclonable` and `shadowrootserializable`). Also allow `crossorigin`, `usemap` and `referrerpolicy` on images, `referrerpolicy` on `a` and `area`, and `autocomplete` on selects and textareas (#341 by @SylvainBoilard for `name` on `details`, fixes #268) * New event handler attributes: the pointer events (`a_onpointerdown` and its siblings), `a_onwheel`, `a_onauxclick`, and the global handlers that were missing (`a_onbeforeinput`, `a_onbeforematch`, `a_onbeforetoggle`, `a_oncancel`, `a_oncontextlost`, `a_oncontextrestored`, `a_oncopy`, `a_oncut`, `a_onpaste`, `a_oncuechange`, `a_onscrollend`, `a_onsecuritypolicyviolation`, `a_onslotchange` and `a_ontoggle`), plus `a_onlanguagechange`, `a_onrejectionhandled` and `a_onunhandledrejection` on body * New attribute values: `dialog` for `method` and `formmethod`, and the newer `sandbox` tokens (`allow-downloads`, `allow-modals`, `allow-orientation-lock`, `allow-popups-to-escape-sandbox`, `allow-presentation`, `allow-top-navigation-by-user-activation` and `allow-top-navigation-to-custom-protocols`) * Content models brought in line with the specification: `div` groups `dt` and `dd` inside `dl`, the script-supporting elements (`script`, `template`) are accepted in `dl`, `ol`, `ul`, `menu`, `table` and its row groups, `tr`, `select` and `optgroup`, `hgroup` accepts `p`, and `select` accepts `hr`. The `_content` types keep their previous value, only the types the element functions use are widened (#344 by toastal, fixes #342 and #321) * Undeprecate the `scope` attribute, which is valid on table header cells in the living standard * Deprecate `a_version`, `a_xml_space` and `a_scrolling`, which produce a type tag that is in no attribute category, so no element ever accepted them ## SVG * New elements: `mask`, `feMergeNode` and `feDropShadow`. `mask` was declared in `Svg_types` but the element itself was missing, and `feMerge` could be given no child at all since `feMergeNode` did not exist * Presentation attributes: add the ones whose type tags were already declared but had no function (`baseline-shift`, `clip-rule`, `color`, `color-interpolation`, `color-interpolation-filters`, `color-rendering`, `cursor`, `direction`, `display`, `fill-opacity`, `filter`, `flood-color`, `flood-opacity`, `font-size-adjust`, `image-rendering`, `letter-spacing`, `lighting-color`, `marker-end`, `marker-mid`, `marker-start`, `mask`, `opacity`, `overflow`, `pointer-events`, `shape-rendering`, `unicode-bidi`, `visibility`, `word-spacing` and `writing-mode`) and the ones new in SVG 2 (`paint-order`, `text-overflow`, `transform-origin`, `vector-effect` and `white-space`). The ones SVG 2 removed are added as deprecated: `clip`, `color-profile`, `enable-background`, `glyph-orientation-horizontal`, `glyph-orientation-vertical` and `kerning` (#333 by Martin @MBodin Bodin for `clip-path`) * Other new attributes: the `tabindex` and `autofocus` global attributes, `lang` becomes global, ARIA support (`a_role` and `a_aria`), the SVG 2 link attributes on the `a` element (`download`, `hreflang`, `ping`, `referrerpolicy`, `rel` and `type`), `crossorigin`, `decoding` and `fetchpriority`, `fr` on radial gradients, `side` and `path` on `textPath`, and the SVG 2 geometry attributes on `symbol` (`x`, `y`, `width`, `height`, `refX`, `refY`) * Attribute functions missing for type tags that were already declared: `a_end` (SMIL timing), `a_z` (light sources), `a_filterUnits`, `a_title` (on `style`), `a_origin`, `a_panose_1`, `a_descent`, and the deprecated `a_xlink_type`, `a_xlink_role` and `a_xlink_arcrole` * New values of existing attributes: `miter-clip` and `arcs` for `stroke-linejoin`, all the CSS blend modes for the `mode` attribute of `feBlend`, and `text-top` and `text-bottom` for `alignment-baseline` and `dominant-baseline` * The HTML event handler attributes, which SVG 2 reuses on every element (focus, keyboard, pointer, wheel, clipboard, drag and media events), and the window event handler attributes on the `svg` element * Content models widened to SVG 2: shapes accept paint servers, `clipPath`, `marker`, `mask`, `script` and `style`; `use` and `image` accept `clipPath`, `mask`, `script` and `style`; text elements accept paint servers, `script` and `style`; filter primitives accept descriptive elements, `animate`, `script` and `set`; gradients, `stop` and `clipPath` accept `script` * Separate the values of the `values`, `keyTimes` and `keySplines` animation attributes with semicolons, as SMIL requires, instead of commas (#308 by @rand00) * Deprecate what SVG 2 removed and was not deprecated yet: `externalResourcesRequired`, `filterRes`, `zoomAndPan`, the `onzoom`, `onactivate`, `onfocusin` and `onfocusout` event handlers, and the `cursor` and `animateColor` elements. Conversely, undeprecate `a_onload`: the load event is still fired on SVG elements ## Fixes * The `area` element could not be used at all: it had no `href` attribute, and its type tag was in no content model, so a `map` containing areas fitted nowhere. It is now phrasing content, and its signature uses `area_attrib` instead of repeating a shorter list that left out `download`, `ping` and `referrerpolicy` (fixes part of #184) * The `li` children of `menu` could not be built: the `` `Lis `` branch required an `li` whose attributes were a subset of the common ones, excluding the `value` attribute that `li` always allows * Several attribute names were emitted misspelled: `reversed` (emitted `reserved`), the `allow-scripts` sandbox token (`allow-script`) and, in SVG, `zoomAndPan`, `requiredExtensions`, `externalResourcesRequired`, `edgeMode` (emitted `targetY`), `filterRes`, `target` (emitted `xlink:target`), `glyph-name` and the `font-face-format` element (emitted `font-face-uri`). Several SVG attribute values were too: the hyphens missing from the `rendering-intent` and `dominant-baseline` values, the case of the `in` and `in2` keywords (`SourceGraphic` and the other built-in inputs), and `` `Align ``, emitted as the empty string (Hugo @hhugo Heuzard) * Several type tags did not match their attribute, making `a_edgeMode`, `a_preserveAlpha`, `a_filterRes`, `a_target`, `a_glyph_name`, `a_arabic_form`, `a_requiredExtensions`, `a_xlink_title` and `a_low` unusable, and some element type tags were misspelled or duplicated (`feFuncR`, `feFuncG` and `feFuncB` were all defined as `` `FeFuncA ``) (Hugo @hhugo Heuzard) * The `symbol` element accepted neither the core attributes, so no `id`, which made it impossible to reference, nor the presentation and event attributes, nor shape children * The `xml:base`, `xml:lang` and `xml:space` attributes and the touch event handler attributes of SVG had type tags listed in no attribute category, which made them unusable on every element * `Xml_print.compose_decl` emitted a literal `\n` instead of a newline, which made the XML declaration invalid (#348 by Martin @MBodin Bodin) * In the JSX syntax, `Html` used as an element name was mistaken for a user-defined component: the test lowercased the name and then compared it with a capitalised string, so it never matched * Fix the development-profile build with recent compilers by anonymizing the unused functor parameters of the printer and functor signatures (warning 67) * Fix the typo `whitout` in a type definition (#324 by Martin @MBodin Bodin) * Fix the typo `subresource` and various English orthographic mistakes (#345 by toastal) * `Unsafe` gains `uris_attrib`, the escape hatch that was missing for an attribute holding a space-separated list of URLs, next to `uri_attrib` ## PPX and JSX syntax * No camel case SVG attribute was recognised, so `viewBox`, `maskUnits`, `stdDeviation`, `gradientTransform`, `preserveAspectRatio`, `refX`, `markerWidth` and many others were rejected * Whitespace between SVG tags is ignored for the elements whose content model does not accept text. Indented SVG, as the specification itself writes it, was rejected: `[%svg " "]` failed to typecheck. Whitespace is still significant in `text`, `tspan`, `textPath`, `desc`, `title`, `style` and `script` (#331 by Martin @MBodin Bodin, fixes #330) * A `transform` attribute whose arguments were comma separated, such as `translate(1,1)`, was rejected. Any whitespace, and not only the space character, is now accepted around the separators of list-valued attributes (#328 by Martin @MBodin Bodin, fixes #326) * Two transforms must now be separated by whitespace or a comma, as the grammar of the attribute requires. `transform="translate(1,2)rotate(45)"` used to be accepted and silently turned into valid output * The `values`, `keyTimes` and `keySplines` animation attributes are split on semicolons, where they used to be split on spaces (#308 by @rand00) * An empty `option` is accepted, as for `script` and `textarea`: an option carrying a `label` and a `value` attribute has no content, which is the usual form inside a `datalist` (fixes #228) ## Documentation * The manual is converted from wikicreole to odoc, and the API references in the interfaces are native odoc references. The themed site published on ocsigen.org is built by wodoc (#352 by Hugo @hhugo Heuzard for the rendering) # 4.6.0 * Update for OCaml 5.0 and drop support for OCaml 4.2.0 (#312 by @rr0gi) * Add additional variants to `linktype` for the `rel` attribute (Leon @LogicalOverflow Vack) * Expand options for `autocomplete` attribute on `` elements (#302 by Aron @aronerben Erben) * Fix the SVG element `` (by the way, deprecate `animation` et al. in favor of `animate` et al.) (#306 by Idir @ilankri Lankri) * Add support for `dialog` element and `onclose` attribute (#301 by Julien Sagot) * Add an escape hatch for emitting attributes with non-standard names in jsx or ppx code (a leading `_` character on attribute name) (#295 Chas @cemerick Emerick) * Add support for `type` attribute on `; let home_page_doc = 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); let fmt = Format.formatter_of_out_channel(file_handle); Format.fprintf(fmt, "%a@.", Html.pp(~indent=true, ()), page); close_out(file_handle); }; let () = List.iter(emit_page, pages); tyxml-5.0.0/examples/basic_website_ppx/000077500000000000000000000000001524654765500202245ustar00rootroot00000000000000tyxml-5.0.0/examples/basic_website_ppx/Makefile000066400000000000000000000002721524654765500216650ustar00rootroot00000000000000site_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 tyxml-5.0.0/examples/basic_website_ppx/Readme.md000066400000000000000000000010471524654765500217450ustar00rootroot00000000000000This 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/ tyxml-5.0.0/examples/basic_website_ppx/dune000066400000000000000000000002621524654765500211020ustar00rootroot00000000000000(executable (name site_html) (libraries tyxml) (preprocess (pps tyxml-ppx) )) (rule (targets index.html) (deps site_html.exe) (action (run %{exe:site_html.exe}) )) tyxml-5.0.0/examples/basic_website_ppx/home.css000066400000000000000000000003141524654765500216640ustar00rootroot00000000000000#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; } tyxml-5.0.0/examples/basic_website_ppx/main.js000066400000000000000000000001271524654765500215060ustar00rootroot00000000000000"use strict"; var handle = document.getElementById("payload"); console.log(handle); tyxml-5.0.0/examples/basic_website_ppx/site_html.ml000066400000000000000000000030261524654765500225470ustar00rootroot00000000000000open Tyxml let this_title = Html.txt "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 Format.fprintf fmt "%a@." (Html.pp ~indent:true ()) page; close_out file_handle let () = List.iter emit_page pages tyxml-5.0.0/examples/dune000066400000000000000000000005331524654765500154110ustar00rootroot00000000000000(alias (name runtest) (deps mini_website/index.html basic_website/index.html ) (package tyxml) ) (alias (name runtest) (deps mini_website_ppx/index.html basic_website_ppx/index.html ) (package tyxml-ppx) ) (alias (name runtest) (deps mini_website_jsx/index.html basic_website_jsx/index.html ) (package tyxml-jsx) ) tyxml-5.0.0/examples/mini_website/000077500000000000000000000000001524654765500172105ustar00rootroot00000000000000tyxml-5.0.0/examples/mini_website/Makefile000066400000000000000000000002641524654765500206520ustar00rootroot00000000000000site_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 tyxml-5.0.0/examples/mini_website/Readme.md000066400000000000000000000006661524654765500207370ustar00rootroot00000000000000This 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/ tyxml-5.0.0/examples/mini_website/dune000066400000000000000000000002161524654765500200650ustar00rootroot00000000000000(executable (name minihtml) (libraries tyxml) ) (rule (targets index.html) (deps minihtml.exe) (action (run %{exe:minihtml.exe})) ) tyxml-5.0.0/examples/mini_website/minihtml.ml000066400000000000000000000006611524654765500213660ustar00rootroot00000000000000open Tyxml.Html let mycontent = div ~a:[a_class ["content"]] [ h1 [txt "A fabulous title"] ; txt "This is a fabulous content." ; ] let mytitle = title (txt "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 Format.fprintf fmt "%a@." (pp ~indent:true ()) mypage; close_out file tyxml-5.0.0/examples/mini_website_jsx/000077500000000000000000000000001524654765500200745ustar00rootroot00000000000000tyxml-5.0.0/examples/mini_website_jsx/Readme.md000066400000000000000000000006431524654765500216160ustar00rootroot00000000000000This is the minimal website in pure tyxml using the jsx syntax extension. To generate the website, compile `minihtml.re` and then execute. This can be done with `make`. Content of this directory: - `minihtml.re`: Generates the Html. - `.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/ tyxml-5.0.0/examples/mini_website_jsx/dune000066400000000000000000000002561524654765500207550ustar00rootroot00000000000000(executable (name minihtml) (libraries tyxml) (preprocess (pps tyxml-jsx)) ) (rule (targets index.html) (deps minihtml.exe) (action (run %{exe:minihtml.exe})) ) tyxml-5.0.0/examples/mini_website_jsx/minihtml.re000066400000000000000000000007361524654765500222530ustar00rootroot00000000000000open Tyxml; let mycontent =

"A fabulous title"

"This is a fabulous content."
; let mytitle = Html.txt("A Fabulous Web Page"); let mypage = mytitle mycontent ; let () = { let file = open_out("index.html"); let fmt = Format.formatter_of_out_channel(file); Format.fprintf(fmt, "%a@.", Html.pp(~indent=true, ()), mypage); close_out(file); }; tyxml-5.0.0/examples/mini_website_ppx/000077500000000000000000000000001524654765500200775ustar00rootroot00000000000000tyxml-5.0.0/examples/mini_website_ppx/Makefile000066400000000000000000000002701524654765500215360ustar00rootroot00000000000000site_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 tyxml-5.0.0/examples/mini_website_ppx/Readme.md000066400000000000000000000007251524654765500216220ustar00rootroot00000000000000This 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/ tyxml-5.0.0/examples/mini_website_ppx/dune000066400000000000000000000002561524654765500207600ustar00rootroot00000000000000(executable (name minihtml) (libraries tyxml) (preprocess (pps tyxml-ppx)) ) (rule (targets index.html) (deps minihtml.exe) (action (run %{exe:minihtml.exe})) ) tyxml-5.0.0/examples/mini_website_ppx/minihtml.ml000066400000000000000000000007631524654765500222600ustar00rootroot00000000000000open Tyxml let%html mycontent = {|

A fabulous title

This is a fabulous content.
|} let mytitle = Html.txt "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 Format.fprintf fmt "%a@." (Html.pp ~indent:true ()) mypage; close_out file tyxml-5.0.0/implem/000077500000000000000000000000001524654765500141775ustar00rootroot00000000000000tyxml-5.0.0/implem/dune000066400000000000000000000002071524654765500150540ustar00rootroot00000000000000(library (name tyxml) (public_name tyxml) (wrapped false) (libraries tyxml_f re uutf) (flags (:standard -safe-string)) ) tyxml-5.0.0/implem/tyxml.ml000066400000000000000000000013621524654765500157100ustar00rootroot00000000000000(** 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 {{!page-"index"}the manual} 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"] tyxml-5.0.0/implem/tyxml_html.ml000066400000000000000000000021171524654765500167330ustar00rootroot00000000000000(* 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 02110-1301, 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) [@@ocaml.warning "-3"] include M include P let _pp = pp () let _pp_elt = pp_elt () tyxml-5.0.0/implem/tyxml_html.mli000066400000000000000000000042121524654765500171020ustar00rootroot00000000000000(* 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 02110-1301, USA. *) (** Typesafe constructors and printers for Html documents. @see W3C Recommendation *) (** Concrete implementation of Html typesafe constructors. See {!module-type: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) -> ?indent:bool -> ?advert:string -> unit -> Format.formatter -> doc -> unit (** [pp_elt ()] is a {!Format} printer for Html elements. *) val pp_elt : ?encode:(string -> string) -> ?indent:bool -> 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."] (**/*) (** Toplevel printers *) val _pp : Format.formatter -> doc -> unit [@@ocaml.toplevel_printer] val _pp_elt : Format.formatter -> _ elt -> unit [@@ocaml.toplevel_printer] tyxml-5.0.0/implem/tyxml_svg.ml000066400000000000000000000021041524654765500165620ustar00rootroot00000000000000(* 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 02110-1301, 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) [@@ocaml.warning "-3"] include M include P let _pp = pp () let _pp_elt = pp_elt () tyxml-5.0.0/implem/tyxml_svg.mli000066400000000000000000000041621524654765500167410ustar00rootroot00000000000000(* 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 02110-1301, USA. *) (** Typesafe constructors and printers for Svg documents. @see W3C Recommendation *) (** Concrete implementation of Svg typesafe constructors. See {!module-type: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) -> ?indent:bool -> ?advert:string -> unit -> Format.formatter -> doc -> unit (** [pp_elt ()] is a {!Format} printer for Svg elements. *) val pp_elt : ?encode:(string -> string) -> ?indent:bool -> 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."] (**/*) (** Toplevel printers *) val _pp : Format.formatter -> doc -> unit [@@ocaml.toplevel_printer] val _pp_elt : Format.formatter -> _ elt -> unit [@@ocaml.toplevel_printer] tyxml-5.0.0/implem/tyxml_xml.ml000066400000000000000000000067411524654765500165760ustar00rootroot00000000000000(* 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 02110-1301, 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 type touch_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 touch_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) [@@ocaml.warning "-3"] include Xml_iter.Make(M) include Xml_print.Make_fmt(M)(struct let emptytags = [] end) include Xml_stream.Import(M) let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x] tyxml-5.0.0/implem/tyxml_xml.mli000066400000000000000000000065371524654765500167520ustar00rootroot00000000000000(* 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 02110-1301, 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 and type touch_event_handler = string include Xml_sigs.Pp with type elt := elt (** {2 Import/Export} *) val of_seq : Xml_stream.signal Seq.t -> elt list (** {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."] tyxml-5.0.0/jsx/000077500000000000000000000000001524654765500135205ustar00rootroot00000000000000tyxml-5.0.0/jsx/dune000066400000000000000000000003611524654765500143760ustar00rootroot00000000000000(library (name tyxml_jsx) (public_name tyxml-jsx) (libraries tyxml-syntax ppxlib ) (kind ppx_rewriter) (preprocess (pps ppxlib.metaquot)) (flags (:standard -safe-string -open Ppxlib -w "-9" )) )tyxml-5.0.0/jsx/tyxml_jsx.ml000066400000000000000000000173621524654765500161240ustar00rootroot00000000000000open Ppxlib.Parsetree open Ppxlib.Asttypes open Tyxml_syntax let is_jsx e = let f = function | { attr_name = {txt = "JSX"}} -> true | _ -> false in List.exists f e.pexp_attributes let lowercase_lead s = String.mapi (fun i c -> if i = 0 then Char.lowercase_ascii c else c) s let to_kebab_case = let open Re in let camelPat = Posix.compile_pat "[A-Z]" in let underscore = compile @@ char '_' in let prefixes = Perl.compile_pat {|^(data_?|aria_?)(.+)|} in fun name -> let kebab string = replace camelPat ~f:(fun g -> "-" ^ Group.get g 0) string |> String.lowercase_ascii |> replace_string underscore ~by:"-" in match exec_opt prefixes name with | None -> if name.[0] == '_' (* need to keep the leading underscore, as that's what the syntax support keys off of to know to use Unsafe.string_attrib *) then "_" ^ kebab @@ String.sub name 1 (String.length name - 1) else name | Some g -> let prefix = String.sub name 0 4 in let suffix = kebab @@ Group.get g 2 in prefix ^ (if suffix.[0] == '-' then "" else "-") ^ suffix let make_attr_name name = let name = match name with | "className" -> "class" | "htmlFor" -> "for" | "class_" -> "class" | "for_" -> "for" | "type_" -> "type" | "to_" -> "to" | "open_" -> "open" | "begin_" -> "begin" | "end_" -> "end" | "in_" -> "in" | "method_" -> "method" | name -> to_kebab_case name in name open Common let rec filter_map f = function | [] -> [] | a :: q -> match f a with | None -> filter_map f q | Some a -> a :: filter_map f q (** Children *) let make_txt ~loc ~lang s = let txt = Common.make ~loc lang "txt" in let arg = Common.wrap lang loc @@ Common.string loc s in Ppxlib.Ast_helper.Exp.apply ~loc txt [Nolabel, arg] let element_mapper transform_expr e = match e with (* Convert string constant into Html.txt "constant" for convenience *) | { pexp_desc = Pexp_constant (Pconst_string (str, loc, _)); _ } -> make_txt ~loc ~lang:Html str | _ -> transform_expr e let extract_element_list transform_expr elements = let rec map acc e = match e with | [%expr []] -> List.rev acc | [%expr [%e? child] :: [%e? rest]] -> let child = Common.value (element_mapper transform_expr child) in map (child :: acc) rest | e -> List.rev (Common.antiquot (element_mapper transform_expr e) :: acc) in map [] elements let extract_children transform_expr args = match List.find (function Labelled "children", _ -> true | _ -> false) args with | _, children -> extract_element_list transform_expr children | exception Not_found -> [] (** Attributes *) type attr = { a_name: Common.name; a_value : string value; a_loc: Location.t; } let rec extract_attr_value ~lang a_name a_value = let a_name = make_attr_name a_name in match a_value with | { pexp_desc = Pexp_constant (Pconst_string (attr_value, _, _)); _ } -> ((lang, a_name), Common.value attr_value) | e -> ((lang, a_name), Common.antiquot e) and extract_attr ~lang = function (* Ignore last unit argument as tyxml api is pure *) | Nolabel, [%expr ()] -> None | Labelled "children", _ -> None | Labelled name, value -> Some (extract_attr_value ~lang name value) | Nolabel, e -> error e.pexp_loc "Unexpected unlabeled jsx attribute" | Optional name, e -> error e.pexp_loc "Unexpected optional jsx attribute %s" name let classify_name ~loc hint_lang lid = let annotated_lang, name = match lid with | Longident.Ldot (Ldot (Lident s, name), "createElement") when String.lowercase_ascii s = "html" -> Some Html, lowercase_lead name | Longident.Ldot (Lident s, name) when String.lowercase_ascii s = "html" -> Some Html, lowercase_lead name | Ldot (Ldot (Lident s, name), "createElement") when String.lowercase_ascii s = "svg" -> Some Svg, lowercase_lead name | Longident.Ldot (Lident s, name) when String.lowercase_ascii s = "svg" -> Some Svg, lowercase_lead name | Lident name -> hint_lang, name | _ -> Common.error loc "Invalid Tyxml tag %s" (String.concat "." (Longident.flatten_exn lid)) in let parent_lang, elt = match Element.find_assembler (Html, name), Element.find_assembler (Svg, name), annotated_lang with | _, Some ("svg", _), Some l -> l, (Svg, name) | _, Some ("svg", _), None -> Svg, (Svg, name) | Some _, None, _ -> Html, (Html, name) | None, Some _, _ -> Svg, (Svg, name) | Some _, Some _, Some lang -> lang, (lang, name) | Some _, Some _, None -> (* In case of doubt, use Html *) Html, (Html, name) | None, None, _ -> Common.error loc "Unknown namespace for the element %s" name in parent_lang, elt let is_homemade_component lid = match lid with | Longident.Ldot (( Lident s | Ldot (_, s)), "createElement") -> String.lowercase_ascii s <> "svg" && String.lowercase_ascii s <> "html" && let c = s.[0] in 'A' <= c && c <= 'Z' | _ -> false let mk_component ~lang ~loc f attrs children = let children = match children with | [] -> [] | l -> [Labelled "children", Common.list_wrap_value lang loc l] in let mk_attr ((_ns, name), v) = Labelled name, match v with | Common.Val s -> Common.string loc s | Common.Antiquot e -> e in let attrs = List.map mk_attr attrs in let args = attrs @ children @ [Nolabel,[%expr ()]] in Ppxlib.Ast_helper.Exp.apply ~loc f args let traverse = object(self) inherit [Common.lang option] Ppxlib.Ast_traverse.map_with_context as super val mutable enabled = true method! structure_item hint_lang stri = match stri.pstr_desc with | Pstr_attribute { attr_name = { txt = ("tyxml.jsx" | "tyxml.jsx.enable") as s } ; attr_payload ; attr_loc ; } -> begin match attr_payload with | PStr [%str true] -> enabled <- true | PStr [%str false] -> enabled <- false | _ -> Common.error attr_loc "Unexpected payload for %s. A boolean is expected." s end ; stri | _ -> super#structure_item hint_lang stri method! expression hint_lang e = if not (is_jsx e) || not enabled then super#expression hint_lang e else let loc = e.pexp_loc in match e with (* matches <> ... ; *) | [%expr []] | [%expr [%e? _] :: [%e? _]] -> let l = extract_element_list (self#expression hint_lang) e in Common.list_wrap_value Common.Html loc l (* matches child1 child2 ; *) | {pexp_desc = Pexp_apply ({ pexp_desc = Pexp_ident { txt }; _ } as f_expr, args )} when is_homemade_component txt -> let lang = match hint_lang with | Some l -> l | None -> Common.Html in let attributes = filter_map (extract_attr ~lang) args in let children = extract_children (self#expression hint_lang) args in let e = mk_component ~loc ~lang f_expr attributes children in e (* matches
child1 child2
; *) | {pexp_desc = Pexp_apply ({ pexp_desc = Pexp_ident { txt }; _ }, args )} -> let parent_lang, name = classify_name ~loc hint_lang txt in let lang = fst name in let attributes = filter_map (extract_attr ~lang) args in let children = extract_children (self#expression @@ Some lang) args in let e = Element.parse ~loc ~parent_lang ~name ~attributes children in e | _ -> super#expression hint_lang e end let () = Ppxlib.Driver.register_transformation ~impl:(traverse#structure None) "tyxml-jsx" tyxml-5.0.0/lib/000077500000000000000000000000001524654765500134625ustar00rootroot00000000000000tyxml-5.0.0/lib/dune000066400000000000000000000004541524654765500143430ustar00rootroot00000000000000(library (name tyxml_f) (public_name tyxml.functor) (wrapped false) (modules_without_implementation Xml_sigs Html_sigs Svg_sigs Html_types Svg_types) (synopsis "Statically correct HTML and SVG documents (Functor version)") (libraries uutf re seq) (flags (:standard -safe-string)) ) tyxml-5.0.0/lib/html_f.ml000066400000000000000000001070251524654765500152720ustar00rootroot00000000000000(* 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 02110-1301, 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"; "track"; "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 uris_attrib a s = Xml.uris_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_onbeforeinput = Xml.event_handler_attrib "onbeforeinput" let a_onbeforematch = Xml.event_handler_attrib "onbeforematch" let a_onbeforetoggle = Xml.event_handler_attrib "onbeforetoggle" let a_onblur = Xml.event_handler_attrib "onblur" let a_oncancel = Xml.event_handler_attrib "oncancel" 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_onclose = Xml.event_handler_attrib "onclose" let a_oncontextlost = Xml.event_handler_attrib "oncontextlost" let a_oncontextrestored = Xml.event_handler_attrib "oncontextrestored" let a_oncopy = Xml.event_handler_attrib "oncopy" let a_oncut = Xml.event_handler_attrib "oncut" let a_oncuechange = Xml.event_handler_attrib "oncuechange" 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_onlanguagechange = Xml.event_handler_attrib "onlanguagechange" let a_onrejectionhandled = Xml.event_handler_attrib "onrejectionhandled" let a_onunhandledrejection = Xml.event_handler_attrib "onunhandledrejection" 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_onpaste = Xml.event_handler_attrib "onpaste" 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_onscrollend = Xml.event_handler_attrib "onscrollend" let a_onsecuritypolicyviolation = Xml.event_handler_attrib "onsecuritypolicyviolation" 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_onslotchange = Xml.event_handler_attrib "onslotchange" 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_ontoggle = Xml.event_handler_attrib "ontoggle" 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_onauxclick = Xml.mouse_event_handler_attrib "onauxclick" 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" let a_onwheel = Xml.mouse_event_handler_attrib "onwheel" (** Javascript pointer events *) let a_onpointercancel = Xml.mouse_event_handler_attrib "onpointercancel" let a_onpointerdown = Xml.mouse_event_handler_attrib "onpointerdown" let a_onpointerenter = Xml.mouse_event_handler_attrib "onpointerenter" let a_onpointerleave = Xml.mouse_event_handler_attrib "onpointerleave" let a_onpointermove = Xml.mouse_event_handler_attrib "onpointermove" let a_onpointerout = Xml.mouse_event_handler_attrib "onpointerout" let a_onpointerover = Xml.mouse_event_handler_attrib "onpointerover" let a_onpointerup = Xml.mouse_event_handler_attrib "onpointerup" let a_ongotpointercapture = Xml.mouse_event_handler_attrib "ongotpointercapture" let a_onlostpointercapture = Xml.mouse_event_handler_attrib "onlostpointercapture" (** Javascript touch events *) let a_ontouchstart = Xml.touch_event_handler_attrib "ontouchstart" let a_ontouchend = Xml.touch_event_handler_attrib "ontouchend" let a_ontouchmove = Xml.touch_event_handler_attrib "ontouchmove" let a_ontouchcancel = Xml.touch_event_handler_attrib "ontouchcancel" (** 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 x = user_attrib C.string_of_big_variant "formmethod" x 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_minlength = int_attrib "minlength" let a_name = string_attrib "name" let a_abbr = string_attrib "abbr" let a_allow = string_attrib "allow" let a_allowfullscreen = constant_attrib "allowfullscreen" let a_allowpaymentrequest = constant_attrib "allowpaymentrequest" let a_referrerpolicy x = user_attrib C.string_of_referrerpolicy "referrerpolicy" x let a_autocomplete x = user_attrib C.string_of_autocomplete "autocomplete" x let a_autocapitalize x = user_attrib C.string_of_big_variant "autocapitalize" x let a_autocorrect x = user_attrib C.onoff_of_bool "autocorrect" x let a_as x = user_attrib C.string_of_big_variant "as" 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_integrity = string_attrib "integrity" let a_mediagroup = string_attrib "mediagroup" let a_challenge = string_attrib "challenge" let a_closedby x = user_attrib C.string_of_big_variant "closedby" x let a_capture x = user_attrib C.string_of_big_variant "capture" x let a_contenteditable x = user_attrib C.string_of_big_variant "contenteditable" x 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_dirname = string_attrib "dirname" let a_draggable d = bool_attrib "draggable" d let a_enterkeyhint x = user_attrib C.string_of_big_variant "enterkeyhint" x 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 x = user_attrib C.string_of_big_variant "hidden" x let a_high = float_attrib "high" let a_icon = uri_attrib "icon" let a_inert = constant_attrib "inert" let a_is = string_attrib "is" let a_itemscope = constant_attrib "itemscope" let a_itemtype = uris_attrib "itemtype" let a_itemid = uri_attrib "itemid" let a_itemprop = space_sep_attrib "itemprop" let a_itemref = space_sep_attrib "itemref" let a_ismap = constant_attrib "ismap" let a_keytype = string_attrib "keytype" let a_list = string_attrib "list" let a_loading x = user_attrib C.string_of_big_variant "loading" x let a_decoding x = user_attrib C.string_of_big_variant "decoding" x let a_fetchpriority x = user_attrib C.string_of_big_variant "fetchpriority" x 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_nomodule = constant_attrib "nomodule" let a_nonce = string_attrib "nonce" 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_ping = uris_attrib "ping" let a_playsinline = constant_attrib "playsinline" let a_disablepictureinpicture = constant_attrib "disablepictureinpicture" let a_disableremoteplayback = constant_attrib "disableremoteplayback" let a_placeholder = string_attrib "placeholder" let a_part = space_sep_attrib "part" let a_exportparts = comma_sep_attrib "exportparts" let a_popover x = user_attrib C.string_of_big_variant "popover" x let a_popovertarget = string_attrib "popovertarget" let a_popovertargetaction x = user_attrib C.string_of_big_variant "popovertargetaction" x let a_command x = user_attrib C.string_of_big_variant "command" x let a_commandfor = string_attrib "commandfor" 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 "reversed" let a_blocking x = user_attrib C.string_of_blocking "blocking" x let a_sandbox x = user_attrib C.string_of_sandbox "sandbox" x let a_writingsuggestions = bool_attrib "writingsuggestions" let a_spellcheck sc = bool_attrib "spellcheck" sc let a_scoped = constant_attrib "scoped" let a_seamless = constant_attrib "seamless" let a_shadowrootmode x = user_attrib C.string_of_big_variant "shadowrootmode" x let a_shadowrootdelegatesfocus = constant_attrib "shadowrootdelegatesfocus" let a_shadowrootclonable = constant_attrib "shadowrootclonable" let a_shadowrootserializable = constant_attrib "shadowrootserializable" let a_sizes sizes = user_attrib C.string_of_sizes "sizes" sizes let a_slot = string_attrib "slot" let a_span = int_attrib "span" let a_srcdoc = string_attrib "srcdoc" (* Legacy alias of [a_xml_lang], deprecated: it emits [xml:lang], as its [`XML_lang] type says. The [srclang] attribute of [track] is [a_track_srclang]. *) let a_srclang = string_attrib "xml:lang" let a_kind x = user_attrib C.string_of_big_variant "kind" x let a_track_srclang = string_attrib "srclang" let a_default = constant_attrib "default" let a_srcset = srcset_attrib "srcset" let a_imagesrcset = srcset_attrib "imagesrcset" let a_imagesizes = comma_sep_attrib "imagesizes" let a_img_sizes = comma_sep_attrib "sizes" let a_start = int_attrib "start" let a_ol_type x = user_attrib C.string_of_ol_type "type" x let a_step step = user_attrib C.string_of_step "step" step let a_translate x = user_attrib C.string_of_big_variant "translate" x 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_script_type sc = user_attrib C.string_of_script_type "type" sc 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" (* ARIA *) let a_role = space_sep_attrib "role" let a_aria name = space_sep_attrib ("aria-" ^ name) 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 txt s = Xml.pcdata s let pcdata = txt 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 dialog = star "dialog" 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 data ~value ?(a = []) elts = Xml.node ~a: ((a_value value) :: a) "data" elts 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 s = star "s" 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 bdi = star "bdi" 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 template = star "template" let slot = star "slot" let article = star "article" let aside = star "aside" let main = star "main" let search = star "search" let video_audio name ?src ?srcs ?tracks ?(a = []) elts = let a = match src with | None -> a | Some uri -> (a_src uri) :: a in let elts = match tracks with | None -> elts | Some tracks -> W.append tracks elts 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 track ~src ?(a = []) () = Xml.leaf ~a: ((a_src src) :: a) "track" 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 picture ~img ?a elts = let tail_node = W.cons img (W.nil ()) in let content = W.append elts tail_node in Xml.node ?a "picture" content let meta = terminal "meta" let meta_itemprop ~itemprop ?(a = []) () = Xml.leaf ~a: ((a_itemprop itemprop) :: a) "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 I = Xml_stream.Import(Xml) let of_seq s = totl @@ I.of_seq s 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 uris_attrib a s = Xml.uris_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_downloads -> "allow-downloads" | `Allow_forms -> "allow-forms" | `Allow_modals -> "allow-modals" | `Allow_orientation_lock -> "allow-orientation-lock" | `Allow_pointer_lock -> "allow-pointer-lock" | `Allow_popups -> "allow-popups" | `Allow_popups_to_escape_sandbox -> "allow-popups-to-escape-sandbox" | `Allow_presentation -> "allow-presentation" | `Allow_same_origin -> "allow-same-origin" | `Allow_script -> "allow-scripts" | `Allow_top_navigation -> "allow-top-navigation" | `Allow_top_navigation_by_user_activation -> "allow-top-navigation-by-user-activation" | `Allow_top_navigation_to_custom_protocols -> "allow-top-navigation-to-custom-protocols" let string_of_linktype = function | `Alternate -> "alternate" | `Archives -> "archives" | `Author -> "author" | `Bookmark -> "bookmark" | `Canonical -> "canonical" | `Dns_prefetch -> "dns-prefetch" | `External -> "external" | `First -> "first" | `Help -> "help" | `Icon -> "icon" | `Index -> "index" | `Last -> "last" | `License -> "license" | `Manifest -> "manifest" | `Me -> "me" | `Modulepreload -> "modulepreload" | `Next -> "next" | `Nofollow -> "nofollow" | `Noopener -> "noopener" | `Noreferrer -> "noreferrer" | `Opener -> "opener" | `Pingback -> "pingback" | `Preconnect -> "preconnect" | `Prefetch -> "prefetch" | `Preload -> "preload" | `Prerender -> "prerender" | `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_referrerpolicy = function | `Empty -> "" | `No_referrer -> "no-referrer" | `No_referrer_when_downgrade -> "no-referrer-when-downgrade" | `Origin -> "origin" | `Origin_when_cross_origin -> "origin-when-cross-origin" | `Same_origin -> "same-origin" | `Strict_origin -> "strict-origin" | `Strict_origin_when_cross_origin -> "strict-origin-when-cross-origin" | `Unsafe_url -> "unsafe-url" 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" | `Dialog -> "dialog" | `Formnovalidate -> "formnovalidate" | `Hidden -> "hidden" | `Ismap -> "ismap" | `Loop -> "loop" | `Novalidate -> "novalidate" | `Open -> "open" | `None -> "none" | `Metadata -> "metadata" | `Subtitles -> "subtitles" | `Captions -> "captions" | `Descriptions -> "descriptions" | `Chapters -> "chapters" | `Audio -> "audio" | `Pubdate -> "pubdate" | `Required -> "required" | `Reversed -> "reversed" | `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" | `True -> "true" | `False -> "false" | `Plaintext_only -> "plaintext-only" | `Until_found -> "until-found" | `Auto -> "auto" | `Manual -> "manual" | `Hint -> "hint" | `On -> "on" | `Off -> "off" | `Enter -> "enter" | `Done -> "done" | `Go -> "go" | `Previous -> "previous" | `Send -> "send" | `Sentences -> "sentences" | `Words -> "words" | `Characters -> "characters" | `Lazy -> "lazy" | `Eager -> "eager" | `Sync -> "sync" | `High -> "high" | `Low -> "low" | `User -> "user" | `Environment -> "environment" | `Closerequest -> "closerequest" | `Closed -> "closed" | `Document -> "document" | `Embed -> "embed" | `Fetch -> "fetch" | `Font -> "font" | `Image -> "image" | `Object -> "object" | `Script -> "script" | `Style -> "style" | `Track -> "track" | `Video -> "video" | `Worker -> "worker" | `Show -> "show" | `Hide -> "hide" | `Toggle -> "toggle" | `Show_modal -> "show-modal" | `Close -> "close" | `Request_close -> "request-close" | `Show_popover -> "show-popover" | `Hide_popover -> "hide-popover" | `Toggle_popover -> "toggle-popover" | `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" | `Text -> "text" | `Decimal -> "decimal" | `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_script_type = function | `Javascript -> "application/javascript" | `Module -> "module" | `Mime s -> s 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_blocking_token = function | `Render -> "render" let string_of_ol_type = function | `Decimal -> "1" | `Lower_alpha -> "a" | `Upper_alpha -> "A" | `Lower_roman -> "i" | `Upper_roman -> "I" let string_of_blocking l = String.concat " " (List.map string_of_blocking_token l) 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) let string_of_autocomplete (l : Html_types.autocomplete_option) = match l with | `On | `Tokens [] -> "on" | `Off -> "off" | `Tokens strs -> String.concat " " strs 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) tyxml-5.0.0/lib/html_f.mli000066400000000000000000000042151524654765500154400ustar00rootroot00000000000000(* 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 02110-1301, USA. *) (** Typesafe constructors for HTML documents (Functorial interface) See {{!page-"functors"}the manual of the functorial interface}. *) (** 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) (_ : 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 tyxml-5.0.0/lib/html_sigs.mli000066400000000000000000001672671524654765500162010ustar00rootroot00000000000000(* 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 02110-1301, USA. *) (** HTML signatures for the functorial interface. *) (** Signature of typesafe constructors for HTML documents. *) module type T = sig open Html_types (** 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. {{!txt}txt} is used for text. [div [a [txt "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"] [txt "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 has exactly one child. *) 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 (** {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
  1. 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_onbeforeinput : Xml.event_handler -> [> | `OnBeforeInput] attrib val a_onbeforematch : Xml.event_handler -> [> | `OnBeforeMatch] attrib val a_onbeforetoggle : Xml.event_handler -> [> | `OnBeforeToggle] attrib val a_onblur : Xml.event_handler -> [> | `OnBlur] attrib val a_oncancel : Xml.event_handler -> [> | `OnCancel] 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_onclose : Xml.event_handler -> [> | `OnClose] attrib val a_oncontextlost : Xml.event_handler -> [> | `OnContextLost] attrib val a_oncontextrestored : Xml.event_handler -> [> | `OnContextRestored] attrib val a_oncopy : Xml.event_handler -> [> | `OnCopy] attrib val a_oncut : Xml.event_handler -> [> | `OnCut] attrib val a_oncuechange : Xml.event_handler -> [> | `OnCueChange] 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_onlanguagechange : Xml.event_handler -> [> | `OnLanguageChange] 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_onpaste : Xml.event_handler -> [> | `OnPaste] 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_onrejectionhandled : Xml.event_handler -> [> | `OnRejectionHandled] attrib val a_onunhandledrejection : Xml.event_handler -> [> | `OnUnhandledRejection] attrib val a_onresize : Xml.event_handler -> [> | `OnResize] attrib val a_onscroll : Xml.event_handler -> [> | `OnScroll] attrib val a_onscrollend : Xml.event_handler -> [> | `OnScrollEnd] attrib val a_onsecuritypolicyviolation : Xml.event_handler -> [> | `OnSecurityPolicyViolation] 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_onslotchange : Xml.event_handler -> [> | `OnSlotChange] 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_ontoggle : Xml.event_handler -> [> | `OnToggle] 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_onauxclick : Xml.mouse_event_handler -> [> | `OnAuxClick] attrib 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 val a_onwheel : Xml.mouse_event_handler -> [> | `OnWheel] attrib (** {4 Pointer events} In the DOM, pointer events inherit from mouse events, so the handlers use {!Xml.mouse_event_handler}. *) val a_onpointercancel : Xml.mouse_event_handler -> [> | `OnPointerCancel] attrib val a_onpointerdown : Xml.mouse_event_handler -> [> | `OnPointerDown] attrib val a_onpointerenter : Xml.mouse_event_handler -> [> | `OnPointerEnter] attrib val a_onpointerleave : Xml.mouse_event_handler -> [> | `OnPointerLeave] attrib val a_onpointermove : Xml.mouse_event_handler -> [> | `OnPointerMove] attrib val a_onpointerout : Xml.mouse_event_handler -> [> | `OnPointerOut] attrib val a_onpointerover : Xml.mouse_event_handler -> [> | `OnPointerOver] attrib val a_onpointerup : Xml.mouse_event_handler -> [> | `OnPointerUp] attrib val a_ongotpointercapture : Xml.mouse_event_handler -> [> | `OnGotPointerCapture] attrib val a_onlostpointercapture : Xml.mouse_event_handler -> [> | `OnLostPointerCapture] attrib (** {4 Touch events} *) val a_ontouchstart : Xml.touch_event_handler -> [> | `OnTouchStart] attrib val a_ontouchend : Xml.touch_event_handler -> [> | `OnTouchEnd] attrib val a_ontouchmove : Xml.touch_event_handler -> [> | `OnTouchMove] attrib val a_ontouchcancel : Xml.touch_event_handler -> [> | `OnTouchCancel] 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_abbr : text wrap -> [> | `Abbr] attrib (** Alternative label of a header cell, for reference in other cells. @see abbr attribute documentation. *) val a_allow : text wrap -> [> | `Allow] attrib (** Permissions policy of an iframe. @see allow documentation. *) val a_allowfullscreen : unit -> [> | `Allowfullscreen] attrib val a_allowpaymentrequest : unit -> [> | `Allowpaymentrequest] attrib val a_autocomplete : autocomplete_option wrap -> [> | `Autocomplete] attrib (** @see autocomplete documentation. *) val a_autocapitalize : [< | `Off | `None | `On | `Sentences | `Words | `Characters ] wrap -> [> | `Autocapitalize] attrib (** @see autocapitalize documentation. *) val a_autocorrect : (bool[@onoff]) wrap -> [> | `Autocorrect] attrib (** @see autocorrect documentation. *) val a_as : [< | `Audio | `Document | `Embed | `Fetch | `Font | `Image | `Object | `Script | `Style | `Track | `Video | `Worker ] wrap -> [> | `As] attrib (** Destination of a preload link. This covers the destinations listed by MDN; other spec destinations can be produced with {!Unsafe.string_attrib}. @see as documentation. *) 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_integrity : string wrap -> [> | `Integrity ] attrib val a_mediagroup : string wrap -> [> | `Mediagroup ] attrib val a_challenge : text wrap -> [> | `Challenge] attrib val a_closedby : [< | `Any | `Closerequest | `None ] wrap -> [> | `Closedby] attrib (** User actions that can close a dialog. @see closedby documentation. *) val a_capture : [< | `User | `Environment ] wrap -> [> | `Capture] attrib (** Preferred camera for file inputs capturing media. Defined by the W3C HTML Media Capture specification. The bare form of the attribute is not supported by the PPX; use an explicit value. @see capture documentation. *) val a_contenteditable : contenteditable_value wrap -> [> | `Contenteditable] attrib (** A bare [contenteditable] attribute is equivalent to [contenteditable="true"]. @see contenteditable attribute documentation on MDN *) val a_contextmenu : idref wrap -> [> | `Contextmenu] attrib val a_controls : unit -> [> | `Controls] attrib val a_dir : [< | `Rtl | `Ltr | `Auto] wrap -> [> | `Dir] attrib val a_dirname : text wrap -> [> | `Dirname] attrib (** Name of the form control field used to submit the element's text directionality. @see dirname documentation. *) val a_draggable : bool wrap -> [> | `Draggable] attrib val a_enterkeyhint : [< | `Enter | `Done | `Go | `Next | `Previous | `Search | `Send ] wrap -> [> | `Enterkeyhint] attrib (** @see enterkeyhint documentation. *) 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 : hidden_value wrap -> [> | `Hidden] attrib (** A bare [hidden] attribute is equivalent to [hidden="hidden"]; use [`Until_found] for the hidden-until-found state. @see