├── vendor ├── dune ├── update-ansi.sh └── ocaml-ansi │ ├── src │ ├── dune │ ├── choose_implementation.ml │ ├── ansi_unix_stubs.c │ ├── ansi_common.ml │ ├── ansi_win.ml │ ├── ansi.mli │ ├── ansi_unix.ml │ └── ansi_win_stubs.c │ └── LICENSE ├── lib ├── exn.ml ├── prompts │ ├── prompt_confirm.mli │ ├── prompt_select.mli │ ├── prompt_raw_select.mli │ ├── prompt_input.mli │ ├── prompt_password.mli │ ├── prompt_password.ml │ ├── prompt_input.ml │ ├── prompt_raw_select.ml │ ├── prompt_select.ml │ └── prompt_confirm.ml ├── dune ├── inquire.ml ├── style.ml ├── utils.ml └── inquire.mli ├── dune ├── .gitignore ├── example ├── confirm.ml ├── dune ├── input.ml ├── password.ml ├── select.ml ├── raw_select.ml ├── confirm_cli.ml ├── input_cli.ml └── password_cli.ml ├── .gitattributes ├── .ocamlformat ├── dune-project ├── inquire.opam ├── LICENSE ├── CHANGES.md ├── .github └── workflows │ └── ci.yml ├── README.md ├── Makefile └── CONTRIBUTING.md /vendor/dune: -------------------------------------------------------------------------------- 1 | (vendored_dirs *) 2 | -------------------------------------------------------------------------------- /lib/exn.ml: -------------------------------------------------------------------------------- 1 | exception Exit of int 2 | 3 | exception Interrupted_by_user 4 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -w +A-48-42-44 -warn-error +A-3)))) 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Dune working directory 2 | _build/ 3 | *.install 4 | 5 | # Local OPAM switch 6 | _opam/ 7 | -------------------------------------------------------------------------------- /lib/prompts/prompt_confirm.mli: -------------------------------------------------------------------------------- 1 | val prompt 2 | : ?default:bool 3 | -> ?auto_enter:bool 4 | -> ?style:Style.t 5 | -> string 6 | -> bool 7 | -------------------------------------------------------------------------------- /example/confirm.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let choice = Inquire.confirm "Are you sure?" in 3 | if choice then print_endline "Yes!" else print_endline "No!" 4 | -------------------------------------------------------------------------------- /lib/prompts/prompt_select.mli: -------------------------------------------------------------------------------- 1 | val prompt 2 | : ?default:int 3 | -> ?style:Style.t 4 | -> options:string list 5 | -> string 6 | -> string 7 | -------------------------------------------------------------------------------- /lib/prompts/prompt_raw_select.mli: -------------------------------------------------------------------------------- 1 | val prompt 2 | : ?default:int 3 | -> ?style:Style.t 4 | -> options:string list 5 | -> string 6 | -> string 7 | -------------------------------------------------------------------------------- /lib/prompts/prompt_input.mli: -------------------------------------------------------------------------------- 1 | val prompt 2 | : ?validate:(string -> (string, string) result) 3 | -> ?default:string 4 | -> ?style:Style.t 5 | -> string 6 | -> string 7 | -------------------------------------------------------------------------------- /lib/prompts/prompt_password.mli: -------------------------------------------------------------------------------- 1 | val prompt 2 | : ?validate:(string -> (string, string) result) 3 | -> ?default:string 4 | -> ?style:Style.t 5 | -> string 6 | -> string 7 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name inquire) 3 | (public_name inquire) 4 | (synopsis "Prompt users on the terminal") 5 | (libraries unix inquire.ansi)) 6 | 7 | (include_subdirs unqualified) 8 | -------------------------------------------------------------------------------- /example/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names 3 | confirm 4 | confirm_cli 5 | input 6 | input_cli 7 | password 8 | password_cli 9 | raw_select 10 | select) 11 | (libraries cmdliner inquire)) 12 | -------------------------------------------------------------------------------- /example/input.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let validate = function 3 | | "test" -> 4 | Error "Not \"test\", enter something else." 5 | | x -> 6 | Ok x 7 | in 8 | let value = 9 | Inquire.input "Enter a value, not test:" ~validate ~default:"default" 10 | in 11 | Printf.printf "You entered: %S\n" value 12 | -------------------------------------------------------------------------------- /example/password.ml: -------------------------------------------------------------------------------- 1 | let validate_password v = 2 | if String.length v >= 6 then 3 | Ok v 4 | else 5 | Error "The password must be 6 characters or more." 6 | 7 | let () = 8 | let password = 9 | Inquire.password "Enter your password:" ~validate:validate_password 10 | in 11 | Printf.printf "Your new password is: %S" password 12 | -------------------------------------------------------------------------------- /example/select.ml: -------------------------------------------------------------------------------- 1 | let movies = 2 | [ "Star Wars: The Rise of Skywalker" 3 | ; "Solo: A Star Wars Story" 4 | ; "Star Wars: The Last Jedi" 5 | ; "Rogue One: A Star Wars Story" 6 | ; "Star Wars: The Force Awakens" 7 | ] 8 | 9 | let () = 10 | let movie = 11 | Inquire.select "What's your favorite movie?" ~options:movies ~default:2 12 | in 13 | Printf.printf "Indeed, %S is a great movie!" movie 14 | -------------------------------------------------------------------------------- /lib/inquire.ml: -------------------------------------------------------------------------------- 1 | exception Interrupted_by_user = Exn.Interrupted_by_user 2 | 3 | module Style = Style 4 | 5 | let confirm = Prompt_confirm.prompt 6 | 7 | let input = Prompt_input.prompt 8 | 9 | let password = Prompt_password.prompt 10 | 11 | let raw_select = Prompt_raw_select.prompt 12 | 13 | let select = Prompt_select.prompt 14 | 15 | let set_exit_on_user_interrupt v = Utils.exit_on_user_interrupt := v 16 | -------------------------------------------------------------------------------- /example/raw_select.ml: -------------------------------------------------------------------------------- 1 | let movies = 2 | [ "Star Wars: The Rise of Skywalker" 3 | ; "Solo: A Star Wars Story" 4 | ; "Star Wars: The Last Jedi" 5 | ; "Rogue One: A Star Wars Story" 6 | ; "Star Wars: The Force Awakens" 7 | ] 8 | 9 | let () = 10 | let movie = 11 | Inquire.raw_select "What's your favorite movie?" ~options:movies ~default:2 12 | in 13 | Printf.printf "Indeed, %S is a great movie!" movie 14 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Tell github that .ml and .mli files are OCaml 2 | *.ml linguist-language=OCaml 3 | *.mli linguist-language=OCaml 4 | 5 | # Declare shell files to have LF endings on checkout 6 | # On Windows, the default git setting for `core.autocrlf` 7 | # means that when checking out code, LF endings get converted 8 | # to CRLF. This causes problems for shell scripts, as bash 9 | # gets choked up on the extra `\r` character. 10 | * text eol=lf 11 | -------------------------------------------------------------------------------- /vendor/update-ansi.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | version=main 4 | 5 | set -e -o pipefail 6 | 7 | TMP="$(mktemp -d)" 8 | trap "rm -rf $TMP" EXIT 9 | 10 | rm -rf ocaml-ansi 11 | mkdir -p ocaml-ansi/src 12 | 13 | ( 14 | cd "$TMP" 15 | git clone https://github.com/tmattio/ocaml-ansi.git 16 | cd ocaml-ansi 17 | git checkout $version 18 | ) 19 | 20 | SRC=$TMP/ocaml-ansi 21 | 22 | cp -v "$SRC"/LICENSE ocaml-ansi 23 | cp -v "$SRC"/lib/*.{ml,mli,c} ocaml-ansi/src 24 | # git checkout ocaml-ansi/src/dune 25 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ansi) 3 | (public_name inquire.ansi) 4 | (modules ansi ansi_common) 5 | (foreign_stubs 6 | (language c) 7 | (names ansi_stubs)) 8 | (synopsis "Basic control of ANSI compliant terminals and the windows shell") 9 | (libraries unix bytes)) 10 | 11 | (rule 12 | (targets ansi.ml ansi_stubs.c) 13 | (deps 14 | ansi_unix.ml 15 | ansi_win.ml 16 | ansi_unix_stubs.c 17 | ansi_win_stubs.c 18 | choose_implementation.ml) 19 | (action 20 | (run %{ocaml} choose_implementation.ml))) 21 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.18.0 2 | profile = sparse 3 | break-cases = nested 4 | break-fun-decl = smart 5 | cases-exp-indent = 2 6 | if-then-else = fit-or-vertical 7 | parens-tuple = multi-line-only 8 | parens-tuple-patterns = multi-line-only 9 | parens-ite = false 10 | infix-precedence = parens 11 | break-infix-before-func = false 12 | sequence-style = terminator 13 | sequence-blank-line = compact 14 | indicate-multiline-delimiters = no 15 | ocp-indent-compat = true 16 | wrap-comments = true 17 | parse-docstrings = true 18 | let-binding-spacing = compact 19 | type-decl = sparse 20 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | 3 | (name inquire) 4 | 5 | (documentation "https://tmattio.github.io/inquire/") 6 | 7 | (source 8 | (github tmattio/inquire)) 9 | 10 | (license MIT) 11 | 12 | (cram enable) 13 | 14 | (authors "Thibaut Mattio") 15 | 16 | (maintainers "Thibaut Mattio") 17 | 18 | (generate_opam_files true) 19 | 20 | (package 21 | (name inquire) 22 | (synopsis "Create beautiful interactive command line interface in OCaml") 23 | (description 24 | "\240\159\142\168 Create beautiful interactive command line interface in OCaml.") 25 | (depends 26 | (ocaml 27 | (>= 4.08.0)) 28 | dune 29 | uutf 30 | (odoc :with-doc))) 31 | -------------------------------------------------------------------------------- /example/confirm_cli.ml: -------------------------------------------------------------------------------- 1 | (* Implementation of the command, we just print the args. *) 2 | 3 | let confirm default auto_enter message = 4 | let choice = Inquire.confirm ?default ?auto_enter message in 5 | if choice then print_endline "Yes!" else print_endline "No!" 6 | 7 | (* Command line interface *) 8 | 9 | open Cmdliner 10 | 11 | let default = Arg.(value & opt (some bool) None & info [ "default" ]) 12 | 13 | let auto_enter = Arg.(value & opt (some bool) None & info [ "auto-enter" ]) 14 | 15 | let message = 16 | Arg.(required & pos 0 (some string) None & info [] ~docv:"MESSAGE") 17 | 18 | let cmd = 19 | ( Term.(const confirm $ default $ auto_enter $ message) 20 | , Term.info "confirm" ~exits:Term.default_exits ) 21 | 22 | let () = Term.(exit @@ eval cmd) 23 | -------------------------------------------------------------------------------- /example/input_cli.ml: -------------------------------------------------------------------------------- 1 | (* Implementation of the command, we just print the args. *) 2 | 3 | let input default message = 4 | let validate input = 5 | if String.length input > 2 then 6 | Ok input 7 | else 8 | Error "Must be more than 2 characters." 9 | in 10 | let value = Inquire.input ?default ~validate message in 11 | Printf.printf "You entered %S" value 12 | 13 | (* Command line interface *) 14 | 15 | open Cmdliner 16 | 17 | let default = Arg.(value & opt (some string) None & info [ "default" ]) 18 | 19 | let message = 20 | Arg.(required & pos 0 (some string) None & info [] ~docv:"MESSAGE") 21 | 22 | let cmd = 23 | ( Term.(const input $ default $ message) 24 | , Term.info "input" ~exits:Term.default_exits ) 25 | 26 | let () = Term.(exit @@ eval cmd) 27 | -------------------------------------------------------------------------------- /example/password_cli.ml: -------------------------------------------------------------------------------- 1 | (* Implementation of the command, we just print the args. *) 2 | 3 | let password default message = 4 | let validate input = 5 | if String.length input > 2 then 6 | Ok input 7 | else 8 | Error "Must be more than 2 characters." 9 | in 10 | let value = Inquire.password ?default ~validate message in 11 | Printf.printf "You entered %S" value 12 | 13 | (* Command line interface *) 14 | 15 | open Cmdliner 16 | 17 | let default = Arg.(value & opt (some string) None & info [ "default" ]) 18 | 19 | let message = 20 | Arg.(required & pos 0 (some string) None & info [] ~docv:"MESSAGE") 21 | 22 | let cmd = 23 | ( Term.(const password $ default $ message) 24 | , Term.info "password" ~exits:Term.default_exits ) 25 | 26 | let () = Term.(exit @@ eval cmd) 27 | -------------------------------------------------------------------------------- /inquire.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Create beautiful interactive command line interface in OCaml" 4 | description: 5 | "🎨 Create beautiful interactive command line interface in OCaml." 6 | maintainer: ["Thibaut Mattio"] 7 | authors: ["Thibaut Mattio"] 8 | license: "MIT" 9 | homepage: "https://github.com/tmattio/inquire" 10 | doc: "https://tmattio.github.io/inquire/" 11 | bug-reports: "https://github.com/tmattio/inquire/issues" 12 | depends: [ 13 | "ocaml" {>= "4.08.0"} 14 | "dune" {>= "2.7"} 15 | "uutf" 16 | "odoc" {with-doc} 17 | ] 18 | build: [ 19 | ["dune" "subst"] {dev} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "@install" 28 | "@runtest" {with-test} 29 | "@doc" {with-doc} 30 | ] 31 | ] 32 | dev-repo: "git+https://github.com/tmattio/inquire.git" 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Thibaut Mattio 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/choose_implementation.ml: -------------------------------------------------------------------------------- 1 | (* Script to choose the unix or windows implementation depending on the platform *) 2 | 3 | open Printf 4 | 5 | let copy_file ?(line_directive = false) ?(dir = ".") source target = 6 | let fh0 = open_in (Filename.concat dir source) in 7 | let target = Filename.concat dir target in 8 | (try Sys.remove target with _ -> ()); 9 | let fh1 = open_out_gen [ Open_wronly; Open_creat; Open_trunc ] 0o444 target in 10 | let content = Buffer.create 4096 in 11 | if line_directive then 12 | bprintf content "#1 \"%s\"\n" (Filename.concat dir source); 13 | Buffer.add_channel content fh0 (in_channel_length fh0); 14 | Buffer.output_buffer fh1 content; 15 | close_in fh0; 16 | close_out fh1 17 | 18 | let choose_unix () = 19 | copy_file "ansi_unix.ml" "ansi.ml" ~line_directive:true; 20 | copy_file "ansi_unix_stubs.c" "ansi_stubs.c" 21 | 22 | let choose_win () = 23 | copy_file "ansi_win.ml" "ansi.ml" ~line_directive:true; 24 | copy_file "ansi_win_stubs.c" "ansi_stubs.c" 25 | 26 | let () = 27 | match Sys.os_type with 28 | | "Unix" | "Cygwin" -> 29 | choose_unix () 30 | | "Win32" -> 31 | choose_win () 32 | | e -> 33 | eprintf "Unknown OS type %S.\n" e 34 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # 0.3.1 - 2021-06-04 2 | 3 | ## Fixed 4 | 5 | - Fix an issue with terminal scroll down. 6 | - Fix an issue with unsupported ANSI sequences for cursor save/restore. 7 | 8 | # 0.3.0 - 2021-05-17 9 | 10 | ## Added 11 | 12 | - Improved all prompts prompt to handle escape sequences (e.g. "Ctrl-L" will clear the screen while reading from answer). 13 | - Improved `select` to allow selection using indexes. 14 | - Improved prompts to clear defaults and other tooltip on a valid answer and print the answer after the prompt. 15 | 16 | ## Changed 17 | 18 | - Stripped out `lambda-term` dependency 19 | - Removed `lwt` integration 20 | 21 | # 0.2.1 - 2020-10-04 22 | 23 | ## Changed 24 | 25 | - Vendored lambda-term to fix dependency on Camomile assets 26 | 27 | # 0.2.0 - 2020-05-08 28 | 29 | ## Changed 30 | 31 | - Changed the Make functor to take a module with functions `make_prompt`, `make_error` and `make_select`. 32 | - Changed `raw_list` to `raw_select`. 33 | 34 | ## Added 35 | 36 | - Add `select` prompt. 37 | - Support default values for all prompts. 38 | - Support validate functions for `password` and `input` prompts. 39 | 40 | # 0.1.0 - 2020-02-12 41 | 42 | ## Added 43 | 44 | - Add `confirm` prompt. 45 | - Add `input` prompt. 46 | - Add `password` prompt. 47 | - Add `raw_list` prompt. 48 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ main ] 6 | pull_request: 7 | branches: [ main ] 8 | 9 | jobs: 10 | build-and-test: 11 | name: CI 12 | 13 | strategy: 14 | fail-fast: false 15 | 16 | matrix: 17 | os: 18 | - macos-latest 19 | - ubuntu-latest 20 | - windows-latest 21 | 22 | ocaml-compiler: 23 | - 4.12.x 24 | 25 | runs-on: ${{ matrix.os }} 26 | 27 | steps: 28 | 29 | - name: Checkout code 30 | uses: actions/checkout@v2 31 | 32 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 33 | uses: avsm/setup-ocaml@v2 34 | with: 35 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 36 | dune-cache: ${{ matrix.os != 'macos-latest' }} 37 | opam-depext-flags: --with-test 38 | 39 | - name: Install ocamlformat 40 | run: opam install ocamlformat.0.18.0 41 | if: ${{ matrix.os == 'ubuntu-latest' }} 42 | 43 | - name: Install opam packages 44 | run: opam install . --with-test 45 | 46 | - name: Install examples opam packages 47 | run: opam install cmdliner 48 | 49 | - name: Check formatting 50 | run: make fmt 51 | if: ${{ matrix.os == 'ubuntu-latest' && always() }} 52 | 53 | - name: Run build 54 | run: make build 55 | 56 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Inquire 2 | 3 | [![Actions Status](https://github.com/tmattio/inquire/workflows/CI/badge.svg)](https://github.com/tmattio/inquire/actions) 4 | 5 | 🎨 Create beautiful interactive command line interface in OCaml 6 | 7 | ## Installation 8 | 9 | ### Using Opam 10 | 11 | ```bash 12 | opam install inquire 13 | ``` 14 | 15 | ### Using Esy 16 | 17 | ```bash 18 | esy add @opam/inquire 19 | ``` 20 | 21 | ## Usage 22 | 23 | ### Confirm 24 | 25 | Prompt the user to answer the given message with "y" or "n". 26 | 27 | ```ocaml 28 | Inquire.confirm "Are you sure?" 29 | ``` 30 | 31 | ### Raw List 32 | 33 | Prompt the user to chose a value from the given options. 34 | 35 | ```ocaml 36 | Inquire.raw_select "What's your favorite movie?" ~options:[ "Choice 1" ; "Choice 2" ] 37 | ``` 38 | 39 | ### Password 40 | 41 | Prompt the user to enter a password that will be hidden with stars (`*`). 42 | 43 | ```ocaml 44 | Inquire.password "Enter your password:" 45 | ``` 46 | 47 | ### Input 48 | 49 | Prompt the user to input a string. 50 | 51 | ```ocaml 52 | Inquire.input "Enter a value:" 53 | ``` 54 | 55 | ## Limitations 56 | 57 | Inquire is dead simple. The prompt implementations are ~100 line of code each and manage the terminal control flow themselves. 58 | This simplicity comes at a price though: 59 | 60 | - No support for UTF8. This would in principle be relatively easy to implement with a buffer that accumulates the input bytes until it matches an UTF8 value, up to a certain number of bytes. A PR for this would be more than welcome. 61 | 62 | ## Contributing 63 | 64 | Take a look at our [Contributing Guide](CONTRIBUTING.md). 65 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all 2 | all: 3 | opam exec -- dune build --root . @install 4 | 5 | .PHONY: deps 6 | deps: ## Install development dependencies 7 | opam install -y dune-release merlin ocamlformat utop ocaml-lsp-server 8 | opam install --deps-only --with-test --with-doc -y . 9 | 10 | .PHONY: create_switch 11 | create_switch: 12 | opam switch create . --no-install 13 | 14 | .PHONY: switch 15 | switch: create_switch deps ## Create an opam switch and install development dependencies 16 | 17 | .PHONY: lock 18 | lock: ## Generate a lock file 19 | opam lock -y . 20 | 21 | .PHONY: build 22 | build: ## Build the project, including non installable libraries and executables 23 | opam exec -- dune build --root . 24 | 25 | .PHONY: install 26 | install: all ## Install the packages on the system 27 | opam exec -- dune install --root . 28 | 29 | .PHONY: start 30 | start: all ## Run the produced executable 31 | opam exec -- dune exec --root . bin/main.exe $(ARGS) 32 | 33 | .PHONY: test 34 | test: ## Run the unit tests 35 | opam exec -- dune build --root . @test/runtest -f 36 | 37 | .PHONY: clean 38 | clean: ## Clean build artifacts and other generated files 39 | opam exec -- dune clean --root . 40 | 41 | .PHONY: doc 42 | doc: ## Generate odoc documentation 43 | opam exec -- dune build --root . @doc 44 | 45 | .PHONY: fmt 46 | fmt: ## Format the codebase with ocamlformat 47 | opam exec -- dune build --root . --auto-promote @fmt 48 | 49 | .PHONY: watch 50 | watch: ## Watch for the filesystem and rebuild on every change 51 | opam exec -- dune build --root . --watch 52 | 53 | .PHONY: utop 54 | utop: ## Run a REPL and link with the project's libraries 55 | opam exec -- dune utop --root . lib -- -implicit-bindings 56 | -------------------------------------------------------------------------------- /lib/style.ml: -------------------------------------------------------------------------------- 1 | include Ansi 2 | 3 | type t = 4 | { qmark_icon : string 5 | ; qmark_format : Ansi.style list 6 | ; message_format : Ansi.style list 7 | ; error_icon : string 8 | ; error_format : Ansi.style list 9 | ; default_format : Ansi.style list 10 | ; option_icon_marked : string 11 | ; option_icon_unmarked : string 12 | ; pointer_icon : string 13 | } 14 | 15 | let default = 16 | { qmark_icon = "?" 17 | ; qmark_format = [ Ansi.green ] 18 | ; message_format = [ Ansi.bold ] 19 | ; error_icon = "X" 20 | ; error_format = [ Ansi.red; Ansi.bold ] 21 | ; default_format = [] 22 | ; option_icon_marked = "○" 23 | ; option_icon_unmarked = "●" 24 | ; pointer_icon = "»" 25 | } 26 | 27 | let make 28 | ?qmark_icon 29 | ?qmark_format 30 | ?message_format 31 | ?error_icon 32 | ?error_format 33 | ?default_format 34 | ?option_icon_marked 35 | ?option_icon_unmarked 36 | ?pointer_icon 37 | () 38 | = 39 | let qmark_icon = Option.value qmark_icon ~default:default.qmark_icon in 40 | let qmark_format = Option.value qmark_format ~default:default.qmark_format in 41 | let message_format = 42 | Option.value message_format ~default:default.message_format 43 | in 44 | let error_icon = Option.value error_icon ~default:default.error_icon in 45 | let error_format = Option.value error_format ~default:default.error_format in 46 | let default_format = 47 | Option.value default_format ~default:default.default_format 48 | in 49 | let option_icon_marked = 50 | Option.value option_icon_marked ~default:default.option_icon_marked 51 | in 52 | let option_icon_unmarked = 53 | Option.value option_icon_unmarked ~default:default.option_icon_unmarked 54 | in 55 | let pointer_icon = Option.value pointer_icon ~default:default.pointer_icon in 56 | { qmark_icon 57 | ; qmark_format 58 | ; message_format 59 | ; error_icon 60 | ; error_format 61 | ; default_format 62 | ; option_icon_marked 63 | ; option_icon_unmarked 64 | ; pointer_icon 65 | } 66 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/ansi_unix_stubs.c: -------------------------------------------------------------------------------- 1 | /* File: Ansi_unix_stubs.c 2 | 3 | Copyright (C) 2010 4 | 5 | Christophe Troestler 6 | WWW: http://math.umons.ac.be/an/software/ 7 | 8 | This library is free software; you can redistribute it and/or modify 9 | it under the terms of the GNU Lesser General Public License version 3 or 10 | later as published by the Free Software Foundation. See the file 11 | LICENCE for more details. 12 | 13 | This library is distributed in the hope that it will be useful, but 14 | WITHOUT ANY WARRANTY; without even the implied warranty of 15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file 16 | LICENSE for more details. */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | 25 | /* Based on http://www.ohse.de/uwe/software/resize.c.html */ 26 | /* Inquire actual terminal size (this it what the kernel thinks - not 27 | * was the user on the over end of the phone line has really). */ 28 | CAMLexport value Ansi_term_size(value vfd) { 29 | CAMLparam1(vfd); 30 | CAMLlocal1(vsize); 31 | int fd = Int_val(vfd); 32 | int x, y; 33 | 34 | #ifdef TIOCGSIZE 35 | struct ttysize win; 36 | #elif defined(TIOCGWINSZ) 37 | struct winsize win; 38 | #endif 39 | 40 | #ifdef TIOCGSIZE 41 | if (ioctl(fd, TIOCGSIZE, &win)) failwith("Ansi.size"); 42 | x = win.ts_cols; 43 | y = win.ts_lines; 44 | #elif defined TIOCGWINSZ 45 | if (ioctl(fd, TIOCGWINSZ, &win)) failwith("Ansi.size"); 46 | x = win.ws_col; 47 | y = win.ws_row; 48 | #else 49 | { 50 | const char *s; 51 | s = getenv("LINES"); 52 | if (s) 53 | y = strtol(s, NULL, 10); 54 | else 55 | y = 25; 56 | s = getenv("COLUMNS"); 57 | if (s) 58 | x = strtol(s, NULL, 10); 59 | else 60 | x = 80; 61 | } 62 | #endif 63 | 64 | vsize = caml_alloc_tuple(2); 65 | Store_field(vsize, 0, Val_int(x)); 66 | Store_field(vsize, 1, Val_int(y)); 67 | CAMLreturn(vsize); 68 | } 69 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | ## Setup your development environment 4 | 5 | You need Opam, you can install it by following [Opam's documentation](https://opam.ocaml.org/doc/Install.html). 6 | 7 | With Opam installed, you can install the dependencies in a new local switch with: 8 | 9 | ```bash 10 | make switch 11 | ``` 12 | 13 | Or globally, with: 14 | 15 | ```bash 16 | make deps 17 | ``` 18 | 19 | Then, build the project with: 20 | 21 | ```bash 22 | make build 23 | ``` 24 | 25 | ### Running Binary 26 | 27 | After building the project, you can run the main binary that is produced. 28 | 29 | 30 | ```bash 31 | make start 32 | ``` 33 | 34 | ### Running Tests 35 | 36 | You can run the test compiled executable: 37 | 38 | 39 | ```bash 40 | make test 41 | ``` 42 | 43 | ### Building documentation 44 | 45 | Documentation for the libraries in the project can be generated with: 46 | 47 | 48 | ```bash 49 | make doc 50 | open-cli $(make doc-path) 51 | ``` 52 | 53 | This assumes you have a command like [open-cli](https://github.com/sindresorhus/open-cli) installed on your system. 54 | 55 | > NOTE: On macOS, you can use the system command `open`, for instance `open $(make doc-path)` 56 | 57 | ### Repository Structure 58 | 59 | The following snippet describes Inquire's repository structure. 60 | 61 | ```text 62 | . 63 | ├── bin/ 64 | | Source for inquire's binary. This links to the library defined in `lib/`. 65 | │ 66 | ├── lib/ 67 | | Source for Inquire's library. Contains Inquire's core functionnalities. 68 | │ 69 | ├── test/ 70 | | Unit tests and integration tests for Inquire. 71 | │ 72 | ├── dune-project 73 | | Dune file used to mark the root of the project and define project-wide parameters. 74 | | For the documentation of the syntax, see https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 75 | │ 76 | ├── LICENSE 77 | │ 78 | ├── Makefile 79 | | Make file containing common development command. 80 | │ 81 | ├── README.md 82 | │ 83 | └── inquire.opam 84 | Opam package definition. 85 | To know more about creating and publishing opam packages, see https://opam.ocaml.org/doc/Packaging.html. 86 | ``` 87 | -------------------------------------------------------------------------------- /lib/prompts/prompt_password.ml: -------------------------------------------------------------------------------- 1 | module Input_buffer = struct 2 | let create () = ref "" 3 | 4 | let is_empty t = !t = "" 5 | 6 | let add_char t chr = t := !t ^ Char.escaped chr 7 | 8 | let rm_last_char t = 9 | if is_empty t then 10 | () 11 | else 12 | t := String.sub !t 0 (String.length !t - 1) 13 | 14 | let get t = !t 15 | 16 | let reset t = t := "" 17 | end 18 | 19 | let prompt ?validate ?default ?style message = 20 | let default_str = "******" in 21 | let default_str_opt = Option.map (fun _ -> default_str) default in 22 | Utils.print_prompt ?default:default_str_opt ?style message; 23 | let buf = Input_buffer.create () in 24 | let validate = match validate with None -> fun x -> Ok x | Some fn -> fn in 25 | let reset () = Input_buffer.reset buf in 26 | let rec aux () = 27 | let ch = Char.code (input_char stdin) in 28 | match ch, default with 29 | | 10, Some default -> 30 | (* Enter *) 31 | if Input_buffer.is_empty buf then ( 32 | Utils.erase_n_chars (3 + String.length default_str); 33 | print_endline default_str; 34 | flush stdout; 35 | default) 36 | else 37 | let input = Input_buffer.get buf in 38 | (match validate input with 39 | | Ok output -> 40 | Utils.erase_n_chars (3 + String.length default_str); 41 | print_endline default_str; 42 | flush stdout; 43 | output 44 | | Error err -> 45 | print_string "\n"; 46 | flush stdout; 47 | Utils.print_err err; 48 | reset (); 49 | aux ()) 50 | | 10, None when Input_buffer.is_empty buf -> 51 | (* Enter, no input *) 52 | aux () 53 | | 10, None -> 54 | (* Enter, with input *) 55 | let input = Input_buffer.get buf in 56 | (match validate input with 57 | | Ok output -> 58 | print_string "\n"; 59 | flush stdout; 60 | output 61 | | Error err -> 62 | print_string "\n"; 63 | flush stdout; 64 | Utils.print_err err; 65 | reset (); 66 | aux ()) 67 | | 12, _ -> 68 | (* Handle ^L *) 69 | Ansi.erase Ansi.Screen; 70 | Ansi.set_cursor 1 1; 71 | Utils.print_prompt ?default:default_str_opt ?style message; 72 | aux () 73 | | 3, _ | 4, _ -> 74 | (* Handle ^C and ^D *) 75 | print_string "\n"; 76 | flush stdout; 77 | (* Exit with an exception so we can catch it and revert the changes on 78 | stdin. *) 79 | Utils.user_interrupt () 80 | | 127, _ -> 81 | (* DEL *) 82 | Input_buffer.rm_last_char buf; 83 | aux () 84 | | code, _ -> 85 | Input_buffer.add_char buf (Char.chr code); 86 | aux () 87 | in 88 | Utils.with_raw Unix.stdin aux 89 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/ansi_common.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2004 by Troestler Christophe Christophe.Troestler(at)umons.ac.be 2 | 3 | This library is free software; you can redistribute it and/or modify it under 4 | the terms of the GNU Lesser General Public License version 3 as published by 5 | the Free Software Foundation, with the special exception on linking described 6 | in file LICENSE. 7 | 8 | This library is distributed in the hope that it will be useful, but WITHOUT 9 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | FOR A PARTICULAR PURPOSE. See the file LICENSE for more details. *) 11 | 12 | let autoreset = ref true 13 | 14 | let set_autoreset b = autoreset := b 15 | 16 | type color = 17 | | Black 18 | | Red 19 | | Green 20 | | Yellow 21 | | Blue 22 | | Magenta 23 | | Cyan 24 | | White 25 | | Bright_black 26 | | Bright_red 27 | | Bright_green 28 | | Bright_yellow 29 | | Bright_blue 30 | | Bright_magenta 31 | | Bright_cyan 32 | | Bright_white 33 | | Default 34 | 35 | type style = 36 | | Reset 37 | | Bold 38 | | Underlined 39 | | Blink 40 | | Inverse 41 | | Hidden 42 | | Foreground of color 43 | | Background of color 44 | 45 | let black = Foreground Black 46 | 47 | let red = Foreground Red 48 | 49 | let green = Foreground Green 50 | 51 | let yellow = Foreground Yellow 52 | 53 | let blue = Foreground Blue 54 | 55 | let magenta = Foreground Magenta 56 | 57 | let cyan = Foreground Cyan 58 | 59 | let white = Foreground White 60 | 61 | let bright_black = Foreground Bright_black 62 | 63 | let bright_red = Foreground Bright_red 64 | 65 | let bright_green = Foreground Bright_green 66 | 67 | let bright_yellow = Foreground Bright_yellow 68 | 69 | let bright_blue = Foreground Bright_blue 70 | 71 | let bright_magenta = Foreground Bright_magenta 72 | 73 | let bright_cyan = Foreground Bright_cyan 74 | 75 | let bright_white = Foreground Bright_white 76 | 77 | let default = Foreground Default 78 | 79 | let bg_black = Background Black 80 | 81 | let bg_red = Background Red 82 | 83 | let bg_green = Background Green 84 | 85 | let bg_yellow = Background Yellow 86 | 87 | let bg_blue = Background Blue 88 | 89 | let bg_magenta = Background Magenta 90 | 91 | let bg_cyan = Background Cyan 92 | 93 | let bg_white = Background White 94 | 95 | let bg_bright_black = Background Bright_black 96 | 97 | let bg_bright_red = Background Bright_red 98 | 99 | let bg_bright_green = Background Bright_green 100 | 101 | let bg_bright_yellow = Background Bright_yellow 102 | 103 | let bg_bright_blue = Background Bright_blue 104 | 105 | let bg_bright_magenta = Background Bright_magenta 106 | 107 | let bg_bright_cyan = Background Bright_cyan 108 | 109 | let bg_bright_white = Background Bright_white 110 | 111 | let bg_default = Background Default 112 | 113 | type loc = 114 | | Eol 115 | | Above 116 | | Below 117 | | Screen 118 | 119 | let bold = Bold 120 | 121 | let underlined = Underlined 122 | 123 | let blink = Blink 124 | 125 | let inverse = Inverse 126 | 127 | let hidden = Hidden 128 | -------------------------------------------------------------------------------- /lib/prompts/prompt_input.ml: -------------------------------------------------------------------------------- 1 | module Input_buffer = struct 2 | let create () = ref "" 3 | 4 | let is_empty t = !t = "" 5 | 6 | let add_char t chr = t := !t ^ Char.escaped chr 7 | 8 | let rm_last_char t = 9 | if is_empty t then 10 | () 11 | else 12 | t := String.sub !t 0 (String.length !t - 1) 13 | 14 | let get t = !t 15 | 16 | let print t = 17 | let input = !t in 18 | print_string input; 19 | flush stdout 20 | 21 | let reset t = t := "" 22 | end 23 | 24 | let prompt ?validate ?default ?style message = 25 | Utils.print_prompt ?default ?style message; 26 | let buf = Input_buffer.create () in 27 | let validate = match validate with None -> fun x -> Ok x | Some fn -> fn in 28 | let reset () = 29 | let len = String.length @@ Input_buffer.get buf in 30 | Ansi.move_cursor (-1 * len) 0; 31 | Ansi.erase Ansi.Eol; 32 | Input_buffer.reset buf 33 | in 34 | let print_input () = Input_buffer.print buf in 35 | let remove_last_char () = 36 | match Input_buffer.get buf with 37 | | "" -> 38 | () 39 | | _ -> 40 | Input_buffer.rm_last_char buf; 41 | Ansi.move_cursor (-1) 0; 42 | Ansi.erase Ansi.Eol 43 | in 44 | let rec aux () = 45 | let ch = Char.code (input_char stdin) in 46 | match ch, default with 47 | | 10, Some default -> 48 | (* Enter *) 49 | if Input_buffer.is_empty buf then ( 50 | Utils.erase_n_chars (3 + String.length default); 51 | print_endline default; 52 | flush stdout; 53 | default) 54 | else 55 | let input = Input_buffer.get buf in 56 | (match validate input with 57 | | Ok output -> 58 | Utils.erase_n_chars (3 + String.length default + String.length input); 59 | print_endline output; 60 | flush stdout; 61 | output 62 | | Error err -> 63 | print_string "\n"; 64 | flush stdout; 65 | Utils.print_err err; 66 | reset (); 67 | aux ()) 68 | | 10, None when Input_buffer.is_empty buf -> 69 | (* Enter, no input *) 70 | aux () 71 | | 10, None -> 72 | (* Enter, with input *) 73 | let input = Input_buffer.get buf in 74 | (match validate input with 75 | | Ok output -> 76 | print_string "\n"; 77 | flush stdout; 78 | output 79 | | Error err -> 80 | print_string "\n"; 81 | flush stdout; 82 | Utils.print_err err; 83 | reset (); 84 | aux ()) 85 | | 12, _ -> 86 | (* Handle ^L *) 87 | Ansi.erase Ansi.Screen; 88 | Ansi.set_cursor 1 1; 89 | Utils.print_prompt ?default ?style message; 90 | print_input (); 91 | aux () 92 | | 3, _ | 4, _ -> 93 | (* Handle ^C and ^D *) 94 | print_string "\n"; 95 | flush stdout; 96 | (* Exit with an exception so we can catch it and revert the changes on 97 | stdin. *) 98 | Utils.user_interrupt () 99 | | 127, _ -> 100 | (* DEL *) 101 | remove_last_char (); 102 | aux () 103 | | code, _ -> 104 | Input_buffer.add_char buf (Char.chr code); 105 | print_char (Char.chr code); 106 | flush stdout; 107 | aux () 108 | in 109 | Utils.with_raw Unix.stdin aux 110 | -------------------------------------------------------------------------------- /lib/prompts/prompt_raw_select.ml: -------------------------------------------------------------------------------- 1 | let print_options ?(style = Style.default) ~selected options = 2 | List.iteri 3 | (fun i opt -> 4 | if Some i = selected then 5 | Printf.printf 6 | " %s %i) %s" 7 | (Ansi.sprintf style.Style.qmark_format "%s" style.Style.pointer_icon) 8 | (i + 1) 9 | opt 10 | else 11 | Printf.printf " %i) %s" (i + 1) opt; 12 | if not (i + 1 = List.length options) then print_string "\n") 13 | options; 14 | print_string "\n Answer: "; 15 | flush stdout 16 | 17 | let print_prompt ?style message = 18 | Utils.print_prompt ?style message; 19 | flush stdout 20 | 21 | let prompt ?default ?style ~options message = 22 | let input = 23 | match default with 24 | | Some v when v < List.length options -> 25 | ref (Some v) 26 | | _ -> 27 | ref None 28 | in 29 | let print_options () = print_options ~selected:!input options in 30 | let print_input () = 31 | match !input with 32 | | None -> 33 | () 34 | | Some i -> 35 | print_int (i + 1); 36 | flush stdout 37 | in 38 | let reset () = 39 | let erase_n_lines = function 40 | | 0 -> 41 | () 42 | | n -> 43 | Ansi.move_bol (); 44 | Ansi.move_cursor 0 (-1 * n); 45 | Ansi.erase Ansi.Below; 46 | flush stdout 47 | in 48 | erase_n_lines (List.length options) 49 | in 50 | let select i = 51 | input := Some i; 52 | reset (); 53 | print_options (); 54 | print_input () 55 | in 56 | print_prompt ?style message; 57 | print_string "\n"; 58 | print_options (); 59 | print_input (); 60 | let rec aux () = 61 | let ch = Char.code (input_char stdin) in 62 | match ch, !input with 63 | | 10, Some input -> 64 | (* Enter *) 65 | reset (); 66 | Ansi.move_cursor 0 (-1); 67 | Ansi.erase Ansi.Eol; 68 | print_prompt ?style message; 69 | let input = List.nth options input in 70 | print_string input; 71 | print_string "\n"; 72 | flush stdout; 73 | input 74 | | 12, _ -> 75 | (* Handle ^L *) 76 | Ansi.erase Ansi.Screen; 77 | Ansi.set_cursor 1 1; 78 | print_prompt ?style message; 79 | print_string "\n"; 80 | print_options (); 81 | print_input (); 82 | aux () 83 | | 3, _ | 4, _ -> 84 | (* Handle ^C and ^D *) 85 | print_string "\n"; 86 | flush stdout; 87 | (* Exit with an exception so we can catch it and revert the changes on 88 | stdin. *) 89 | Utils.user_interrupt () 90 | | code, _ -> 91 | (match Char.chr code with 92 | | '1' when List.length options >= 1 -> 93 | select 0 94 | | '2' when List.length options >= 2 -> 95 | select 1 96 | | '3' when List.length options >= 3 -> 97 | select 2 98 | | '4' when List.length options >= 4 -> 99 | select 3 100 | | '5' when List.length options >= 5 -> 101 | select 4 102 | | '6' when List.length options >= 6 -> 103 | select 5 104 | | '7' when List.length options >= 7 -> 105 | select 6 106 | | '8' when List.length options >= 8 -> 107 | select 7 108 | | '9' when List.length options >= 9 -> 109 | select 8 110 | | _ -> 111 | ()); 112 | aux () 113 | in 114 | Utils.with_raw Unix.stdin aux 115 | -------------------------------------------------------------------------------- /lib/prompts/prompt_select.ml: -------------------------------------------------------------------------------- 1 | let print_options ?(style = Style.default) ~selected options = 2 | List.iteri 3 | (fun i opt -> 4 | if i = selected then 5 | Printf.printf 6 | " %s %i) %s" 7 | (Ansi.sprintf style.Style.qmark_format "%s" style.Style.pointer_icon) 8 | (i + 1) 9 | opt 10 | else 11 | Printf.printf " %i) %s" (i + 1) opt; 12 | if not (i + 1 = List.length options) then print_string "\n") 13 | options; 14 | flush stdout 15 | 16 | let print_prompt ?style message = 17 | Utils.print_prompt ?style message; 18 | flush stdout 19 | 20 | let prompt ?default ?style ~options message = 21 | let selected = 22 | match default with 23 | | Some v when v < List.length options -> 24 | ref v 25 | | _ -> 26 | ref 0 27 | in 28 | let print_options () = print_options ~selected:!selected options in 29 | let reset () = 30 | let erase_n_lines = function 31 | | 0 -> 32 | () 33 | | n -> 34 | Ansi.move_bol (); 35 | Ansi.move_cursor 0 (-1 * (n - 1)); 36 | Ansi.erase Ansi.Below; 37 | flush stdout 38 | in 39 | erase_n_lines (List.length options) 40 | in 41 | let up () = 42 | selected := max 0 (!selected - 1); 43 | reset (); 44 | print_options () 45 | in 46 | let down () = 47 | selected := min (List.length options - 1) (!selected + 1); 48 | reset (); 49 | print_options () 50 | in 51 | let select i = 52 | selected := i; 53 | reset (); 54 | print_options () 55 | in 56 | print_prompt ?style message; 57 | print_string "\n"; 58 | print_options (); 59 | flush stdout; 60 | let rec aux () = 61 | let buf = Bytes.create 3 in 62 | let size = input stdin buf 0 3 in 63 | match 64 | ( size 65 | , Char.code (Bytes.get buf 0) 66 | , Char.code (Bytes.get buf 1) 67 | , Char.code (Bytes.get buf 2) ) 68 | with 69 | | 1, 10, _, _ -> 70 | (* Enter *) 71 | reset (); 72 | Ansi.move_cursor 0 (-1); 73 | Ansi.erase Ansi.Eol; 74 | print_prompt ?style message; 75 | let input = List.nth options !selected in 76 | print_string input; 77 | print_string "\n"; 78 | flush stdout; 79 | input 80 | | 1, 12, _, _ -> 81 | (* Handle ^L *) 82 | Ansi.erase Ansi.Screen; 83 | Ansi.set_cursor 1 1; 84 | print_prompt ?style message; 85 | print_string "\n"; 86 | print_options (); 87 | aux () 88 | | 1, (3 | 4), _, _ -> 89 | (* Handle ^C and ^D *) 90 | print_string "\n"; 91 | flush stdout; 92 | (* Exit with an exception so we can catch it and revert the changes on 93 | stdin. *) 94 | Utils.user_interrupt () 95 | | 3, 27, 91, 65 -> 96 | (* UP *) 97 | up (); 98 | aux () 99 | | 3, 27, 91, 66 -> 100 | (* DOWN *) 101 | down (); 102 | aux () 103 | | 1, code, _, _ -> 104 | (match Char.chr code with 105 | | '1' when List.length options >= 1 -> 106 | select 0 107 | | '2' when List.length options >= 2 -> 108 | select 1 109 | | '3' when List.length options >= 3 -> 110 | select 2 111 | | '4' when List.length options >= 4 -> 112 | select 3 113 | | '5' when List.length options >= 5 -> 114 | select 4 115 | | '6' when List.length options >= 6 -> 116 | select 5 117 | | '7' when List.length options >= 7 -> 118 | select 6 119 | | '8' when List.length options >= 8 -> 120 | select 7 121 | | '9' when List.length options >= 9 -> 122 | select 8 123 | | _ -> 124 | ()); 125 | aux () 126 | | _ -> 127 | aux () 128 | in 129 | Utils.with_raw ~hide_cursor:true Unix.stdin aux 130 | -------------------------------------------------------------------------------- /lib/utils.ml: -------------------------------------------------------------------------------- 1 | let exit_on_user_interrupt = ref true 2 | 3 | let exit i = raise (Exn.Exit i) 4 | 5 | let user_interrupt () = 6 | if !exit_on_user_interrupt then ( 7 | prerr_string "\nCancelled by user\n"; 8 | flush stderr; 9 | exit 130) 10 | else 11 | raise Exn.Interrupted_by_user 12 | 13 | let print_prompt ?default ?(style = Style.default) message = 14 | let () = 15 | match style.Style.qmark_icon, default with 16 | | "", Some default -> 17 | Printf.printf 18 | "%s [%s] " 19 | (Ansi.sprintf style.Style.message_format "%s" message) 20 | (Ansi.sprintf style.Style.default_format "%s" default) 21 | | qmark, Some default -> 22 | Printf.printf 23 | "%s %s [%s] " 24 | (Ansi.sprintf style.Style.qmark_format "%s" qmark) 25 | (Ansi.sprintf style.Style.message_format "%s" message) 26 | (Ansi.sprintf style.Style.default_format "%s" default) 27 | | "", None -> 28 | Printf.printf "%s " (Ansi.sprintf style.Style.message_format "%s" message) 29 | | qmark, None -> 30 | Printf.printf 31 | "%s %s " 32 | (Ansi.sprintf style.Style.qmark_format "%s" qmark) 33 | (Ansi.sprintf style.Style.message_format "%s" message) 34 | in 35 | flush stdout 36 | 37 | let print_err ?(style = Style.default) err = 38 | let () = 39 | match style.Style.error_icon with 40 | | "" -> 41 | prerr_string (Ansi.sprintf style.Style.error_format "%s" err) 42 | | _ -> 43 | prerr_string 44 | (Ansi.sprintf 45 | style.Style.error_format 46 | "%s %s" 47 | style.Style.error_icon 48 | err) 49 | in 50 | flush stderr 51 | 52 | let with_cbreak ?(when_ = Unix.TCSANOW) fd f = 53 | if Unix.isatty fd then ( 54 | let term_init = Unix.tcgetattr fd in 55 | Unix.tcsetattr 56 | fd 57 | when_ 58 | { term_init with 59 | Unix.c_icanon = false 60 | ; Unix.c_echo = false 61 | ; Unix.c_vmin = 1 62 | ; Unix.c_vtime = 0 63 | }; 64 | try 65 | let result = f () in 66 | Unix.tcsetattr fd Unix.TCSADRAIN term_init; 67 | result 68 | with 69 | | Exn.Exit i -> 70 | Unix.tcsetattr fd Unix.TCSADRAIN term_init; 71 | Stdlib.exit i 72 | | e -> 73 | Unix.tcsetattr fd Unix.TCSADRAIN term_init; 74 | raise e) 75 | else 76 | f () 77 | 78 | let with_raw ?(hide_cursor = false) ?(when_ = Unix.TCSANOW) fd f = 79 | if Unix.isatty fd then ( 80 | if hide_cursor then ( 81 | Ansi.hide_cursor (); 82 | flush stdout); 83 | let term_init = Unix.tcgetattr fd in 84 | Unix.tcsetattr 85 | fd 86 | when_ 87 | { term_init with 88 | (* Inspired from Python-3.0/Lib/tty.py: *) 89 | Unix.c_brkint = false 90 | ; Unix.c_inpck = false 91 | ; Unix.c_istrip = false 92 | ; Unix.c_ixon = false 93 | ; Unix.c_csize = 8 94 | ; Unix.c_parenb = false 95 | ; Unix.c_echo = false 96 | ; Unix.c_icanon = false 97 | ; Unix.c_vmin = 1 98 | ; Unix.c_vtime = 0 99 | ; Unix.c_isig = false 100 | }; 101 | try 102 | let result = f () in 103 | if hide_cursor then ( 104 | Ansi.show_cursor (); 105 | flush stdout); 106 | Unix.tcsetattr fd Unix.TCSADRAIN term_init; 107 | result 108 | with 109 | | Exn.Exit i -> 110 | if hide_cursor then ( 111 | Ansi.show_cursor (); 112 | flush stdout); 113 | Unix.tcsetattr fd Unix.TCSADRAIN term_init; 114 | Stdlib.exit i 115 | | e -> 116 | Unix.tcsetattr fd Unix.TCSADRAIN term_init; 117 | if hide_cursor then 118 | Ansi.show_cursor (); 119 | raise e) 120 | else 121 | f () 122 | 123 | let erase_n_chars x = 124 | Ansi.move_cursor (-1 * x) 0; 125 | let rec aux acc i = 126 | if i = 0 then 127 | acc 128 | else 129 | aux (acc ^ " ") (i - 1) 130 | in 131 | print_string (aux "" x); 132 | Ansi.move_cursor (-1 * x) 0 133 | 134 | let erase_default x = erase_n_chars (2 + String.length x) 135 | 136 | let erase_default_opt = function None -> () | Some x -> erase_default x 137 | -------------------------------------------------------------------------------- /lib/prompts/prompt_confirm.ml: -------------------------------------------------------------------------------- 1 | let prompt_auto_enter ?default print_prompt = 2 | print_prompt (); 3 | let rec aux () = 4 | let ch = Char.code (input_char stdin) in 5 | match ch, default with 6 | | 89, _ | 121, _ -> 7 | (* 'Y' | 'y' *) 8 | Utils.erase_n_chars 6; 9 | print_endline "Yes"; 10 | flush stdout; 11 | true 12 | | 78, _ | 110, _ -> 13 | (* 'N' | 'n' *) 14 | Utils.erase_n_chars 6; 15 | print_endline "No"; 16 | flush stdout; 17 | false 18 | | 10, Some default -> 19 | (* Enter *) 20 | Utils.erase_n_chars 6; 21 | if default then 22 | print_endline "Yes" 23 | else 24 | print_endline "No"; 25 | flush stdout; 26 | default 27 | | 10, None -> 28 | (* Enter *) 29 | aux () 30 | | 12, _ -> 31 | (* Handle ^L *) 32 | Ansi.erase Ansi.Screen; 33 | Ansi.set_cursor 1 1; 34 | print_prompt (); 35 | aux () 36 | | 3, _ | 4, _ -> 37 | (* Handle ^C and ^D *) 38 | print_string "\n"; 39 | flush stdout; 40 | (* Exit with an exception so we can catch it and revert the changes on 41 | stdin. *) 42 | Utils.user_interrupt () 43 | | _ -> 44 | aux () 45 | in 46 | Utils.with_raw Unix.stdin aux 47 | 48 | let prompt_no_auto_enter ?default print_prompt = 49 | print_prompt (); 50 | let print_selection ~current selection = 51 | let () = 52 | match current with 53 | | Some true -> 54 | (* Erase "Yes" *) 55 | Utils.erase_n_chars 3 56 | | Some false -> 57 | (* Erase "No" *) 58 | Utils.erase_n_chars 2 59 | | None -> 60 | () 61 | in 62 | if selection then 63 | print_string "Yes" 64 | else 65 | print_string "No"; 66 | flush stdout 67 | in 68 | let rec aux selection = 69 | let ch = Char.code (input_char stdin) in 70 | match ch with 71 | | 89 | 121 -> 72 | (* 'Y' | 'y' *) 73 | print_selection ~current:selection true; 74 | aux (Some true) 75 | | 78 | 110 -> 76 | (* 'N' | 'n' *) 77 | print_selection ~current:selection false; 78 | aux (Some false) 79 | | 10 -> 80 | (match selection, default with 81 | | Some true, _ -> 82 | (* Erase current selection with default tooltip *) 83 | Utils.erase_n_chars 9; 84 | print_string "Yes\n"; 85 | flush stdout; 86 | true 87 | | None, Some true -> 88 | (* Erase current selection with default tooltip *) 89 | (match default with Some _ -> Utils.erase_n_chars 6 | None -> ()); 90 | print_string "Yes\n"; 91 | flush stdout; 92 | true 93 | | Some false, _ -> 94 | (* Erase current selection with default tooltip *) 95 | Utils.erase_n_chars 8; 96 | print_string "No\n"; 97 | flush stdout; 98 | false 99 | | None, Some false -> 100 | (* Erase current selection with default tooltip *) 101 | (match default with Some _ -> Utils.erase_n_chars 6 | None -> ()); 102 | print_string "No\n"; 103 | flush stdout; 104 | false 105 | | None, None -> 106 | aux None) 107 | | 12 -> 108 | (* Handle ^L *) 109 | Ansi.erase Ansi.Screen; 110 | Ansi.set_cursor 1 1; 111 | print_prompt (); 112 | Option.iter 113 | (fun selection -> print_selection ~current:None selection) 114 | selection; 115 | aux selection 116 | | 3 -> 117 | (* Handle ^C *) 118 | print_endline "\n\nCancelled by user\n"; 119 | (* Exit with an exception so we can catch it and revert the changes on 120 | stdin. *) 121 | Utils.exit 130 122 | | _ -> 123 | aux selection 124 | in 125 | Utils.with_raw Unix.stdin (fun () -> aux None) 126 | 127 | let prompt ?default ?(auto_enter = true) ?style message = 128 | let default_str = 129 | match default with 130 | | Some true -> 131 | "Y/n" 132 | | Some false -> 133 | "y/N" 134 | | None -> 135 | "y/n" 136 | in 137 | let print_prompt () = 138 | Utils.print_prompt ~default:default_str ?style message 139 | in 140 | if auto_enter then 141 | prompt_auto_enter ?default print_prompt 142 | else 143 | prompt_no_auto_enter ?default print_prompt 144 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/ansi_win.ml: -------------------------------------------------------------------------------- 1 | (* File: Ansi_win.ml 2 | 3 | Copyright 2010 by Vincent Hugot vincent.hugot@gmail.com www.vincent-hugot.com 4 | 5 | Copyright 2010 by Troestler Christophe Christophe.Troestler@umons.ac.be 6 | 7 | This library is free software; you can redistribute it and/or modify it under 8 | the terms of the GNU Lesser General Public License version 3 as published by 9 | the Free Software Foundation, with the special exception on linking described 10 | in file LICENSE. 11 | 12 | This library is distributed in the hope that it will be useful, but WITHOUT 13 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 14 | FOR A PARTICULAR PURPOSE. See the file LICENSE for more details. *) 15 | 16 | open Printf 17 | include Ansi_common 18 | 19 | exception Error of string * string 20 | 21 | let () = Callback.register_exception "Ansi.Error" (Error ("", "")) 22 | 23 | let isatty = ref Unix.isatty 24 | 25 | let is_out_channel_atty ch = !isatty (Unix.descr_of_out_channel ch) 26 | 27 | type rgb = 28 | | R 29 | | G 30 | | B 31 | 32 | let rgb_of_color = function 33 | | Red | Bright_red -> 34 | [ R ] 35 | | Green | Bright_green -> 36 | [ G ] 37 | | Blue | Bright_blue -> 38 | [ B ] 39 | | White | Bright_white -> 40 | [ R; G; B ] 41 | | Cyan | Bright_cyan -> 42 | [ B; G ] 43 | | Magenta | Bright_magenta -> 44 | [ B; R ] 45 | | Yellow | Bright_yellow -> 46 | [ R; G ] 47 | | Black | Bright_black -> 48 | [] 49 | | Default -> 50 | [] 51 | 52 | (* calls to SetConsoleTextAttribute replace one another, so foreground, 53 | background and bold must be set in the same action *) 54 | type color_state = 55 | { fore : rgb list 56 | ; back : rgb list 57 | ; bold : bool 58 | (* could intensify background too, but Unix does not support that so 59 | scrapped. *) 60 | } 61 | 62 | let empty = { fore = [ R; G; B ]; back = []; bold = false } 63 | 64 | let state_of_styles sty = 65 | List.fold_left 66 | (fun sta style -> 67 | match style with 68 | | Reset -> 69 | empty (* could stop there, but does not, for exact compat with ansi *) 70 | | Bold -> 71 | { sta with bold = true } 72 | | Inverse -> 73 | (* simulated inverse... not exact compat *) 74 | let oba = sta.back 75 | and ofo = sta.fore in 76 | { sta with fore = oba; back = ofo } 77 | | Foreground c -> 78 | { sta with fore = rgb_of_color c } 79 | | Background c -> 80 | { sta with back = rgb_of_color c } 81 | | _ -> 82 | sta) 83 | empty 84 | sty 85 | 86 | let int_of_state st = 87 | (* Quoth wincon.h #define FOREGROUND_BLUE 1 #define FOREGROUND_GREEN 2 #define 88 | FOREGROUND_RED 4 #define FOREGROUND_INTENSITY 8 #define BACKGROUND_BLUE 16 89 | #define BACKGROUND_GREEN 32 #define BACKGROUND_RED 64 #define 90 | BACKGROUND_INTENSITY 128 *) 91 | let fo = function R -> 4 | G -> 2 | B -> 1 92 | and ba = function R -> 64 | G -> 32 | B -> 16 93 | and sum mode rgb = List.fold_left ( lor ) 0 (List.map mode rgb) in 94 | sum fo st.fore lor sum ba st.back lor if st.bold then 8 else 0 95 | (* let win_set_style code = printf "<%d>" code let win_unset_style () = printf 96 | "" *) 97 | 98 | external win_set_style : out_channel -> int -> unit = "Ansi_set_style" 99 | 100 | external win_unset_style : out_channel -> int -> unit = "Ansi_unset_style" 101 | 102 | (* [win_unset_style] is the same as [win_set_style] except for the error 103 | message. *) 104 | external win_get_style : out_channel -> int = "Ansi_get_style" 105 | 106 | let channel_styles = Hashtbl.create 8 107 | 108 | let set_style ch styles = 109 | let prev_sty = win_get_style ch in 110 | Hashtbl.add channel_styles ch prev_sty; 111 | let st = int_of_state (state_of_styles styles) in 112 | flush ch; 113 | win_set_style ch st; 114 | flush ch 115 | 116 | let unset_style ch = 117 | flush ch; 118 | try 119 | win_unset_style ch (Hashtbl.find channel_styles ch); 120 | Hashtbl.remove channel_styles ch 121 | with 122 | | Not_found -> 123 | () 124 | 125 | let print ch styles txt = 126 | let tty = is_out_channel_atty ch in 127 | if tty then set_style ch styles; 128 | output_string ch txt; 129 | flush ch; 130 | if tty && !autoreset then unset_style ch 131 | 132 | let print_string = print stdout 133 | 134 | let prerr_string = print stderr 135 | 136 | let printf style = kprintf (print_string style) 137 | 138 | let eprintf style = ksprintf (prerr_string style) 139 | 140 | let sprintf _style = sprintf 141 | 142 | external set_cursor_ : int -> int -> unit = "Ansi_SetCursorPosition" 143 | 144 | external pos_cursor : unit -> int * int = "Ansi_pos" 145 | 146 | external scroll : int -> unit = "Ansi_Scroll" 147 | 148 | external size : unit -> int * int = "Ansi_size" 149 | 150 | external resize_ : int -> int -> unit = "Ansi_resize" 151 | 152 | let set_cursor x y = 153 | if is_out_channel_atty stdout then 154 | let x0, y0 = pos_cursor () in 155 | let x = if x <= 0 then x0 else x 156 | and y = if y <= 0 then y0 else y in 157 | set_cursor_ x y 158 | (* FIXME: (x,y) outside the console?? *) 159 | 160 | let move_cursor dx dy = 161 | if is_out_channel_atty stdout then 162 | let x0, y0 = pos_cursor () in 163 | let x = x0 + dx 164 | and y = y0 + dy in 165 | let x = if x <= 0 then 1 else x 166 | and y = if y <= 0 then 1 else y in 167 | set_cursor_ x y 168 | (* FIXME: (x,y) outside the console?? *) 169 | 170 | let move_bol () = 171 | if is_out_channel_atty stdout then 172 | let _, y0 = pos_cursor () in 173 | set_cursor_ 1 y0 174 | 175 | let saved_x = ref 0 176 | 177 | let saved_y = ref 0 178 | 179 | let save_cursor () = 180 | if is_out_channel_atty stdout then ( 181 | let x, y = pos_cursor () in 182 | saved_x := x; 183 | saved_y := y) 184 | 185 | let restore_cursor () = 186 | if is_out_channel_atty stdout then set_cursor_ !saved_x !saved_y 187 | 188 | let show_cursor () = () 189 | 190 | let hide_cursor () = () 191 | 192 | let resize x y = 193 | if is_out_channel_atty stdout then 194 | (* The specified width and height cannot be less than the width and height 195 | of the console screen buffer's window. *) 196 | let xmin, ymin = size () in 197 | let x = if x <= xmin then xmin else x 198 | and y = if y <= ymin then ymin else y in 199 | resize_ x y 200 | 201 | external fill 202 | : out_channel 203 | -> char 204 | -> n:int 205 | -> x:int 206 | -> y:int 207 | -> int 208 | = "Ansi_FillConsoleOutputCharacter" 209 | (* Writes the character to the console screen buffer [n] times, beginning at the 210 | coordinates [(x,y)]. Returns the number of chars actually written. *) 211 | 212 | let erase loc = 213 | if is_out_channel_atty stdout then 214 | let w, h = size () in 215 | match loc with 216 | | Eol -> 217 | let x, y = pos_cursor () in 218 | ignore (fill stdout ' ' ~n:(w - x + 1) ~x ~y) 219 | | Above -> 220 | let x, y = pos_cursor () in 221 | ignore (fill stdout ' ' ~n:(((y - 1) * w) + x) ~x:1 ~y:1) 222 | | Below -> 223 | let x, y = pos_cursor () in 224 | ignore (fill stdout ' ' ~n:(w - x + 1 + ((h - y) * w)) ~x ~y) 225 | | Screen -> 226 | ignore (fill stdout ' ' ~n:(w * h) ~x:1 ~y:1) 227 | (* Local Variables: *) 228 | (* compile-command: "make Ansi_win.cmo" *) 229 | (* End: *) 230 | -------------------------------------------------------------------------------- /lib/inquire.mli: -------------------------------------------------------------------------------- 1 | (** Inquire is a high-level library to create interactive command line 2 | interfaces. *) 3 | 4 | exception Interrupted_by_user 5 | 6 | module Style : sig 7 | (** Module to customize Inquire prompts. *) 8 | 9 | (** Available colors. *) 10 | type color = 11 | | Black 12 | | Red 13 | | Green 14 | | Yellow 15 | | Blue 16 | | Magenta 17 | | Cyan 18 | | White 19 | | Bright_black 20 | | Bright_red 21 | | Bright_green 22 | | Bright_yellow 23 | | Bright_blue 24 | | Bright_magenta 25 | | Bright_cyan 26 | | Bright_white 27 | | Default 28 | 29 | (** Various styles for the text. [Blink] and [Hidden] may not work on every 30 | terminal. *) 31 | type style = 32 | | Reset 33 | | Bold 34 | | Underlined 35 | | Blink 36 | | Inverse 37 | | Hidden 38 | | Foreground of color 39 | | Background of color 40 | 41 | val black : style 42 | (** Shortcut for [Foreground Black] *) 43 | 44 | val red : style 45 | (** Shortcut for [Foreground Red] *) 46 | 47 | val green : style 48 | (** Shortcut for [Foreground Green] *) 49 | 50 | val yellow : style 51 | (** Shortcut for [Foreground Yellow] *) 52 | 53 | val blue : style 54 | (** Shortcut for [Foreground Blue] *) 55 | 56 | val magenta : style 57 | (** Shortcut for [Foreground Magenta] *) 58 | 59 | val cyan : style 60 | (** Shortcut for [Foreground Cyan] *) 61 | 62 | val white : style 63 | (** Shortcut for [Foreground White] *) 64 | 65 | val bg_black : style 66 | (** Shortcut for [Background Black] *) 67 | 68 | val bg_red : style 69 | (** Shortcut for [Background Red] *) 70 | 71 | val bg_green : style 72 | (** Shortcut for [Background Green] *) 73 | 74 | val bg_yellow : style 75 | (** Shortcut for [Background Yellow] *) 76 | 77 | val bg_blue : style 78 | (** Shortcut for [Background Blue] *) 79 | 80 | val bg_magenta : style 81 | (** Shortcut for [Background Magenta] *) 82 | 83 | val bg_cyan : style 84 | (** Shortcut for [Background Cyan] *) 85 | 86 | val bg_white : style 87 | (** Shortcut for [Background White] *) 88 | 89 | val bg_default : style 90 | (** Shortcut for [Background Default] *) 91 | 92 | val bold : style 93 | (** Shortcut for [Bold] *) 94 | 95 | val underlined : style 96 | (** Shortcut for [Underlined] *) 97 | 98 | val blink : style 99 | (** Shortcut for [Blink] *) 100 | 101 | val inverse : style 102 | (** Shortcut for [Inverse] *) 103 | 104 | val hidden : style 105 | (** Shortcut for [Hidden] *) 106 | 107 | type t 108 | 109 | val default : t 110 | (** The default style used by Inquire prompts if none is provided. *) 111 | 112 | val make 113 | : ?qmark_icon:string 114 | -> ?qmark_format:Ansi.style list 115 | -> ?message_format:Ansi.style list 116 | -> ?error_icon:string 117 | -> ?error_format:Ansi.style list 118 | -> ?default_format:Ansi.style list 119 | -> ?option_icon_marked:string 120 | -> ?option_icon_unmarked:string 121 | -> ?pointer_icon:string 122 | -> unit 123 | -> t 124 | (** Create a custom style. 125 | 126 | - [qmark_icon] is the icon used for the question mark that prefixes the 127 | prompt. 128 | - [qmark_format] is the format of the question mark. 129 | - [message_format] is the format of the prompt message. 130 | - [error_icon] is the icon used for error messages. 131 | - [error_format] is the format used for the error messages. 132 | - [default_format] is the format used for the default tooltip of the 133 | prompt, if present. 134 | - [option_icon_marked] is the icon used to mark selected options in 135 | multi-selection prompts. 136 | - [option_icon_unmarked] is the icon used to mark unselected options in 137 | multi-selection prompts. 138 | - [pointer_icon] is the icon used to mark the selected option in 139 | single-selection prompts. *) 140 | end 141 | 142 | val confirm 143 | : ?default:bool 144 | -> ?auto_enter:bool 145 | -> ?style:Style.t 146 | -> string 147 | -> bool 148 | (** Prompt the user to answer the given message with "y" or "n". 149 | 150 | {4 Examples} 151 | 152 | {[ 153 | Inquire.confirm "Are you sure?" ~default:true |> fun choice -> 154 | if choice then print_endline "Yes!" else print_endline "No!" 155 | ]} *) 156 | 157 | val password 158 | : ?validate:(string -> (string, string) result) 159 | -> ?default:string 160 | -> ?style:Style.t 161 | -> string 162 | -> string 163 | (** Prompt the user to enter a password that will be hidden. 164 | 165 | The password can take any value, except the empty string. 166 | 167 | On Unix, this works by setting the echo mode of the terminal to off. 168 | 169 | On Windows, we print "\x1b[8m" before prompting the password and "\x1b[0m" 170 | after. 171 | 172 | {4 Examples} 173 | 174 | {[ Inquire.password "Enter your password:" |> fun password -> print_endline 175 | "Your new password is: %S" password ]} *) 176 | 177 | val input 178 | : ?validate:(string -> (string, string) result) 179 | -> ?default:string 180 | -> ?style:Style.t 181 | -> string 182 | -> string 183 | (** Prompt the user to input a string. 184 | 185 | The string can take any value, except the empty string. 186 | 187 | {4 Examples} 188 | 189 | {[ 190 | Inquire.input "Enter a value:" |> fun value -> 191 | print_endline "You entered: %S" value 192 | ]} *) 193 | 194 | val raw_select 195 | : ?default:int 196 | -> ?style:Style.t 197 | -> options:string list 198 | -> string 199 | -> string 200 | (** Prompt the user to chose a value from the given options. The options will be 201 | listed with an index prefixed and the users will have to enter the index of 202 | their choice. 203 | 204 | Note that [raw_select] does not support more than 9 options. If you need 205 | more options, please use [select] instead. 206 | 207 | {4 Examples} 208 | 209 | {[ 210 | let movies = 211 | [ "Star Wars: The Rise of Skywalker" 212 | ; "Solo: A Star Wars Story" 213 | ; "Star Wars: The Last Jedi" 214 | ; "Rogue One: A Star Wars Story" 215 | ; "Star Wars: The Force Awakens" 216 | ] 217 | in 218 | Inquire.raw_select "What's your favorite movie?" ~options:movies 219 | |> fun movie -> print_endline "Indeed, %S is a great movie!" movie 220 | ]} *) 221 | 222 | val select 223 | : ?default:int 224 | -> ?style:Style.t 225 | -> options:string list 226 | -> string 227 | -> string 228 | (** Prompt the user to chose a value from the given options. The prompt is 229 | interactive and users can select their choice with directional keys. 230 | 231 | {4 Examples} 232 | 233 | {[ 234 | let movies = 235 | [ "Star Wars: The Rise of Skywalker" 236 | ; "Solo: A Star Wars Story" 237 | ; "Star Wars: The Last Jedi" 238 | ; "Rogue One: A Star Wars Story" 239 | ; "Star Wars: The Force Awakens" 240 | ] 241 | in 242 | Inquire.select "What's your favorite movie?" ~options:movies 243 | |> fun movie -> print_endline "Indeed, %S is a great movie!" movie 244 | ]} *) 245 | 246 | val set_exit_on_user_interrupt : bool -> unit 247 | (** Configure the behavior on user interruptions during a prompt. 248 | 249 | If [exit_on_user_interrupt] is [true], the program will exit with status 250 | code [130]. If it is [false], an [Interrupted_by_user] exception is raised. 251 | 252 | The default behavior is to exit on user interruptions. *) 253 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/ansi.mli: -------------------------------------------------------------------------------- 1 | (* File: Ansi.mli 2 | 3 | Copyright 2004 Troestler Christophe Christophe.Troestler(at)umons.ac.be 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License version 3 as published by 7 | the Free Software Foundation, with the special exception on linking described 8 | in file LICENSE. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the file LICENSE for more details. *) 13 | 14 | (** This module offers basic control of ANSI compliant terminals and the windows 15 | shell. 16 | 17 | The functions below do not send ANSI codes (i.e., do nothing or only print 18 | the output) when then output is not connected to a TTY. Functions providing 19 | information (such as {!pos_cursor}) fail when in that situation. TTY 20 | detection is configurable by changing the value of {!isatty}. 21 | 22 | This library is not thread safe. 23 | 24 | @author Christophe Troestler (Christophe.Troestler@umons.ac.be) 25 | @author Vincent Hugot (vincent.hugot@gmail.com) *) 26 | 27 | (** {2 Colors and style} *) 28 | 29 | (** Available colors. *) 30 | type color = 31 | | Black 32 | | Red 33 | | Green 34 | | Yellow 35 | | Blue 36 | | Magenta 37 | | Cyan 38 | | White 39 | | Bright_black 40 | | Bright_red 41 | | Bright_green 42 | | Bright_yellow 43 | | Bright_blue 44 | | Bright_magenta 45 | | Bright_cyan 46 | | Bright_white 47 | | Default (** Default color of the terminal *) 48 | 49 | (** Various styles for the text. [Blink] and [Hidden] may not work on every 50 | terminal. *) 51 | type style = 52 | | Reset 53 | | Bold 54 | | Underlined 55 | | Blink 56 | | Inverse 57 | | Hidden 58 | | Foreground of color 59 | | Background of color 60 | 61 | val black : style 62 | (** Shortcut for [Foreground Black] *) 63 | 64 | val red : style 65 | (** Shortcut for [Foreground Red] *) 66 | 67 | val green : style 68 | (** Shortcut for [Foreground Green] *) 69 | 70 | val yellow : style 71 | (** Shortcut for [Foreground Yellow] *) 72 | 73 | val blue : style 74 | (** Shortcut for [Foreground Blue] *) 75 | 76 | val magenta : style 77 | (** Shortcut for [Foreground Magenta] *) 78 | 79 | val cyan : style 80 | (** Shortcut for [Foreground Cyan] *) 81 | 82 | val white : style 83 | (** Shortcut for [Foreground White] *) 84 | 85 | val default : style 86 | (** Shortcut for [Foreground Default] *) 87 | 88 | val bg_black : style 89 | (** Shortcut for [Background Black] *) 90 | 91 | val bg_red : style 92 | (** Shortcut for [Background Red] *) 93 | 94 | val bg_green : style 95 | (** Shortcut for [Background Green] *) 96 | 97 | val bg_yellow : style 98 | (** Shortcut for [Background Yellow] *) 99 | 100 | val bg_blue : style 101 | (** Shortcut for [Background Blue] *) 102 | 103 | val bg_magenta : style 104 | (** Shortcut for [Background Magenta] *) 105 | 106 | val bg_cyan : style 107 | (** Shortcut for [Background Cyan] *) 108 | 109 | val bg_white : style 110 | (** Shortcut for [Background White] *) 111 | 112 | val bg_default : style 113 | (** Shortcut for [Background Default] *) 114 | 115 | val bold : style 116 | (** Shortcut for [Bold] *) 117 | 118 | val underlined : style 119 | (** Shortcut for [Underlined] *) 120 | 121 | val blink : style 122 | (** Shortcut for [Blink] *) 123 | 124 | val inverse : style 125 | (** Shortcut for [Inverse] *) 126 | 127 | val hidden : style 128 | (** Shortcut for [Hidden] *) 129 | 130 | val set_autoreset : bool -> unit 131 | (** Turns the autoreset feature on and off. It defaults to on. *) 132 | 133 | val print_string : style list -> string -> unit 134 | (** [print_string attr txt] prints the string [txt] with the attibutes [attr]. 135 | After printing, the attributes are automatically reseted to the defaults, 136 | unless autoreset is turned off. *) 137 | 138 | val prerr_string : style list -> string -> unit 139 | (** Like [print_string] but prints on the standard error. *) 140 | 141 | val printf : style list -> ('a, unit, string, unit) format4 -> 'a 142 | (** [printf attr format arg1 ... argN] prints the arguments [arg1],...,[argN] 143 | according to [format] with the attibutes [attr]. After printing, the 144 | attributes are automatically reseted to the defaults, unless autoreset is 145 | turned off. *) 146 | 147 | val eprintf : style list -> ('a, unit, string, unit) format4 -> 'a 148 | (** Same as {!printf} but prints the result on [stderr]. *) 149 | 150 | val sprintf : style list -> ('a, unit, string) format -> 'a 151 | (** Same as {!printf} but returns the result in a string. This only works on 152 | ANSI compliant terminals — for which escape sequences are used — and not 153 | under Windows — where system calls are required. On Windows, it is 154 | identical to the standard [sprintf]. *) 155 | 156 | (** {2 Erasing} *) 157 | 158 | type loc = 159 | | Eol 160 | | Above 161 | | Below 162 | | Screen 163 | 164 | val erase : loc -> unit 165 | (** [erase Eol] clear from the cursor position to the end of the line without 166 | moving the cursor. [erase Above] erases everything before the position of 167 | the cursor. [erase Below] erases everything after the position of the 168 | cursor. [erase Screen] erases the whole screen. 169 | 170 | This function does not modify the position of the cursor. *) 171 | 172 | (** {2 Cursor} *) 173 | 174 | val set_cursor : int -> int -> unit 175 | (** [set_cursor x y] puts the cursor at position [(x,y)], [x] indicating the 176 | column (the leftmost one being 1) and [y] being the line (the topmost one 177 | being 1). If [x <= 0], the [x] coordinate is unchanged; if [y <= 0], the [y] 178 | coordinate is unchanged. *) 179 | 180 | val move_cursor : int -> int -> unit 181 | (** [move_cursor x y] moves the cursor by [x] columns (to the right if [x > 0], 182 | to the left if [x < 0]) and by [y] lines (downwards if [y > 0] and upwards 183 | if [y < 0]). *) 184 | 185 | val move_bol : unit -> unit 186 | (** [move_bol ()] moves the cursor to the beginning of the current line. This is 187 | useful for progress bars for example. *) 188 | 189 | val pos_cursor : unit -> int * int 190 | (** [pos_cursor ()] returns a couple [(x,y)] giving the current position of the 191 | cursor, [x >= 1] being the column and [y >= 1] the row. *) 192 | 193 | val save_cursor : unit -> unit 194 | (** [save_cursor ()] saves the current position of the cursor. *) 195 | 196 | val show_cursor : unit -> unit 197 | (** [show_cursor ()] show the cursor. 198 | 199 | Not implemented on Windows. *) 200 | 201 | val hide_cursor : unit -> unit 202 | (** [show_cursor ()] hidex the cursor. 203 | 204 | Not implemented on Windows. *) 205 | 206 | val restore_cursor : unit -> unit 207 | (** [restore_cursor ()] replaces the cursor to the position saved with 208 | [save_cursor ()]. *) 209 | 210 | (** {2 Size} *) 211 | 212 | val resize : int -> int -> unit 213 | (** [resize width height] resize the current terminal to the given [width] and 214 | [height]. *) 215 | 216 | val size : unit -> int * int 217 | (** [size ()] returns a pair [(width, height)] giving the size of the terminal 218 | in character cells. *) 219 | 220 | (** {2 Scrolling} *) 221 | 222 | val scroll : int -> unit 223 | (** [scroll n] scrolls the terminal by [n] lines, up (creating new lines at the 224 | bottom) if [n > 0] and down if [n < 0]. *) 225 | 226 | (** {2 TTY} *) 227 | 228 | val isatty : (Unix.file_descr -> bool) ref 229 | (** Function used to detect whether the current output is connected to a TTY. 230 | Defaults to [Unix.isatty]. *) 231 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/ansi_unix.ml: -------------------------------------------------------------------------------- 1 | (* File: Ansi_unix.ml 2 | 3 | Allow colors, cursor movements, erasing,... under Unix shells. 4 | ********************************************************************* 5 | 6 | Copyright 2004 by Troestler Christophe Christophe.Troestler(at)umons.ac.be 7 | 8 | This library is free software; you can redistribute it and/or modify it under 9 | the terms of the GNU Lesser General Public License version 3 as published by 10 | the Free Software Foundation, with the special exception on linking described 11 | in file LICENSE. 12 | 13 | This library is distributed in the hope that it will be useful, but WITHOUT 14 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 15 | FOR A PARTICULAR PURPOSE. See the file LICENSE for more details. *) 16 | 17 | (* man tty(4) *) 18 | 19 | open Printf 20 | open Scanf 21 | include Ansi_common 22 | 23 | let isatty = ref Unix.isatty 24 | 25 | let is_out_channel_atty ch = !isatty (Unix.descr_of_out_channel ch) 26 | 27 | (* Cursor *) 28 | 29 | let set_cursor x y = 30 | if is_out_channel_atty stdout then 31 | if x <= 0 then ( 32 | if y > 0 then 33 | printf "\027[%id%!" y) 34 | else if (* x > 0 *) y <= 0 then 35 | printf "\027[%iG%!" x 36 | else 37 | printf "\027[%i;%iH%!" y x 38 | 39 | let move_cursor x y = 40 | if is_out_channel_atty stdout then ( 41 | if x > 0 then 42 | printf "\027[%iC%!" x 43 | else if x < 0 then 44 | printf "\027[%iD%!" (-x); 45 | if y > 0 then 46 | printf "\027[%iB%!" y 47 | else if y < 0 then 48 | printf "\027[%iA%!" (-y)) 49 | 50 | let save_cursor () = if is_out_channel_atty stdout then printf "\027[s%!" 51 | 52 | let restore_cursor () = if is_out_channel_atty stdout then printf "\027[u%!" 53 | 54 | let show_cursor () = if is_out_channel_atty stdout then printf "\027[?25h" 55 | 56 | let hide_cursor () = if is_out_channel_atty stdout then printf "\027[?25l" 57 | 58 | let move_bol () = 59 | print_string "\r"; 60 | flush stdout 61 | 62 | (* Inpired by http://www.ohse.de/uwe/software/resize.c.html and 63 | http://qemacs.sourcearchive.com/documentation/0.3.1.cvs.20050713-5/tty_8c-source.html *) 64 | let send_and_read_response fdin query fmt f = 65 | let alarm = ref false in 66 | let set_alarm (_ : int) = alarm := true in 67 | let old_alarm = Sys.signal Sys.sigalrm (Sys.Signal_handle set_alarm) in 68 | let tty = Unix.tcgetattr fdin in 69 | Unix.tcsetattr 70 | fdin 71 | Unix.TCSANOW 72 | { tty with 73 | Unix.c_ignbrk = false 74 | ; c_brkint = false 75 | ; c_parmrk = false 76 | ; c_istrip = false 77 | ; c_inlcr = false 78 | ; c_igncr = false 79 | ; c_icrnl = false 80 | ; c_ixon = false 81 | ; c_opost = true 82 | ; c_csize = 8 83 | ; c_parenb = false 84 | ; c_icanon = false 85 | ; c_isig = false 86 | ; c_echo = false 87 | ; c_echonl = false 88 | ; c_vmin = 1 89 | ; c_vtime = 0 90 | }; 91 | let restore () = 92 | ignore (Unix.alarm 0); 93 | Unix.tcsetattr fdin Unix.TCSANOW tty; 94 | Sys.set_signal Sys.sigalrm old_alarm 95 | in 96 | let buf = Bytes.make 127 '\000' in 97 | (* FIXME: make it more robust so that it ignores previous key pressed. *) 98 | let rec get_answer pos = 99 | let l = Unix.read fdin buf pos 1 in 100 | let buf = Bytes.unsafe_to_string buf in 101 | (* local use only *) 102 | try sscanf buf fmt f (* bail out as soon as enough info is present *) with 103 | | Scan_failure _ -> 104 | if !alarm || pos = 126 then 105 | failwith "Ansi.input_answer" 106 | else if buf.[pos] = '\000' then 107 | get_answer pos 108 | else 109 | get_answer (pos + l) 110 | in 111 | try 112 | ignore (Unix.write fdin query 0 (Bytes.length query)); 113 | ignore (Unix.alarm 1); 114 | let r = get_answer 0 in 115 | restore (); 116 | r 117 | with 118 | | e -> 119 | restore (); 120 | raise e 121 | 122 | (* Query Cursor Position [6n *) 123 | (* Report Cursor Position [{ROW};{COLUMN}R *) 124 | let pos_cursor_query = Bytes.of_string "\027[6n" 125 | 126 | let pos_cursor () = 127 | if is_out_channel_atty stdout then 128 | try 129 | send_and_read_response 130 | Unix.stdin 131 | pos_cursor_query 132 | "\027[%d;%dR" 133 | (fun y x -> x, y) 134 | with 135 | | _ -> 136 | failwith "Ansi.pos_cursor" 137 | else 138 | failwith "Ansi.pos_cursor: not a TTY" 139 | 140 | (* See also the output of 'resize -s x y' (e.g. in an Emacs shell). *) 141 | let resize width height = 142 | if is_out_channel_atty stdout then ( 143 | if width <= 0 then invalid_arg "Ansi.resize: width <= 0"; 144 | if height <= 0 then invalid_arg "Ansi.resize: height <= 0"; 145 | printf "\027[8;%i;%it%!" height width) 146 | 147 | (* FIXME: what about the following recipe: If you run echo -e "\e[18t" then 148 | xterm will respond with a line of the form ESC [ 8 ; height ; width t It 149 | generates this line as if it were typed input, so it can then be read by your 150 | program on stdin. *) 151 | external size_ : Unix.file_descr -> int * int = "Ansi_term_size" 152 | 153 | let size () = 154 | if !isatty Unix.stdin then 155 | size_ Unix.stdin 156 | else 157 | failwith "Ansi.size: not a TTY" 158 | 159 | (* Erasing *) 160 | 161 | let erase loc = 162 | if is_out_channel_atty stdout then ( 163 | print_string 164 | (match loc with 165 | | Eol -> 166 | "\027[K" 167 | | Above -> 168 | "\027[1J" 169 | | Below -> 170 | "\027[0J" 171 | | Screen -> 172 | "\027[2J"); 173 | flush stdout) 174 | 175 | (* Scrolling *) 176 | 177 | let scroll lines = 178 | if is_out_channel_atty stdout then 179 | if lines > 0 then 180 | printf "\027[%iS%!" lines 181 | else if lines < 0 then 182 | printf "\027[%iT%!" (-lines) 183 | 184 | let style_to_string = function 185 | | Reset -> 186 | "0" 187 | | Bold -> 188 | "1" 189 | | Underlined -> 190 | "4" 191 | | Blink -> 192 | "5" 193 | | Inverse -> 194 | "7" 195 | | Hidden -> 196 | "8" 197 | | Foreground Black -> 198 | "30" 199 | | Foreground Red -> 200 | "31" 201 | | Foreground Green -> 202 | "32" 203 | | Foreground Yellow -> 204 | "33" 205 | | Foreground Blue -> 206 | "34" 207 | | Foreground Magenta -> 208 | "35" 209 | | Foreground Cyan -> 210 | "36" 211 | | Foreground White -> 212 | "37" 213 | | Foreground Bright_black -> 214 | "30;1" 215 | | Foreground Bright_red -> 216 | "31;1" 217 | | Foreground Bright_green -> 218 | "32;1" 219 | | Foreground Bright_yellow -> 220 | "33;1" 221 | | Foreground Bright_blue -> 222 | "34;1" 223 | | Foreground Bright_magenta -> 224 | "35;1" 225 | | Foreground Bright_cyan -> 226 | "36;1" 227 | | Foreground Bright_white -> 228 | "37;1" 229 | | Foreground Default -> 230 | "39" 231 | | Background Black -> 232 | "40" 233 | | Background Red -> 234 | "41" 235 | | Background Green -> 236 | "42" 237 | | Background Yellow -> 238 | "43" 239 | | Background Blue -> 240 | "44" 241 | | Background Magenta -> 242 | "45" 243 | | Background Cyan -> 244 | "46" 245 | | Background White -> 246 | "47" 247 | | Background Bright_black -> 248 | "40;1" 249 | | Background Bright_red -> 250 | "41;1" 251 | | Background Bright_green -> 252 | "42;1" 253 | | Background Bright_yellow -> 254 | "43;1" 255 | | Background Bright_blue -> 256 | "44;1" 257 | | Background Bright_magenta -> 258 | "45;1" 259 | | Background Bright_cyan -> 260 | "46;1" 261 | | Background Bright_white -> 262 | "47;1" 263 | | Background Default -> 264 | "49" 265 | 266 | let print_with pr ~tty style txt = 267 | if tty then ( 268 | pr "\027["; 269 | pr (String.concat ";" (List.map style_to_string style)); 270 | pr "m"); 271 | pr txt; 272 | if tty && !autoreset then pr "\027[0m" 273 | 274 | let print_string style txt = 275 | print_with print_string style txt ~tty:(is_out_channel_atty stdout) 276 | 277 | let prerr_string style txt = 278 | print_with prerr_string style txt ~tty:(is_out_channel_atty stderr) 279 | 280 | let printf style = ksprintf (print_string style) 281 | 282 | let eprintf style = ksprintf (prerr_string style) 283 | 284 | let to_string style txt = 285 | let s = 286 | "\027[" ^ String.concat ";" (List.map style_to_string style) ^ "m" ^ txt 287 | in 288 | if !autoreset then s ^ "\027[0m" else s 289 | 290 | let sprintf style = ksprintf (to_string style) 291 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/src/ansi_win_stubs.c: -------------------------------------------------------------------------------- 1 | /* Ansi; windows API calls 2 | 3 | Allow colors, cursor movements, erasing,... under Unix and DOS shells. 4 | ********************************************************************* 5 | 6 | Copyright 2010 by Christophe Troestler 7 | http://math.umons.ac.be/an/software/ 8 | 9 | Copyright 2010 by Vincent Hugot 10 | vincent.hugot@gmail.com 11 | www.vincent-hugot.com 12 | 13 | This library is free software; you can redistribute it and/or 14 | modify it under the terms of the GNU Lesser General Public License 15 | version 2.1 as published by the Free Software Foundation, with the 16 | special exception on linking described in file LICENSE. 17 | 18 | This library is distributed in the hope that it will be useful, but 19 | WITHOUT ANY WARRANTY; without even the implied warranty of 20 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file 21 | LICENSE for more details. 22 | */ 23 | 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | #include 31 | 32 | #include "io.h" 33 | 34 | /* From otherlibs/win32unix/channels.c */ 35 | extern long _get_osfhandle(int); 36 | #define HANDLE_OF_CHAN(vchan) ((HANDLE)_get_osfhandle(Channel(vchan)->fd)) 37 | 38 | static HANDLE hStdout; 39 | static CONSOLE_SCREEN_BUFFER_INFO *csbiInfo = NULL; 40 | 41 | void raise_error(char *fname, char *msg) { 42 | CAMLparam0(); 43 | CAMLlocal2(vfname, vmsg); 44 | static value *exn = NULL; 45 | value args[2]; 46 | 47 | if (exn == NULL) { 48 | /* First time around, look up by name */ 49 | exn = caml_named_value("Ansi.Error"); 50 | } 51 | vfname = caml_copy_string(fname); 52 | vmsg = caml_copy_string(msg); 53 | args[0] = vfname; 54 | args[1] = vmsg; 55 | caml_raise_with_args(*exn, 2, args); 56 | CAMLnoreturn; 57 | } 58 | 59 | void exn_of_error(char *fname, BOOL cond) { 60 | CAMLparam0(); 61 | CAMLlocal2(vfname, vmsg); 62 | char *msg, *p; 63 | LPVOID lpMsgBuf; 64 | static value *exn = NULL; 65 | value args[2]; 66 | 67 | if (cond) { 68 | if (exn == NULL) { 69 | /* First time around, look up by name */ 70 | exn = caml_named_value("Ansi.Error"); 71 | } 72 | FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | 73 | FORMAT_MESSAGE_IGNORE_INSERTS, 74 | NULL, GetLastError(), 75 | MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR)&lpMsgBuf, 76 | 0, NULL); 77 | vfname = caml_copy_string(fname); 78 | msg = (char *)lpMsgBuf; 79 | p = msg + strlen(msg) - 1; 80 | while (*p == '\n' || *p == '\r') { 81 | *p = '\0'; 82 | p--; 83 | } 84 | vmsg = caml_copy_string(msg); 85 | LocalFree(lpMsgBuf); 86 | args[0] = vfname; 87 | args[1] = vmsg; 88 | caml_raise_with_args(*exn, 2, args); 89 | } 90 | CAMLreturn0; 91 | } 92 | 93 | #define SET_CSBI(fname) \ 94 | if (!csbiInfo) { \ 95 | hStdout = GetStdHandle(STD_OUTPUT_HANDLE); \ 96 | if (hStdout == INVALID_HANDLE_VALUE) { \ 97 | raise_error(fname, "Invalid stdout handle"); \ 98 | } \ 99 | exn_of_error(fname, !GetConsoleScreenBufferInfo(hStdout, csbiInfo)); \ 100 | } 101 | 102 | #define SET_STYLE(fname) \ 103 | CAMLexport value Ansi_##fname(value vchan, value vcode) { \ 104 | HANDLE h = HANDLE_OF_CHAN(vchan); \ 105 | int code = Int_val(vcode); \ 106 | \ 107 | exn_of_error("Ansi." #fname, !SetConsoleTextAttribute(h, code)); \ 108 | return Val_unit; \ 109 | } 110 | 111 | SET_STYLE(set_style) 112 | SET_STYLE(unset_style) 113 | 114 | CAMLexport value Ansi_get_style(value vchan) { 115 | HANDLE h = HANDLE_OF_CHAN(vchan); 116 | CONSOLE_SCREEN_BUFFER_INFO info; 117 | 118 | /* To save the previous info when setting style */ 119 | exn_of_error("Ansi.set_style", !GetConsoleScreenBufferInfo(h, &info)); 120 | 121 | return (Val_int(info.wAttributes)); 122 | } 123 | 124 | CAMLexport value Ansi_pos(value vunit) { 125 | CAMLparam1(vunit); 126 | CAMLlocal1(vpos); 127 | SMALL_RECT w; 128 | SHORT x, y; 129 | 130 | exn_of_error("Ansi.pos_cursor", 131 | !GetConsoleScreenBufferInfo(hStdout, csbiInfo)); 132 | w = csbiInfo->srWindow; 133 | /* The topmost left character has pos (1,1) */ 134 | x = csbiInfo->dwCursorPosition.X - w.Left + 1; 135 | y = csbiInfo->dwCursorPosition.Y - w.Top + 1; 136 | 137 | vpos = caml_alloc_tuple(2); 138 | Store_field(vpos, 0, Val_int(x)); 139 | Store_field(vpos, 1, Val_int(y)); 140 | CAMLreturn(vpos); 141 | } 142 | 143 | CAMLexport value Ansi_size(value vunit) { 144 | CAMLparam1(vunit); 145 | CAMLlocal1(vsize); 146 | SMALL_RECT w; 147 | 148 | /* Update the global var as the terminal may have been be resized */ 149 | SET_CSBI("Ansi.size"); 150 | exn_of_error("Ansi.size", 151 | !GetConsoleScreenBufferInfo(hStdout, csbiInfo)); 152 | w = csbiInfo->srWindow; 153 | 154 | vsize = caml_alloc_tuple(2); 155 | Store_field(vsize, 0, Val_int(w.Right - w.Left + 1)); 156 | Store_field(vsize, 1, Val_int(w.Bottom - w.Top + 1)); 157 | 158 | CAMLreturn(vsize); 159 | } 160 | 161 | CAMLexport value Ansi_resize(value vx, value vy) { 162 | /* noalloc */ 163 | COORD dwSize; 164 | dwSize.X = Int_val(vx); 165 | dwSize.Y = Int_val(vy); 166 | exn_of_error("Ansi.resize", 167 | !SetConsoleScreenBufferSize(hStdout, dwSize)); 168 | return Val_unit; 169 | } 170 | 171 | CAMLexport value Ansi_SetCursorPosition(value vx, value vy) { 172 | COORD c; 173 | SMALL_RECT w; 174 | 175 | SET_CSBI("Ansi.set_cursor"); 176 | exn_of_error("Ansi.set_cursor", 177 | !GetConsoleScreenBufferInfo(hStdout, csbiInfo)); 178 | /* The top lefmost coordinate is (1,1) for Ansi while it is 179 | * (0,0) for windows. */ 180 | w = csbiInfo->srWindow; 181 | c.X = Int_val(vx) - 1 + w.Left; 182 | c.Y = Int_val(vy) - 1 + w.Top; 183 | 184 | // very subtle debugging method... 185 | fprintf(stderr, "vx,vy = %d,%d --> [c.X,Y = %d,%d ; L %d R %d T %d B %d]\n", 186 | Int_val(vx), Int_val(vy), c.X, c.Y, w.Left, w.Right, w.Top, w.Bottom); 187 | 188 | if (c.X > w.Right) c.X = w.Right; 189 | if (c.Y > w.Bottom) c.Y = w.Bottom; 190 | exn_of_error("Ansi.set_cursor", 191 | !SetConsoleCursorPosition(hStdout, c)); 192 | return Val_unit; 193 | } 194 | 195 | CAMLexport value Ansi_FillConsoleOutputCharacter(value vchan, value vc, 196 | value vlen, value vx, 197 | value vy) { 198 | CAMLparam1(vchan); 199 | HANDLE h = HANDLE_OF_CHAN(vchan); 200 | int NumberOfCharsWritten; 201 | COORD dwWriteCoord; 202 | 203 | SET_CSBI("Ansi.erase"); 204 | exn_of_error("Ansi.erase", 205 | !GetConsoleScreenBufferInfo(hStdout, csbiInfo)); 206 | dwWriteCoord.X = Int_val(vx) - 1 + csbiInfo->srWindow.Left; 207 | dwWriteCoord.Y = Int_val(vy) - 1 + csbiInfo->srWindow.Top; 208 | exn_of_error("Ansi.erase", !FillConsoleOutputCharacter( 209 | h, Int_val(vc), Int_val(vlen), 210 | dwWriteCoord, &NumberOfCharsWritten)); 211 | CAMLreturn(Val_int(NumberOfCharsWritten)); 212 | } 213 | 214 | CAMLexport value Ansi_Scroll(value vx) { 215 | /* noalloc */ 216 | INT x = Int_val(vx); 217 | SMALL_RECT srctScrollRect, srctClipRect; 218 | CHAR_INFO chiFill; 219 | COORD coordDest; 220 | 221 | SET_CSBI("Ansi.scroll"); 222 | srctScrollRect.Left = 0; 223 | srctScrollRect.Top = 1; 224 | srctScrollRect.Right = csbiInfo->dwSize.X - x; 225 | srctScrollRect.Bottom = csbiInfo->dwSize.Y - x; 226 | 227 | // The destination for the scroll rectangle is one row up. 228 | coordDest.X = 0; 229 | coordDest.Y = 0; 230 | 231 | // The clipping rectangle is the same as the scrolling rectangle. 232 | // The destination row is left unchanged. 233 | srctClipRect = srctScrollRect; 234 | 235 | // Set the fill character and attributes. 236 | chiFill.Attributes = FOREGROUND_RED | FOREGROUND_INTENSITY; 237 | chiFill.Char.AsciiChar = (char)' '; 238 | 239 | exn_of_error( 240 | "Ansi.scroll", 241 | !ScrollConsoleScreenBuffer(hStdout, // screen buffer handle 242 | &srctScrollRect, // scrolling rectangle 243 | &srctClipRect, // clipping rectangle 244 | coordDest, // top left destination cell 245 | &chiFill)); // fill character and color 246 | return Val_unit; 247 | } 248 | -------------------------------------------------------------------------------- /vendor/ocaml-ansi/LICENSE: -------------------------------------------------------------------------------- 1 | As a special exception to the GNU Lesser General Public License, you 2 | may link, statically or dynamically, a "work that uses the Library" 3 | with a publicly distributed version of the Library to produce an 4 | executable file containing portions of the Library, and distribute 5 | that executable file under terms of your choice, without any of the 6 | additional requirements listed in clause 6 of the GNU Library General 7 | Public License. By "a publicly distributed version of the Library", 8 | we mean either the unmodified Library as distributed by INRIA, or a 9 | modified version of the Library that is distributed under the 10 | conditions defined in clause 3 of the GNU Library General Public 11 | License. This exception does not however invalidate any other reasons 12 | why the executable file might be covered by the GNU Lesser General 13 | Public License. 14 | 15 | ---------------------------------------------------------------------- 16 | 17 | GNU LESSER GENERAL PUBLIC LICENSE 18 | Version 3, 29 June 2007 19 | 20 | Copyright (C) 2007 Free Software Foundation, Inc. 21 | Everyone is permitted to copy and distribute verbatim copies 22 | of this license document, but changing it is not allowed. 23 | 24 | 25 | This version of the GNU Lesser General Public License incorporates 26 | the terms and conditions of version 3 of the GNU General Public 27 | License, supplemented by the additional permissions listed below. 28 | 29 | 0. Additional Definitions. 30 | 31 | As used herein, "this License" refers to version 3 of the GNU Lesser 32 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 33 | General Public License. 34 | 35 | "The Library" refers to a covered work governed by this License, 36 | other than an Application or a Combined Work as defined below. 37 | 38 | An "Application" is any work that makes use of an interface provided 39 | by the Library, but which is not otherwise based on the Library. 40 | Defining a subclass of a class defined by the Library is deemed a mode 41 | of using an interface provided by the Library. 42 | 43 | A "Combined Work" is a work produced by combining or linking an 44 | Application with the Library. The particular version of the Library 45 | with which the Combined Work was made is also called the "Linked 46 | Version". 47 | 48 | The "Minimal Corresponding Source" for a Combined Work means the 49 | Corresponding Source for the Combined Work, excluding any source code 50 | for portions of the Combined Work that, considered in isolation, are 51 | based on the Application, and not on the Linked Version. 52 | 53 | The "Corresponding Application Code" for a Combined Work means the 54 | object code and/or source code for the Application, including any data 55 | and utility programs needed for reproducing the Combined Work from the 56 | Application, but excluding the System Libraries of the Combined Work. 57 | 58 | 1. Exception to Section 3 of the GNU GPL. 59 | 60 | You may convey a covered work under sections 3 and 4 of this License 61 | without being bound by section 3 of the GNU GPL. 62 | 63 | 2. Conveying Modified Versions. 64 | 65 | If you modify a copy of the Library, and, in your modifications, a 66 | facility refers to a function or data to be supplied by an Application 67 | that uses the facility (other than as an argument passed when the 68 | facility is invoked), then you may convey a copy of the modified 69 | version: 70 | 71 | a) under this License, provided that you make a good faith effort to 72 | ensure that, in the event an Application does not supply the 73 | function or data, the facility still operates, and performs 74 | whatever part of its purpose remains meaningful, or 75 | 76 | b) under the GNU GPL, with none of the additional permissions of 77 | this License applicable to that copy. 78 | 79 | 3. Object Code Incorporating Material from Library Header Files. 80 | 81 | The object code form of an Application may incorporate material from 82 | a header file that is part of the Library. You may convey such object 83 | code under terms of your choice, provided that, if the incorporated 84 | material is not limited to numerical parameters, data structure 85 | layouts and accessors, or small macros, inline functions and templates 86 | (ten or fewer lines in length), you do both of the following: 87 | 88 | a) Give prominent notice with each copy of the object code that the 89 | Library is used in it and that the Library and its use are 90 | covered by this License. 91 | 92 | b) Accompany the object code with a copy of the GNU GPL and this license 93 | document. 94 | 95 | 4. Combined Works. 96 | 97 | You may convey a Combined Work under terms of your choice that, 98 | taken together, effectively do not restrict modification of the 99 | portions of the Library contained in the Combined Work and reverse 100 | engineering for debugging such modifications, if you also do each of 101 | the following: 102 | 103 | a) Give prominent notice with each copy of the Combined Work that 104 | the Library is used in it and that the Library and its use are 105 | covered by this License. 106 | 107 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 108 | document. 109 | 110 | c) For a Combined Work that displays copyright notices during 111 | execution, include the copyright notice for the Library among 112 | these notices, as well as a reference directing the user to the 113 | copies of the GNU GPL and this license document. 114 | 115 | d) Do one of the following: 116 | 117 | 0) Convey the Minimal Corresponding Source under the terms of this 118 | License, and the Corresponding Application Code in a form 119 | suitable for, and under terms that permit, the user to 120 | recombine or relink the Application with a modified version of 121 | the Linked Version to produce a modified Combined Work, in the 122 | manner specified by section 6 of the GNU GPL for conveying 123 | Corresponding Source. 124 | 125 | 1) Use a suitable shared library mechanism for linking with the 126 | Library. A suitable mechanism is one that (a) uses at run time 127 | a copy of the Library already present on the user's computer 128 | system, and (b) will operate properly with a modified version 129 | of the Library that is interface-compatible with the Linked 130 | Version. 131 | 132 | e) Provide Installation Information, but only if you would otherwise 133 | be required to provide such information under section 6 of the 134 | GNU GPL, and only to the extent that such information is 135 | necessary to install and execute a modified version of the 136 | Combined Work produced by recombining or relinking the 137 | Application with a modified version of the Linked Version. (If 138 | you use option 4d0, the Installation Information must accompany 139 | the Minimal Corresponding Source and Corresponding Application 140 | Code. If you use option 4d1, you must provide the Installation 141 | Information in the manner specified by section 6 of the GNU GPL 142 | for conveying Corresponding Source.) 143 | 144 | 5. Combined Libraries. 145 | 146 | You may place library facilities that are a work based on the 147 | Library side by side in a single library together with other library 148 | facilities that are not Applications and are not covered by this 149 | License, and convey such a combined library under terms of your 150 | choice, if you do both of the following: 151 | 152 | a) Accompany the combined library with a copy of the same work based 153 | on the Library, uncombined with any other library facilities, 154 | conveyed under the terms of this License. 155 | 156 | b) Give prominent notice with the combined library that part of it 157 | is a work based on the Library, and explaining where to find the 158 | accompanying uncombined form of the same work. 159 | 160 | 6. Revised Versions of the GNU Lesser General Public License. 161 | 162 | The Free Software Foundation may publish revised and/or new versions 163 | of the GNU Lesser General Public License from time to time. Such new 164 | versions will be similar in spirit to the present version, but may 165 | differ in detail to address new problems or concerns. 166 | 167 | Each version is given a distinguishing version number. If the 168 | Library as you received it specifies that a certain numbered version 169 | of the GNU Lesser General Public License "or any later version" 170 | applies to it, you have the option of following the terms and 171 | conditions either of that published version or of any later version 172 | published by the Free Software Foundation. If the Library as you 173 | received it does not specify a version number of the GNU Lesser 174 | General Public License, you may choose any version of the GNU Lesser 175 | General Public License ever published by the Free Software Foundation. 176 | 177 | If the Library as you received it specifies that a proxy can decide 178 | whether future versions of the GNU Lesser General Public License shall 179 | apply, that proxy's public statement of acceptance of any version is 180 | permanent authorization for you to choose that version for the 181 | Library. 182 | --------------------------------------------------------------------------------