├── .github └── workflows │ ├── build.yaml │ └── changelog.yml ├── .gitignore ├── .readthedocs.yaml ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── docs ├── Makefile ├── conf.py ├── examples.rst ├── faq.rst ├── index.rst ├── make.bat ├── odoc │ ├── dune │ └── index.mld ├── quick-start.rst ├── requirements.txt ├── syntax.rst ├── themes.rst └── tutorial.rst ├── dune ├── dune-project ├── example ├── campus-du-libre │ ├── access-slipshow.md │ ├── cdl.md │ ├── how-to-write.md │ ├── slipshow.html │ ├── slipshow.md │ └── what-is-a-presentation.md └── ocaml_lecture │ ├── effets_de_bord.html │ ├── effets_de_bord.md │ ├── iterateurs.html │ ├── iterateurs.md │ ├── new_types.html │ └── new_types.md ├── logo ├── favicon-32x32.png ├── favicon.ico ├── favicon.svg └── logo-slipshow.svg ├── release ├── Dockerfile └── release.sh ├── slip_scroll.gif ├── slipshow.opam ├── slipshow.opam.template ├── src ├── .ocamlformat ├── cli │ ├── dune │ ├── main.ml │ ├── run.ml │ ├── run.mli │ └── static-linking-flags │ │ ├── dune │ │ └── static_linking_flags.ml ├── communication │ ├── communication.ml │ ├── communication.mli │ └── dune ├── compiler │ ├── asset.ml │ ├── ast.ml │ ├── dune │ ├── folders.ml │ ├── mappings.ml │ ├── mappings.mli │ ├── renderers.ml │ ├── slipshow.ml │ └── slipshow.mli ├── engine │ ├── browser │ │ ├── css.ml │ │ ├── css.mli │ │ ├── dune │ │ ├── history.ml │ │ └── history.mli │ ├── constants │ │ ├── constants.ml │ │ ├── constants.mli │ │ └── dune │ ├── controller.ml │ ├── controller.mli │ ├── drawing │ │ ├── drawing.css │ │ ├── drawing.ml │ │ ├── drawing.mli │ │ └── dune │ ├── dune │ ├── main.ml │ ├── mouse_disappearing │ │ ├── dune │ │ ├── mouse_disappearing.ml │ │ └── mouse_disappearing.mli │ ├── normalization │ │ ├── dune │ │ ├── normalization.css │ │ ├── normalization.ml │ │ └── normalization.mli │ ├── rescale │ │ ├── dune │ │ ├── rescale.css │ │ ├── rescale.ml │ │ └── rescale.mli │ ├── step │ │ ├── action_scheduler.ml │ │ ├── action_scheduler.mli │ │ ├── actions.ml │ │ ├── actions.mli │ │ ├── dune │ │ ├── javascript_api.ml │ │ ├── javascript_api.mli │ │ ├── messaging.ml │ │ ├── messaging.mli │ │ ├── next.ml │ │ ├── next.mli │ │ ├── state.ml │ │ ├── state.mli │ │ └── step.css │ ├── system.css │ ├── table_of_content │ │ ├── dune │ │ ├── table_of_content.css │ │ ├── table_of_content.ml │ │ └── table_of_content.mli │ ├── undoable │ │ ├── browser_.ml │ │ ├── dune │ │ ├── monad.ml │ │ ├── undoable.ml │ │ └── undoable.mli │ └── universe │ │ ├── coordinates.ml │ │ ├── coordinates.mli │ │ ├── dune │ │ ├── state.ml │ │ ├── state.mli │ │ ├── universe.css │ │ ├── window.ml │ │ └── window.mli ├── previewer │ ├── dune │ ├── previewer.ml │ └── previewer.mli ├── server │ ├── client │ │ ├── client.ml │ │ ├── dune │ │ └── index.html │ ├── dune │ ├── slipshow_server.ml │ └── slipshow_server.mli ├── static_data │ ├── .ocamlformat │ ├── data_contents.ml │ ├── data_files.ml │ ├── data_files.mli │ ├── dune │ ├── highlight-js.css │ ├── highlight-js.css.crunch │ ├── highlight-js.js │ ├── highlight-js.js.crunch │ ├── highlight-js.ocaml.js │ ├── highlight-js.ocaml.js.crunch │ ├── tex-chtml.js.crunch │ └── tex-svg.js.crunch └── themes │ ├── default.css │ ├── dune │ ├── themes.ml │ └── vanier.css ├── test ├── compiler │ ├── dune │ ├── images.t │ │ ├── run.t │ │ └── slip.md │ ├── multi-file.t │ │ ├── chapter1.md │ │ ├── chapter2 │ │ │ ├── chapter2.md │ │ │ ├── image_of_chapter_2.png │ │ │ └── parts │ │ │ │ ├── part1.md │ │ │ │ └── part2.md │ │ ├── main.md │ │ └── run.t │ ├── simple.t │ │ ├── file.md │ │ ├── file_with_image.md │ │ ├── plus.png │ │ └── run.t │ ├── slides.t │ │ ├── run.t │ │ └── slides.md │ ├── slipshow.ml │ ├── theme.t │ │ └── run.t │ └── to_commonmark.t │ │ ├── file.md │ │ └── run.t └── engine │ ├── basic.t │ ├── new_engine.md │ └── run.t │ ├── campus_du_libre.t │ ├── access-slipshow.md │ ├── cdl.md │ ├── how-to-write.md │ ├── run.t │ └── what-is-a-presentation.md │ └── dune └── vendor └── github.com └── panglesd ├── brr ├── .gitignore ├── .merlin ├── .ocp-indent ├── B0.ml ├── BRZO ├── CHANGES.md ├── DEVEL.md ├── LICENSE.md ├── README.md ├── _tags ├── attic │ ├── glfuns.spec │ ├── glgen.ml │ ├── log.ml │ └── log.mli ├── brr.opam ├── doc │ ├── ffi_cookbook.mld │ ├── ffi_manual.mld │ ├── index.mld │ ├── ocaml_console.mld │ ├── ocaml_console.png │ └── web_page_howto.mld ├── dune-project ├── myocamlbuild.ml ├── pkg │ ├── META │ └── pkg.ml ├── src │ ├── brr.ml │ ├── brr.mli │ ├── brr.mllib │ ├── brr_canvas.ml │ ├── brr_canvas.mli │ ├── brr_io.ml │ ├── brr_io.mli │ ├── brr_webaudio.ml │ ├── brr_webaudio.mli │ ├── brr_webcrypto.ml │ ├── brr_webcrypto.mli │ ├── brr_webgpu.ml │ ├── brr_webgpu.mli │ ├── brr_webmidi.ml │ ├── brr_webmidi.mli │ ├── brr_webworkers.ml │ ├── brr_webworkers.mli │ ├── console │ │ ├── devtools.html │ │ ├── devtools.js │ │ ├── dune │ │ ├── highlight.pack.js │ │ ├── manifest.json │ │ ├── ocaml.png │ │ ├── ocaml_console.css │ │ ├── ocaml_console.html │ │ └── ocaml_console.ml │ ├── dune │ ├── fut.ml │ ├── fut.mli │ ├── jstr.ml │ ├── jstr.mli │ ├── jv.ml │ ├── jv.mli │ ├── ocaml_poke │ │ ├── brr_ocaml_poke.ml │ │ ├── brr_ocaml_poke.mli │ │ ├── brr_ocaml_poke.mllib │ │ └── dune │ ├── ocaml_poke_ui │ │ ├── brr_ocaml_poke_ui.ml │ │ ├── brr_ocaml_poke_ui.mli │ │ ├── brr_ocaml_poke_ui.mllib │ │ └── dune │ ├── poke │ │ ├── brr_poke.ml │ │ ├── brr_poke.mli │ │ ├── brr_poke.mllib │ │ └── dune │ └── poked │ │ ├── brr_poked.ml │ │ ├── brr_poked.mli │ │ ├── brr_poked.mllib │ │ └── dune └── test │ ├── base.css │ ├── min.html │ ├── min.ml │ ├── nop.ml │ ├── poke.ml │ ├── test_audio.ml │ ├── test_base64.ml │ ├── test_c2d.ml │ ├── test_clipboard.ml │ ├── test_console.ml │ ├── test_crypto.ml │ ├── test_fact.ml │ ├── test_file.ml │ ├── test_geolocation.ml │ ├── test_gl.ml │ ├── test_gpu.ml │ ├── test_hello.ml │ ├── test_history.ml │ ├── test_media.ml │ ├── test_midi.ml │ ├── test_notification.ml │ ├── test_worker.ml │ └── top.ml ├── cmarkit ├── .gitignore ├── .ocp-indent ├── B0.ml ├── BRZO ├── CHANGES.md ├── DEVEL.md ├── LICENSE.md ├── README.md ├── _tags ├── cmarkit.opam ├── doc │ └── index.mld ├── pkg │ ├── META │ └── pkg.ml ├── src │ ├── cmarkit.ml │ ├── cmarkit.mli │ ├── cmarkit.mllib │ ├── cmarkit_base.ml │ ├── cmarkit_base.mli │ ├── cmarkit_commonmark.ml │ ├── cmarkit_commonmark.mli │ ├── cmarkit_data.ml │ ├── cmarkit_data.mli │ ├── cmarkit_data_html.ml │ ├── cmarkit_data_uchar.ml │ ├── cmarkit_html.ml │ ├── cmarkit_html.mli │ ├── cmarkit_latex.ml │ ├── cmarkit_latex.mli │ ├── cmarkit_renderer.ml │ ├── cmarkit_renderer.mli │ └── dune ├── support │ └── unicode_data.ml ├── test │ ├── bench.ml │ ├── examples.ml │ ├── expect │ │ ├── basic.exts.html │ │ ├── basic.exts.latex │ │ ├── basic.exts.locs │ │ ├── basic.exts.md │ │ ├── basic.exts.nolayout.locs │ │ ├── basic.exts.strip-attributes.md │ │ ├── basic.exts.trip.md │ │ ├── basic.html │ │ ├── basic.latex │ │ ├── basic.locs │ │ ├── basic.md │ │ ├── basic.nolayout.locs │ │ ├── basic.strip-attributes.md │ │ ├── basic.trip.md │ │ ├── bug-18.html │ │ ├── bug-18.latex │ │ ├── bug-18.locs │ │ ├── bug-18.md │ │ ├── bug-18.nolayout.locs │ │ ├── bug-18.strip-attributes.md │ │ ├── bug-18.trip.md │ │ ├── bugs.exts.html │ │ ├── bugs.exts.latex │ │ ├── bugs.exts.locs │ │ ├── bugs.exts.md │ │ ├── bugs.exts.nolayout.locs │ │ ├── bugs.exts.strip-attributes.md │ │ ├── bugs.exts.trip.md │ │ ├── bugs.html │ │ ├── bugs.latex │ │ ├── bugs.locs │ │ ├── bugs.md │ │ ├── bugs.nolayout.locs │ │ ├── bugs.strip-attributes.md │ │ ├── bugs.trip.md │ │ ├── spec.trip │ │ └── test.expect │ ├── pathological.ml │ ├── spec.json │ ├── spec.ml │ ├── spec.mli │ ├── test.ml │ ├── test_spec.ml │ └── trip_spec.ml └── tool │ ├── cmd_commonmark.ml │ ├── cmd_commonmark.mli │ ├── cmd_html.ml │ ├── cmd_html.mli │ ├── cmd_latex.ml │ ├── cmd_latex.mli │ ├── cmd_locs.ml │ ├── cmd_locs.mli │ ├── cmd_main.ml │ ├── cmd_main.mli │ ├── std.ml │ └── std.mli └── irmin-watcher ├── .github └── workflows │ └── test.yml ├── .gitignore ├── .ocamlformat ├── .ocp-indent ├── CHANGES.md ├── LICENSE.md ├── Makefile ├── README.md ├── appveyor.yml ├── dune-project ├── irmin-watcher.opam ├── src ├── backend.fsevents.ml ├── backend.fsevents.mli ├── backend.inotify.ml ├── backend.inotify.mli ├── backend.polling.ml ├── backend.polling.mli ├── core.ml ├── core.mli ├── dune ├── hook.ml ├── hook.mli ├── irmin_watcher.ml ├── irmin_watcher.mli ├── polling.ml ├── polling.mli └── realpath.c └── test ├── dune └── test.ml /.github/workflows/changelog.yml: -------------------------------------------------------------------------------- 1 | name: Check Changelog 2 | on: 3 | pull_request: 4 | types: [assigned, opened, synchronize, reopened, labeled, unlabeled] 5 | branches: 6 | - main 7 | jobs: 8 | Check-Changelog: 9 | name: Check Changelog Action 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: tarides/changelog-check-action@v3 13 | with: 14 | changelog: CHANGELOG.md 15 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # NPM / YARN (just in case) 2 | node_modules 3 | yarn-error.log 4 | 5 | # dune 6 | _build 7 | -------------------------------------------------------------------------------- /.readthedocs.yaml: -------------------------------------------------------------------------------- 1 | # Read the Docs configuration file for Sphinx projects 2 | # See https://docs.readthedocs.io/en/stable/config-file/v2.html for details 3 | 4 | # Required 5 | version: 2 6 | 7 | # Set the OS, Python version and other tools you might need 8 | build: 9 | os: ubuntu-22.04 10 | tools: 11 | python: "3.12" 12 | # You can also specify other tool versions: 13 | # nodejs: "20" 14 | # rust: "1.70" 15 | # golang: "1.20" 16 | 17 | # Build documentation in the "docs/" directory with Sphinx 18 | sphinx: 19 | configuration: docs/conf.py 20 | # You can configure Sphinx to use a different builder, for instance use the dirhtml builder for simpler URLs 21 | # builder: "dirhtml" 22 | # Fail on all warnings to avoid broken references 23 | # fail_on_warning: true 24 | 25 | # Optionally build your docs in additional formats such as PDF and ePub 26 | # formats: 27 | # - pdf 28 | # - epub 29 | 30 | # Optional but recommended, declare the Python requirements required 31 | # to build your documentation 32 | # See https://docs.readthedocs.io/en/stable/guides/reproducible-builds.html 33 | python: 34 | install: 35 | - requirements: docs/requirements.txt 36 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line, and also 5 | # from the environment for the first two. 6 | SPHINXOPTS ?= 7 | SPHINXBUILD ?= sphinx-build 8 | SOURCEDIR = . 9 | BUILDDIR = _build 10 | 11 | # Put it first so that "make" without argument is like "make help". 12 | help: 13 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 14 | 15 | .PHONY: help Makefile 16 | 17 | # Catch-all target: route all unknown targets to Sphinx using the new 18 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 19 | %: Makefile 20 | @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 21 | -------------------------------------------------------------------------------- /docs/conf.py: -------------------------------------------------------------------------------- 1 | # Configuration file for the Sphinx documentation builder. 2 | # 3 | # This file only contains a selection of the most common options. For a full 4 | # list see the documentation: 5 | # https://www.sphinx-doc.org/en/master/usage/configuration.html 6 | 7 | # -- Path setup -------------------------------------------------------------- 8 | 9 | # If extensions (or modules to document with autodoc) are in another directory, 10 | # add these directories to sys.path here. If the directory is relative to the 11 | # documentation root, use os.path.abspath to make it absolute, like shown here. 12 | # 13 | # import os 14 | # import sys 15 | # sys.path.insert(0, os.path.abspath('.')) 16 | 17 | 18 | # -- Project information ----------------------------------------------------- 19 | 20 | project = 'slipshow' 21 | copyright = '2020, Paul-Elliot' 22 | author = 'Paul-Elliot' 23 | 24 | 25 | # -- General configuration --------------------------------------------------- 26 | 27 | # Add any Sphinx extension module names here, as strings. They can be 28 | # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom 29 | # ones. 30 | extensions = [ 31 | 'sphinx_rtd_theme', 32 | 'sphinx.ext.autosectionlabel', 33 | 'sphinx_tabs.tabs' 34 | ] 35 | extensions.append('sphinx.ext.todo') 36 | todo_include_todos=True 37 | 38 | # Add any paths that contain templates here, relative to this directory. 39 | templates_path = ['_templates'] 40 | 41 | # List of patterns, relative to source directory, that match files and 42 | # directories to ignore when looking for source files. 43 | # This pattern also affects html_static_path and html_extra_path. 44 | exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] 45 | 46 | 47 | # -- Options for HTML output ------------------------------------------------- 48 | 49 | # The theme to use for HTML and HTML Help pages. See the documentation for 50 | # a list of builtin themes. 51 | # 52 | #html_theme = 'alabaster' 53 | html_theme = 'sphinx_rtd_theme' 54 | 55 | # Add any paths that contain custom static files (such as style sheets) here, 56 | # relative to this directory. They are copied after the builtin static files, 57 | # so a file named "default.css" will overwrite the builtin "default.css". 58 | # html_static_path = ['_static'] 59 | 60 | 61 | # -- Added By PE ------------------------------------------------------------- 62 | 63 | # Read The Doc uses a different version of sphinx by default, which has 64 | # a different default for master_doc 65 | master_doc = 'index' 66 | -------------------------------------------------------------------------------- /docs/examples.rst: -------------------------------------------------------------------------------- 1 | Examples 2 | ============== 3 | 4 | 5 | You can find examples of slipshows here. Do not hesitate to look at the source code, although it might use a different version of slipshow. And moreover, do not hesitate to send me your slipshow! 6 | 7 | * `The slips to present slip (in French) `_ (Source file `here `_) 8 | * `The slips of my thesis `_ (old version of the engine, before the compiler existed: The source is the HTML file). 9 | * `The slips of a presentation on reverse mathematics `__ (old version of the engine, before the compiler existed: The source is the HTML file). 10 | * `A presentation on the BB(5) resolution `_. See the `sources `__ (Disclaimer: I'm not the author of this presentation!) 11 | -------------------------------------------------------------------------------- /docs/index.rst: -------------------------------------------------------------------------------- 1 | .. slip-js documentation master file, created by 2 | sphinx-quickstart on Thu Jan 23 17:03:49 2020. 3 | You can adapt this file completely to your liking, but it should at least 4 | contain the root `toctree` directive. 5 | 6 | Welcome to slipshow's documentation! 7 | ==================================== 8 | 9 | **Slipshow is a tool specifically designed for technical presentations where traditional slides are not enough.** 10 | 11 | In a slipshow presentation, the equivalent of a slide is called a *slip*. Each slip is like a slide, but with no bottom limit. That is, the content can be arbitrarily long! During the presentation, the camera will "scroll" down to reveal the hidden content, following a script given by the presenter! 12 | 13 | Here are the goals of slipshow, in no specific orders: 14 | 15 | - Lift restrictions from traditional slide-based presentation. In particular, make it closer to a blackboard presentation! 16 | - Easy to write and readable syntax: markdown with few extensions. No manual placement like in powerpoint. No crazy syntax like in latex. 17 | - Source of the presentation is plain text: much better for source control, sharing with people, using your favorite editor, readability, compatibility. 18 | - Open the possibility for a dynamic presentation. Watching scientific popularization video demonstrates how well-chosen animations can make a difficult subject more understandable. 19 | 20 | Slipshow compiles files written in an extension of markdown, to a standalone html file viewable offline in any web browser. 21 | 22 | We advise you to start by reading the :ref:`tutorial`. You can also peek at the :ref:`examples`. 23 | 24 | .. toctree:: 25 | :maxdepth: 1 26 | :caption: Contents: 27 | 28 | quick-start 29 | tutorial 30 | syntax 31 | themes 32 | faq 33 | examples 34 | 35 | .. 36 | Indices and tables 37 | ================== 38 | 39 | * :ref:`genindex` 40 | * :ref:`modindex` 41 | * :ref:`search` 42 | -------------------------------------------------------------------------------- /docs/make.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | pushd %~dp0 4 | 5 | REM Command file for Sphinx documentation 6 | 7 | if "%SPHINXBUILD%" == "" ( 8 | set SPHINXBUILD=sphinx-build 9 | ) 10 | set SOURCEDIR=. 11 | set BUILDDIR=_build 12 | 13 | if "%1" == "" goto help 14 | 15 | %SPHINXBUILD% >NUL 2>NUL 16 | if errorlevel 9009 ( 17 | echo. 18 | echo.The 'sphinx-build' command was not found. Make sure you have Sphinx 19 | echo.installed, then set the SPHINXBUILD environment variable to point 20 | echo.to the full path of the 'sphinx-build' executable. Alternatively you 21 | echo.may add the Sphinx directory to PATH. 22 | echo. 23 | echo.If you don't have Sphinx installed, grab it from 24 | echo.http://sphinx-doc.org/ 25 | exit /b 1 26 | ) 27 | 28 | %SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% 29 | goto end 30 | 31 | :help 32 | %SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% 33 | 34 | :end 35 | popd 36 | -------------------------------------------------------------------------------- /docs/odoc/dune: -------------------------------------------------------------------------------- 1 | (documentation) 2 | -------------------------------------------------------------------------------- /docs/odoc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Slipshow} 2 | 3 | See the {{:https://slipshow.readthedocs.io/}readthedocs} documentation. -------------------------------------------------------------------------------- /docs/requirements.txt: -------------------------------------------------------------------------------- 1 | # Defining the exact version will make sure things don't break 2 | sphinx==5.3.0 3 | sphinx_rtd_theme==1.1.1 4 | readthedocs-sphinx-search==0.3.2 5 | sphinx-tabs 6 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (data_only_dirs node_modules) 2 | 3 | (vendored_dirs vendor) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.6) 2 | 3 | (name slipshow) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github panglesd/slipshow)) 9 | 10 | (authors "Paul-Elliot") 11 | 12 | (maintainers "Paul-Elliot") 13 | 14 | (license GPL-3.0-or-later) 15 | 16 | (documentation https://slipshow.readthedocs.io) 17 | 18 | (using directory-targets 0.1) 19 | 20 | (package 21 | (name slipshow) 22 | (synopsis "A compiler from markdown to slipshow") 23 | (description "Slipshow is an engine to write slips, a concept evolved from slides.") 24 | (depends 25 | (ocaml (>= 4.14)) 26 | dune 27 | (crunch :with-dev-setup) 28 | (cmdliner (>= 1.3.0)) 29 | base64 30 | bos 31 | lwt 32 | (inotify (= :os "linux")) 33 | (cf-lwt (>="0.4")) 34 | astring 35 | fmt 36 | logs 37 | fsevents-lwt 38 | js_of_ocaml-compiler 39 | js_of_ocaml-lwt 40 | magic-mime 41 | (dream (>= "1.0.0~alpha5")) 42 | fpath 43 | (ppx_blob (>= "0.8.0")) 44 | sexplib 45 | ppx_sexp_conv 46 | (odoc :with-doc) 47 | (ocamlformat 48 | (and :with-dev-setup (= 0.27.0)))) 49 | (tags 50 | (slipshow presentation slideshow beamer))) 51 | 52 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 53 | -------------------------------------------------------------------------------- /example/campus-du-libre/access-slipshow.md: -------------------------------------------------------------------------------- 1 | # Accéder à Slipshow 2 | 3 | {pause} 4 | De nombreuses possibilités : 5 | 6 | - ["Sliphub"](https://sliphub.choum.net) **pour tester**. 7 | 8 | - ✅ Rien à installer 9 | 10 | - ✅ Collaboratif 11 | 12 | - ❌❌✅ En ligne 13 | 14 | - [VSCode](https://open-vsx.org/extension/Slipshow/slipshow) [extension](https://marketplace.visualstudio.com/items?itemName=Slipshow.slipshow) (par exemple si **sous windows**.) 15 | 16 | - ✅✅❌ Facile à installer si VS Code. 17 | 18 | - ❌ Support moins avancé. {pause} 19 | 20 | - [Binaire Slipshow](https://github.com/panglesd/slipshow/releases) 21 | 22 | - ✅ Marche uniquement sous Linux et Mac. 23 | 24 | - ✅ Meilleurs support et performance. 25 | -------------------------------------------------------------------------------- /example/campus-du-libre/cdl.md: -------------------------------------------------------------------------------- 1 | # Slipshow 2 | 3 | - Slipshow est un logiciel libre pour faire des présentations améliorées. {pause} 4 | 5 | - Avec slipshow, pas besoin de gérer l'alignement du texte ! {pause} 6 | 7 | - Une présentation slipshow prend la forme d'un fichier texte. 8 | 9 | {pause} 10 | 11 | {.example #example} 12 | ```markdown 13 | # Ceci n'est pas un titre 14 | 15 | Et ceci est un paragraphe. 16 | 17 | - Et ceci est une liste à points 18 | - Avec plusieurs points 19 | 20 | On peut aussi mettre du texte **en gras**, ou en *italique*. 21 | ``` 22 | 23 | {pause} 24 | 25 | Mais le truc **VRAIMENT** cool, avec slipshow, c'est : 26 | 27 | ... 28 | 29 | {.block #cool title="Le truc vraiment cool" pause} 30 | > Supsense, suspense... 31 | > 32 | > ## **On peut faire dérouler un slide! {pause up=example} 33 | 34 | {pause #vrai-sommaire up=cool} 35 | ## Sommaire 36 | 37 | Cette présentation se fera en **trois parties** : 38 | 39 | {pause style="text-align:center" #comment-presenter} 40 | 41 | {style="display: flex; position:relative"} 42 | > {#part1 slip include src="what-is-a-presentation.md"} 43 | > 44 | > {up=vrai-sommaire} 45 | > 46 | > {#part3 include src=how-to-write.md slip enter} 47 | > 48 | > {step} 49 | > 50 | > {enter #part4 include src="access-slipshow.md" slip} 51 | > 52 | > {pause} 53 | > 54 | > {#merci pause} 55 | > > {#merci-2} 56 | > > > # Merci de votre attention ! 57 | > > > 58 | > > > - Site du projet : 59 | > > > 60 | > > > - Documentation : 61 | > > > 62 | > > > - Source de ces slides : 63 | > > > 64 | > > > - Sliphub : 65 | 66 | 89 | 90 | 91 | 113 | 114 | 115 | 116 | 124 | 125 | -------------------------------------------------------------------------------- /example/campus-du-libre/what-is-a-presentation.md: -------------------------------------------------------------------------------- 1 | # **Qu'est-ce** qu'une présentation slipshow ? 2 | 3 | {pause} 4 | Voici [un exemple](https://choum.net/panglesd/slides/WDCM-2021-slips/wdcm-ada.html#2,21). 5 | 6 | {pause #preslip .block} 7 | > Une présentation slipshow tient plus du **tableau noir** que des diapositives. {pause} 8 | > 9 | > Elle se contrôle avec les touches : 10 | > 11 | > {.flex} 12 | > > [`←`]{.touche} [`→`]{.touche} [`↑`]{.touche} [`↓`]{.touche} [`SPACE`]{.touche .space} 13 | > > 14 | > > **Avancer/Reculer** 15 | > 16 | > {.flex} 17 | > > [`w`]{.touche} [`W`]{.touche} [`h`]{.touche} [`H`]{.touche} [`x`]{.touche} [`X`]{.touche} 18 | > > 19 | > > **Mode dessin** 20 | > 21 | > {pause} 22 | > 23 | > 24 | > Une présentation slipshow permet de : 25 | > 26 | > - Compléter interactivement sa présentation avec le **mode dessin**. Essayez! {pause} 27 | > 28 | > - Faire apparaître **la structure** de la présentation. {pause} 29 | > 30 | > - Ouvrir de **nouvelles possibilités [pédagogiques]{step focus-at-unpause}** 31 | 32 | {pause unfocus-at-unpause} 33 | -------------------------------------------------------------------------------- /example/ocaml_lecture/iterateurs.md: -------------------------------------------------------------------------------- 1 | # Itérateurs 2 | 3 | ```ocaml 4 | val mystere : 'a list -> ('a -> 'b) -> 'b list 5 | ``` 6 | 7 | À partir du type de `mystere`, tentez de deviner ce que fait cette fonction. 8 | 9 | {pause} 10 | 11 | {#traverseur} 12 | ### Les itérateurs : traverser un type de donnée 13 | 14 | Il existe plusieurs types d'itérateurs : 15 | 16 | - Le `map`: 17 | ```ocaml 18 | val map : 'a list -> ('a -> 'b) -> 'b list 19 | ``` 20 | {pause} 21 | - L'`iter`: 22 | ```ocaml 23 | val iter : 'a list -> ('a -> unit) -> unit 24 | ``` 25 | {pause up=traverseur} 26 | - Le `fold`: 27 | {#folds} 28 | ```ocaml 29 | val fold_left : 'a list -> ('acc -> 'a -> 'acc) -> 'acc -> 'acc 30 | val fold_right : 'a list -> ('a -> 'acc -> 'acc) -> 'acc -> 'acc 31 | ``` 32 | 33 | ... 34 | 35 | {pause} 36 | ## Faites les exercices 37 | 38 | {pause up} 39 | ## Récursion terminale 40 | 41 | {.definition} 42 | Lorsqu'une fonction termine par un (unique) appel récursif, on dit qu'elle est **récursive terminale**. 43 | 44 | {.example pause} 45 | > 46 | > 47 | > ```ocaml 48 | > let rec length l = match l with 49 | > | [] -> 0 50 | > | _ :: q -> 51 | > let lq = length q in 52 | > lq + 1 53 | > ``` 54 | > { pause #no-rec-term} 55 | > ```ocaml 56 | > let rec length l = match l with 57 | > | [] -> 0 58 | > | _ :: q -> 1 + (length q) 59 | > ``` 60 | > { pause} 61 | > ```ocaml 62 | > let rec length acc l = match l with 63 | > | [] -> acc 64 | > | _ :: q -> length (acc + 1) 65 | > ``` 66 | 67 | {pause up=no-rec-term} 68 | Une fonction récursive terminale ne fera pas de `Stack_overflow`. Comparons l'execution dans le cas non-récursif terminal: 69 | 70 | ``` 71 | length [1; 2; 3] 72 | => 1 + length [2; 3] 73 | => 1 + (1 + length [3]) 74 | => 1 + (1 + (1 + length [])) 75 | => 1 + (1 + (1 + 0)) 76 | => 1 + (1 + 1) 77 | => 1 + 2 78 | => 3 79 | ``` 80 | 81 | {pause down=rec-term-exec} 82 | et dans le cas récursif terminal: 83 | 84 | {#rec-term-exec} 85 | ``` 86 | length 0 [1; 2; 3] 87 | => length 1 [2; 3] 88 | => length 2 [3] 89 | => length 3 [] 90 | => 3 91 | ``` 92 | 93 | {pause down} 94 | ## Refaire les exercices en mode "récursif terminale" 95 | -------------------------------------------------------------------------------- /logo/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/logo/favicon-32x32.png -------------------------------------------------------------------------------- /logo/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/logo/favicon.ico -------------------------------------------------------------------------------- /release/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ocaml/opam:alpine-ocaml-4.14 2 | RUN sudo apk add libev-dev openssl-dev libffi-dev gmp-dev 3 | RUN sudo apk add openssl-libs-static 4 | WORKDIR slipshow/ 5 | 6 | COPY --chown=opam *.opam . 7 | RUN opam install -y --deps-only --with-test --with-doc . 8 | 9 | COPY --chown=opam . . 10 | 11 | RUN opam exec -- dune subst 12 | 13 | RUN sed -i 's/"()"/"(-cclib -static -cclib -no-pie)"/g' src/cli/static-linking-flags/static_linking_flags.ml 14 | 15 | -------------------------------------------------------------------------------- /release/release.sh: -------------------------------------------------------------------------------- 1 | #/usr/bin/env bash 2 | set -xeuo pipefail 3 | 4 | archive_name=$OUTPUT/slipshow-$TARGETOS-$TARGETARCH.tar 5 | 6 | dune subst 7 | 8 | dune build --profile release -p slipshow 9 | 10 | # Executables are symlinks, follow with -h. 11 | tar hcf "$archive_name" -C _build/install/default bin/slipshow 12 | -------------------------------------------------------------------------------- /slip_scroll.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/slip_scroll.gif -------------------------------------------------------------------------------- /slipshow.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A compiler from markdown to slipshow" 4 | description: 5 | "Slipshow is an engine to write slips, a concept evolved from slides." 6 | maintainer: ["Paul-Elliot"] 7 | authors: ["Paul-Elliot"] 8 | license: "GPL-3.0-or-later" 9 | tags: ["slipshow" "presentation" "slideshow" "beamer"] 10 | homepage: "https://github.com/panglesd/slipshow" 11 | doc: "https://slipshow.readthedocs.io" 12 | bug-reports: "https://github.com/panglesd/slipshow/issues" 13 | depends: [ 14 | "ocaml" {>= "4.14"} 15 | "dune" {>= "3.6"} 16 | "crunch" {with-dev-setup} 17 | "cmdliner" {>= "1.3.0"} 18 | "base64" 19 | "bos" 20 | "lwt" 21 | "inotify" {os = "linux"} 22 | "cf-lwt" {>= "0.4"} 23 | "astring" 24 | "fmt" 25 | "logs" 26 | "fsevents-lwt" 27 | "js_of_ocaml-compiler" 28 | "js_of_ocaml-lwt" 29 | "magic-mime" 30 | "dream" {>= "1.0.0~alpha5"} 31 | "fpath" 32 | "ppx_blob" {>= "0.8.0"} 33 | "sexplib" 34 | "ppx_sexp_conv" 35 | "odoc" {with-doc} 36 | "ocamlformat" {with-dev-setup & = "0.27.0"} 37 | ] 38 | build: [ 39 | ["dune" "subst"] {dev} 40 | [ 41 | "dune" 42 | "build" 43 | "-p" 44 | name 45 | "-j" 46 | jobs 47 | "@install" 48 | "@runtest" {with-test} 49 | "@doc" {with-doc} 50 | ] 51 | ] 52 | dev-repo: "git+https://github.com/panglesd/slipshow.git" 53 | # We avoid 32 bits arcitecture because our usage of ppx_blob generates strings 54 | # whose size exceed the maximum size in 32 bits OCaml... 55 | available: arch != "arm32" & arch != "x86_32" 56 | x-maintenance-intent: [ "(latest)" ] 57 | -------------------------------------------------------------------------------- /slipshow.opam.template: -------------------------------------------------------------------------------- 1 | # We avoid 32 bits arcitecture because our usage of ppx_blob generates strings 2 | # whose size exceed the maximum size in 32 bits OCaml... 3 | available: arch != "arm32" & arch != "x86_32" 4 | x-maintenance-intent: [ "(latest)" ] 5 | -------------------------------------------------------------------------------- /src/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.27.0 -------------------------------------------------------------------------------- /src/cli/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (public_name slipshow) 3 | (name main) 4 | (flags 5 | (:standard 6 | (:include static-linking-flags/flags))) 7 | (libraries 8 | slipshow_server 9 | cmdliner 10 | fpath 11 | logs.cli 12 | fmt.cli 13 | fmt.tty 14 | logs.fmt 15 | themes)) 16 | -------------------------------------------------------------------------------- /src/cli/run.mli: -------------------------------------------------------------------------------- 1 | val compile : 2 | input:[ `File of Fpath.t | `Stdin ] -> 3 | output:[ `File of Fpath.t | `Stdout ] -> 4 | math_link:string option -> 5 | css_links:string list -> 6 | theme:string option -> 7 | (Fpath.Set.t, [ `Msg of string ]) result 8 | 9 | val watch : 10 | input:Fpath.t -> 11 | output:Fpath.t -> 12 | math_link:string option -> 13 | css_links:string list -> 14 | theme:string option -> 15 | (unit, [ `Msg of string ]) result 16 | 17 | val serve : 18 | input:Fpath.t -> 19 | output:Fpath.t -> 20 | math_link:string option -> 21 | css_links:string list -> 22 | theme:string option -> 23 | (unit, [ `Msg of string ]) result 24 | 25 | val markdown_compile : 26 | input:[< `File of Fpath.t | `Stdin ] -> 27 | output:[< `File of Fpath.t | `Stdout ] -> 28 | (unit, [ `Msg of string ]) result 29 | -------------------------------------------------------------------------------- /src/cli/static-linking-flags/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (with-stdout-to 3 | flags 4 | (run ocaml %{dep:static_linking_flags.ml} %{ocaml-config:target}))) 5 | -------------------------------------------------------------------------------- /src/cli/static-linking-flags/static_linking_flags.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | print_endline 3 | @@ 4 | match Sys.argv.(1) with 5 | | "aarch64-unknown-linux-musl" | "x86_64-pc-linux-musl" -> "()" 6 | | _ -> "()" 7 | -------------------------------------------------------------------------------- /src/communication/communication.ml: -------------------------------------------------------------------------------- 1 | open Sexplib.Std 2 | 3 | type payload = State of int | Ready [@@deriving sexp] 4 | type t = { id : string; payload : payload } [@@deriving sexp] 5 | 6 | let t_of_sexp_opt s = 7 | try Some (t_of_sexp s) with Sexplib0.Sexp.Of_sexp_error _ -> None 8 | 9 | let of_string s = 10 | match Sexplib.Sexp.of_string_conv s t_of_sexp_opt with 11 | | `Result (Some _ as r) -> r 12 | | _ -> None 13 | 14 | let to_string v = v |> sexp_of_t |> Sexplib.Sexp.to_string 15 | -------------------------------------------------------------------------------- /src/communication/communication.mli: -------------------------------------------------------------------------------- 1 | type payload = State of int | Ready 2 | type t = { id : string; payload : payload } 3 | 4 | val of_string : string -> t option 5 | val to_string : t -> string 6 | -------------------------------------------------------------------------------- /src/communication/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name communication) 3 | (public_name slipshow.communication) 4 | (libraries brr sexplib) 5 | (preprocess 6 | (pps ppx_sexp_conv))) 7 | -------------------------------------------------------------------------------- /src/compiler/asset.ml: -------------------------------------------------------------------------------- 1 | module Uri = struct 2 | type t = Link of string | Path of Fpath.t 3 | 4 | let of_string s = 5 | if 6 | Astring.String.is_infix ~affix:"://" s 7 | || String.starts_with ~prefix:"//" s 8 | then Link s 9 | else Path (Fpath.v s) 10 | end 11 | 12 | type t = 13 | | Local of { mime_type : string option; content : string } 14 | | Remote of string 15 | 16 | (* https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types#image_types *) 17 | let mime_of_ext = function 18 | | "apng" -> Some "image/apng" (* Animated Portable Network Graphics (APNG) *) 19 | | "avif" -> Some "image/avif" (* AV1 Image File Format (AVIF) *) 20 | | "gif" -> Some "image/gif" (* Graphics Interchange Format (GIF) *) 21 | | "jpeg" -> 22 | Some "image/jpeg" (* Joint Photographic Expert Group image (JPEG) *) 23 | | "png" -> Some "image/png" (* Portable Network Graphics (PNG) *) 24 | | "svg+xml" -> Some "image/svg+xml" (* Scalable Vector Graphics (SVG) *) 25 | | "webp" -> Some "image/webp" (* Web Picture format (WEBP) *) 26 | | _ -> None 27 | 28 | let of_uri ~read_file s = 29 | match s with 30 | | Uri.Link s -> Remote s 31 | | Path p -> ( 32 | let fp = Fpath.normalize p in 33 | match read_file fp with 34 | | Ok (Some content) -> 35 | let mime_type = mime_of_ext (Fpath.get_ext fp) in 36 | Local { mime_type; content } 37 | | Ok None -> Remote (Fpath.to_string p) 38 | | Error (`Msg e) -> 39 | Logs.warn (fun f -> 40 | f "Could not read file: %a. Considering it as an URL. (%s)" 41 | Fpath.pp p e); 42 | Remote (Fpath.to_string p)) 43 | 44 | let of_string ~read_file s = s |> Uri.of_string |> of_uri ~read_file 45 | -------------------------------------------------------------------------------- /src/compiler/ast.ml: -------------------------------------------------------------------------------- 1 | (** Extensions to the Cmarkit AST *) 2 | 3 | open Cmarkit 4 | 5 | type Block.t += 6 | | Included of Block.t attributed node 7 | | Div of Block.t attributed node 8 | | Slide of Block.t attributed node 9 | | Slip of Block.t attributed node 10 | | SlipScript of Block.Code_block.t attributed node 11 | 12 | module Folder = struct 13 | let block_ext_default f acc = function 14 | | Div ((b, _), _) 15 | | Included ((b, _), _) 16 | | Slide ((b, _), _) 17 | | Slip ((b, _), _) -> 18 | Folder.fold_block f acc b 19 | | SlipScript _ -> acc 20 | | _ -> assert false 21 | 22 | let make = Folder.make ~block_ext_default 23 | end 24 | 25 | module Mapper = struct 26 | let ( let* ) = Option.bind 27 | 28 | let block_ext_default m = function 29 | | Div ((b, attrs), meta) -> 30 | let* b = Mapper.map_block m b in 31 | let attrs = (Mapper.map_attrs m (fst attrs), snd attrs) in 32 | Some (Div ((b, attrs), meta)) 33 | | Included ((b, attrs), meta) -> 34 | let* b = Mapper.map_block m b in 35 | let attrs = (Mapper.map_attrs m (fst attrs), snd attrs) in 36 | Some (Included ((b, attrs), meta)) 37 | | Slide ((b, attrs), meta) -> 38 | let* b = Mapper.map_block m b in 39 | let attrs = (Mapper.map_attrs m (fst attrs), snd attrs) in 40 | Some (Slide ((b, attrs), meta)) 41 | | Slip ((b, attrs), meta) -> 42 | let* b = Mapper.map_block m b in 43 | let attrs = (Mapper.map_attrs m (fst attrs), snd attrs) in 44 | Some (Slip ((b, attrs), meta)) 45 | | SlipScript ((s, attrs), meta) -> 46 | let attrs = (Mapper.map_attrs m (fst attrs), snd attrs) in 47 | Some (SlipScript ((s, attrs), meta)) 48 | | _ -> assert false 49 | 50 | let make = Mapper.make ~block_ext_default 51 | end 52 | -------------------------------------------------------------------------------- /src/compiler/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name slipshow) 3 | (public_name slipshow) 4 | (libraries cmarkit data_files base64 fpath magic-mime themes bos)) 5 | -------------------------------------------------------------------------------- /src/compiler/folders.ml: -------------------------------------------------------------------------------- 1 | open Cmarkit 2 | 3 | exception Has_math 4 | 5 | let has_math = 6 | let block _ _ = function 7 | | Block.Ext_math_block _ -> raise Has_math 8 | | _ -> Folder.default 9 | in 10 | let inline _ _ = function 11 | | Inline.Ext_math_span _ -> raise Has_math 12 | | _ -> Folder.default 13 | in 14 | Ast.Folder.make ~block ~inline () 15 | 16 | let has_math doc = 17 | try Cmarkit.Folder.fold_doc has_math false doc with Has_math -> true 18 | -------------------------------------------------------------------------------- /src/compiler/mappings.mli: -------------------------------------------------------------------------------- 1 | val of_cmarkit : 2 | (Fpath.t -> (string option, [< `Msg of string ]) result) -> 3 | Cmarkit.Doc.t -> 4 | Cmarkit.Doc.t 5 | 6 | val to_cmarkit : Cmarkit.Doc.t -> Cmarkit.Doc.t 7 | -------------------------------------------------------------------------------- /src/compiler/slipshow.mli: -------------------------------------------------------------------------------- 1 | module Asset : sig 2 | module Uri : sig 3 | type t = Link of string | Path of Fpath.t 4 | 5 | val of_string : string -> t 6 | end 7 | 8 | type t = 9 | | Local of { mime_type : string option; content : string } 10 | | Remote of string 11 | 12 | val of_uri : 13 | read_file:(Fpath.t -> (string option, [< `Msg of string ]) result) -> 14 | Uri.t -> 15 | t 16 | 17 | val of_string : 18 | read_file:(Fpath.t -> (string option, [< `Msg of string ]) result) -> 19 | string -> 20 | t 21 | end 22 | 23 | type starting_state = int * string 24 | type delayed 25 | 26 | val delayed_to_string : delayed -> string 27 | val string_to_delayed : string -> delayed 28 | 29 | val delayed : 30 | ?math_link:Asset.t -> 31 | ?css_links:Asset.t list -> 32 | ?theme:[ `Builtin of Themes.t | `External of Asset.t ] -> 33 | ?slipshow_js_link:Asset.t -> 34 | ?read_file:(Fpath.t -> (string option, [< `Msg of string ]) result) -> 35 | string -> 36 | delayed 37 | (** This function is used to delay the decision on the starting state. It allows 38 | to run [convert] server-side (which is useful to get images and so on) but 39 | let the previewer decide on the starting state. *) 40 | 41 | val add_starting_state : delayed -> starting_state option -> string 42 | 43 | val convert : 44 | ?starting_state:starting_state -> 45 | ?math_link:Asset.t -> 46 | ?theme:[ `Builtin of Themes.t | `External of Asset.t ] -> 47 | ?css_links:Asset.t list -> 48 | ?slipshow_js_link:Asset.t -> 49 | ?read_file:(Fpath.t -> (string option, [< `Msg of string ]) result) -> 50 | string -> 51 | string 52 | 53 | val convert_to_md : 54 | read_file:(Fpath.t -> (string option, [< `Msg of string ]) result) -> 55 | string -> 56 | string 57 | -------------------------------------------------------------------------------- /src/engine/browser/css.ml: -------------------------------------------------------------------------------- 1 | type property = 2 | | Scale of float 3 | | Rotate of float 4 | | Left of float 5 | | Right of float 6 | | Top of float 7 | | Bottom of float 8 | | TransitionDuration of float 9 | | Width of float 10 | | Height of float 11 | 12 | let style_of_prop = function 13 | | Scale _ | Rotate _ -> Jstr.v "transform" 14 | | Left _ -> Brr.El.Style.left 15 | | Top _ -> Brr.El.Style.top 16 | | Right _ -> Brr.El.Style.right 17 | | Bottom _ -> Brr.El.Style.bottom 18 | | TransitionDuration _ -> Jstr.v "transition-duration" 19 | | Width _ -> Jstr.v "width" 20 | | Height _ -> Jstr.v "height" 21 | 22 | let sof x = Printf.sprintf "%.15f" x 23 | 24 | let value_of_prop = function 25 | | Scale x -> "scale(" ^ sof x ^ ")" 26 | | Rotate r -> "rotate( " ^ sof r ^ "deg)" 27 | | Left l -> sof l ^ "px" 28 | | Top t -> sof t ^ "px" 29 | | Right r -> sof r ^ "px" 30 | | Bottom b -> sof b ^ "px" 31 | | TransitionDuration td -> sof td ^ "s" 32 | | Width w -> sof w ^ "px" 33 | | Height h -> sof h ^ "px" 34 | 35 | let set prop elem = 36 | let style = style_of_prop prop in 37 | let value = value_of_prop prop in 38 | Brr.El.set_inline_style style (Jstr.v value) elem 39 | 40 | let set props elem = 41 | let () = List.iter (fun prop -> set prop elem) props in 42 | Fut.tick ~ms:0 43 | 44 | (* let set prop elem = *) 45 | (* let style = style_of_prop prop in *) 46 | (* let value = value_of_prop prop in *) 47 | (* let old_value = *) 48 | (* let old_value = Brr.El.inline_style style elem in *) 49 | (* if Jstr.equal old_value Jstr.empty then None else Some old_value *) 50 | (* in *) 51 | (* Brr.El.set_inline_style style (Jstr.v value) elem; *) 52 | (* let undo () = *) 53 | (* Fut.return *) 54 | (* @@ *) 55 | (* match old_value with *) 56 | (* | None -> Brr.El.remove_inline_style style elem *) 57 | (* | Some old_value -> Brr.El.set_inline_style style old_value elem *) 58 | (* in *) 59 | (* Fut.return ((), undo) *) 60 | 61 | (* open UndoMonad.Syntax *) 62 | 63 | (* let set props elem = *) 64 | (* let* res = *) 65 | (* List.fold_left *) 66 | (* (fun undo prop -> *) 67 | (* let> () = undo in *) 68 | (* set prop elem) *) 69 | (* (UndoMonad.return ()) props *) 70 | (* in *) 71 | (* let+ () = Fut.tick ~ms:0 in *) 72 | (* res *) 73 | 74 | (* let set_pure props elem = set props elem |> UndoMonad.discard *) 75 | -------------------------------------------------------------------------------- /src/engine/browser/css.mli: -------------------------------------------------------------------------------- 1 | type property = 2 | | Scale of float 3 | | Rotate of float 4 | | Left of float 5 | | Right of float 6 | | Top of float 7 | | Bottom of float 8 | | TransitionDuration of float 9 | | Width of float 10 | | Height of float 11 | 12 | val set : property list -> Brr.El.t -> unit Fut.t 13 | -------------------------------------------------------------------------------- /src/engine/browser/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name browser) 3 | (libraries brr)) 4 | -------------------------------------------------------------------------------- /src/engine/browser/history.ml: -------------------------------------------------------------------------------- 1 | let set_hash h = 2 | let old_uri = Brr.Window.location Brr.G.window in 3 | match Brr.Uri.scheme old_uri |> Jstr.to_string with 4 | | "about" -> None 5 | | _ -> 6 | let history = Brr.Window.history Brr.G.window in 7 | let uri = 8 | let fragment = Jstr.v h in 9 | Brr.Uri.with_uri ~fragment old_uri |> Result.get_ok 10 | in 11 | Brr.Window.History.replace_state ~uri history; 12 | Some history 13 | -------------------------------------------------------------------------------- /src/engine/browser/history.mli: -------------------------------------------------------------------------------- 1 | val set_hash : string -> Brr.Window.History.t option 2 | -------------------------------------------------------------------------------- /src/engine/constants/constants.ml: -------------------------------------------------------------------------------- 1 | let width = 1440. 2 | let height = 1080. 3 | -------------------------------------------------------------------------------- /src/engine/constants/constants.mli: -------------------------------------------------------------------------------- 1 | val width : float 2 | val height : float 3 | -------------------------------------------------------------------------------- /src/engine/constants/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name constants)) 3 | -------------------------------------------------------------------------------- /src/engine/controller.mli: -------------------------------------------------------------------------------- 1 | val setup : Universe.Window.window -> unit 2 | -------------------------------------------------------------------------------- /src/engine/drawing/drawing.css: -------------------------------------------------------------------------------- 1 | 2 | .slipshow-drawing-mode #slipshow-open-window { 3 | pointer-events: none; 4 | } 5 | 6 | #slipshow-drawing-toolbar { 7 | position: fixed; 8 | top: 0; 9 | left: 0; 10 | } 11 | 12 | .slip-writing-toolbar:hover, 13 | .slipshow-drawing-mode .slip-writing-toolbar { 14 | width: 32px; 15 | height: min(640px, 100vh); 16 | overflow: scroll; 17 | } 18 | .slip-writing-toolbar { 19 | background-color: white; 20 | overflow: hidden; 21 | transition: 22 | width 0.5s, 23 | height 0.5s; 24 | display: flex; 25 | flex-direction: column; 26 | position: fixed; 27 | left: 0; 28 | width: 32px; 29 | height: 32px; 30 | z-index: 10; 31 | border-radius: 0px 0px 16px 16px; 32 | user-select: none; 33 | } 34 | 35 | .slip-writing-toolbar > * { 36 | display: flex; 37 | flex-direction: column; 38 | margin-bottom: 10px; 39 | } 40 | .slip-writing-toolbar > * > * { 41 | width: 30px; 42 | height: 30px; 43 | border: 1px solid black; 44 | border-radius: 30px; 45 | transition: border-radius 0.5s; 46 | cursor: pointer; 47 | } 48 | .slip-writing-toolbar > .slip-toolbar-color > .slip-toolbar-red { 49 | background-color: red; 50 | } 51 | .slip-writing-toolbar > .slip-toolbar-color > .slip-toolbar-black { 52 | background-color: black; 53 | } 54 | .slip-writing-toolbar > .slip-toolbar-color > .slip-toolbar-blue { 55 | background-color: blue; 56 | } 57 | .slip-writing-toolbar > .slip-toolbar-color > .slip-toolbar-green { 58 | background-color: green; 59 | } 60 | .slip-writing-toolbar > .slip-toolbar-color > .slip-toolbar-yellow { 61 | background-color: yellow; 62 | } 63 | .slip-writing-toolbar > * > * { 64 | display: flex; 65 | justify-content: center; 66 | align-items: center; 67 | } 68 | .slip-writing-toolbar > .slip-toolbar-width > * > * { 69 | width: 14px; 70 | border-radius: 16px; 71 | } 72 | 73 | .slip-writing-toolbar > .slip-toolbar-width > .slip-toolbar-small > * { 74 | border: 1px solid black; 75 | } 76 | .slip-writing-toolbar > .slip-toolbar-width > .slip-toolbar-medium > * { 77 | border: 2px solid black; 78 | } 79 | .slip-writing-toolbar > .slip-toolbar-width > .slip-toolbar-large > * { 80 | border: 4px solid black; 81 | } 82 | .slip-set-tool, 83 | .slip-set-width { 84 | background-color: lightsteelblue; 85 | border-radius: 5px; 86 | } 87 | 88 | .slip-set-color { 89 | height: 25px; 90 | width: 25px; 91 | border: 3px solid steelblue; 92 | border-radius: 5px; 93 | } 94 | -------------------------------------------------------------------------------- /src/engine/drawing/drawing.mli: -------------------------------------------------------------------------------- 1 | module Color : sig 2 | type t = Red | Blue | Green | Black | Yellow 3 | end 4 | 5 | module Width : sig 6 | type t = Small | Medium | Large 7 | end 8 | 9 | module Tool : sig 10 | type t = Pen | Highlighter | Eraser | Pointer 11 | end 12 | 13 | module State : sig 14 | val set_color : Color.t -> unit 15 | val set_width : Width.t -> unit 16 | val set_tool : Tool.t -> unit 17 | val get_tool : unit -> Tool.t 18 | end 19 | 20 | val setup : Brr.El.t -> unit 21 | val clear : unit -> unit 22 | -------------------------------------------------------------------------------- /src/engine/drawing/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name drawing) 3 | (libraries brr universe normalization)) 4 | -------------------------------------------------------------------------------- /src/engine/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (modes js) 3 | (name main) 4 | (libraries 5 | communication 6 | brr 7 | normalization 8 | browser 9 | rescale 10 | table_of_content 11 | undoable 12 | step 13 | universe 14 | drawing 15 | mouse_disappearing)) 16 | 17 | (rule 18 | (action 19 | (copy main.bc.js slipshow.js))) 20 | 21 | (rule 22 | (action 23 | (with-stdout-to 24 | slipshow-internal.css 25 | (progn 26 | (cat normalization/normalization.css) 27 | (cat rescale/rescale.css) 28 | (cat universe/universe.css) 29 | (cat step/step.css))))) 30 | 31 | (rule 32 | (action 33 | (with-stdout-to 34 | slipshow-system.css 35 | (progn 36 | (cat drawing/drawing.css) 37 | (cat table_of_content/table_of_content.css) 38 | (cat system.css))))) 39 | -------------------------------------------------------------------------------- /src/engine/main.ml: -------------------------------------------------------------------------------- 1 | let start id step = 2 | let open Fut.Syntax in 3 | let el = 4 | Brr.El.find_first_by_selector (Jstr.v "#slipshow-content") |> Option.get 5 | in 6 | let body = Brr.El.find_first_by_selector (Jstr.v "body") |> Option.get in 7 | let* () = Normalization.setup el in 8 | let* window = Universe.Window.setup el in 9 | let () = Table_of_content.generate window el in 10 | (* TODO: move out of here (Later: Why?) *) 11 | let () = Rescale.setup_rescalers () in 12 | let () = Drawing.setup body in 13 | let () = Mouse_disappearing.setup () in 14 | let initial_step = 15 | match step with 16 | | Some _ as step -> step 17 | | None -> 18 | Brr.G.window |> Brr.Window.location |> Brr.Uri.fragment 19 | |> Jstr.to_string |> int_of_string_opt 20 | in 21 | let _history = Browser.History.set_hash "" in 22 | let* () = 23 | Step.Action_scheduler.setup_pause_ancestors () |> Undoable.discard 24 | in 25 | let* () = 26 | match Brr.El.find_first_by_selector (Jstr.v "[slipshow-entry-point]") with 27 | | None -> Fut.return () 28 | | Some elem -> Step.Actions.enter window elem |> Undoable.discard 29 | in 30 | let* () = 31 | match initial_step with 32 | | None -> Fut.return @@ Step.Next.actualize () 33 | | Some step -> 34 | Universe.Window.with_fast_moving @@ fun () -> Step.Next.goto step window 35 | in 36 | let () = Controller.setup window in 37 | let () = Step.Messaging.set_id id in 38 | let () = Step.Messaging.send_ready () in 39 | Fut.return () 40 | 41 | let () = 42 | let start step id = 43 | start (Jv.to_option Jv.to_string id) (Jv.to_option Jv.to_int step) 44 | in 45 | Jv.set Jv.global "startSlipshow" (Jv.callback ~arity:2 start) 46 | -------------------------------------------------------------------------------- /src/engine/mouse_disappearing/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name mouse_disappearing) 3 | (libraries brr)) 4 | -------------------------------------------------------------------------------- /src/engine/mouse_disappearing/mouse_disappearing.ml: -------------------------------------------------------------------------------- 1 | (* 2 | document.body.style.cursor = "auto"; 3 | let timeOutIds = []; 4 | document.body.addEventListener("mousemove", (ev) => { 5 | timeOutIds.forEach((id) => { clearTimeout(id); }); 6 | document.body.style.cursor = "auto"; 7 | timeOutIds.push(setTimeout(() => { document.body.style.cursor = "none";}, 5000)); 8 | }); 9 | *) 10 | let body = Brr.Document.body Brr.G.document 11 | 12 | let show_cursor () = 13 | Brr.El.set_inline_style Brr.El.Style.cursor (Jstr.v "auto") body 14 | 15 | let hide_cursor () = 16 | Brr.El.set_inline_style Brr.El.Style.cursor (Jstr.v "none") body 17 | 18 | let setup () = 19 | show_cursor (); 20 | let timeout_id = ref None in 21 | let _unlisten = 22 | Brr.Ev.listen Brr.Ev.mousemove 23 | (fun _ -> 24 | (match !timeout_id with None -> () | Some id -> Brr.G.stop_timer id); 25 | show_cursor (); 26 | let id = Brr.G.set_timeout ~ms:5000 (fun _ -> hide_cursor ()) in 27 | timeout_id := Some id) 28 | (Brr.El.as_target body) 29 | in 30 | () 31 | -------------------------------------------------------------------------------- /src/engine/mouse_disappearing/mouse_disappearing.mli: -------------------------------------------------------------------------------- 1 | val setup : unit -> unit 2 | -------------------------------------------------------------------------------- /src/engine/normalization/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name normalization) 3 | (libraries brr browser)) 4 | -------------------------------------------------------------------------------- /src/engine/normalization/normalization.css: -------------------------------------------------------------------------------- 1 | body { 2 | position: absolute; 3 | left: 0; 4 | top: 0; 5 | bottom: 0; 6 | right: 0; 7 | display: flex; 8 | flex-direction: row-reverse; 9 | } 10 | 11 | #slipshow-main { 12 | position: relative; 13 | flex-grow: 1; 14 | } 15 | 16 | #slipshow-open-window { 17 | position: absolute; 18 | overflow: hidden; 19 | background-color: white; 20 | } 21 | 22 | .slipshow-format-container { 23 | transform-origin: top left; 24 | } 25 | -------------------------------------------------------------------------------- /src/engine/normalization/normalization.mli: -------------------------------------------------------------------------------- 1 | (** This is the code that makes it so that: 2 | 3 | - The displayed content has a ratio [width/height], centered, with black 4 | around it, 5 | 6 | - The displayed content (on scale 1) has size [width x height] 7 | 8 | It is important that 2 is not made by moving the window, as otherwise on 9 | rescaling the window, the scale would change... *) 10 | 11 | val setup : Brr.El.t -> unit Fut.t 12 | val translate_coords : float * float -> float * float 13 | -------------------------------------------------------------------------------- /src/engine/rescale/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name rescale) 3 | (libraries brr)) 4 | -------------------------------------------------------------------------------- /src/engine/rescale/rescale.css: -------------------------------------------------------------------------------- 1 | .slip, .slide { 2 | width: 1438px; 3 | transform-origin: top left; 4 | /* Borders make margin of inner elements not leak outside */ 5 | border: 1px solid transparent; 6 | } 7 | 8 | .slide { 9 | height: calc(1080px - 2px); 10 | width: calc(1440px - 2px); 11 | } 12 | 13 | .slipshow-rescaler { 14 | /* overflow-x: hidden; */ 15 | /* overflow-y: hidden; */ 16 | /* Whether or not to hide what's outside of rescalers is not clear. */ 17 | width: unset; 18 | height: unset; 19 | min-width: 0; 20 | } 21 | -------------------------------------------------------------------------------- /src/engine/rescale/rescale.ml: -------------------------------------------------------------------------------- 1 | open Brr 2 | 3 | (* We need to listen on resize for both slipshow-rescalers (the containers) as well as their only child. *) 4 | let setup_rescalers () = 5 | let slip_rescalers = 6 | El.fold_find_by_selector 7 | (fun x a -> x :: a) 8 | (Jstr.v ".slipshow-rescaler") 9 | [] 10 | in 11 | let slips = 12 | List.filter_map 13 | (fun e -> 14 | match El.children ~only_els:true e with [ c ] -> Some c | _ -> None) 15 | slip_rescalers 16 | in 17 | let rescaled_rescaler entry = 18 | match El.children ~only_els:true entry with 19 | | [ c ] -> 20 | let scale = 21 | El.inner_w entry /. (El.inner_w c +. 2. (* The borders *)) 22 | in 23 | let height = (El.inner_h c +. 2. (* The borders *)) *. scale in 24 | fun () -> 25 | let string_of_float x = 26 | (* [string_of_int] outputs floats with not decimal part with a trailing 27 | ".". But CSS properties consider this way of writing floats as 28 | erroneous and ignores them. As a consequence, we add a trailing 0 to 29 | avoid this: 30 | - 12. -> 12.0 31 | - 12.5 -> 12.50 *) 32 | string_of_float x ^ "0" 33 | in 34 | El.set_inline_style (Jstr.v "transform") 35 | (scale |> fun x -> "scale(" ^ string_of_float x ^ ")" |> Jstr.v) 36 | c; 37 | El.set_inline_style El.Style.height 38 | (height |> fun x -> string_of_float x ^ "px" |> Jstr.v) 39 | entry 40 | | [] | _ :: _ :: _ -> fun () -> Console.(log [ "problem!" ]) 41 | in 42 | let rescale entry = 43 | if Brr.El.class' (Jstr.v "slipshow-rescaler") entry then 44 | rescaled_rescaler entry 45 | else 46 | match Brr.El.parent entry with 47 | | None -> fun () -> () 48 | | Some parent -> rescaled_rescaler parent 49 | in 50 | let callback entries _observer = 51 | entries 52 | |> List.map (fun entry -> rescale (ResizeObserver.Entry.target entry)) 53 | (* We need to do all the size computations at once, and then execute them, 54 | otherwise they'll influence each others *) 55 | |> List.iter (fun f -> f ()) 56 | in 57 | let observer = ResizeObserver.create callback in 58 | List.iter (ResizeObserver.observe observer) slip_rescalers; 59 | List.iter (ResizeObserver.observe observer) slips 60 | -------------------------------------------------------------------------------- /src/engine/rescale/rescale.mli: -------------------------------------------------------------------------------- 1 | (** A rescaler is an element which: 2 | - Transform its child so that its child width becomes the same as its own 3 | width (usually, children of rescalers have a fixed width) 4 | - Adapt its height to the (new) child height. 5 | 6 | For instance, a subslip needs a rescaler to have a fixed rendering (as if 7 | rendered on 1440px of width) but have another width computed by something 8 | else (eg three subslips in a flexbox row) *) 9 | 10 | val setup_rescalers : unit -> unit 11 | (** Setup resize_observers for all elements with the right class *) 12 | -------------------------------------------------------------------------------- /src/engine/step/action_scheduler.mli: -------------------------------------------------------------------------------- 1 | val is_action : Brr.El.t -> bool 2 | val all_action_selector : string 3 | val setup_pause_ancestors : unit -> unit Undoable.t 4 | val next : Universe.Window.window -> unit -> unit Undoable.t option 5 | -------------------------------------------------------------------------------- /src/engine/step/actions.mli: -------------------------------------------------------------------------------- 1 | val setup_pause : Brr.El.t -> unit Undoable.t 2 | val pause : Brr.El.t -> unit Undoable.t 3 | val up : Universe.Window.window -> Brr.El.t -> unit Undoable.t 4 | val down : Universe.Window.window -> Brr.El.t -> unit Undoable.t 5 | val center : Universe.Window.window -> Brr.El.t -> unit Undoable.t 6 | val enter : Universe.Window.window -> Brr.El.t -> unit Undoable.t 7 | val exit : Universe.Window.window -> Brr.El.t -> unit Undoable.t 8 | val unstatic : Brr.El.t list -> unit Undoable.t 9 | val static : Brr.El.t list -> unit Undoable.t 10 | val focus : Universe.Window.window -> Brr.El.t list -> unit Undoable.t 11 | val unfocus : Universe.Window.window -> unit -> unit Undoable.t 12 | val reveal : Brr.El.t list -> unit Undoable.t 13 | val unreveal : Brr.El.t list -> unit Undoable.t 14 | val emph : Brr.El.t list -> unit Undoable.t 15 | val unemph : Brr.El.t list -> unit Undoable.t 16 | val scroll : Universe.Window.window -> Brr.El.t -> unit Undoable.t 17 | -------------------------------------------------------------------------------- /src/engine/step/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name step) 3 | (libraries undoable universe communication)) 4 | -------------------------------------------------------------------------------- /src/engine/step/javascript_api.ml: -------------------------------------------------------------------------------- 1 | open Fut.Syntax 2 | 3 | let register_undo undos_ref f = 4 | let res = 5 | let+ (), undo = f () in 6 | undos_ref := undo :: !undos_ref; 7 | Ok (Jv.callback ~arity:1 undo) 8 | in 9 | Fut.to_promise ~ok:Fun.id res 10 | 11 | let one_arg conv action undos_ref = 12 | Jv.callback ~arity:1 @@ fun elem -> 13 | let elem = conv elem in 14 | register_undo undos_ref @@ fun () -> action elem 15 | 16 | let one_elem action = one_arg Brr.El.of_jv action 17 | let one_elem_list action = one_arg (Jv.to_list Brr.El.of_jv) action 18 | let up window = one_elem (Actions.up window) 19 | let center window = one_elem (Actions.center window) 20 | let down window = one_elem (Actions.down window) 21 | let scroll window = one_elem (Actions.scroll window) 22 | let focus window = one_elem_list (Actions.focus window) 23 | let unfocus window = one_arg (fun _ -> ()) (Actions.unfocus window) 24 | let static = one_elem_list Actions.static 25 | let unstatic = one_elem_list Actions.unstatic 26 | let reveal = one_elem_list Actions.reveal 27 | let unreveal = one_elem_list Actions.unreveal 28 | let emph = one_elem_list Actions.emph 29 | let unemph = one_elem_list Actions.unemph 30 | 31 | let on_undo = 32 | one_arg Fun.id @@ fun callback -> 33 | let undo () = Fut.return @@ ignore @@ Jv.apply callback [||] in 34 | Undoable.return ~undo () 35 | 36 | let state = Jv.obj [||] 37 | 38 | let set_style undos_ref = 39 | Jv.callback ~arity:3 @@ fun elem style value -> 40 | let elem = Brr.El.of_jv elem 41 | and style = Jv.to_jstr style 42 | and value = Jv.to_jstr value in 43 | register_undo undos_ref @@ fun () -> 44 | Undoable.Browser.set_style style value elem 45 | 46 | let set_class undos_ref = 47 | Jv.callback ~arity:3 @@ fun elem class_ bool -> 48 | let bool = Jv.to_bool bool in 49 | register_undo undos_ref @@ fun () -> 50 | Undoable.Browser.set_class class_ bool elem 51 | 52 | let set_prop undos_ref = 53 | Jv.callback ~arity:3 @@ fun obj prop value -> 54 | let prop = Jv.to_jstr prop in 55 | register_undo undos_ref @@ fun () -> Undoable.Browser.set_prop obj prop value 56 | 57 | let slip window undos_ref = 58 | Jv.obj 59 | [| 60 | (* Actions *) 61 | ("up", up window undos_ref); 62 | ("center", center window undos_ref); 63 | ("down", down window undos_ref); 64 | ("scroll", scroll window undos_ref); 65 | ("focus", focus window undos_ref); 66 | ("unfocus", unfocus window undos_ref); 67 | ("static", static undos_ref); 68 | ("unstatic", unstatic undos_ref); 69 | ("reveal", reveal undos_ref); 70 | ("unreveal", unreveal undos_ref); 71 | ("emph", emph undos_ref); 72 | ("unemph", unemph undos_ref); 73 | ("onUndo", on_undo undos_ref); 74 | (* Scripting utilities *) 75 | ("state", state); 76 | ("setStyle", set_style undos_ref); 77 | ("setClass", set_class undos_ref); 78 | ("setProp", set_prop undos_ref); 79 | |] 80 | -------------------------------------------------------------------------------- /src/engine/step/javascript_api.mli: -------------------------------------------------------------------------------- 1 | val slip : Universe.Window.window -> Undoable.undo list ref -> Jv.t 2 | -------------------------------------------------------------------------------- /src/engine/step/messaging.ml: -------------------------------------------------------------------------------- 1 | let id = ref None 2 | let set_id i = id := i 3 | let if_id f = match !id with None -> () | Some id -> f id 4 | 5 | let if_parent f = 6 | match Brr.Window.parent Brr.G.window with 7 | | None -> () 8 | | Some parent -> f parent 9 | 10 | let send_ready () = 11 | if_id @@ fun id -> 12 | if_parent @@ fun parent -> 13 | let msg = 14 | { Communication.id; payload = Ready } 15 | |> Communication.to_string |> Jv.of_string 16 | in 17 | Brr.Window.post_message parent ~msg 18 | 19 | let send_step () = 20 | if_id @@ fun id -> 21 | if_parent @@ fun parent -> 22 | let step = State.get_step () in 23 | let msg = 24 | { Communication.id; payload = State step } 25 | |> Communication.to_string |> Jv.of_string 26 | in 27 | Brr.Window.post_message parent ~msg 28 | -------------------------------------------------------------------------------- /src/engine/step/messaging.mli: -------------------------------------------------------------------------------- 1 | val set_id : string option -> unit 2 | val send_ready : unit -> unit 3 | val send_step : unit -> unit 4 | -------------------------------------------------------------------------------- /src/engine/step/next.ml: -------------------------------------------------------------------------------- 1 | open Fut.Syntax 2 | 3 | let in_queue = 4 | let running = ref false in 5 | let queue = Queue.create () in 6 | let wait_in_queue () = 7 | if !running then ( 8 | let fut, cont = Fut.create () in 9 | Queue.add cont queue; 10 | fut) 11 | else ( 12 | running := true; 13 | Fut.return ()) 14 | in 15 | let next_in_queue () = 16 | match Queue.take_opt queue with 17 | | None -> 18 | running := false; 19 | () 20 | | Some cont -> cont () 21 | in 22 | fun f -> 23 | let* () = wait_in_queue () in 24 | let+ () = f () in 25 | next_in_queue () 26 | 27 | let all_undos = Stack.create () 28 | let ( !! ) = Jstr.v 29 | 30 | let actualize () = 31 | let () = 32 | Brr.El.fold_find_by_selector 33 | (fun el () -> Brr.El.set_class !!"slipshow-toc-current-step" false el) 34 | !!".slipshow-toc-current-step" 35 | () 36 | in 37 | let () = 38 | match 39 | Brr.El.find_first_by_selector 40 | !!(".slipshow-toc-step-" ^ string_of_int (State.get_step ())) 41 | with 42 | | None -> () 43 | | Some el -> 44 | Brr.El.scroll_into_view ~align_v:`Nearest ~behavior:`Smooth el; 45 | Brr.El.set_class !!"slipshow-toc-current-step" true el 46 | in 47 | Messaging.send_step () 48 | 49 | let go_next window n = 50 | in_queue @@ fun () -> 51 | let rec loop n = 52 | if n <= 0 then Fut.return () 53 | else 54 | match Action_scheduler.next window () with 55 | | None -> Fut.return () 56 | | Some undos -> 57 | let* (), undos = undos in 58 | Stack.push undos all_undos; 59 | loop (n - 1) 60 | in 61 | let+ () = loop n in 62 | actualize () 63 | 64 | let go_prev _window n = 65 | in_queue @@ fun () -> 66 | let rec loop n = 67 | if n <= 0 then Fut.return () 68 | else 69 | match Stack.pop_opt all_undos with 70 | | None -> Fut.return () 71 | | Some undo -> 72 | let* () = undo () in 73 | loop (n - 1) 74 | in 75 | let+ () = loop n in 76 | actualize () 77 | 78 | let goto step window = 79 | let current_step = State.get_step () in 80 | if current_step > step then go_prev window (current_step - step) 81 | else if current_step < step then go_next window (step - current_step) 82 | else Fut.return () 83 | -------------------------------------------------------------------------------- /src/engine/step/next.mli: -------------------------------------------------------------------------------- 1 | val actualize : unit -> unit 2 | val go_next : Universe.Window.window -> int -> unit Fut.t 3 | val go_prev : 'a -> int -> unit Fut.t 4 | val goto : int -> Universe.Window.window -> unit Fut.t 5 | -------------------------------------------------------------------------------- /src/engine/step/state.ml: -------------------------------------------------------------------------------- 1 | let step = ref 0 2 | let get_step () = !step 3 | 4 | let incr_step () = 5 | let old_step = !step in 6 | let undo () = Fut.return (step := old_step) in 7 | Undoable.return ~undo @@ incr step 8 | 9 | module Focus = struct 10 | let stack = Stack.create () 11 | 12 | let push c = 13 | let undo () = Fut.return @@ ignore @@ Stack.pop stack in 14 | Undoable.return ~undo (Stack.push c stack) 15 | 16 | let pop () = 17 | let value = Stack.pop_opt stack in 18 | let undo () = 19 | Fut.return @@ Option.iter (fun v -> Stack.push v stack) value 20 | in 21 | Undoable.return ~undo value 22 | end 23 | -------------------------------------------------------------------------------- /src/engine/step/state.mli: -------------------------------------------------------------------------------- 1 | val get_step : unit -> int 2 | val incr_step : unit -> unit Undoable.t 3 | 4 | module Focus : sig 5 | val push : Universe.Coordinates.window -> unit Undoable.t 6 | val pop : unit -> Universe.Coordinates.window option Undoable.t 7 | end 8 | -------------------------------------------------------------------------------- /src/engine/step/step.css: -------------------------------------------------------------------------------- 1 | .pauseAncestor ~ *, .pauseTarget { 2 | opacity: 0; 3 | } 4 | 5 | .unstatic { 6 | position: absolute; 7 | visibility: hidden; 8 | } 9 | 10 | .unrevealed { 11 | opacity: 0; 12 | } 13 | 14 | #slipshow-counter { 15 | position: fixed; 16 | bottom: 0; 17 | right: 0; 18 | background-color: white; 19 | padding: 5px; 20 | font-size: 2em; 21 | border: 1px solid black; 22 | border-radius: 5px; 23 | cursor: pointer; 24 | } 25 | -------------------------------------------------------------------------------- /src/engine/system.css: -------------------------------------------------------------------------------- 1 | #slip-touch-controls { 2 | display: none; 3 | } 4 | 5 | .mobile #slip-touch-controls { 6 | display: unset; 7 | } 8 | 9 | .mobile.slipshow-toc-mode.horizontal #slip-touch-controls, 10 | .mobile.slipshow-toc-mode.vertical #slip-touch-controls { 11 | display: none; 12 | } 13 | 14 | .mobile.horizontal #slip-touch-controls { 15 | position: fixed; 16 | bottom: 0; 17 | width: 100%; 18 | display: flex; 19 | height: 10vw; 20 | justify-content: space-evenly; 21 | } 22 | 23 | .mobile.horizontal #slip-touch-controls > div { 24 | width: 10vw; 25 | background: rgba(0, 0, 0, 0.3); 26 | cursor: pointer; 27 | color: white; 28 | font-size: 10vw; 29 | text-align: center; 30 | vertical-align: middle; 31 | line-height: 10vw; 32 | } 33 | 34 | .mobile.vertical #slip-touch-controls { 35 | position: fixed; 36 | right: 0; 37 | width: 10vh; 38 | display: flex; 39 | height: 80vh; 40 | justify-content: space-evenly; 41 | flex-direction: column; 42 | } 43 | 44 | .mobile.vertical #slip-touch-controls > div { 45 | width: 10vh; 46 | background: rgba(0, 0, 0, 0.3); 47 | cursor: pointer; 48 | color: white; 49 | font-size: 10vh; 50 | text-align: center; 51 | vertical-align: middle; 52 | line-height: 10vh; 53 | } 54 | 55 | 56 | body.slipshow-drawing-mode { 57 | touch-action: pinch-zoom; 58 | } 59 | -------------------------------------------------------------------------------- /src/engine/table_of_content/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name table_of_content) 3 | (libraries brr step)) 4 | -------------------------------------------------------------------------------- /src/engine/table_of_content/table_of_content.css: -------------------------------------------------------------------------------- 1 | .slipshow-toc-mode #slipshow-toc { 2 | display: block; 3 | } 4 | 5 | #slipshow-toc { 6 | overflow: scroll; 7 | opacity: 0.98; 8 | top: 0; 9 | left: 0; 10 | bottom: 0; 11 | min-width: 25%; 12 | max-width: 30%; 13 | padding: 30px; 14 | background: rosybrown; 15 | display: none; 16 | z-index: 100; 17 | } 18 | 19 | .slipshow-toc-step { 20 | display: inline-block; 21 | border: 1px solid black; 22 | border-radius: 3px; 23 | padding: 5px; 24 | padding-bottom: 0px; 25 | margin: 5px; 26 | margin-left: 0; 27 | margin-right: 10px; 28 | } 29 | 30 | .slipshow-toc-only-step { 31 | display: inline-block; 32 | } 33 | 34 | .slipshow-toc-content { 35 | display: inline; 36 | } 37 | 38 | .slipshow-toc-entry { 39 | cursor: pointer; 40 | } 41 | 42 | .slipshow-toc-current-step .slipshow-toc-step { 43 | background-color: red; 44 | } 45 | -------------------------------------------------------------------------------- /src/engine/table_of_content/table_of_content.mli: -------------------------------------------------------------------------------- 1 | val generate : Universe.Window.window -> Brr.El.t -> unit 2 | val toggle_visibility : unit -> unit 3 | -------------------------------------------------------------------------------- /src/engine/undoable/browser_.ml: -------------------------------------------------------------------------------- 1 | open Monad 2 | 3 | let set_prop obj prop value = 4 | let old_value = Jv.get' obj prop in 5 | Jv.set' obj prop value; 6 | let undo () = Fut.return @@ Jv.set' obj prop old_value in 7 | return ~undo () 8 | 9 | let set_class c b elem : unit t = 10 | let c = Jstr.v c in 11 | let old_class = Brr.El.class' c elem in 12 | let () = Brr.El.set_class c b elem in 13 | let undo () = Fut.return @@ Brr.El.set_class c old_class elem in 14 | return ~undo () 15 | 16 | let set_at at v elem = 17 | let at = Jstr.v at in 18 | let old_at = Brr.El.at at elem in 19 | let () = Brr.El.set_at at v elem in 20 | let undo () = Fut.return @@ Brr.El.set_at at old_at elem in 21 | return ~undo () 22 | 23 | let set_style style value elem = 24 | let old_value = 25 | let old_value = Brr.El.inline_style style elem in 26 | if Jstr.equal old_value Jstr.empty then None else Some old_value 27 | in 28 | let () = Brr.El.set_inline_style style value elem in 29 | let undo _ = 30 | Fut.return 31 | @@ 32 | match old_value with 33 | | None -> Brr.El.remove_inline_style style elem 34 | | Some old_value -> Brr.El.set_inline_style style old_value elem 35 | in 36 | return ~undo () 37 | 38 | module History = struct 39 | let set_hash h = 40 | let old_uri = Brr.Window.location Brr.G.window in 41 | let history = Browser.History.set_hash h in 42 | let undo () = 43 | match history with 44 | | None -> Fut.return () 45 | | Some history -> 46 | Fut.return @@ Brr.Window.History.replace_state ~uri:old_uri history 47 | in 48 | return ~undo () 49 | end 50 | -------------------------------------------------------------------------------- /src/engine/undoable/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name undoable) 3 | (libraries brr browser)) 4 | -------------------------------------------------------------------------------- /src/engine/undoable/monad.ml: -------------------------------------------------------------------------------- 1 | type undo = unit -> unit Fut.t 2 | type 'a t = ('a * undo) Fut.t 3 | 4 | let bind f x = 5 | let open Fut.Syntax in 6 | let* x, undo1 = x in 7 | let* y, undo2 = f x in 8 | let undo () = 9 | let* () = undo2 () in 10 | undo1 () 11 | in 12 | Fut.return (y, undo) 13 | 14 | let return ?(undo = fun () -> Fut.return ()) x = Fut.return (x, undo) 15 | let discard x = Fut.map fst x 16 | 17 | module Syntax = struct 18 | let ( let> ) x f = bind f x 19 | end 20 | -------------------------------------------------------------------------------- /src/engine/undoable/undoable.ml: -------------------------------------------------------------------------------- 1 | include Monad 2 | module Browser = Browser_ 3 | 4 | module List = struct 5 | open Syntax 6 | 7 | let iter f l = 8 | List.fold_left 9 | (fun acc x -> 10 | let> () = acc in 11 | f x) 12 | (return ()) l 13 | end 14 | 15 | module Stack = struct 16 | let push x s = 17 | let undo () = Fut.return @@ ignore @@ Stack.pop s in 18 | return ~undo (Stack.push x s) 19 | 20 | let pop_opt stack = 21 | let value = Stack.pop_opt stack in 22 | let undo () = 23 | Fut.return @@ Option.iter (fun v -> Stack.push v stack) value 24 | in 25 | return ~undo value 26 | 27 | let peek stack = 28 | match Stack.pop_opt stack with 29 | | None -> None 30 | | Some x as s -> 31 | Stack.push x stack; 32 | s 33 | end 34 | -------------------------------------------------------------------------------- /src/engine/undoable/undoable.mli: -------------------------------------------------------------------------------- 1 | type undo = unit -> unit Fut.t 2 | type 'a t = ('a * undo) Fut.t 3 | 4 | val bind : ('a -> 'b t) -> 'a t -> 'b t 5 | val return : ?undo:undo -> 'a -> 'a t 6 | val discard : 'a t -> 'a Fut.t 7 | 8 | module Syntax : sig 9 | val ( let> ) : 'a t -> ('a -> 'b t) -> 'b t 10 | end 11 | 12 | module Browser = Browser_ 13 | 14 | module List : sig 15 | val iter : ('a -> unit t) -> 'a list -> unit t 16 | end 17 | 18 | module Stack : sig 19 | val push : 'a -> 'a Stack.t -> unit t 20 | (** [push x s] adds the element [x] at the top of stack [s]. *) 21 | 22 | val pop_opt : 'a Stack.t -> 'a option t 23 | (** [pop s] removes and returns the topmost element in stack [s], or returns 24 | [None] if the stack is empty. *) 25 | 26 | val peek : 'a Stack.t -> 'a option 27 | (** [pop s] returns the topmost element in stack [s], or returns [None] if the 28 | stack is empty. *) 29 | end 30 | -------------------------------------------------------------------------------- /src/engine/universe/coordinates.mli: -------------------------------------------------------------------------------- 1 | type window = { x : float; y : float; scale : float } 2 | (** Represent the position of the window. Since scaling happens with origin the 3 | center of the screen, x and y have to to the coordinate of the center as 4 | well. 5 | 6 | This does not use {!elem_coordinate} since the window has a fixed ratio, 7 | defined elsewhere, and we do not want to be able to represent invalid state. 8 | *) 9 | 10 | type element = { x : float; y : float; width : float; height : float } 11 | (** Represent the position of an element in the universe. To ease interaction 12 | with the window coordinates, x and y are the center of the element. *) 13 | 14 | val log_window : window -> unit 15 | val log_element : element -> unit 16 | val get : Brr.El.t -> element 17 | 18 | module Window_of_elem : sig 19 | val focus : current:window -> element list -> window 20 | val enter : element -> window 21 | val up : ?margin:float -> current:window -> element -> window 22 | val center : current:window -> element -> window 23 | val down : ?margin:float -> current:window -> element -> window 24 | end 25 | -------------------------------------------------------------------------------- /src/engine/universe/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name universe) 3 | (libraries undoable brr browser constants)) 4 | -------------------------------------------------------------------------------- /src/engine/universe/state.ml: -------------------------------------------------------------------------------- 1 | open Constants 2 | 3 | let coordinates = 4 | ref { Coordinates.x = width /. 2.; y = height /. 2.; scale = 1. } 5 | 6 | let set_coord v = coordinates := v 7 | let get_coord () = !coordinates 8 | -------------------------------------------------------------------------------- /src/engine/universe/state.mli: -------------------------------------------------------------------------------- 1 | val set_coord : Coordinates.window -> unit 2 | val get_coord : unit -> Coordinates.window 3 | -------------------------------------------------------------------------------- /src/engine/universe/universe.css: -------------------------------------------------------------------------------- 1 | html, 2 | body { 3 | margin: 0; 4 | padding: 0; 5 | background-color: black; 6 | } 7 | 8 | #slipshow-universe { 9 | position: absolute; 10 | top: 0; 11 | left: 0; 12 | } 13 | -------------------------------------------------------------------------------- /src/engine/universe/window.mli: -------------------------------------------------------------------------------- 1 | type window 2 | 3 | val pp : window -> unit 4 | val setup : Brr.El.t -> window Fut.t 5 | val move_pure : window -> Coordinates.window -> delay:float -> unit Fut.t 6 | val move : window -> Coordinates.window -> delay:float -> unit Undoable.t 7 | val translate_coords : float * float -> float * float 8 | 9 | val move_relative_pure : 10 | ?x:float -> ?y:float -> ?scale:float -> window -> delay:float -> unit Fut.t 11 | 12 | val move_relative : 13 | ?x:float -> 14 | ?y:float -> 15 | ?scale:float -> 16 | window -> 17 | delay:float -> 18 | unit Undoable.t 19 | 20 | val focus_pure : ?margin:float -> window -> Brr.El.t list -> unit Fut.t 21 | val focus : ?margin:float -> window -> Brr.El.t list -> unit Undoable.t 22 | val enter : window -> Brr.El.t -> unit Undoable.t 23 | val up : window -> Brr.El.t -> unit Undoable.t 24 | val center : window -> Brr.El.t -> unit Undoable.t 25 | val down : window -> Brr.El.t -> unit Undoable.t 26 | val scroll : window -> Brr.El.t -> unit Undoable.t 27 | 28 | val with_fast_moving : (unit -> unit Fut.t) -> unit Fut.t 29 | (** Inside this scope, window movement are immediate no matter the initial delay 30 | *) 31 | -------------------------------------------------------------------------------- /src/previewer/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name previewer) 3 | (public_name slipshow.previewer) 4 | (libraries communication brr slipshow js_of_ocaml-lwt lwt)) 5 | -------------------------------------------------------------------------------- /src/previewer/previewer.ml: -------------------------------------------------------------------------------- 1 | module Msg = struct 2 | type msg = Communication.t 3 | 4 | let of_jv m : msg option = m |> Jv.to_string |> Communication.of_string 5 | end 6 | 7 | type previewer = { stage : int ref; index : int ref; panels : Brr.El.t array } 8 | 9 | let ids = [| "p1"; "p2" |] 10 | 11 | let create_previewer ?(initial_stage = 0) ?(callback = fun _ -> ()) root = 12 | let panel1 = 13 | Brr.El.find_first_by_selector ~root (Jstr.v "#right-panel1") |> Option.get 14 | in 15 | let panel2 = 16 | Brr.El.find_first_by_selector ~root (Jstr.v "#right-panel2") |> Option.get 17 | in 18 | let panels = [| panel1; panel2 |] in 19 | let index = ref 0 in 20 | let stage = ref initial_stage in 21 | let _ = 22 | Brr.Ev.listen Brr_io.Message.Ev.message 23 | (fun event -> 24 | let source = 25 | Brr_io.Message.Ev.source (Brr.Ev.as_type event) |> Option.get 26 | in 27 | let source_name = Jv.get source "name" |> Jv.to_jstr in 28 | if not (Jstr.equal source_name (Jstr.v "frame")) then () 29 | else 30 | let raw_data : Jv.t = Brr_io.Message.Ev.data (Brr.Ev.as_type event) in 31 | let msg = Msg.of_jv raw_data in 32 | match msg with 33 | | Some { id; payload = State new_stage } when id = ids.(!index) -> 34 | callback new_stage; 35 | stage := new_stage 36 | | Some { id = "p1"; payload = Ready } -> 37 | index := 0; 38 | Brr.El.set_class (Jstr.v "active_panel") true panels.(!index); 39 | Brr.El.set_class (Jstr.v "active_panel") false panels.(1 - !index) 40 | | Some { id = "p2"; payload = Ready } -> 41 | index := 1; 42 | Brr.El.set_class (Jstr.v "active_panel") true panels.(!index); 43 | Brr.El.set_class (Jstr.v "active_panel") false panels.(1 - !index) 44 | | _ -> ()) 45 | (Brr.Window.as_target Brr.G.window) 46 | in 47 | { stage; index; panels } 48 | 49 | let preview { stage; index; panels } source = 50 | let unused () = 1 - !index in 51 | let get_starting_state () = (!stage, ids.(unused ())) in 52 | let set_srcdoc slipshow = 53 | Jv.set (Brr.El.to_jv panels.(unused ())) "srcdoc" (Jv.of_string slipshow) 54 | in 55 | let starting_state = get_starting_state () in 56 | let slipshow = Slipshow.convert ~starting_state source in 57 | set_srcdoc slipshow 58 | 59 | let preview_compiled { stage; index; panels } delayed = 60 | let unused () = 1 - !index in 61 | let get_starting_state () = (!stage, ids.(unused ())) in 62 | let set_srcdoc slipshow = 63 | Jv.set (Brr.El.to_jv panels.(unused ())) "srcdoc" (Jv.of_string slipshow) 64 | in 65 | let starting_state = Some (get_starting_state ()) in 66 | let slipshow = Slipshow.add_starting_state delayed starting_state in 67 | set_srcdoc slipshow 68 | -------------------------------------------------------------------------------- /src/previewer/previewer.mli: -------------------------------------------------------------------------------- 1 | type previewer 2 | 3 | (** A previewer is meant for "live previewing without flickering". 4 | 5 | To create a previewer, you {e need} to provide an HTML element that contains 6 | exactly: 7 | - An iframe with the [right-panel1] ID 8 | - An iframe with the [right-panel2] ID. 9 | 10 | When you have a previewer, you can preview a source. For the moment, it has 11 | to be a {e source}: you cannot pass it a compiled file. *) 12 | 13 | val create_previewer : 14 | ?initial_stage:int -> ?callback:(int -> unit) -> Brr.El.t -> previewer 15 | 16 | val preview : previewer -> string -> unit 17 | val preview_compiled : previewer -> Slipshow.delayed -> unit 18 | -------------------------------------------------------------------------------- /src/server/client/client.ml: -------------------------------------------------------------------------------- 1 | let uri typ = 2 | let uri = Brr.Window.location Brr.G.window in 3 | let uri = 4 | Brr.Uri.with_fragment_params uri (Brr.Uri.Params.of_jstr (Jstr.v "")) 5 | in 6 | let route_segment = 7 | let segment = match typ with `OnChange -> "onchange" | `Now -> "now" in 8 | [ Jstr.v segment ] 9 | in 10 | let uri = Brr.Uri.with_path_segments uri route_segment in 11 | uri |> Result.get_ok |> Brr.Uri.to_jstr 12 | 13 | let elem = Brr.El.find_first_by_selector (Jstr.v "#iframes") |> Option.get 14 | 15 | let previewer = 16 | let initial_stage = 17 | Brr.G.window |> Brr.Window.location |> Brr.Uri.fragment |> Jstr.to_string 18 | |> int_of_string_opt 19 | in 20 | let callback i = 21 | let old_uri = Brr.Window.location Brr.G.window in 22 | match Brr.Uri.scheme old_uri |> Jstr.to_string with 23 | | "about" -> () 24 | | _ -> 25 | let history = Brr.Window.history Brr.G.window in 26 | let uri = 27 | let fragment = Jstr.v (string_of_int i) in 28 | Brr.Uri.with_uri ~fragment old_uri |> Result.get_ok 29 | in 30 | Brr.Window.History.replace_state ~uri history 31 | in 32 | Previewer.create_previewer ?initial_stage ~callback elem 33 | 34 | let recv () = 35 | let open Lwt.Syntax in 36 | let _ : unit Lwt.t = 37 | let request_and_update typ = 38 | let+ x = Js_of_ocaml_lwt.XmlHttpRequest.get (uri typ |> Jstr.to_string) in 39 | let raw_data = x.content in 40 | let data = Slipshow.string_to_delayed raw_data in 41 | Previewer.preview_compiled previewer data 42 | in 43 | let rec recv () = 44 | let* () = request_and_update `OnChange in 45 | recv () 46 | in 47 | let* () = request_and_update `Now in 48 | recv () 49 | in 50 | () 51 | 52 | let () = recv () 53 | -------------------------------------------------------------------------------- /src/server/client/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name client) 3 | (modes js) 4 | (libraries brr slipshow.previewer)) 5 | -------------------------------------------------------------------------------- /src/server/client/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/src/server/client/index.html -------------------------------------------------------------------------------- /src/server/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name slipshow_server) 3 | (preprocess 4 | (pps ppx_blob)) 5 | (preprocessor_deps 6 | (file client/client.bc.js)) 7 | (libraries lwt slipshow bos fpath irmin-watcher dream)) 8 | -------------------------------------------------------------------------------- /src/server/slipshow_server.mli: -------------------------------------------------------------------------------- 1 | val do_serve : 2 | (unit -> (Slipshow.delayed * Fpath.Set.t, [ `Msg of string ]) result) -> 3 | (unit, [ `Msg of string ]) result 4 | 5 | val do_watch : 6 | (unit -> (Fpath.Set.t, [ `Msg of string ]) result) -> 7 | (unit, [ `Msg of string ]) result 8 | -------------------------------------------------------------------------------- /src/static_data/.ocamlformat: -------------------------------------------------------------------------------- 1 | disable -------------------------------------------------------------------------------- /src/static_data/data_files.ml: -------------------------------------------------------------------------------- 1 | type file = 2 | | Slipshow_js 3 | | Slip_internal_css 4 | | Slip_system_css 5 | | Favicon 6 | | Mathjax_js 7 | | Highlight_js 8 | | Highlight_css 9 | | Highlight_js_ocaml 10 | 11 | let string_of_file = function 12 | | Slipshow_js -> "slipshow.cdn.min.js.crunch" 13 | | Mathjax_js -> "tex-svg.js.crunch" 14 | | Highlight_css -> "highlight-js.css.crunch" 15 | | Highlight_js -> "highlight-js.js.crunch" 16 | | Highlight_js_ocaml -> "highlight-js.ocaml.js.crunch" 17 | | _ -> assert false 18 | 19 | let read f =match f with 20 | | Slipshow_js -> [%blob "src/engine/slipshow.js"] 21 | | Slip_internal_css -> [%blob "src/engine/slipshow-internal.css"] 22 | | Slip_system_css -> [%blob "src/engine/slipshow-system.css"] 23 | | Favicon -> [%blob "logo/favicon.ico"] 24 | | _ -> 25 | Data_contents.read (string_of_file f) 26 | |> function 27 | | Some c -> c 28 | | None -> assert false 29 | -------------------------------------------------------------------------------- /src/static_data/data_files.mli: -------------------------------------------------------------------------------- 1 | type file = 2 | | Slipshow_js 3 | | Slip_internal_css 4 | | Slip_system_css 5 | | Favicon 6 | | Mathjax_js 7 | | Highlight_js 8 | | Highlight_css 9 | | Highlight_js_ocaml 10 | 11 | val read : file -> string 12 | -------------------------------------------------------------------------------- /src/static_data/highlight-js.css: -------------------------------------------------------------------------------- 1 | /*! 2 | Theme: Default 3 | Description: Original highlight.js style 4 | Author: (c) Ivan Sagalaev 5 | Maintainer: @highlightjs/core-team 6 | Website: https://highlightjs.org/ 7 | License: see project LICENSE 8 | Touched: 2021 9 | */pre code.hljs{display:block;overflow-x:auto;padding:1em}code.hljs{padding:3px 5px}.hljs{background:#f3f3f3;color:#444}.hljs-comment{color:#697070}.hljs-punctuation,.hljs-tag{color:#444a}.hljs-tag .hljs-attr,.hljs-tag .hljs-name{color:#444}.hljs-attribute,.hljs-doctag,.hljs-keyword,.hljs-meta .hljs-keyword,.hljs-name,.hljs-selector-tag{font-weight:700}.hljs-deletion,.hljs-number,.hljs-quote,.hljs-selector-class,.hljs-selector-id,.hljs-string,.hljs-template-tag,.hljs-type{color:#800}.hljs-section,.hljs-title{color:#800;font-weight:700}.hljs-link,.hljs-operator,.hljs-regexp,.hljs-selector-attr,.hljs-selector-pseudo,.hljs-symbol,.hljs-template-variable,.hljs-variable{color:#ab5656}.hljs-literal{color:#695}.hljs-addition,.hljs-built_in,.hljs-bullet,.hljs-code{color:#397300}.hljs-meta{color:#1f7199}.hljs-meta .hljs-string{color:#38a}.hljs-emphasis{font-style:italic}.hljs-strong{font-weight:700} -------------------------------------------------------------------------------- /src/static_data/highlight-js.css.crunch: -------------------------------------------------------------------------------- 1 | /*! 2 | Theme: Default 3 | Description: Original highlight.js style 4 | Author: (c) Ivan Sagalaev 5 | Maintainer: @highlightjs/core-team 6 | Website: https://highlightjs.org/ 7 | License: see project LICENSE 8 | Touched: 2021 9 | */pre code.hljs{display:block;overflow-x:auto;padding:1em}code.hljs{padding:3px 5px}.hljs{background:#f3f3f3;color:#444}.hljs-comment{color:#697070}.hljs-punctuation,.hljs-tag{color:#444a}.hljs-tag .hljs-attr,.hljs-tag .hljs-name{color:#444}.hljs-attribute,.hljs-doctag,.hljs-keyword,.hljs-meta .hljs-keyword,.hljs-name,.hljs-selector-tag{font-weight:700}.hljs-deletion,.hljs-number,.hljs-quote,.hljs-selector-class,.hljs-selector-id,.hljs-string,.hljs-template-tag,.hljs-type{color:#800}.hljs-section,.hljs-title{color:#800;font-weight:700}.hljs-link,.hljs-operator,.hljs-regexp,.hljs-selector-attr,.hljs-selector-pseudo,.hljs-symbol,.hljs-template-variable,.hljs-variable{color:#ab5656}.hljs-literal{color:#695}.hljs-addition,.hljs-built_in,.hljs-bullet,.hljs-code{color:#397300}.hljs-meta{color:#1f7199}.hljs-meta .hljs-string{color:#38a}.hljs-emphasis{font-style:italic}.hljs-strong{font-weight:700} -------------------------------------------------------------------------------- /src/static_data/highlight-js.ocaml.js: -------------------------------------------------------------------------------- 1 | /*! `ocaml` grammar compiled for Highlight.js 11.9.0 */ 2 | (()=>{var e=(()=>{"use strict";return e=>({name:"OCaml",aliases:["ml"], 3 | keywords:{$pattern:"[a-z_]\\w*!?", 4 | keyword:"and as assert asr begin class constraint do done downto else end exception external for fun function functor if in include inherit! inherit initializer land lazy let lor lsl lsr lxor match method!|10 method mod module mutable new object of open! open or private rec sig struct then to try type val! val virtual when while with parser value", 5 | built_in:"array bool bytes char exn|5 float int int32 int64 list lazy_t|5 nativeint|5 string unit in_channel out_channel ref", 6 | literal:"true false"},illegal:/\/\/|>>/,contains:[{className:"literal", 7 | begin:"\\[(\\|\\|)?\\]|\\(\\)",relevance:0},e.COMMENT("\\(\\*","\\*\\)",{ 8 | contains:["self"]}),{className:"symbol",begin:"'[A-Za-z_](?!')[\\w']*"},{ 9 | className:"type",begin:"`[A-Z][\\w']*"},{className:"type", 10 | begin:"\\b[A-Z][\\w']*",relevance:0},{begin:"[a-z_]\\w*'[\\w']*",relevance:0 11 | },e.inherit(e.APOS_STRING_MODE,{className:"string",relevance:0 12 | }),e.inherit(e.QUOTE_STRING_MODE,{illegal:null}),{className:"number", 13 | begin:"\\b(0[xX][a-fA-F0-9_]+[Lln]?|0[oO][0-7_]+[Lln]?|0[bB][01_]+[Lln]?|[0-9][0-9_]*([Lln]|(\\.[0-9_]*)?([eE][-+]?[0-9_]+)?)?)", 14 | relevance:0},{begin:/->/}]})})();hljs.registerLanguage("ocaml",e)})(); -------------------------------------------------------------------------------- /src/static_data/highlight-js.ocaml.js.crunch: -------------------------------------------------------------------------------- 1 | /*! `ocaml` grammar compiled for Highlight.js 11.9.0 */ 2 | (()=>{var e=(()=>{"use strict";return e=>({name:"OCaml",aliases:["ml"], 3 | keywords:{$pattern:"[a-z_]\\w*!?", 4 | keyword:"and as assert asr begin class constraint do done downto else end exception external for fun function functor if in include inherit! inherit initializer land lazy let lor lsl lsr lxor match method!|10 method mod module mutable new object of open! open or private rec sig struct then to try type val! val virtual when while with parser value", 5 | built_in:"array bool bytes char exn|5 float int int32 int64 list lazy_t|5 nativeint|5 string unit in_channel out_channel ref", 6 | literal:"true false"},illegal:/\/\/|>>/,contains:[{className:"literal", 7 | begin:"\\[(\\|\\|)?\\]|\\(\\)",relevance:0},e.COMMENT("\\(\\*","\\*\\)",{ 8 | contains:["self"]}),{className:"symbol",begin:"'[A-Za-z_](?!')[\\w']*"},{ 9 | className:"type",begin:"`[A-Z][\\w']*"},{className:"type", 10 | begin:"\\b[A-Z][\\w']*",relevance:0},{begin:"[a-z_]\\w*'[\\w']*",relevance:0 11 | },e.inherit(e.APOS_STRING_MODE,{className:"string",relevance:0 12 | }),e.inherit(e.QUOTE_STRING_MODE,{illegal:null}),{className:"number", 13 | begin:"\\b(0[xX][a-fA-F0-9_]+[Lln]?|0[oO][0-7_]+[Lln]?|0[bB][01_]+[Lln]?|[0-9][0-9_]*([Lln]|(\\.[0-9_]*)?([eE][-+]?[0-9_]+)?)?)", 14 | relevance:0},{begin:/->/}]})})();hljs.registerLanguage("ocaml",e)})(); -------------------------------------------------------------------------------- /src/themes/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name themes) 3 | (package slipshow) 4 | (preprocess (pps ppx_blob)) 5 | (preprocessor_deps 6 | vanier.css 7 | default.css)) 8 | -------------------------------------------------------------------------------- /src/themes/themes.ml: -------------------------------------------------------------------------------- 1 | type t = Default | Vanier | None 2 | 3 | let all = [ Default; Vanier; None ] 4 | 5 | let to_string = function 6 | | Default -> "default" 7 | | Vanier -> "vanier" 8 | | None -> "none" 9 | 10 | let description = function 11 | | Default -> "The default theme, inspired from Beamer's Warsaw theme." 12 | | Vanier -> "Another Warsaw inspired theme." 13 | | None -> "Include no theme." 14 | 15 | let of_string = function 16 | | "default" -> Some Default 17 | | "vanier" -> Some Vanier 18 | | "none" -> Some None 19 | | _ -> None 20 | 21 | let content = function 22 | | Default -> [%blob "default.css"] 23 | | Vanier -> [%blob "vanier.css"] 24 | | None -> "" 25 | -------------------------------------------------------------------------------- /test/compiler/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name slipshow)) 3 | 4 | (cram 5 | (deps %{bin:slipshow})) 6 | -------------------------------------------------------------------------------- /test/compiler/images.t/run.t: -------------------------------------------------------------------------------- 1 | We can compile the file using the slip_of_mark binary 2 | 3 | $ slipshow compile slip.md 4 | slipshow: [WARNING] Could not read file: img.png. Considering it as an URL. (img.png: No such file or directory) 5 | slipshow: [WARNING] Could not read file: img.png. Considering it as an URL. (img.png: No such file or directory) 6 | slipshow: [WARNING] Could not read file: img.png. Considering it as an URL. (img.png: No such file or directory) 7 | 8 | $ cat slip.html | grep "" -A 10 9 | 10 |
11 |
12 | 13 |
14 |
15 |
16 |

A paragraph with an image

17 |

18 |

19 | 20 | 21 | -------------------------------------------------------------------------------- /test/compiler/images.t/slip.md: -------------------------------------------------------------------------------- 1 | A paragraph with an ![image](img.png) 2 | 3 | {#id .class key=value} 4 | ![](img.png) 5 | 6 | 7 | ![](img.png){#id2 .class2 key2=value2} 8 | -------------------------------------------------------------------------------- /test/compiler/multi-file.t/chapter1.md: -------------------------------------------------------------------------------- 1 | Hello! How are you? 2 | -------------------------------------------------------------------------------- /test/compiler/multi-file.t/chapter2/chapter2.md: -------------------------------------------------------------------------------- 1 | I am the chapter 2 {pause} and I consist of two parts: 2 | 3 | ### Part 1 4 | {include src="parts/part1.md"} 5 | 6 | ### Part 2 7 | {include src="parts/part2.md"} 8 | -------------------------------------------------------------------------------- /test/compiler/multi-file.t/chapter2/image_of_chapter_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/test/compiler/multi-file.t/chapter2/image_of_chapter_2.png -------------------------------------------------------------------------------- /test/compiler/multi-file.t/chapter2/parts/part1.md: -------------------------------------------------------------------------------- 1 | This is Part 1 2 | -------------------------------------------------------------------------------- /test/compiler/multi-file.t/chapter2/parts/part2.md: -------------------------------------------------------------------------------- 1 | This is Part 2 and it includes an image: 2 | 3 | ![](../image_of_chapter_2.png) 4 | -------------------------------------------------------------------------------- /test/compiler/multi-file.t/main.md: -------------------------------------------------------------------------------- 1 | # A title 2 | 3 | ## Chapter 1 4 | 5 | {include src=chapter1.md} 6 | 7 | {pause} 8 | ## Chapter 2 9 | 10 | {include src="chapter2/chapter2.md" pause} 11 | -------------------------------------------------------------------------------- /test/compiler/simple.t/file.md: -------------------------------------------------------------------------------- 1 | # A title 2 | 3 | {pause} 4 | 5 | A word and{#id step emph-at-unpause} some other words. 6 | 7 | {pause} 8 | 9 | ## subtitle 10 | 11 | {pause} 12 | 13 | Blibli. 14 | 15 | [emph]: {style="color: red"} 16 | 17 | And {pause} [standalone][emph] inlines2 18 | -------------------------------------------------------------------------------- /test/compiler/simple.t/file_with_image.md: -------------------------------------------------------------------------------- 1 | A paragraph with an ![image](plus.png) 2 | -------------------------------------------------------------------------------- /test/compiler/simple.t/plus.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/test/compiler/simple.t/plus.png -------------------------------------------------------------------------------- /test/compiler/slides.t/run.t: -------------------------------------------------------------------------------- 1 | We can compile the file using the slip_of_mark binary 2 | 3 | $ slipshow compile slides.md 4 | 5 | $ cat slides.html | grep "" -A 15 6 | 7 |
8 |
9 | 10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |

First title

18 |

Aren’t you just bored with all those slides-based presentations?

19 |
20 |
21 |
22 | 23 | $ cp slides.html /tmp/ 24 | -------------------------------------------------------------------------------- /test/compiler/slides.t/slides.md: -------------------------------------------------------------------------------- 1 | 2 | {style="display: flex"} 3 | > {#slide1 slide} 4 | > > # First title 5 | > > Aren’t you just bored with all those slides-based presentations? 6 | > 7 | > {#slide2 slide} 8 | > Don’t you think that presentations given in modern browsers shouldn’t copy the limits of ‘classic’ slide decks? 9 | > 10 | > {#slide3 slide} 11 | > Would you like to impress your audience with stunning visualization of your talk? 12 | 13 | {slide #idslide} 14 | > Hello this is a slide 15 | > 16 | > {slide} 17 | > > Hello ! 18 | > > 19 | > > {slide} 20 | > > > Hello ! 21 | > > > 22 | > > > {slide} 23 | > > > > Hello ! 24 | > > > > 25 | > > > > {slide} 26 | > > > > > Hello ! 27 | > > > > > 28 | > > > > > {slide} 29 | > > > > > > Hello ! 30 | > > > > > > 31 | > > > > > > {.box #box2} 32 | > > > > > > Yo !! 33 | > 34 | > {slide #idslide2} 35 | > > This is a subslide 36 | 37 | {#box} 38 | 39 | Hello 40 | 41 | {pause enter=idslide} 42 | yo 43 | 44 | {pause enter=idslide2} 45 | yo 46 | 47 | {pause unfocus-at-unpause} 48 | 49 | {pause focus-at-unpause=box} 50 | yo 51 | 52 | {pause unfocus-at-unpause} 53 | 54 | {pause focus-at-unpause=box2} 55 | yo 56 | 57 | 58 | 74 | -------------------------------------------------------------------------------- /test/compiler/slipshow.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/test/compiler/slipshow.ml -------------------------------------------------------------------------------- /test/compiler/theme.t/run.t: -------------------------------------------------------------------------------- 1 | Let's start with an empty file 2 | 3 | $ touch file.md 4 | 5 | No theme provided or "--theme default" is the same 6 | 7 | $ slipshow compile file.md -o default_theme1.html 8 | $ slipshow compile --theme default file.md -o default_theme2.html 9 | 10 | $ diff -s default_theme1.html default_theme2.html 11 | Files default_theme1.html and default_theme2.html are identical 12 | 13 | In those cases, the default theme is included 14 | 15 | $ grep ".slip-body, " default_theme1.html -A 3 16 | 65 | 66 | Remote themes also replace the default theme but are included with a link: 67 | 68 | $ slipshow compile --theme https://example.org file.md -o remote_theme.html 69 | $ grep example.org remote_theme.html 70 | 71 | 72 | Independently, an arbitrary number of css files can be included with "--css", without changing the theme: 73 | 74 | $ slipshow compile --css https://example.org file.md --css my_theme.css -o additional_css.html 75 | $ grep example.org additional_css.html 76 | 80 | $ grep ".slip-body, " additional_css.html 81 | 89 | 90 | 91 | 113 | 114 | 115 | 116 | 124 | 125 | -------------------------------------------------------------------------------- /test/engine/campus_du_libre.t/run.t: -------------------------------------------------------------------------------- 1 | 2 | 3 | $ slipshow compile cdl.md 4 | $ cp cdl.html /tmp/ 5 | 6 | -------------------------------------------------------------------------------- /test/engine/campus_du_libre.t/what-is-a-presentation.md: -------------------------------------------------------------------------------- 1 | # **Qu'est-ce** qu'une présentation slipshow ? 2 | 3 | {pause} 4 | Voici [un exemple](https://choum.net/panglesd/slides/WDCM-2021-slips/wdcm-ada.html#2,21). 5 | 6 | {pause #preslip .block} 7 | > Une présentation slipshow tient plus du **tableau noir** que des diapositives. {pause} 8 | > 9 | > Elle se contrôle avec les touches : 10 | > 11 | > {.flex} 12 | > > [`←`]{.touche} [`→`]{.touche} [`↑`]{.touche} [`↓`]{.touche} [`SPACE`]{.touche .space} 13 | > > 14 | > > **Avancer/Reculer** 15 | > 16 | > {.flex} 17 | > > [`w`]{.touche} [`W`]{.touche} [`h`]{.touche} [`H`]{.touche} [`x`]{.touche} [`X`]{.touche} 18 | > > 19 | > > **Mode dessin** 20 | > 21 | > {pause} 22 | > 23 | > 24 | > Une présentation slipshow permet de : 25 | > 26 | > - Compléter interactivement sa présentation avec le **mode dessin**. Essayez! {pause} 27 | > 28 | > - Faire apparaître **la structure** de la présentation. {pause} 29 | > 30 | > - Ouvrir de **nouvelles possibilités [pédagogiques]{step focus-at-unpause}** 31 | 32 | {pause unfocus-at-unpause} 33 | -------------------------------------------------------------------------------- /test/engine/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:slipshow})) 3 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/.gitignore: -------------------------------------------------------------------------------- 1 | _b0 2 | _build 3 | tmp 4 | *.install 5 | src/console/ocaml_console.js -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/.merlin: -------------------------------------------------------------------------------- 1 | EXT js 2 | PKG b0.kit js_of_ocaml js_of_ocaml-toplevel 3 | S src/** 4 | S test/** 5 | B _b0/** 6 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/BRZO: -------------------------------------------------------------------------------- 1 | (srcs-x pkg myocamlbuild.ml attic test) 2 | (srcs-i . test/test_browser.ml) 3 | (ocaml (libs js_of_ocaml js_of_ocaml-compiler/runtime)) -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/DEVEL.md: -------------------------------------------------------------------------------- 1 | # Testing 2 | 3 | There are a few test see `b0 list`, they can be built and shown in your 4 | browser with: 5 | 6 | b0 -- test_c2d 7 | b0 -- test_gl 8 | b0 -- test_audio 9 | … 10 | 11 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/LICENSE.md: -------------------------------------------------------------------------------- 1 | 2 | # Brr copyrights 3 | 4 | All sources except 5 | [src/console/highlight.pack.js](src/console/highlight.pack.js) 6 | are distributed under the following license: 7 | 8 | ``` 9 | Copyright (c) 2018 The brr programmers 10 | 11 | Permission to use, copy, modify, and/or distribute this software for any 12 | purpose with or without fee is hereby granted, provided that the above 13 | copyright notice and this permission notice appear in all copies. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 16 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 17 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 18 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 19 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 20 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 21 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 22 | ``` 23 | 24 | # Highlight.js copyrights 25 | 26 | The file [src/console/highlight.pack.js](src/console/highlight.pack.js) 27 | is distributed under the following license: 28 | 29 | ``` 30 | BSD 3-Clause License 31 | 32 | Copyright (c) 2006, Ivan Sagalaev. 33 | All rights reserved. 34 | 35 | Redistribution and use in source and binary forms, with or without 36 | modification, are permitted provided that the following conditions are met: 37 | 38 | * Redistributions of source code must retain the above copyright notice, this 39 | list of conditions and the following disclaimer. 40 | 41 | * Redistributions in binary form must reproduce the above copyright notice, 42 | this list of conditions and the following disclaimer in the documentation 43 | and/or other materials provided with the distribution. 44 | 45 | * Neither the name of the copyright holder nor the names of its 46 | contributors may be used to endorse or promote products derived from 47 | this software without specific prior written permission. 48 | 49 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 50 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 51 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 52 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 53 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 54 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 55 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 56 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 57 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 58 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 59 | ``` 60 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/README.md: -------------------------------------------------------------------------------- 1 | brr — Browser programming toolkit for OCaml 2 | =========================================== 3 | 4 | Brr is a toolkit for programming browsers in OCaml with the 5 | [`js_of_ocaml`][jsoo] compiler. It provides: 6 | 7 | * Interfaces to a selection of browser APIs. 8 | * An OCaml console developer tool for live interaction 9 | with programs running in web pages. 10 | * A JavaScript FFI for idiomatic OCaml programming. 11 | 12 | Brr is distributed under the ISC license. It depends on the 13 | `js_of_ocaml` compiler and runtime – but not on its libraries or 14 | syntax extension. 15 | 16 | [jsoo]: https://ocsigen.org/js_of_ocaml 17 | 18 | Homepage: 19 | 20 | ## Installation 21 | 22 | Brr can be installed with `opam`: 23 | 24 | opam install brr 25 | 26 | If you don't use `opam` consult the [`opam`](opam) file for build 27 | instructions. 28 | 29 | ## Documentation 30 | 31 | The documentation can be consulted [online] or via `odig doc brr`. 32 | 33 | Questions are welcome but better asked on the [OCaml forum] than on 34 | the issue tracker. 35 | 36 | [online]: https://erratique.ch/software/brr/doc 37 | [OCaml forum]: https://discuss.ocaml.org/ 38 | 39 | ## Sample programs 40 | 41 | A few basic programs can be found in the [test suite](test). 42 | 43 | You can run them with for example `b0 -- test_audio`, see 44 | `b0 list` for the list of tests. 45 | 46 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | <_b0> : -traverse 3 | : include 4 | : package(js_of_ocaml-compiler.runtime) 5 | : include 6 | : package(js_of_ocaml-toplevel) 7 | : include 8 | : include 9 | : include 10 | : include 11 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/attic/log.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2018 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | type level = Quiet | App | Error | Warning | Info | Debug 7 | let _level = ref Debug 8 | let level () = !_level 9 | let set_level l = _level := l 10 | 11 | type ('a, 'b) msgf = 12 | (?header:string -> ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b 13 | 14 | type 'a log = ('a, unit) msgf -> unit 15 | type kmsg = { kmsg : 'a 'b. (unit -> 'b) -> level -> ('a, 'b) msgf -> 'b } 16 | 17 | let pp_header ppf = function 18 | | None -> () 19 | | Some v -> Format.fprintf ppf "[%s] " v 20 | 21 | let console : level -> string -> unit = 22 | fun level s -> 23 | let meth = match level with 24 | | Error -> "error" 25 | | Warning -> "warn" 26 | | Info -> "info" 27 | | Debug -> "debug" 28 | | App -> "log" 29 | | Quiet -> assert false 30 | in 31 | ignore @@ Jv.call Brr.Console.(to_jv (get ())) meth [| Jv.of_string s |] 32 | 33 | 34 | let report level k msgf = 35 | msgf @@ fun ?header fmt -> 36 | let k str = console level str; k () in 37 | Format.kasprintf k ("%a@[" ^^ fmt ^^ "@]@.") pp_header header 38 | 39 | let nop_kmsg = 40 | let kmsg k level msgf = k () in 41 | { kmsg } 42 | 43 | let default_kmsg = 44 | let kmsg k level msgf = match !_level with 45 | | Quiet -> k () 46 | | level' when level > level' -> k () 47 | | _ -> report level k msgf 48 | in 49 | { kmsg } 50 | 51 | let _kmsg = ref default_kmsg 52 | let set_kmsg kmsg = _kmsg := kmsg 53 | 54 | let kunit _ = () 55 | let msg level msgf = !_kmsg.kmsg kunit level msgf 56 | let app msgf = !_kmsg.kmsg kunit App msgf 57 | let err msgf = !_kmsg.kmsg kunit Error msgf 58 | let warn msgf = !_kmsg.kmsg kunit Warning msgf 59 | let info msgf = !_kmsg.kmsg kunit Info msgf 60 | let debug msgf = !_kmsg.kmsg kunit Debug msgf 61 | let kmsg k level msgf = !_kmsg.kmsg k level msgf 62 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/attic/log.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2018 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Console logging. 7 | 8 | The following functions log to the browser console. *) 9 | 10 | type level = Quiet | App | Error | Warning | Info | Debug (** *) 11 | (** The type for reporting levels. *) 12 | 13 | type ('a, 'b) msgf = 14 | (?header:string -> ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b 15 | (** The type for client specified message formatting functions. See 16 | {!Logs.msgf}. *) 17 | 18 | type 'a log = ('a, unit) msgf -> unit 19 | (** The type for log functions. See {!Logs.log}. *) 20 | 21 | val msg : level -> 'a log 22 | (** [msg l (fun m -> m fmt ...)] logs with level [l] a message 23 | formatted with [fmt]. *) 24 | 25 | val app : 'a log 26 | (** [app] is [msg App]. *) 27 | 28 | val err : 'a log 29 | (** [err] is [msg Error]. *) 30 | 31 | val warn : 'a log 32 | (** [warn] is [msg Warning]. *) 33 | 34 | val info : 'a log 35 | (** [info] is [msg Info]. *) 36 | 37 | val debug : 'a log 38 | (** [debug] is [msg Debug]. *) 39 | 40 | val kmsg : (unit -> 'b) -> level -> ('a, 'b) msgf -> 'b 41 | (** [kmsg k level m] logs [m] with level [level] and continues with [k]. *) 42 | 43 | (** {1 Logging backend} *) 44 | 45 | type kmsg = { kmsg : 'a 'b. (unit -> 'b) -> level -> ('a, 'b) msgf -> 'b } 46 | (** The type for the basic logging function. The function is never 47 | invoked with a level of [Quiet]. *) 48 | 49 | val set_kmsg : kmsg -> unit 50 | (** [set_kmsg kmsg] sets the logging function to [kmsg]. *) 51 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/brr.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "brr" 3 | synopsis: "Browser programming toolkit for OCaml" 4 | description: """\ 5 | Brr is a toolkit for programming browsers in OCaml with the 6 | [`js_of_ocaml`][jsoo] compiler. It provides: 7 | 8 | * Interfaces to a selection of browser APIs. 9 | * An OCaml console developer tool for live interaction 10 | with programs running in web pages. 11 | * A JavaScript FFI for idiomatic OCaml programming. 12 | 13 | Brr is distributed under the ISC license. It depends on the 14 | `js_of_ocaml` compiler and runtime – but not on its libraries or 15 | syntax extension. 16 | 17 | [jsoo]: https://ocsigen.org/js_of_ocaml 18 | 19 | Homepage: """ 20 | maintainer: "Daniel Bünzli " 21 | authors: "The brr programmers" 22 | license: ["ISC" "BSD-3-Clause"] 23 | tags: ["reactive" "declarative" "frp" "front-end" "browser" "org:erratique"] 24 | homepage: "https://github.com/dune-universe/brr" 25 | bug-reports: "https://github.com/dbuenzli/brr/issues" 26 | depends: [ 27 | "ocaml" {>= "4.08.0"} 28 | "topkg" {build & >= "1.0.3"} 29 | "js_of_ocaml-compiler" {>= "5.5.0"} 30 | "js_of_ocaml-toplevel" {>= "5.5.0"} 31 | "dune" {>= "2.8"} 32 | ] 33 | build: [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} ] 34 | dev-repo: "git+https://github.com/dune-universe/brr.git" 35 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/doc/ocaml_console.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/vendor/github.com/panglesd/brr/doc/ocaml_console.png -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.8) 2 | (using dune_site 0.1) 3 | (name brr) 4 | (package 5 | (name brr) 6 | (sites (share console))) 7 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | 3 | let jsoo () = 4 | let dep = "%.byte" in 5 | let prod = "%.js" in 6 | let f env _ = 7 | let dep = env dep in 8 | let prod = env prod in 9 | let tags = tags_of_pathname prod ++ "js_of_ocaml" in 10 | Cmd 11 | (S [ A "js_of_ocaml" ; T tags ; A "-o" ; Px prod; P dep]) 12 | in 13 | rule "js_of_ocaml: .byte -> .js" ~dep ~prod f; 14 | flag [ "js_of_ocaml"; "debug" ] 15 | (S [ A "--pretty"; A "--debug-info"; A "--source-map" ]); 16 | flag [ "js_of_ocaml"; "pretty" ] (A "--pretty"); 17 | flag [ "js_of_ocaml"; "debuginfo" ] (A "--debug-info"); 18 | flag [ "js_of_ocaml"; "noinline" ] (A "--no-inline"); 19 | flag [ "js_of_ocaml"; "sourcemap" ] (A "--source-map"); 20 | pflag [ "js_of_ocaml" ] "opt" (fun n -> S [ A "--opt"; A n ]); 21 | pflag [ "js_of_ocaml" ] "set" (fun n -> S [ A "--set"; A n ]) 22 | 23 | let () = Ocamlbuild_plugin.dispatch @@ function 24 | | After_rules -> 25 | jsoo (); 26 | | _ -> () 27 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/pkg/META: -------------------------------------------------------------------------------- 1 | description = "Browser programming toolkit for OCaml" 2 | version = "%%VERSION_NUM%%" 3 | requires = "js_of_ocaml-compiler.runtime" 4 | archive(byte) = "brr.cma" 5 | archive(native) = "brr.cmxa" 6 | plugin(byte) = "brr.cma" 7 | plugin(native) = "brr.cmxs" 8 | exists_if = "brr.cma brr.cmxa" 9 | 10 | package "ocaml_poke" ( 11 | directory = "ocaml_poke" 12 | description = "OCaml poke objects interaction" 13 | version = "%%VERSION_NUM%%" 14 | requires = "brr" 15 | archive(byte) = "brr_ocaml_poke.cma" 16 | archive(native) = "brr_ocaml_poke.cmxa" 17 | plugin(byte) = "brr_ocaml_poke.cma" 18 | plugin(native) = "brr_ocaml_poke.cmxs" 19 | exists_if = "brr_ocaml_poke.cma brr_ocaml_poke.cmxa" 20 | ) 21 | 22 | package "ocaml_poke_ui" ( 23 | directory = "ocaml_poke_ui" 24 | description = "OCaml poke user interface (toplevel)" 25 | version = "%%VERSION_NUM%%" 26 | requires = "brr brr.ocaml_poke" 27 | archive(byte) = "brr_ocaml_poke_ui.cma" 28 | archive(native) = "brr_ocaml_poke_ui.cmxa" 29 | plugin(byte) = "brr_ocaml_poke_ui.cma" 30 | plugin(native) = "brr_ocaml_poke_ui.cmxs" 31 | exists_if = "brr_ocaml_poke_ui.cma brr_ocaml_poke_ui.cmxa" 32 | ) 33 | 34 | package "poke" ( 35 | directory = "poke" 36 | description = "Poke explicitely" 37 | version = "%%VERSION_NUM%%" 38 | requires = "js_of_ocaml-compiler.runtime js_of_ocaml-toplevel brr" 39 | archive(byte) = "brr_poke.cma" 40 | archive(native) = "brr_poke.cmxa" 41 | plugin(byte) = "brr_poke.cma" 42 | plugin(native) = "brr_poke.cmxs" 43 | exists_if = "brr_poke.cma brr_poke.cmxa" 44 | ) 45 | 46 | package "poked" ( 47 | directory = "poked" 48 | description = "Poke by side effect" 49 | version = "%%VERSION_NUM%%" 50 | requires = "brr.poke" 51 | archive(byte) = "brr_poked.cma" 52 | archive(native) = "brr_poked.cmxa" 53 | plugin(byte) = "brr_poked.cma" 54 | plugin(native) = "brr_poked.cmxs" 55 | exists_if = "brr_poked.cma brr_poked.cmxa" 56 | ) 57 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "topkg" 4 | open Topkg 5 | 6 | let () = 7 | Pkg.describe "brr" @@ fun c -> 8 | Ok [ Pkg.mllib "src/brr.mllib"; 9 | Pkg.mllib "src/ocaml_poke/brr_ocaml_poke.mllib" ~dst_dir:"ocaml_poke/"; 10 | Pkg.mllib "src/ocaml_poke_ui/brr_ocaml_poke_ui.mllib" 11 | ~dst_dir:"ocaml_poke_ui/"; 12 | Pkg.mllib "src/poke/brr_poke.mllib" ~dst_dir:"poke/"; 13 | Pkg.mllib "src/poked/brr_poked.mllib" ~dst_dir:"poked/"; 14 | Pkg.share "src/console/devtools.html" ~dst:"console/"; 15 | Pkg.share "src/console/devtools.js" ~dst:"console/"; 16 | Pkg.share "src/console/highlight.pack.js" ~dst:"console/"; 17 | Pkg.share "src/console/manifest.json" ~dst:"console/"; 18 | Pkg.share "src/console/ocaml.png" ~dst:"console/"; 19 | Pkg.share "src/console/ocaml_console.css" ~dst:"console/"; 20 | Pkg.share "src/console/ocaml_console.html" ~dst:"console/"; 21 | Pkg.share "src/console/ocaml_console.js" ~dst:"console/"; 22 | 23 | (* Samples *) 24 | Pkg.doc "test/poke.ml"; 25 | 26 | (* Doc *) 27 | Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; 28 | Pkg.doc "doc/ffi_manual.mld" ~dst:"odoc-pages/ffi_manual.mld"; 29 | Pkg.doc "doc/ffi_cookbook.mld" ~dst:"odoc-pages/ffi_cookbook.mld"; 30 | Pkg.doc "doc/ocaml_console.mld" ~dst:"odoc-pages/ocaml_console.mld"; 31 | Pkg.doc "doc/web_page_howto.mld" ~dst:"odoc-pages/web_page_howto.mld"; 32 | Pkg.doc ~built:false "doc/ocaml_console.png" ~dst:"odoc-assets/"; 33 | ] 34 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/brr.mllib: -------------------------------------------------------------------------------- 1 | Jv 2 | Jstr 3 | Fut 4 | Brr 5 | Brr_io 6 | Brr_canvas 7 | Brr_webgpu 8 | Brr_webaudio 9 | Brr_webcrypto 10 | Brr_webmidi 11 | Brr_webworkers -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/console/devtools.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/console/devtools.js: -------------------------------------------------------------------------------- 1 | chrome.devtools.panels.create("OCaml", "ocaml.png", "ocaml_console.html"); 2 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/console/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name ocaml_console) 3 | (modules ocaml_console) 4 | (libraries brr brr.ocaml_poke_ui) 5 | (modes js)) 6 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/console/manifest.json: -------------------------------------------------------------------------------- 1 | { 2 | "manifest_version": 3, 3 | "name": "OCaml console", 4 | "version": "0.0.6", 5 | "author": "The brr programmers", 6 | "description": 7 | "OCaml console developer tools panel. Connects to an OCaml toplevel (REPL) provided by the inspected web page.", 8 | "homepage_url": "https://erratique.ch/software/brr", 9 | "icons": { "128": "ocaml.png" }, 10 | "permissions": ["storage", "management"], 11 | "host_permissions": [""], 12 | "devtools_page": "devtools.html" 13 | } 14 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/console/ocaml.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/panglesd/slipshow/fb46d458aa2c9bd85b0556357f82c26e6c549367/vendor/github.com/panglesd/brr/src/console/ocaml.png -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/console/ocaml_console.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | OCaml console 10 | 11 | 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name brr) 3 | (public_name brr) 4 | (modules brr brr_canvas brr_io brr_webaudio brr_webcrypto brr_webworkers fut jv jstr) 5 | (libraries js_of_ocaml-compiler.runtime) 6 | (wrapped false)) 7 | 8 | (dirs :standard console) 9 | 10 | (subdir console 11 | (rule 12 | (target ocaml_console.js) 13 | (deps ocaml_console.bc.js) 14 | (action (copy %{deps} %{target})))) 15 | 16 | (install 17 | (section 18 | (site (brr console))) 19 | (files 20 | console/devtools.html 21 | console/devtools.js 22 | console/highlight.pack.js 23 | console/manifest.json 24 | console/ocaml.png 25 | console/ocaml_console.css 26 | console/ocaml_console.html 27 | console/ocaml_console.js)) 28 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/ocaml_poke/brr_ocaml_poke.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [ocaml_poke] object for OCaml console. 7 | 8 | See the {{!page-ocaml_console}OCaml console manual} 9 | for more information. *) 10 | 11 | (** {1:poke Poke objects} *) 12 | 13 | type t 14 | (** The type for OCaml poke objects. Note that the actual object 15 | may live in another global context. *) 16 | 17 | val version : t -> int 18 | (** [version p] is the version of the poke object interface. *) 19 | 20 | val ocaml_version : t -> Jstr.t 21 | (** [ocaml_version p] is the OCaml version being poked by [p]. *) 22 | 23 | val jsoo_version : t -> Jstr.t 24 | (** [jsoo_version p] is the [js_of_ocaml] version being poked by [p]. *) 25 | 26 | val eval : t -> Jstr.t -> Brr.Json.t Fut.or_error 27 | (** [eval expr] evaluates the given OCaml toplevel phrase in the poke 28 | object and returns the result as a JSON string. *) 29 | 30 | val use : t -> Jstr.t -> Brr.Json.t Fut.or_error 31 | (** [use phrases] silently evaluates the given OCaml toplevel phrases in 32 | the poke object and returns possible errors via a JSON string. *) 33 | 34 | (** {1:finding Finding poke objects} *) 35 | 36 | val find : unit -> t option Fut.or_error 37 | (** [find ()] looks for and initalizes an OCaml poke object in the global 38 | context of the caller. *) 39 | 40 | val find_eval'd : 41 | eval:(Jstr.t -> Brr.Json.t Fut.or_error) -> t option Fut.or_error 42 | (** [find_eval'd] looks for and initializes an OCaml poke object by using 43 | the given JavaScript [eval] function. *) 44 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/ocaml_poke/brr_ocaml_poke.mllib: -------------------------------------------------------------------------------- 1 | Brr_ocaml_poke -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/ocaml_poke/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name brr_ocaml_poke) 3 | (public_name brr.ocaml_poke) 4 | (modules brr_ocaml_poke) 5 | (libraries brr) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/ocaml_poke_ui/brr_ocaml_poke_ui.mllib: -------------------------------------------------------------------------------- 1 | Brr_ocaml_poke_ui -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/ocaml_poke_ui/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name brr_ocaml_poke_ui) 3 | (public_name brr.ocaml_poke_ui) 4 | (modules brr_ocaml_poke_ui) 5 | (libraries brr brr.ocaml_poke) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poke/brr_poke.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** OCaml poke object definition for the OCaml console. 7 | 8 | See the {{!page-ocaml_console}OCaml console documentation} 9 | for more information. *) 10 | 11 | val define : unit -> unit 12 | (** [define ()] defines a global 13 | {{!page-ocaml_console.ocaml_poke}[ocaml_poke]} object in 14 | the global context of the caller. 15 | 16 | {b Limitation.} Due to {!Js_of_ocaml_toplevel.JsooTop}, this poke 17 | object sets channel flusher via 18 | {!Jsoo_runtime.Sys.set_channel_output'} for [stdout] and [stderr]. 19 | This will not work if your application makes use of these 20 | channels. It's unclear whether this limitation can be easily 21 | lifted. *) 22 | 23 | val pp_jstr : Format.formatter -> Jstr.t -> unit 24 | val pp_jv_error : Format.formatter -> Jv.Error.t -> unit 25 | val pp_jv : Format.formatter -> Jv.t -> unit 26 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poke/brr_poke.mllib: -------------------------------------------------------------------------------- 1 | Brr_poke -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poke/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name brr_poke) 3 | (public_name brr.poke) 4 | (modules brr_poke) 5 | (libraries js_of_ocaml-toplevel brr) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poked/brr_poked.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let () = Brr_poke.define () 7 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poked/brr_poked.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** OCaml poke by side effect. 7 | 8 | This module calls {!Brr_poke.define} by side effect. You can 9 | simply link against this library to allow the 10 | {{!page-ocaml_console}OCaml console} to interact with your 11 | program. *) 12 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poked/brr_poked.mllib: -------------------------------------------------------------------------------- 1 | Brr_poked -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/src/poked/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name brr_poked) 3 | (public_name brr.poked) 4 | (modules brr_poked) 5 | (libraries brr brr.poke) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/min.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Brr minimal example 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/min.ml: -------------------------------------------------------------------------------- 1 | open Brr 2 | let () = 3 | El.set_children (Document.body G.document) El.[txt' "Hello World!"] 4 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/nop.ml: -------------------------------------------------------------------------------- 1 | let () = () 2 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/poke.ml: -------------------------------------------------------------------------------- 1 | (* Compile with: 2 | 3 | ocamlfind ocamlc -g -linkall -linkpkg \ 4 | -package brr,brr.poked poke.ml 5 | 6 | js_of_ocaml $(ocamlfind query -r -i-format brr.poked) -I . \ 7 | --toplevel a.out -o poke.js *) 8 | 9 | open Brr 10 | 11 | let me () = 12 | El.set_children (Document.body G.document) El.[ h1 [ txt' "Revolt!" ]] 13 | 14 | let main () = 15 | let h1 = El.h1 [El.txt' "OCaml console"] in 16 | let info = El.[ 17 | p [txt' "This page has an OCaml poke object with the "; 18 | code [txt' "Brr"]; txt' " library."]; 19 | p [txt' "Install the OCaml console web extension, open the developer \ 20 | tools, switch to the ‘OCaml’ tab and interact. Try:"]; 21 | p [pre [txt' "Poke.me ();;"]]; 22 | p [pre [txt' "open Brr;;"]]; 23 | p [pre [txt' "Console.log [Document.body G.document];;"]]] 24 | in 25 | El.set_children (Document.body G.document) (h1 :: info) 26 | 27 | let () = main () 28 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_base64.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | open Fut.Result_syntax 8 | 9 | let text = Jstr.v "Program browsers in O\u{1F42B}." 10 | 11 | let test log = 12 | log [El.txt Jstr.(v "encoding: " + text)]; 13 | let data = Base64.data_utf_8_of_jstr text in 14 | let enc = Base64.encode data |> Result.get_ok in 15 | log [El.txt Jstr.(v "encoded : " + enc)]; 16 | let dec = Base64.decode enc |> Result.get_ok in 17 | let text' = Base64.data_utf_8_to_jstr dec |> Result.get_ok in 18 | log [El.txt Jstr.(v "decoded : " + text')]; 19 | if Jstr.equal text text' 20 | then log [El.txt Jstr.(v "Success.")] 21 | else log [El.txt Jstr.(v "ERROR: text did not round trip.")] 22 | 23 | let main () = 24 | let h1 = El.h1 [El.txt' "Base64 test"] in 25 | let log_view = El.ol [] in 26 | let log cs = El.append_children log_view [El.li cs] in 27 | let children = [h1; log_view] in 28 | El.set_children (Document.body G.document) children; 29 | test log 30 | 31 | let () = ignore (main ()) 32 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_c2d.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | open Brr_canvas 8 | open Fut.Syntax 9 | 10 | let stripe_cnv_rect c ~x ~y ~w ~h = 11 | let x = truncate x and y = truncate y in 12 | let w = truncate w and h = truncate h in 13 | let idata = C2d.get_image_data c ~x ~y ~w ~h in 14 | let d = C2d.Image_data.data idata in 15 | let ba = Tarray.to_bigarray1 d in 16 | for y = 0 to h - 1 do 17 | for x = 0 to w - 1 do 18 | if x mod 4 <> 0 then () else 19 | let off = 4 * (y * w + x) in 20 | Bigarray.Array1.set ba (off ) 0xFF; 21 | Bigarray.Array1.set ba (off + 1) 0x00; 22 | Bigarray.Array1.set ba (off + 2) 0x00 23 | done 24 | done; 25 | C2d.put_image_data c idata ~x ~y 26 | 27 | let draw_brr c ~x ~y = 28 | let size = truncate (96. *. Window.device_pixel_ratio G.window) in 29 | C2d.set_font c Jstr.(v "bold " + of_int size + v "px SourceSansPro"); 30 | C2d.fill_text c (Jstr.v " Brr!") ~x ~y 31 | 32 | let draw_rect c ~x ~y ~w ~h = 33 | C2d.set_fill_style c (C2d.color (Jstr.v "#000")); 34 | C2d.fill_rect c ~x ~y ~w ~h 35 | 36 | let draw cnv = 37 | let c = C2d.get_context cnv in 38 | let w = float @@ Canvas.w cnv in 39 | let h = float @@ Canvas.h cnv in 40 | C2d.stroke_rect c ~x:0. ~y:0. ~w ~h; 41 | let w = 0.5 *. w and h = 0.5 *. h in 42 | let x = w and y = h in 43 | draw_rect c ~x ~y ~w ~h; 44 | stripe_cnv_rect c ~x ~y ~w ~h; 45 | draw_brr c ~x:10. ~y:h 46 | 47 | let set_size cnv = 48 | let el = Canvas.to_el cnv in 49 | let w = El.inner_w el in 50 | let h = Jstr.(of_int (truncate ((w *. 3.) /. 4.)) + v "px") (* 4:3 *) in 51 | El.set_inline_style El.Style.height h el; 52 | Canvas.set_size_to_layout_size cnv 53 | 54 | let main () = 55 | let h1 = El.h1 [El.txt' "2D canvas"] in 56 | let info = 57 | let brr = El.strong [El.txt' "Brr!"] in 58 | [ El.txt' "Draws "; brr; El.txt' " and a black and red striped corner. " ] 59 | in 60 | let cnv = Canvas.create [] in 61 | let children = [h1; El.p info; Canvas.to_el cnv] in 62 | El.set_children (Document.body G.document) children; 63 | (* We need to wait for the stylesheet to access the font and setup the 64 | layout *) 65 | let* _ev = Ev.next Ev.load (Window.as_target G.window) in 66 | set_size cnv; draw cnv; Fut.return () 67 | 68 | let () = ignore (main ()) 69 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_clipboard.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | open Brr_io 8 | open Fut.Result_syntax 9 | 10 | let handle_error ~view = function 11 | | Ok () -> () 12 | | Error e -> 13 | let err = Jv.Error.message e in 14 | let msg = El.p [El.txt Jstr.(v "An error occured: " + err)] in 15 | El.set_children view [msg] 16 | 17 | let show_clipboard view () = 18 | ignore @@ Fut.map (handle_error ~view) @@ 19 | let c = Clipboard.of_navigator G.navigator in 20 | let* t = Clipboard.read_text c in 21 | let contents = El.strong [El.txt' "Contents:"] in 22 | El.set_children view [El.p [contents; El.pre [El.txt t]]]; 23 | Fut.ok () 24 | 25 | let put_clipboard view () = 26 | ignore @@ Fut.map (handle_error ~view) @@ 27 | let c = Clipboard.of_navigator G.navigator in 28 | let* t = Clipboard.write_text c (Jstr.v "Brr!") in 29 | El.set_children view [El.p [El.txt' "Done!"]]; 30 | Fut.ok () 31 | 32 | let button ?at onclick label = 33 | let but = El.button ?at [El.txt (Jstr.v label)] in 34 | ignore (Ev.listen Ev.click (fun _e -> onclick ()) (El.as_target but)); but 35 | 36 | let main () = 37 | let h1 = El.h1 [El.txt' "Clipboard test"] in 38 | let view = El.p [] in 39 | let show = button (show_clipboard view) "Show clipboard text" in 40 | let put = button (put_clipboard view) "Put ‘Brr!’ in the clipboard" in 41 | let children = [h1; El.p [show; put]; view] in 42 | El.set_children (Document.body G.document) children 43 | 44 | let () = main () 45 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_fact.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2024 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let rec fact n = if n <= 0 then 1 else n * fact (n - 1) 7 | let fact' n = Jv.of_int (fact (Jv.to_int n)) 8 | let () = Jv.set Jv.global "fact" (Jv.callback ~arity:1 fact') 9 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_file.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | 8 | let file_view file data_uri contents = 9 | let field_name f = El.strong [El.txt' f] in 10 | let field f d = [field_name f; El.br (); El.pre [El.txt d] ] in 11 | let jstr_of_type t = if Jstr.is_empty t then Jstr.v "Unknown" else t in 12 | List.concat 13 | [ field "Name" (File.name file); 14 | field "Modified" (Jstr.of_int @@ File.last_modified_ms file); 15 | field "Byte size" (Jstr.of_int @@ Blob.byte_length (File.as_blob file)); 16 | field "Type" (jstr_of_type @@ Blob.type' (File.as_blob file)); 17 | field "Data URL" data_uri; 18 | field "Content" contents ] 19 | 20 | let show_file viewer file = 21 | let muddle_error = function Ok v -> v | Error e -> Jv.Error.message e in 22 | let blob = File.as_blob file in 23 | let contents = 24 | if Jv.has "text" blob then Fut.map muddle_error (Blob.text blob) else 25 | Fut.return (Jstr.v "text() method unsupported in this browser") 26 | in 27 | let data_uri = Fut.map muddle_error (Blob.data_uri blob) in 28 | let set_viewer (duri, c) = El.set_children viewer (file_view file duri c) in 29 | El.set_children viewer []; 30 | Fut.await (Fut.pair data_uri contents) set_viewer 31 | 32 | let file_selector ~on_change = 33 | (* The input file can't be styled we hide it and use a click forwarding 34 | button instead. *) 35 | let i = El.input ~at:At.[type' (Jstr.v "file")] () in 36 | let b = El.button [ El.txt' "Choose file…" ] in 37 | El.set_inline_style El.Style.display (Jstr.v "none") i; 38 | ignore (Ev.listen Ev.click (fun e -> El.click i) (El.as_target b)); 39 | ignore (Ev.listen Ev.change (fun e -> on_change (El.Input.files i)) 40 | (El.as_target i)); 41 | El.span [i; b] 42 | 43 | let main () = 44 | let h1 = El.h1 [El.txt' "Show file"] in 45 | let viewer = El.div [] in 46 | let on_change files = show_file viewer (List.hd files) in 47 | let selector = file_selector ~on_change in 48 | El.set_children (Document.body G.document) [h1; El.p [selector]; viewer] 49 | 50 | let () = main () 51 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_hello.ml: -------------------------------------------------------------------------------- 1 | open Brr 2 | let () = Console.(log [str "Yo!"]) 3 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_history.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | 8 | let button ?at onclick label = 9 | let but = El.button ?at [El.txt (Jstr.v label)] in 10 | ignore (Ev.listen Ev.click (fun _e -> onclick ()) (El.as_target but)); but 11 | 12 | let with_frag frag u = Uri.with_uri ~fragment:(Jstr.v frag) u 13 | let test_history () = 14 | let h = Window.history G.window in 15 | let loc = Window.location G.window in 16 | Window.History.push_state h ~uri:(with_frag "h1" loc |> Result.get_ok); 17 | Window.History.push_state h ~uri:(with_frag "h2" loc |> Result.get_ok); 18 | Window.History.push_state h ~uri:(with_frag "h3" loc |> Result.get_ok); 19 | () 20 | 21 | let test_no_reload () = 22 | let loc = Window.location G.window in 23 | Window.set_location G.window (with_frag "l1" loc |> Result.get_ok); 24 | Window.set_location G.window (with_frag "l2" loc |> Result.get_ok); 25 | () 26 | 27 | let test_back () = Window.History.back (Window.history G.window) 28 | let test_forward () = Window.History.forward (Window.history G.window) 29 | let test_reload () = Window.reload G.window 30 | 31 | let main () = 32 | let noreload = button test_no_reload "Set window location" in 33 | let history = button test_history "Use history API" in 34 | let reload = button test_reload "Reload window" in 35 | let prev = button test_back "← prev" in 36 | let next = button test_forward "next →" in 37 | let children = [ El.p [prev; next]; 38 | El.p [noreload; history; reload ]] 39 | in 40 | El.append_children (Document.body G.document) children 41 | 42 | let () = main () 43 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_midi.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | open Fut.Result_syntax 8 | open Brr_webmidi 9 | 10 | let test log = 11 | Fut.map (Console.log_if_error ~use:()) @@ 12 | let opts = Midi.Access.opts ~sysex:true () in 13 | let* a = Midi.Access.of_navigator ~opts G.navigator in 14 | log El.[txt' "Enumerating IO…"]; 15 | let log_input mi () = 16 | Console.(log [mi]); 17 | log El.[txt' "Input: "; txt (Midi.Port.name (Midi.Input.as_port mi))] 18 | in 19 | let log_output mo () = 20 | Console.(log [mo]); 21 | log El.[txt' "Output: "; txt (Midi.Port.name (Midi.Output.as_port mo))] 22 | in 23 | let () = Midi.Access.inputs a log_input () in 24 | let () = Midi.Access.outputs a log_output () in 25 | Fut.ok () 26 | 27 | let main () = 28 | let h1 = El.h1 [El.txt' "Web MIDI test"] in 29 | let log_view = El.ol [] in 30 | let log cs = El.append_children log_view [El.li cs] in 31 | let children = [h1; log_view] in 32 | El.set_children (Document.body G.document) children; 33 | test log 34 | 35 | let () = ignore (main ()) 36 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_notification.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | open Brr_io 8 | open Brr_webworkers 9 | open Fut.Result_syntax 10 | 11 | let handle_error ~view = function 12 | | Ok () -> () 13 | | Error e -> 14 | let err = Jv.Error.message e in 15 | let msg = El.p [El.txt Jstr.(v "An error occured: " + err)] in 16 | El.set_children view [msg] 17 | 18 | let notif_options () = 19 | let j = Jstr.v in 20 | let hot = Notification.Action.v ~action:(j "hot") ~title:(j "Hot") () in 21 | let cold = Notification.Action.v ~action:(j "cold") ~title:(j "Cold") () in 22 | Notification.opts ~actions:[hot; cold] () 23 | 24 | let show_notification () = 25 | let c = Service_worker.Container.of_navigator G.navigator in 26 | let* r = Service_worker.Container.register c (Jstr.v "test_notification.js")in 27 | let t = Jstr.v "Brr!" and opts = notif_options () in 28 | let* () = Service_worker.Registration.show_notification r t ~opts in 29 | Fut.ok () 30 | 31 | let notify_me view () = 32 | ignore @@ Fut.map (handle_error ~view) @@ 33 | let* perm = Notification.request_permission () in 34 | El.set_children view [El.p [El.txt Jstr.(v "Permission: " + perm)]]; 35 | if Jstr.equal perm Notification.Permission.granted 36 | then show_notification () 37 | else Fut.ok () 38 | 39 | let button ?at onclick label = 40 | let but = El.button ?at [El.txt (Jstr.v label)] in 41 | ignore (Ev.listen Ev.click (fun _e -> onclick ()) (El.as_target but)); but 42 | 43 | let page_main () = 44 | let h1 = El.h1 [El.txt' "Notification test"] in 45 | let info = El.p [ El.strong [El.txt' "Note."]; 46 | El.txt' " Doesn't work over the file:// protocol."] 47 | in 48 | let view = El.p [] in 49 | let notify_me = button (notify_me view) "Notify me" in 50 | let children = [h1; info; El.p [notify_me]; view] in 51 | El.set_children (Document.body G.document) children 52 | 53 | let () = if Worker.ami () then () else page_main () 54 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/test_worker.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Brr 7 | open Brr_io 8 | open Brr_webworkers 9 | 10 | let recv_from_page e = 11 | let data = (Message.Ev.data (Ev.as_type e) : Jstr.t) in 12 | match Jstr.to_string data with 13 | | "Work!" -> Worker.G.post Jstr.(v "Page said: " + data + v " I say Revolt!") 14 | | _ -> assert false 15 | 16 | let worker_main () = 17 | Console.(log [str "Worker hello!"]); 18 | let msg = Ev.next Message.Ev.message G.target in 19 | let _ = Fut.map recv_from_page msg in 20 | () 21 | 22 | let spawn_worker () = try Ok (Worker.create (Jstr.v "test_worker.js")) with 23 | | Jv.Error e -> Error e 24 | 25 | let recv_from_worker ~view e = 26 | let data : Jstr.t = Message.Ev.data (Ev.as_type e) in 27 | El.set_children view [El.p El.[txt Jstr.(v "Worker says: " + data)]] 28 | 29 | let page_main () = 30 | let h1 = El.h1 [El.txt' "Test workers"] in 31 | let info = El.p [ El.strong [El.txt' "Note."]; 32 | El.txt' " Doesn't work over the file:// protocol."] 33 | in 34 | let view = El.div [] in 35 | El.set_children (Document.body G.document) [h1; info; view]; 36 | match spawn_worker () with 37 | | Error e -> El.set_children view [El.p El.[txt (Jv.Error.message e)]] 38 | | Ok w -> 39 | let msg = Ev.next Message.Ev.message (Worker.as_target w) in 40 | let _ = Fut.map (recv_from_worker ~view) msg in 41 | Worker.post w (Jstr.v "Work!"); 42 | () 43 | 44 | let main () = if Worker.ami () then worker_main () else page_main () 45 | let () = main () 46 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/brr/test/top.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2020 The brr programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Fut.Result_syntax 7 | open Brr 8 | 9 | let setup panel = 10 | let* ui = Brr_ocaml_poke_ui.create panel in 11 | Fut.bind (Brr_ocaml_poke.find ()) @@ function 12 | | Ok (Some poke) -> 13 | let drop_target = Document.as_target G.document in 14 | Brr_ocaml_poke_ui.run ui poke ~drop_target; Fut.ok () 15 | | Ok None -> 16 | let msg = "No OCaml poke object found in page." in 17 | Brr_ocaml_poke_ui.output ~kind:`Warning ui [El.pre [El.txt (Jstr.v msg)]]; 18 | Fut.ok () 19 | | Error e -> 20 | Brr_ocaml_poke_ui.output ~kind:`Error ui [El.txt (Jv.Error.message e)]; 21 | Fut.ok () 22 | 23 | let setup_theme () = 24 | let theme = 25 | if Window.prefers_dark_color_scheme G.window then "dark" else "light" 26 | in 27 | let html = Document.root G.document in 28 | El.set_at (Jstr.v "theme") (Some (Jstr.v theme)) html 29 | 30 | let setup_body_style body = 31 | El.set_inline_style (Jstr.v "margin") (Jstr.v "0") body; 32 | El.set_inline_style (Jstr.v "padding") (Jstr.v "0") body; 33 | El.set_inline_style 34 | (Jstr.v "background-color") (Jstr.v "var(--ocaml-color-bg)") body; 35 | () 36 | 37 | let main () = 38 | Brr_poke.define (); 39 | let ui = El.div [] in 40 | let body = Document.body G.document in 41 | setup_body_style body; 42 | El.append_children (Document.body G.document) [ui]; 43 | setup_theme (); 44 | setup ui 45 | 46 | let () = ignore (main ()) 47 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/.gitignore: -------------------------------------------------------------------------------- 1 | _b0 2 | _build 3 | tmp 4 | *.install -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/BRZO: -------------------------------------------------------------------------------- 1 | (srcs-x pkg tmp) -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/CHANGES.md: -------------------------------------------------------------------------------- 1 | 2 | - `Cmarkit_latex`. Add option `?first_heading_level` to the renderer 3 | to set the LaTeX heading level to use for the first CommonMark 4 | heading level. A corresponding option `--first-heading-level` is 5 | added to `cmarkit latex`. Thanks to Léo Andrès for the patch (#16). 6 | 7 | - `Cmarkit.Mapper`, do not drop empty table cells. 8 | Thanks to Hannes Mehnert for the report (#14). 9 | 10 | - Fix crash (out of bounds exception) when lists are terminated by 11 | the end of file. Thanks to Ty Overby for the report (#18). 12 | 13 | - Fix invalid markup generated for cancelled task items. 14 | Thanks to Sebastien Mondet for the report (#15). 15 | 16 | - Updated data for Unicode 16.0.0. 17 | 18 | v0.3.0 2023-12-12 La Forclaz (VS) 19 | --------------------------------- 20 | 21 | - Fix ordered item marker escaping. Thanks to Rafał Gwoździński for 22 | the report (#11). 23 | 24 | - Data updated for Unicode 15.1.0 (no changes except 25 | for the value of `Cmarkit.Doc.unicode_version`). 26 | 27 | - Fix table extension column parsing, toplevel text inlines were being 28 | dropped. Thanks to Javier Chávarri for the report (#10). 29 | 30 | - `List_item.make`, change default value of `after_marker` from 0 to 1. 31 | We don't want to generate invalid CommonMark by default. Thanks to 32 | Rafał Gwoździński for the report (#9). 33 | 34 | - Add option `-f/--full-featured`, to `cmarkit html`. A synonym for a 35 | bunch of existing options to generate a publishable document with extensions 36 | and math rendering without hassle. See `cmarkit html --help` for details. 37 | 38 | v0.2.0 2023-05-10 La Forclaz (VS) 39 | --------------------------------- 40 | 41 | - Fix bug in `Block_lines.list_of_string`. Thanks to Rafał Gwoździński 42 | for the report and the fix (#7, #8). 43 | - `Cmarkit.Mapper`. Fix non-sensical default map for `Image` nodes: do 44 | not delete `Image` nodes whose alt text maps to `None`, replace the 45 | alt text by `Inline.empty`. Thanks to Nicolás Ojeda Bär for the 46 | report and the fix (#6). 47 | 48 | v0.1.0 2023-04-06 La Forclaz (VS) 49 | --------------------------------- 50 | 51 | First release. 52 | 53 | Supported by a grant from the OCaml Software Foundation. 54 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/DEVEL.md: -------------------------------------------------------------------------------- 1 | 2 | A few development tips. 3 | 4 | # Benchmark parse to HTML rendering 5 | 6 | ```sh 7 | time cmark --unsafe /file/to/md > /dev/null 8 | time $(b0 --path -- bench --unsafe /file/to/md) > /dev/null 9 | ``` 10 | 11 | # Expectation tests 12 | 13 | To add a new test, add an `.md` test in `test/expect`, run the tests 14 | and add the new generated files to the repo. 15 | 16 | ```sh 17 | b0 -- expect 18 | b0 -- expect --help 19 | ``` 20 | 21 | # Specification tests 22 | 23 | To run the specification test use: 24 | 25 | ```sh 26 | b0 -- test_spec # All examples 27 | b0 -- test_spec 1-10 34 56 # Specific examples 28 | ``` 29 | 30 | To test the CommonMark renderer on the specification tests use: 31 | 32 | ```sh 33 | b0 -- trip_spec # All examples 34 | b0 -- trip_spec 1-10 32 56 # Specific examples 35 | b0 -- trip_spec --show-diff # Show correct render diffs (if applicable) 36 | ``` 37 | 38 | Given a source a *correct* render yields the same HTML and it *round 39 | trips* if the source is byte-for-byte equivalent. Using `--show-diff` 40 | on an example that does not round trip shows the reason and the diff. 41 | 42 | The tests are also run on parses without layout preservation to check 43 | they are correct. 44 | 45 | # Pathological tests 46 | 47 | The [pathological tests][p] of `cmark` have been ported to 48 | [`test/pathological.ml`]. You can run them on any executable that 49 | reads CommonMark on standard input and writes HTML rendering on 50 | standard output. 51 | 52 | ```sh 53 | b0 -- pathological -- cmark 54 | b0 -u cmarkit -- pathological -- $(b0 --path -- cmarkit html) 55 | b0 -- pathological --help 56 | b0 -- pathological -d /tmp/ # Dump tests and expectations 57 | ``` 58 | 59 | [p]: https://github.com/commonmark/cmark/blob/master/test/pathological_tests.py 60 | [`test/pathological.ml`]: src/cmarkit.ml 61 | 62 | # Specification update 63 | 64 | If there's a specification version update. The `commonmark_version` 65 | variable must be updated in both in [`B0.ml`] and in [`src/cmarkit.ml`]. 66 | A `s/old_version/new_version/g` should be performed on `.mli` files. 67 | 68 | The repository has the CommonMark specification test file in 69 | [`test/spec.json`]. 70 | 71 | To update it invoke: 72 | 73 | ```sh 74 | b0 -- update_spec_tests 75 | ``` 76 | 77 | [`test/spec.json`]: test/spec.json 78 | [`src/cmarkit.ml`]: src/cmarkit.ml 79 | [`B0.ml`]: B0.ml 80 | 81 | # Unicode data update 82 | 83 | The library contains Unicode data generated in the file 84 | [`src/cmarkit_data_uchar.ml`] 85 | 86 | To update it invoke: 87 | 88 | ```sh 89 | opem install uucp 90 | b0 -- update_unicode_data 91 | ``` 92 | 93 | [`src/cmarkit_data_uchar.ml`]: src/cmarkit_data_uchar.ml 94 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020 The cmarkit programmers 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/README.md: -------------------------------------------------------------------------------- 1 | cmarkit — CommonMark parser and renderer for OCaml 2 | ================================================== 3 | %%VERSION%% 4 | 5 | Cmarkit parses the [CommonMark specification]. It provides: 6 | 7 | - A CommonMark parser for UTF-8 encoded documents. Link label resolution 8 | can be customized and a non-strict parsing mode can be activated to add: 9 | strikethrough, LaTeX math, footnotes, task items and tables. 10 | 11 | - An extensible abstract syntax tree for CommonMark documents with 12 | source location tracking and best-effort source layout preservation. 13 | 14 | - Abstract syntax tree mapper and folder abstractions for quick and 15 | concise tree transformations. 16 | 17 | - Extensible renderers for HTML, LaTeX and CommonMark with source 18 | layout preservation. 19 | 20 | Cmarkit is distributed under the ISC license. It has no dependencies. 21 | 22 | [CommonMark specification]: https://spec.commonmark.org/ 23 | 24 | Homepage: 25 | 26 | ## Installation 27 | 28 | cmarkit can be installed with `opam`: 29 | 30 | opam install cmarkit 31 | opam install cmarkit cmdliner # For the cmarkit tool 32 | 33 | If you don't use `opam` consult the [`opam`](opam) file for build 34 | instructions. 35 | 36 | ## Documentation 37 | 38 | The documentation can be consulted [online] or via `odig doc cmarkit`. 39 | 40 | Questions are welcome but better asked on the [OCaml forum] than on 41 | the issue tracker. 42 | 43 | [online]: https://erratique.ch/software/cmarkit/doc 44 | [OCaml forum]: https://discuss.ocaml.org/ 45 | 46 | ## Sample programs 47 | 48 | The [`cmarkit`] tool parses and renders CommonMark files in various 49 | ways. 50 | 51 | See also [`bench.ml`] and the [doc examples]. 52 | 53 | [`cmarkit`]: test/cmarkit_tool.ml 54 | [`bench.ml`]: test/bench.ml 55 | [doc examples]: test/examples.ml 56 | 57 | ## Acknowledgements 58 | 59 | A grant from the [OCaml Software Foundation] helped to bring the first 60 | public release of `cmarkit`. 61 | 62 | The `cmarkit` implementation benefited from the work of John 63 | MacFarlane ([spec][CommonMark specification], [`cmark`]) and Martin 64 | Mitáš ([`md4c`]). 65 | 66 | [`cmark`]: https://github.com/commonmark/cmark 67 | [`md4c`]: https://github.com/mity/md4c 68 | [OCaml Software Foundation]: http://ocaml-sf.org/ 69 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | <_b0> : -traverse 3 | : include 4 | : package(b0.std b0.kit) 5 | : package(b0.std b0.kit) 6 | : package(cmdliner) -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/cmarkit.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "cmarkit" 3 | synopsis: "CommonMark parser and renderer for OCaml" 4 | description: """\ 5 | Cmarkit parses the [CommonMark specification]. It provides: 6 | 7 | - A CommonMark parser for UTF-8 encoded documents. Link label resolution 8 | can be customized and a non-strict parsing mode can be activated to add: 9 | strikethrough, LaTeX math, footnotes, task items and tables. 10 | 11 | - An extensible abstract syntax tree for CommonMark documents with 12 | source location tracking and best-effort source layout preservation. 13 | 14 | - Abstract syntax tree mapper and folder abstractions for quick and 15 | concise tree transformations. 16 | 17 | - Extensible renderers for HTML, LaTeX and CommonMark with source 18 | layout preservation. 19 | 20 | Cmarkit is distributed under the ISC license. It has no dependencies. 21 | 22 | [CommonMark specification]: https://spec.commonmark.org/ 23 | 24 | Homepage: """ 25 | maintainer: "Daniel Bünzli " 26 | authors: "The cmarkit programmers" 27 | license: "ISC" 28 | tags: ["codec" "commonmark" "markdown" "org:erratique"] 29 | homepage: "https://erratique.ch/software/cmarkit" 30 | doc: "https://erratique.ch/software/cmarkit/doc" 31 | bug-reports: "https://github.com/dbuenzli/cmarkit/issues" 32 | depends: [ 33 | "ocaml" {>= "4.14.0"} 34 | "dune" 35 | ] 36 | depopts: ["cmdliner"] 37 | conflicts: [ 38 | "cmdliner" {< "1.1.0"} 39 | ] 40 | build: [ "dune" "build" "-p" name "-j" jobs ] 41 | dev-repo: "git+https://erratique.ch/repos/cmarkit.git" 42 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Cmarkit {%html: %%VERSION%%%}} 2 | 3 | Cmarkit parses the {{:https://spec.commonmark.org/current}CommonMark 4 | specification}. It provides: 5 | 6 | - A CommonMark parser for UTF-8 encoded documents. Link label resolution 7 | can be {{!Cmarkit.Label.resolvers}customized} and a non-strict 8 | parsing mode can be activated to {{!Cmarkit.extensions}add}: strikethrough, 9 | L{^A}T{_E}X math, footnotes, task items and tables. 10 | - An extensible abstract syntax tree for CommonMark documents with source 11 | location tracking and best effort {{!Cmarkit_commonmark.layout}source layout 12 | preservation}. 13 | - Abstract syntax tree {{!Cmarkit.Mapper}mapper} and {{!Cmarkit.Folder}folder} 14 | abstractions for quick and concise tree transformations. 15 | - Extensible renderers for {{!Cmarkit_html}HTML}, 16 | {{!Cmarkit_latex}L{^A}T{_E}X} and {{!Cmarkit_commonmark}CommonMark} with 17 | source layout preservation. 18 | 19 | See the {{!quick}quick start}. 20 | 21 | {1:cmarkit_library Library [cmarkit]} 22 | 23 | {!modules: 24 | Cmarkit 25 | Cmarkit_renderer 26 | Cmarkit_commonmark 27 | Cmarkit_html 28 | Cmarkit_latex 29 | } 30 | 31 | {1:quick Quick start} 32 | 33 | The following functions render CommonMark snippets using the built-in 34 | renderers. The parsing bit via {!Cmarkit.Doc.of_string} is always the same 35 | except for CommonMark rendering where we make sure to keep the layout 36 | for {{!Cmarkit_commonmark.layout}source layout preservation}. 37 | 38 | If [strict] is [true] the CommonMark specification is strictly 39 | followed otherwise the built-in {{!Cmarkit.extensions}extensions} are 40 | enabled. 41 | 42 | {[ 43 | let cmark_to_html : strict:bool -> safe:bool -> string -> string = 44 | fun ~strict ~safe md -> 45 | let doc = Cmarkit.Doc.of_string ~strict md in 46 | Cmarkit_html.of_doc ~safe doc 47 | 48 | let cmark_to_latex : strict:bool -> string -> string = 49 | fun ~strict md -> 50 | let doc = Cmarkit.Doc.of_string ~strict md in 51 | Cmarkit_latex.of_doc doc 52 | 53 | let cmark_to_commonmark : strict:bool -> string -> string = 54 | fun ~strict md -> 55 | let doc = Cmarkit.Doc.of_string ~layout:true ~strict md in 56 | Cmarkit_commonmark.of_doc doc 57 | ]} 58 | 59 | If you want to: 60 | 61 | {ul 62 | {- Extend the abstract syntax tree or the renderers, see 63 | {{!Cmarkit_renderer.example}this example}.} 64 | {- Map parts of an abstract syntax, see {!Cmarkit.Mapper}.} 65 | {- Fold over parts of an abstract syntax, see {!Cmarkit.Folder}.} 66 | {- Interfere with link label definition and resolution, see 67 | {{!Cmarkit.Label}labels} and their 68 | {{!Cmarkit.Label.resolvers}resolvers}.}} 69 | 70 | Test -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/pkg/META: -------------------------------------------------------------------------------- 1 | description = "CommonMark parser and renderer for OCaml" 2 | version = "%%VERSION_NUM%%" 3 | requires = "" 4 | archive(byte) = "cmarkit.cma" 5 | archive(native) = "cmarkit.cmxa" 6 | plugin(byte) = "cmarkit.cma" 7 | plugin(native) = "cmarkit.cmxs" 8 | exists_if = "cmarkit.cma cmarkit.cmxa" 9 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "topkg" 4 | open Topkg 5 | 6 | let cmdliner = Conf.with_pkg "cmdliner" 7 | 8 | let () = 9 | Pkg.describe "cmarkit" @@ fun c -> 10 | let cmdliner = Conf.value c cmdliner in 11 | let api = ["Cmarkit"; "Cmarkit_renderer"; 12 | "Cmarkit_commonmark"; "Cmarkit_html"; "Cmarkit_latex"] 13 | in 14 | Ok [ Pkg.mllib ~api "src/cmarkit.mllib"; 15 | Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; 16 | Pkg.bin ~cond:cmdliner "tool/cmd_main" ~dst:"cmarkit" ] 17 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/src/cmarkit.mllib: -------------------------------------------------------------------------------- 1 | Cmarkit_data 2 | Cmarkit_data_uchar 3 | Cmarkit_data_html 4 | Cmarkit_base 5 | Cmarkit 6 | Cmarkit_renderer 7 | Cmarkit_commonmark 8 | Cmarkit_html 9 | Cmarkit_latex -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/src/cmarkit_data.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2021 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Unicode character data 7 | 8 | XXX. For now we kept that simple and use the Stdlib's Set and 9 | Maps. Bring in Uucp's tmapbool and tmap if that turns out to be too 10 | costly in space or time. *) 11 | 12 | module Uset = struct 13 | include Set.Make (Uchar) 14 | let of_array = 15 | let add acc u = add (Uchar.unsafe_of_int u) acc in 16 | Array.fold_left add empty 17 | end 18 | 19 | module Umap = struct 20 | include Map.Make (Uchar) 21 | let of_array = 22 | let add acc (u, f) = add (Uchar.unsafe_of_int u) f acc in 23 | Array.fold_left add empty 24 | end 25 | 26 | let whitespace_uset = Uset.of_array Cmarkit_data_uchar.whitespace 27 | let punctuation_uset = Uset.of_array Cmarkit_data_uchar.punctuation 28 | let case_fold_umap = Umap.of_array Cmarkit_data_uchar.case_fold 29 | 30 | let unicode_version = Cmarkit_data_uchar.unicode_version 31 | let is_unicode_whitespace u = Uset.mem u whitespace_uset 32 | let is_unicode_punctuation u = Uset.mem u punctuation_uset 33 | let unicode_case_fold u = Umap.find_opt u case_fold_umap 34 | 35 | (* HTML entity data. *) 36 | 37 | module String_map = Map.Make (String) 38 | 39 | let html_entity_smap = 40 | let add acc (entity, rep) = String_map.add entity rep acc in 41 | Array.fold_left add String_map.empty Cmarkit_data_html.entities 42 | 43 | let html_entity e = String_map.find_opt e html_entity_smap 44 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/src/cmarkit_data.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2021 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Data needed for CommonMark parsing. *) 7 | 8 | (** {1:unicode Unicode data} *) 9 | 10 | val unicode_version : string 11 | (** [unicode_version] is the supported Unicode version. *) 12 | 13 | val is_unicode_whitespace : Uchar.t -> bool 14 | (** [is_unicode_whitespace u] is [true] iff 15 | [u] is a CommonMark 16 | {{:https://spec.commonmark.org/current/#unicode-whitespace-character} 17 | Unicode whitespace character}. *) 18 | 19 | val is_unicode_punctuation : Uchar.t -> bool 20 | (** [is_unicode_punctuation u] is [true] iff 21 | [u] is a CommonMark 22 | {{:https://spec.commonmark.org/current/#unicode-punctuation-character} 23 | Unicode punctuation character}. *) 24 | 25 | val unicode_case_fold : Uchar.t -> string option 26 | (** [unicode_case_fold u] is the UTF-8 encoding of [u]'s Unicode 27 | {{:http://www.unicode.org/reports/tr44/#Case_Folding}case fold} or 28 | [None] if [u] case folds to itself. *) 29 | 30 | (** {1:html HTML data} *) 31 | 32 | val html_entity : string -> string option 33 | (** [html_entity e] is the UTF-8 data for of the HTML entity {e name} 34 | (without [&] and [;]) [e]. *) 35 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/src/cmarkit_renderer.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2021 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Renderers *) 7 | 8 | module Dict = Cmarkit_base.Dict 9 | 10 | type t = 11 | { init_context : context -> Cmarkit.Doc.t -> unit; 12 | inline : inline; 13 | block : block; 14 | doc : doc; } 15 | 16 | and context = 17 | { renderer : t; 18 | mutable state : Dict.t; 19 | b : Buffer.t; 20 | mutable doc : Cmarkit.Doc.t } 21 | 22 | and inline = context -> Cmarkit.Inline.t -> bool 23 | and block = context -> Cmarkit.Block.t -> bool 24 | and doc = context -> Cmarkit.Doc.t -> bool 25 | 26 | let nop _ _ = () 27 | let none _ _ = false 28 | 29 | let make 30 | ?(init_context = nop) ?(inline = none) ?(block = none) ?(doc = none) () 31 | = 32 | { init_context; inline; block; doc } 33 | 34 | let compose g f = 35 | let init_context c d = g.init_context c d; f.init_context c d in 36 | let block c b = f.block c b || g.block c b in 37 | let inline c i = f.inline c i || g.inline c i in 38 | let doc c d = f.doc c d || g.doc c d in 39 | { init_context; inline; block; doc } 40 | 41 | let init_context r = r.init_context 42 | let inline r = r.inline 43 | let block r = r.block 44 | let doc r = r.doc 45 | 46 | module Context = struct 47 | type t = context 48 | let make renderer b = 49 | { renderer; b; state = Dict.empty; doc = Cmarkit.Doc.empty } 50 | 51 | let buffer c = c.b 52 | let renderer c = c.renderer 53 | let get_doc (c : context) = c.doc 54 | let get_defs (c : context) = Cmarkit.Doc.defs c.doc 55 | 56 | module State = struct 57 | type 'a t = 'a Dict.key 58 | let make = Dict.key 59 | let find c st = Dict.find st c.state 60 | let get c st = Option.get (Dict.find st c.state) 61 | let set c st = function 62 | | None -> c.state <- Dict.remove st c.state 63 | | Some s -> c.state <- Dict.add st s c.state 64 | end 65 | 66 | let init c d = c.renderer.init_context c d 67 | 68 | let invalid_inline _ = invalid_arg "Unknown Cmarkit.Inline.t case" 69 | let invalid_block _ = invalid_arg "Unknown Cmarkit.Block.t case" 70 | let unhandled_doc _ = invalid_arg "Unhandled Cmarkit.Doc.t" 71 | 72 | let byte r c = Buffer.add_char r.b c 73 | let utf_8_uchar r u = Buffer.add_utf_8_uchar r.b u 74 | let string c s = Buffer.add_string c.b s 75 | let inline c i = ignore (c.renderer.inline c i || invalid_inline i) 76 | let block c b = ignore (c.renderer.block c b || invalid_block b) 77 | let doc (c : context) d = 78 | c.doc <- d; init c d; 79 | ignore (c.renderer.doc c d || unhandled_doc d); 80 | c.doc <- Cmarkit.Doc.empty 81 | end 82 | 83 | let doc_to_string r d = 84 | let b = Buffer.create 1024 in 85 | let c = Context.make r b in 86 | Context.doc c d; Buffer.contents b 87 | 88 | let buffer_add_doc r b d = Context.doc (Context.make r b) d 89 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/src/dune: -------------------------------------------------------------------------------- 1 | (library (name cmarkit) (package slipshow) (wrapped false) (flags -w -26-27)) 2 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/bench.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Benchmarker for Cmarkit. Just renders to HTML the way `cmark` does. *) 7 | 8 | let ( let* ) = Result.bind 9 | 10 | let read_file file = 11 | try 12 | let ic = if file = "-" then stdin else open_in_bin file in 13 | let finally () = if file = "-" then () else close_in_noerr ic in 14 | Fun.protect ~finally @@ fun () -> Ok (In_channel.input_all ic) 15 | with 16 | | Sys_error err -> Error err 17 | 18 | let to_html file exts locs layout unsafe = 19 | let strict = not exts and safe = not unsafe in 20 | let* content = read_file file in 21 | let doc = Cmarkit.Doc.of_string ~layout ~locs ~file ~strict content in 22 | let r = Cmarkit_html.xhtml_renderer ~safe () in 23 | let html = Cmarkit_renderer.doc_to_string r doc in 24 | Ok (print_string html) 25 | 26 | let main () = 27 | let strf = Printf.sprintf in 28 | let usage = "Usage: bench [OPTION]… [FILE.md]" in 29 | let layout = ref false in 30 | let locs = ref false in 31 | let unsafe = ref false in 32 | let exts = ref false in 33 | let file = ref None in 34 | let args = 35 | [ "--layout", Arg.Set layout, "Keep layout information."; 36 | "--locs", Arg.Set locs, "Keep locations."; 37 | "--exts", Arg.Set exts, "Activate supported extensions"; 38 | "--unsafe", Arg.Set unsafe, "Keep HTML blocks and raw HTML"; ] 39 | in 40 | let pos s = match !file with 41 | | Some _ -> raise (Arg.Bad (strf "Don't know what to do with %S" s)) 42 | | None -> file := Some s 43 | in 44 | Arg.parse args pos usage; 45 | let file = Option.value ~default:"-" !file in 46 | match to_html file !exts !locs !layout !unsafe with 47 | | Error e -> Printf.eprintf "bench: %s\n%!" e; 1 48 | | Ok () -> 0 49 | 50 | let () = if !Sys.interactive then () else exit (main ()) 51 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bug-18.latex: -------------------------------------------------------------------------------- 1 | \section{Issue \#18} 2 | 3 | When a list marker is followed by end of file, we crash. 4 | 5 | \begin{itemize} 6 | \item{} 7 | Item 1 8 | \item{} 9 | Item 2 10 | \item{}\end{itemize} 11 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bug-18.locs: -------------------------------------------------------------------------------- 1 | Blocks: 2 | File "bug-18.md", lines 1-7, characters 0-2 3 | Heading, level 1: 4 | File "bug-18.md", line 1, characters 0-11 5 | Text: 6 | File "bug-18.md", line 1, characters 2-11 7 | Blank line: 8 | File "bug-18.md", line 2 9 | Paragraph: 10 | File "bug-18.md", line 3, characters 0-56 11 | Text: 12 | File "bug-18.md", line 3, characters 0-56 13 | Blank line: 14 | File "bug-18.md", line 4 15 | List (tight:true): 16 | File "bug-18.md", lines 5-7, characters 1-2 17 | List item: 18 | File "bug-18.md", line 5, characters 1-9 19 | List marker: 20 | File "bug-18.md", line 5, characters 1-2 21 | Paragraph: 22 | File "bug-18.md", line 5, characters 3-9 23 | Text: 24 | File "bug-18.md", line 5, characters 3-9 25 | List item: 26 | File "bug-18.md", line 6, characters 1-9 27 | List marker: 28 | File "bug-18.md", line 6, characters 1-2 29 | Paragraph: 30 | File "bug-18.md", line 6, characters 3-9 31 | Text: 32 | File "bug-18.md", line 6, characters 3-9 33 | List item: 34 | File "bug-18.md", line 7, characters 1-2 35 | List marker: 36 | File "bug-18.md", line 7, characters 1-2 37 | Blank line: 38 | File "bug-18.md", line 7, characters 2-2 -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bug-18.md: -------------------------------------------------------------------------------- 1 | # Issue #18 2 | 3 | When a list marker is followed by end of file, we crash. 4 | 5 | - Item 1 6 | - Item 2 7 | - -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bug-18.nolayout.locs: -------------------------------------------------------------------------------- 1 | Blocks: 2 | File "bug-18.md", lines 1-7, characters 0-2 3 | Heading, level 1: 4 | File "bug-18.md", line 1, characters 0-11 5 | Text: 6 | File "bug-18.md", line 1, characters 2-11 7 | Blank line: 8 | File "bug-18.md", line 2 9 | Paragraph: 10 | File "bug-18.md", line 3, characters 0-56 11 | Text: 12 | File "bug-18.md", line 3, characters 0-56 13 | Blank line: 14 | File "bug-18.md", line 4 15 | List (tight:true): 16 | File "bug-18.md", lines 5-7, characters 1-2 17 | List item: 18 | File "bug-18.md", line 5, characters 1-9 19 | List marker: 20 | File "bug-18.md", line 5, characters 1-2 21 | Paragraph: 22 | File "bug-18.md", line 5, characters 3-9 23 | Text: 24 | File "bug-18.md", line 5, characters 3-9 25 | List item: 26 | File "bug-18.md", line 6, characters 1-9 27 | List marker: 28 | File "bug-18.md", line 6, characters 1-2 29 | Paragraph: 30 | File "bug-18.md", line 6, characters 3-9 31 | Text: 32 | File "bug-18.md", line 6, characters 3-9 33 | List item: 34 | File "bug-18.md", line 7, characters 1-2 35 | List marker: 36 | File "bug-18.md", line 7, characters 1-2 37 | Blank line: 38 | File "bug-18.md", line 7, characters 2-2 -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bug-18.strip-attributes.md: -------------------------------------------------------------------------------- 1 | # Issue \#18 2 | 3 | When a list marker is followed by end of file, we crash. 4 | 5 | - Item 1 6 | - Item 2 7 | - -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bug-18.trip.md: -------------------------------------------------------------------------------- 1 | # Issue \#18 2 | 3 | When a list marker is followed by end of file, we crash. 4 | 5 | - Item 1 6 | - Item 2 7 | - -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.exts.latex: -------------------------------------------------------------------------------- 1 | \section{Bugs} 2 | 3 | Add a section for the bug and the CommonMark that triggers it as 4 | follows: 5 | 6 | \begin{verbatim} 7 | # Bug #NUM 8 | 9 | The triggering CommonMark 10 | \end{verbatim} 11 | 12 | \section{Bug \#10} 13 | 14 | In cells toplevel text nodes not at the beginning or end of the cell 15 | get dropped. 16 | 17 | \bigskip 18 | \begin{tabular}{l} 19 | {\bfseries{}Foo} 20 | \\ 21 | \hline 22 | {\texttt{a} or \texttt{b}} 23 | \\ 24 | {before \texttt{a} or \texttt{b} after} 25 | \\ 26 | {before \texttt{a} or \texttt{b}after} 27 | \\ 28 | {before\texttt{a}or\texttt{b}after} 29 | \\ 30 | {\emph{a}\texttt{a}} 31 | \\ 32 | {% Raw CommonMark HTML omitted 33 | foo% Raw CommonMark HTML omitted 34 | } 35 | \\ 36 | \hline 37 | \end{tabular} 38 | \bigskip 39 | 40 | \section{Bug \#15} 41 | 42 | Invalid markup generated for cancelled task. 43 | 44 | \begin{itemize} 45 | \item{} \lbrack ~\rbrack \enspace 46 | This has been cancelled 47 | \end{itemize} 48 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.exts.md: -------------------------------------------------------------------------------- 1 | Bugs 2 | ==== 3 | 4 | Add a section for the bug and the CommonMark that triggers it as 5 | follows: 6 | 7 | ``` 8 | # Bug #NUM 9 | 10 | The triggering CommonMark 11 | ``` 12 | 13 | # Bug #10 14 | 15 | In cells toplevel text nodes not at the beginning or end of the cell 16 | get dropped. 17 | 18 | | Foo | 19 | |-------------------------| 20 | | `a` or `b` | 21 | | before `a` or `b` after | 22 | | before `a` or `b`after | 23 | | before`a`or`b`after | 24 | | *a*`a` | 25 | |

foo

| 26 | 27 | # Bug #15 28 | 29 | Invalid markup generated for cancelled task. 30 | 31 | * [~] This has been cancelled 32 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.exts.strip-attributes.md: -------------------------------------------------------------------------------- 1 | Bugs 2 | ==== 3 | 4 | Add a section for the bug and the CommonMark that triggers it as 5 | follows: 6 | 7 | ``` 8 | # Bug #NUM 9 | 10 | The triggering CommonMark 11 | ``` 12 | 13 | # Bug \#10 14 | 15 | In cells toplevel text nodes not at the beginning or end of the cell 16 | get dropped. 17 | 18 | | Foo | 19 | |-------------------------| 20 | | `a` or `b` | 21 | | before `a` or `b` after | 22 | | before `a` or `b`after | 23 | | before`a`or`b`after | 24 | | *a*`a` | 25 | |

foo

| 26 | 27 | # Bug \#15 28 | 29 | Invalid markup generated for cancelled task. 30 | 31 | * [~] This has been cancelled 32 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.exts.trip.md: -------------------------------------------------------------------------------- 1 | Bugs 2 | ==== 3 | 4 | Add a section for the bug and the CommonMark that triggers it as 5 | follows: 6 | 7 | ``` 8 | # Bug #NUM 9 | 10 | The triggering CommonMark 11 | ``` 12 | 13 | # Bug \#10 14 | 15 | In cells toplevel text nodes not at the beginning or end of the cell 16 | get dropped. 17 | 18 | | Foo | 19 | |-------------------------| 20 | | `a` or `b` | 21 | | before `a` or `b` after | 22 | | before `a` or `b`after | 23 | | before`a`or`b`after | 24 | | *a*`a` | 25 | |

foo

| 26 | 27 | # Bug \#15 28 | 29 | Invalid markup generated for cancelled task. 30 | 31 | * [~] This has been cancelled 32 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.latex: -------------------------------------------------------------------------------- 1 | \section{Bugs} 2 | 3 | Add a section for the bug and the CommonMark that triggers it as 4 | follows: 5 | 6 | \begin{verbatim} 7 | # Issue #NUM 8 | 9 | The triggering CommonMark 10 | \end{verbatim} 11 | 12 | \section{Issue \#11} 13 | 14 | Escape ordered item markers at the beginning of paragraphs correctly. 15 | These should be paragraphs when rendered to markdown not list items. 16 | 17 | 1. 18 | 19 | 2. 20 | 21 | 23. 22 | 23 | 24) 24 | 25 | 1234567890. This is not a list marker no need to escape it. 26 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.md: -------------------------------------------------------------------------------- 1 | Bugs 2 | ==== 3 | 4 | Add a section for the bug and the CommonMark that triggers it as 5 | follows: 6 | 7 | ``` 8 | # Issue #NUM 9 | 10 | The triggering CommonMark 11 | ``` 12 | 13 | # Issue #11 14 | 15 | Escape ordered item markers at the beginning of paragraphs correctly. 16 | These should be paragraphs when rendered to markdown not list items. 17 | 18 | 1\. 19 | 20 | 2\. 21 | 22 | 23\. 23 | 24 | 25 | 24\) 26 | 27 | 1234567890. This is not a list marker no need to escape it. 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.strip-attributes.md: -------------------------------------------------------------------------------- 1 | Bugs 2 | ==== 3 | 4 | Add a section for the bug and the CommonMark that triggers it as 5 | follows: 6 | 7 | ``` 8 | # Issue #NUM 9 | 10 | The triggering CommonMark 11 | ``` 12 | 13 | # Issue \#11 14 | 15 | Escape ordered item markers at the beginning of paragraphs correctly. 16 | These should be paragraphs when rendered to markdown not list items. 17 | 18 | 1\. 19 | 20 | 2\. 21 | 22 | 23\. 23 | 24 | 25 | 24\) 26 | 27 | 1234567890. This is not a list marker no need to escape it. 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/bugs.trip.md: -------------------------------------------------------------------------------- 1 | Bugs 2 | ==== 3 | 4 | Add a section for the bug and the CommonMark that triggers it as 5 | follows: 6 | 7 | ``` 8 | # Issue #NUM 9 | 10 | The triggering CommonMark 11 | ``` 12 | 13 | # Issue \#11 14 | 15 | Escape ordered item markers at the beginning of paragraphs correctly. 16 | These should be paragraphs when rendered to markdown not list items. 17 | 18 | 1\. 19 | 20 | 2\. 21 | 22 | 23\. 23 | 24 | 25 | 24\) 26 | 27 | 1234567890. This is not a list marker no need to escape it. 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/spec.trip: -------------------------------------------------------------------------------- 1 | [ OK ] 274 out of 652 are correct. 2 | [TRIP] 378 out of 652 round trip. 3 | [ OK ] All 652 on parse without layout. 4 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/expect/test.expect: -------------------------------------------------------------------------------- 1 | Expectation for mapper table bug #14: 2 | 3 | | a | b | c | 4 | |---|---|---| 5 | | a | b | c | 6 | | | b | c | 7 | | | | c | 8 | 9 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/spec.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Specification test parser *) 7 | 8 | val version : string 9 | 10 | type test = 11 | { markdown : string; 12 | html : string; 13 | example : int; 14 | start_line : int; 15 | end_line : int; 16 | section : string } 17 | 18 | val parse_tests : string -> (test list, string) result 19 | 20 | val diff : spec:string -> string -> string 21 | 22 | val ok : string B0_std.Fmt.t 23 | val fail : string B0_std.Fmt.t 24 | val cli : exe:string -> unit -> bool * string * int list 25 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let test_mapper_table_bug_14 () = 7 | let table = 8 | "| a | b | c |\n\ 9 | |---|---|---|\n\ 10 | | a | b | c |\n\ 11 | | | b | c |\n\ 12 | | | | c |\n" 13 | in 14 | let doc = Cmarkit.Doc.of_string ~layout:true ~strict:false table in 15 | let mdoc = Cmarkit.Mapper.map_doc (Cmarkit.Mapper.make ()) doc in 16 | print_endline "Expectation for mapper table bug #14:\n"; 17 | print_endline (Cmarkit_commonmark.of_doc ~include_attributes:false mdoc); 18 | () 19 | 20 | let main () = 21 | test_mapper_table_bug_14 (); 22 | () 23 | 24 | let () = if !Sys.interactive then () else main () 25 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/test/test_spec.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2021 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | open Result.Syntax 8 | open B0_json 9 | 10 | let status ~pass ex_num = 11 | Log.stdout @@ fun m -> 12 | let pp_ex ppf n = 13 | Fmt.pf ppf "https://spec.commonmark.org/%s/#example-%d" Spec.version n 14 | in 15 | let pp, st = if pass then Spec.ok, "PASS" else Spec.fail, "FAIL" in 16 | m "[%a] %a" pp st Fmt.(code' pp_ex) ex_num 17 | 18 | let renderer = 19 | (* Specification tests render empty elements as XHTML. *) 20 | Cmarkit_html.xhtml_renderer ~safe:false () 21 | 22 | let test (t : Spec.test) = 23 | let doc = Cmarkit.Doc.of_string t.markdown in 24 | let html = Cmarkit_renderer.doc_to_string renderer doc in 25 | if String.equal html t.html then Ok ((* status ~pass:true t.example *)) else 26 | let diff = String.concat "\n" [t.markdown; Spec.diff ~spec:t.html html] in 27 | status ~pass:false t.example; 28 | Log.stdout (fun m -> m "%s" diff); 29 | Error () 30 | 31 | let run_tests test_file examples (* empty is all *) = 32 | let log_ok n = Log.stdout @@ fun m -> 33 | m "[ %a ] All %d tests succeeded." Spec.ok "OK" n 34 | in 35 | let log_fail n f = Log.stdout @@ fun m -> 36 | m "[%a] %d out of %d tests failed." Spec.fail "FAIL" f n 37 | in 38 | Log.if_error ~use:1 @@ 39 | let* tests = Spec.parse_tests test_file in 40 | let select (t : Spec.test) = examples = [] || List.mem t.example examples in 41 | let do_test (n, fail as acc) t = 42 | if not (select t) then acc else 43 | match test t with 44 | | Ok () -> (n + 1, fail) 45 | | Error () -> (n + 1, fail + 1) 46 | in 47 | let n, fail = List.fold_left do_test (0, 0) tests in 48 | if fail = 0 then (log_ok n; Ok 0) else (log_fail n fail; Ok 1) 49 | 50 | let main () = 51 | let _, file, examples = Spec.cli ~exe:"test_spec" () in 52 | run_tests file examples 53 | 54 | let () = if !Sys.interactive then () else exit (main ()) 55 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/cmd_commonmark.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | val v : Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t 7 | (** [v] is the command line for [commonmark]. *) 8 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/cmd_html.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | val v : Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t 7 | (** [v] is the command line for [html]. *) 8 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/cmd_latex.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | val v : Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t 7 | (** [v] is the command line for [latex]. *) 8 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/cmd_locs.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | val v : Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t 7 | (** [v] is the command line for [locs]. *) 8 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/cmd_main.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Std 7 | open Cmdliner 8 | 9 | let cmds = [ Cmd_commonmark.v; Cmd_html.v; Cmd_latex.v; Cmd_locs.v; ] 10 | 11 | let cmarkit = 12 | let doc = "Process CommonMark files" in 13 | let exits = Exit.exits_with_err_diff in 14 | let man = [ 15 | `S Manpage.s_description; 16 | `P "$(mname) processes CommonMark files"; 17 | `Blocks Cli.common_man; ] 18 | in 19 | Cmd.group (Cmd.info "cmarkit" ~version:"%%VERSION%%" ~doc ~exits ~man) @@ 20 | cmds 21 | 22 | let main () = exit (Cmd.eval' cmarkit) 23 | let () = if !Sys.interactive then () else main () 24 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/cmd_main.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/cmarkit/tool/std.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2023 The cmarkit programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | type fpath = string 7 | 8 | module Result : sig 9 | include module type of Result 10 | val to_failure : ('a, string) result -> 'a 11 | 12 | module Syntax : sig 13 | val (let*) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result 14 | end 15 | end 16 | 17 | module Log : sig 18 | val err : ('a, Format.formatter, unit, unit) format4 -> 'a 19 | val warn : ('a, Format.formatter, unit, unit) format4 -> 'a 20 | val on_error : use:'a -> ('b, string) result -> ('b -> 'a) -> 'a 21 | end 22 | 23 | module Label_resolver : sig 24 | val v : quiet:bool -> Cmarkit.Label.resolver 25 | end 26 | 27 | module Os : sig 28 | val read_file : fpath -> (string, string) result 29 | val write_file : fpath -> string -> (unit, string) result 30 | val with_tmp_dir : (fpath -> 'a) -> ('a, string) result 31 | val with_cwd : fpath -> (unit -> 'a) -> ('a, string) result 32 | end 33 | 34 | module Exit : sig 35 | type code = Cmdliner.Cmd.Exit.code 36 | val err_file : code 37 | val err_diff : code 38 | val exits : Cmdliner.Cmd.Exit.info list 39 | val exits_with_err_diff : Cmdliner.Cmd.Exit.info list 40 | end 41 | 42 | val process_files : (file:fpath -> string -> 'a) -> string list -> Exit.code 43 | 44 | module Cli : sig 45 | open Cmdliner 46 | 47 | val accumulate_defs : bool Term.t 48 | val backend_blocks : doc:string -> bool Term.t 49 | val docu : bool Term.t 50 | val files : string list Term.t 51 | val heading_auto_ids : bool Term.t 52 | val lang : string Term.t 53 | val no_layout : bool Term.t 54 | val quiet : bool Term.t 55 | val safe : bool Term.t 56 | val strict : bool Term.t 57 | val title : string option Term.t 58 | 59 | val common_man : Manpage.block list 60 | end 61 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Main workflow 2 | 3 | on: 4 | - pull_request 5 | - push 6 | 7 | jobs: 8 | build: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - macos-latest 14 | ocaml-version: 15 | - 4.12.0 16 | - 4.11.1 17 | - 4.10.2 18 | - 4.09.1 19 | - 4.08.1 20 | 21 | runs-on: ${{ matrix.os }} 22 | 23 | steps: 24 | - name: Checkout code 25 | uses: actions/checkout@v2 26 | - name: Use OCaml ${{ matrix.ocaml-version }} 27 | uses: avsm/setup-ocaml@v2 28 | with: 29 | ocaml-compiler: ${{ matrix.ocaml-version }} 30 | - run: opam pin add . --no-action 31 | - run: opam install . --deps-only --with-doc --with-test 32 | - run: opam exec -- dune build 33 | - run: opam exec -- dune runtest 34 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | tmp 3 | *~ 4 | \.\#* 5 | \#*# 6 | *.install 7 | *.native 8 | *.byte 9 | pkg/META 10 | test/_tags 11 | .merlin 12 | _opam 13 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.18.0 2 | break-infix = fit-or-vertical 3 | parse-docstrings = true 4 | indicate-multiline-delimiters = no 5 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/CHANGES.md: -------------------------------------------------------------------------------- 1 | ### Pending 2 | 3 | - Use _WIN32 and MAX_PATH on Windows to support MSVC (#34, @jonahbeckford) 4 | 5 | ### 0.5.0 (2020-04-30) 6 | 7 | - Switch to GitHub Actions from Travis (#31, @avsm) 8 | - Initialise backends only when needed via a 9 | lazy watcher interface (#31, @samoht @avsm) 10 | - Use fsevents and cf-lwt packages (#31, @avsm) 11 | - Use ocamlformat.0.18.0 (#31, @avsm) 12 | 13 | ### 0.4.1 (2019-07-02) 14 | 15 | - Clearer name for hook logger (@talex5, #21) 16 | - Fix race when scanning directories (@talex5, #21) 17 | - Make listen loop tail-recursive (@talex5, #21) 18 | 19 | ### 0.4.0 (2018-10-08) 20 | 21 | - use dune (#13, @mc10) 22 | - rename `unix_realpath` function name to avoid name clashes (#17, @samoht) 23 | 24 | ### 0.3.0 (2017-06-21) 25 | 26 | - Use jbuilder (#11, @samoht) 27 | 28 | ### 0.2.0 (2016-11-14) 29 | 30 | - Allow to watch non-existing directories (#8, @samoht) 31 | - Expose `Irmin_watches.stats` to get stats about the numbers 32 | of active watchdogs, and callback dispatchers (#7, @samoht) 33 | - When using fsevents/inotify do not scan the whole tree everytime 34 | (#6, @samoht) 35 | - Use realpath(3) on Linux and GetFullPathName on Windows to 36 | normalise the path to watch (#6, @samoht) 37 | - inotify: close the inotify file descriptor when stopping the 38 | watch (#6. @samoht) 39 | - inotify: fix the path of watched events (inotify uses relative 40 | patch, unless fsevents which uses absolute paths) (#6, @samoht) 41 | - fix detection of removed files (#6, @samoht) 42 | 43 | ### 0.1.4 (2016-08-16) 44 | 45 | - Use osx-fsevents > 0.2.0 to avoid an fd leak when starting/stoping 46 | the main watch scheduler. 47 | 48 | ### 0.1.3 (2016-08-15) 49 | 50 | - Fix `uname` runtime checks on Windows 51 | 52 | ### 0.1.2 (2016-08-10) 53 | 54 | - Fix link issue when no inotify/fsevents backends are available 55 | - Use topkg 0.7.8 56 | 57 | ### 0.1.1 (2016-08-09) 58 | 59 | - Fix link issue with the inotify backend 60 | 61 | ### 0.1.0 (2016-08-09) 62 | 63 | - Initial release 64 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Thomas Gazagnaire 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all test clean 2 | 3 | all: 4 | dune build 5 | 6 | test: 7 | dune runtest 8 | 9 | clean: 10 | dune clean 11 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/README.md: -------------------------------------------------------------------------------- 1 | ## irmin-watcher — Portable Irmin watch backends using FSevents or Inotify 2 | 3 | %%VERSION%% 4 | 5 | irmin-watcher implements [Irmin's watch hooks][watch] for various OS, 6 | using FSevents in OSX and Inotify on Linux. 7 | 8 | irmin-watcher is distributed under the ISC license. 9 | 10 | [watch]: https://mirage.github.io/irmin/irmin/Irmin/Private/Watch/index.html 11 | 12 | ## Installation 13 | 14 | irmin-watcher can be installed with `opam`: 15 | 16 | opam install irmin-watcher 17 | 18 | If you don't use `opam` consult the [`opam`](opam) file for build 19 | instructions. 20 | 21 | ## Documentation 22 | 23 | The documentation and API reference is automatically generated by 24 | `ocamldoc` from the interfaces. It can be consulted [online][doc] 25 | and there is a generated version in the `doc` directory of the 26 | distribution. 27 | 28 | [doc]: https://mirage.github.io/irmin-watcher/ 29 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/appveyor.yml: -------------------------------------------------------------------------------- 1 | platform: 2 | - x86 3 | 4 | environment: 5 | CYG_ROOT: "C:\\cygwin" 6 | CYG_BASH: "%CYG_ROOT%\\bin\\bash -lc" 7 | 8 | install: 9 | - appveyor DownloadFile https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/appveyor-opam.sh 10 | - "%CYG_ROOT%\\setup-x86.exe -qnNdO -R %CYG_ROOT% -s http://cygwin.mirror.constant.com -l C:/cygwin/var/cache/setup -P rsync -P patch -P diffutils -P make -P unzip -P git -P m4 -P perl -P mingw64-x86_64-gcc-core" 11 | 12 | build_script: 13 | - "%CYG_BASH% '${APPVEYOR_BUILD_FOLDER}/appveyor-opam.sh'" 14 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.8) 2 | (name irmin-watcher) 3 | 4 | (generate_opam_files true) 5 | 6 | (source (github mirage/irmin-watcher)) 7 | (license ISC) 8 | (authors "Thomas Gazagnaire") 9 | (maintainers "Thomas Gazagnaire") 10 | (documentation "https://mirage.github.io/irmin-watcher/") 11 | 12 | (package 13 | (name irmin-watcher) 14 | (synopsis "Portable Irmin watch backends using FSevents or Inotify") 15 | (description "irmin-watcher implements [Irmin's watch hooks][watch] for various OS, 16 | using FSevents in macOS and Inotify on Linux. 17 | 18 | irmin-watcher is distributed under the ISC license. 19 | 20 | [watch]: http://mirage.github.io/irmin/irmin/Irmin/Private/Watch/index.html#type-hook 21 | ") 22 | (depends 23 | (ocaml (>= "4.02.0")) 24 | (alcotest :with-test) 25 | (mtime (and :with-test (>= "2.0.0"))) 26 | (inotify (= :os "linux")) 27 | (cf-lwt (>="0.4")) 28 | lwt 29 | logs 30 | fmt 31 | astring 32 | fsevents-lwt 33 | ) 34 | ) 35 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/irmin-watcher.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Portable Irmin watch backends using FSevents or Inotify" 4 | description: """ 5 | irmin-watcher implements [Irmin's watch hooks][watch] for various OS, 6 | using FSevents in macOS and Inotify on Linux. 7 | 8 | irmin-watcher is distributed under the ISC license. 9 | 10 | [watch]: http://mirage.github.io/irmin/irmin/Irmin/Private/Watch/index.html#type-hook 11 | """ 12 | maintainer: ["Thomas Gazagnaire"] 13 | authors: ["Thomas Gazagnaire"] 14 | license: "ISC" 15 | homepage: "https://github.com/mirage/irmin-watcher" 16 | doc: "https://mirage.github.io/irmin-watcher/" 17 | bug-reports: "https://github.com/mirage/irmin-watcher/issues" 18 | depends: [ 19 | "dune" {>= "2.8"} 20 | "ocaml" {>= "4.02.0"} 21 | "alcotest" {with-test} 22 | "mtime" {with-test & >= "2.0.0"} 23 | "inotify" {os = "linux"} 24 | "cf-lwt" {>= "0.4"} 25 | "lwt" 26 | "logs" 27 | "fmt" 28 | "astring" 29 | "fsevents-lwt" 30 | "odoc" {with-doc} 31 | ] 32 | build: [ 33 | ["dune" "subst"] {dev} 34 | [ 35 | "dune" 36 | "build" 37 | "-p" 38 | name 39 | "-j" 40 | jobs 41 | "@install" 42 | "@runtest" {with-test} 43 | "@doc" {with-doc} 44 | ] 45 | ] 46 | dev-repo: "git+https://github.com/mirage/irmin-watcher.git" 47 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/backend.fsevents.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** FSevents backend for Irmin watchers. 8 | 9 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *) 10 | 11 | val v : Core.t Lazy.t 12 | (** [v id p f] is the hook calling [f] everytime a sub-path of [p] is modified. 13 | Return a function to call to remove the hook. Use the FSevent framework to 14 | be notified on filesystem changes. *) 15 | 16 | val mode : [ `FSEvents ] 17 | 18 | (*--------------------------------------------------------------------------- 19 | Copyright (c) 2016 Thomas Gazagnaire 20 | 21 | Permission to use, copy, modify, and/or distribute this software for any 22 | purpose with or without fee is hereby granted, provided that the above 23 | copyright notice and this permission notice appear in all copies. 24 | 25 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 26 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 27 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 28 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 29 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 30 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 31 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 32 | ---------------------------------------------------------------------------*) 33 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/backend.inotify.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Inotify backend for Irmin watchers. 8 | 9 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *) 10 | 11 | val v : Core.t Lazy.t 12 | (** [v id p f] is the hook calling [f] everytime a sub-path of [p] is modified. 13 | Return a function to call to remove the hook. Use inofity to be notified on 14 | filesystem changes. *) 15 | 16 | val mode : [ `Inotify | `Polling ] 17 | (** [mode] is [Inotify] on Linux and [`Polling] on Darwin. *) 18 | 19 | (*--------------------------------------------------------------------------- 20 | Copyright (c) 2016 Thomas Gazagnaire 21 | 22 | Permission to use, copy, modify, and/or distribute this software for any 23 | purpose with or without fee is hereby granted, provided that the above 24 | copyright notice and this permission notice appear in all copies. 25 | 26 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 27 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 28 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 29 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 30 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 31 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 32 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 33 | ---------------------------------------------------------------------------*) 34 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/backend.polling.ml: -------------------------------------------------------------------------------- 1 | include Polling 2 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/backend.polling.mli: -------------------------------------------------------------------------------- 1 | include module type of struct 2 | include Polling 3 | end 4 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (foreign_stubs 3 | (language c) 4 | (names realpath)) 5 | (name irmin_watcher) 6 | (public_name irmin-watcher) 7 | (libraries 8 | fmt 9 | lwt 10 | logs 11 | astring 12 | (select 13 | backend.ml 14 | from 15 | (cf-lwt fsevents-lwt -> backend.fsevents.ml) 16 | (inotify.lwt -> backend.inotify.ml) 17 | (lwt.unix -> backend.polling.ml)) 18 | (select 19 | backend.mli 20 | from 21 | (cf-lwt fsevents-lwt -> backend.fsevents.mli) 22 | (inotify.lwt -> backend.inotify.mli) 23 | (lwt.unix -> backend.polling.mli)))) 24 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/hook.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Active polling backend for Irmin watchers. 8 | 9 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *) 10 | 11 | open Core 12 | 13 | type event = [ `Unknown | `File of string ] 14 | (** The type for change event. *) 15 | 16 | val v : wait_for_changes:(unit -> event Lwt.t) -> dir:string -> Watchdog.hook 17 | (** [v ~wait_for_changes ~dir] is the watchdog hook using [wait_for_changes] to 18 | detect filesystem updates in the directory [dir]. The polling implemention 19 | just calls [Lwt_unix.sleep]. *) 20 | 21 | (*--------------------------------------------------------------------------- 22 | Copyright (c) 2016 Thomas Gazagnaire 23 | 24 | Permission to use, copy, modify, and/or distribute this software for any 25 | purpose with or without fee is hereby granted, provided that the above 26 | copyright notice and this permission notice appear in all copies. 27 | 28 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 29 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 30 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 31 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 32 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 33 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 34 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 35 | ---------------------------------------------------------------------------*) 36 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/irmin_watcher.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | let v = Lazy.force Backend.v 8 | 9 | let mode = (Backend.mode :> [ `FSEvents | `Inotify | `Polling ]) 10 | 11 | let hook = Core.hook v 12 | 13 | type stats = { watchdogs : int; dispatches : int } 14 | 15 | let stats () = 16 | let w = Core.watchdog v in 17 | let d = Core.Watchdog.dispatch w in 18 | { watchdogs = Core.Watchdog.length w; dispatches = Core.Dispatch.length d } 19 | 20 | let set_polling_time f = 21 | match mode with `Polling -> Core.default_polling_time := f | _ -> () 22 | 23 | (*--------------------------------------------------------------------------- 24 | Copyright (c) 2016 Thomas Gazagnaire 25 | 26 | Permission to use, copy, modify, and/or distribute this software for any 27 | purpose with or without fee is hereby granted, provided that the above 28 | copyright notice and this permission notice appear in all copies. 29 | 30 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 31 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 32 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 33 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 34 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 35 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 36 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 37 | ---------------------------------------------------------------------------*) 38 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/irmin_watcher.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Irmin watchers. 8 | 9 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *) 10 | 11 | val v : Core.t 12 | (** [v id p f] is the listen hook calling [f] everytime a sub-path of [p] is 13 | modified. Return a function to call to remove the hook. Default to polling 14 | if no better solution is available. FSevents and Inotify backends are 15 | available. *) 16 | 17 | val mode : [ `FSEvents | `Inotify | `Polling ] 18 | 19 | type stats = { watchdogs : int; dispatches : int } 20 | 21 | val hook : Core.hook 22 | (** [hook t] is an {!Irmin.Watcher} compatible representation of {!v}. *) 23 | 24 | val stats : unit -> stats 25 | (** [stats ()] is a snapshot of [v]'s stats. *) 26 | 27 | val set_polling_time : float -> unit 28 | (** [set_polling_time f] set the polling interval to [f]. Only valid when 29 | [mode = `Polling]. *) 30 | 31 | (*--------------------------------------------------------------------------- 32 | Copyright (c) 2016 Thomas Gazagnaire 33 | 34 | Permission to use, copy, modify, and/or distribute this software for any 35 | purpose with or without fee is hereby granted, provided that the above 36 | copyright notice and this permission notice appear in all copies. 37 | 38 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 39 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 40 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 41 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 42 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 43 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 44 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 45 | ---------------------------------------------------------------------------*) 46 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/polling.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | open Lwt.Infix 8 | 9 | let src = Logs.Src.create "irw-polling" ~doc:"Irmin watcher using using polling" 10 | 11 | module Log = (val Logs.src_log src : Logs.LOG) 12 | 13 | let listen ~wait_for_changes dir = 14 | Log.info (fun l -> l "Polling mode"); 15 | Hook.v ~wait_for_changes ~dir 16 | 17 | let with_delay delay = 18 | let wait_for_changes () = Lwt_unix.sleep delay >|= fun () -> `Unknown in 19 | Core.create (listen ~wait_for_changes) 20 | 21 | let mode = `Polling 22 | 23 | let v = 24 | let wait_for_changes () = 25 | Lwt_unix.sleep !Core.default_polling_time >|= fun () -> `Unknown 26 | in 27 | lazy (Core.create (listen ~wait_for_changes)) 28 | 29 | (*--------------------------------------------------------------------------- 30 | Copyright (c) 2016 Thomas Gazagnaire 31 | 32 | Permission to use, copy, modify, and/or distribute this software for any 33 | purpose with or without fee is hereby granted, provided that the above 34 | copyright notice and this permission notice appear in all copies. 35 | 36 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 37 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 38 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 39 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 40 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 41 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 42 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 43 | ---------------------------------------------------------------------------*) 44 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/polling.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Thomas Gazagnaire. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Active polling backend for Irmin watchers. 8 | 9 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *) 10 | 11 | open Core 12 | 13 | val with_delay : float -> t 14 | (** [with_delay delay id p f] is the hook calling [f] everytime a sub-path of 15 | [p] is modified. Return a function to call to remove the hook. Active 16 | polling is done every [delay] seconds. *) 17 | 18 | val v : t Lazy.t 19 | (** [v] is [with_delay !default_polling_time]. *) 20 | 21 | val mode : [ `Polling ] 22 | 23 | (*--------------------------------------------------------------------------- 24 | Copyright (c) 2016 Thomas Gazagnaire 25 | 26 | Permission to use, copy, modify, and/or distribute this software for any 27 | purpose with or without fee is hereby granted, provided that the above 28 | copyright notice and this permission notice appear in all copies. 29 | 30 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 31 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 32 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 33 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 34 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 35 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 36 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 37 | ---------------------------------------------------------------------------*) 38 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/src/realpath.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2009 Anil Madhavapeddy 3 | * Copyright (c) 2016 Thomas Gazagnaire 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | */ 17 | 18 | #ifdef _MSC_VER 19 | /* https://docs.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation */ 20 | #define PATH_MAX MAX_PATH 21 | #else 22 | #include 23 | #endif 24 | #include 25 | #include 26 | 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | #include 34 | 35 | #ifdef _WIN32 36 | CAMLprim value irmin_watcher_unix_realpath(value path) 37 | { 38 | TCHAR buffer[PATH_MAX]=TEXT(""); 39 | DWORD error = 0; 40 | DWORD retval = 0; 41 | retval = GetFullPathName(String_val(path), PATH_MAX, buffer, NULL); 42 | if (retval == 0) { 43 | error = GetLastError(); 44 | uerror("realpath", path); 45 | }; 46 | return caml_copy_string(buffer); 47 | } 48 | #else 49 | CAMLprim value irmin_watcher_unix_realpath(value path) 50 | { 51 | char buffer[PATH_MAX]; 52 | char *r; 53 | r = realpath(String_val(path), buffer); 54 | if (r == NULL) uerror("realpath", path); 55 | return caml_copy_string(buffer); 56 | } 57 | #endif 58 | -------------------------------------------------------------------------------- /vendor/github.com/panglesd/irmin-watcher/test/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (libraries alcotest logs.fmt irmin-watcher mtime mtime.clock.os)) 4 | 5 | (rule 6 | (alias runtest) 7 | (deps test.exe) 8 | (action 9 | (run ./test.exe -q --color=always))) 10 | --------------------------------------------------------------------------------