B0.ml

+open B0
+
+let cmdliner = "cmdliner"
+let doc = "Declarative definition of command line interfaces for OCaml"
+
+let pkg = Pkg.create cmdliner ~doc
+let lib =
+  let srcs = (`Src_dirs [Fpath.v "src"]) in
+  B0_ocaml.Unit.lib ~pkg cmdliner srcs ~doc

CHANGES.md

+v1.0.4 2019-06-14 Zagreb
+------------------------
+
+- Change the way `Error (_, e)` term evaluation results 
+  are formatted. Instead of treating `e` as text, treat
+  it as formatted lines.
+- Fix 4.08 `Pervasives` deprecation.
+- Fix 4.03 String deprecations.
+- Fix boostrap build in absence of dynlink.
+- Make the `Makefile` bootstrap build reproducible.
+  Thanks to Thomas Leonard for the patch.
+
+v1.0.3 2018-11-26 Zagreb
+------------------------
+
+- Add `Term.with_used_args`. Thanks to Jeremie Dimino for
+  the patch.
+- Use `Makefile` bootstrap build in opam file.
+- Drop ocamlbuild requirement for `Makefile` bootstrap build.
+- Drop support for ocaml < 4.03.0
+- Dune build support.
+
 v1.0.2 2017-08-07 Zagreb
 ------------------------
 

Makefile

@@ -10,20 +10,26 @@
 
 # Adjust the following on the cli invocation for configuring
 
+-include $(shell ocamlc -where)/Makefile.config
+
 PREFIX=/usr
 LIBDIR=$(DESTDIR)$(PREFIX)/lib/ocaml/cmdliner
 DOCDIR=$(DESTDIR)$(PREFIX)/share/doc/cmdliner
 NATIVE=$(shell ocamlopt -version > /dev/null 2>&1 && echo true)
+# EXT_LIB     by default value of OCaml's Makefile.config
+# NATDYNLINK  by default value of OCaml's Makefile.config
 
 INSTALL=install
-OCAMLBUILD=ocamlbuild -use-ocamlfind
-B=_build/src
+B=_build
 BASE=$(B)/cmdliner
 
 ifeq ($(NATIVE),true)
-	BUILD-TARGETS=build-byte build-native build-native-dynlink
-	INSTALL-TARGETS=install-common install-byte install-native \
-                 install-native-dynlink
+	BUILD-TARGETS=build-byte build-native
+	INSTALL-TARGETS=install-common install-byte install-native
+	ifeq ($(NATDYNLINK),true)
+	  BUILD-TARGETS += build-native-dynlink
+	  INSTALL-TARGETS += install-native-dynlink
+	endif
 else
 	BUILD-TARGETS=build-byte
 	INSTALL-TARGETS=install-common install-byte
@@ -38,28 +44,30 @@ install-doc:
 	$(INSTALL) CHANGES.md LICENSE.md README.md $(DOCDIR)
 
 clean:
-	$(OCAMLBUILD) -clean
+	ocaml build.ml clean
 
 build-byte:
-	$(OCAMLBUILD) src/cmdliner.cma
+	ocaml build.ml cma
 
 build-native:
-	$(OCAMLBUILD) src/cmdliner.cmxa
+	ocaml build.ml cmxa
 
 build-native-dynlink:
-	$(OCAMLBUILD) src/cmdliner.cmxs
+	ocaml build.ml cmxs
 
 create-libdir:
 	$(INSTALL) -d $(LIBDIR)
 
 install-common: create-libdir
-	$(INSTALL) pkg/META opam $(BASE).mli $(BASE).cmi $(BASE).cmti $(LIBDIR)
+	$(INSTALL) pkg/META $(BASE).mli $(BASE).cmi $(BASE).cmti $(LIBDIR)
+	$(INSTALL) cmdliner.opam $(LIBDIR)/opam
 
 install-byte: create-libdir
 	$(INSTALL) $(BASE).cma $(LIBDIR)
 
 install-native: create-libdir
-	$(INSTALL) $(BASE).cmxa $(BASE).a $(wildcard $(B)/cmdliner*.cmx) $(LIBDIR)
+	$(INSTALL) $(BASE).cmxa $(BASE)$(EXT_LIB) $(wildcard $(B)/cmdliner*.cmx) \
+  $(LIBDIR)
 
 install-native-dynlink: create-libdir
 	$(INSTALL) $(BASE).cmxs $(LIBDIR)

README.md

 Cmdliner — Declarative definition of command line interfaces for OCaml
 -------------------------------------------------------------------------------
-v1.0.2
+v1.0.4
 
 Cmdliner allows the declarative definition of command line interfaces
 for OCaml.

_tags

-true : bin_annot, safe_string, package(bytes), package(result)
+true : bin_annot, safe_string
 <src> : include
 <test> : include
\ No newline at end of file
-
-# Remove once we require >= 4.03
-<src/cmdliner_base*> : warn(-3)
\ No newline at end of file

build.ml

+#!/usr/bin/env ocaml
+
+(* Usage: ocaml build.ml [cma|cmxa|cmxs|clean] *)
+
+let root_dir = Sys.getcwd ()
+let build_dir = "_build"
+let src_dir = "src"
+
+let base_ocaml_opts =
+  [ "-g"; "-bin-annot";
+    "-safe-string"; (* Remove once we require >= 4.06 *) ]
+
+(* Logging *)
+
+let strf = Printf.sprintf
+let err fmt = Printf.kfprintf (fun oc -> flush oc; exit 1) stderr fmt
+let log fmt = Printf.kfprintf (fun oc -> flush oc) stdout fmt
+
+(* The running joke *)
+
+let rev_cut ~sep s = match String.rindex s sep with
+| exception Not_found -> None
+| i -> String.(Some (sub s 0 i, sub s (i + 1) (length s - (i + 1))))
+
+let cuts ~sep s =
+  let rec loop acc = function
+  | "" -> acc
+  | s ->
+      match rev_cut ~sep s with
+      | None -> s :: acc
+      | Some (l, r) -> loop (r :: acc) l
+  in
+  loop [] s
+
+(* Read, write and collect files *)
+
+let fpath ~dir f = String.concat "" [dir; "/"; f]
+
+let string_of_file f =
+  let ic = open_in_bin f in
+  let len = in_channel_length ic in
+  let buf = Bytes.create len in
+  really_input ic buf 0 len;
+  close_in ic;
+  Bytes.unsafe_to_string buf
+
+let string_to_file f s =
+  let oc = open_out_bin f in
+  output_string oc s;
+  close_out oc
+
+let cp src dst = string_to_file dst (string_of_file src)
+
+let ml_srcs dir =
+  let add_file dir acc f = match rev_cut ~sep:'.' f with
+  | Some (m, e) when e = "ml" || e = "mli" -> f :: acc
+  | Some _ | None -> acc
+  in
+  Array.fold_left (add_file dir) [] (Sys.readdir dir)
+
+(* Finding and running commands *)
+
+let find_cmd cmds =
+  let test, null = match Sys.win32 with
+  | true -> "where", " NUL"
+  | false -> "type", "/dev/null"
+  in
+  let cmd c = Sys.command (strf "%s %s 1>%s 2>%s" test c null null) = 0 in
+  try Some (List.find cmd cmds) with Not_found -> None
+
+let err_cmd exit cmd = err "exited with %d: %s\n" exit cmd
+let quote_cmd = match Sys.win32 with
+| false -> fun cmd -> cmd
+| true -> fun cmd -> strf "\"%s\"" cmd
+
+let run_cmd args =
+  let cmd = String.concat " " (List.map Filename.quote args) in
+(*  log "[EXEC] %s\n" cmd; *)
+  let exit = Sys.command (quote_cmd cmd) in
+  if exit = 0 then () else err_cmd exit cmd
+
+let read_cmd args =
+  let stdout = Filename.temp_file (Filename.basename Sys.argv.(0)) "b00t" in
+  at_exit (fun () -> try ignore (Sys.remove stdout) with _ -> ());
+  let cmd = String.concat " " (List.map Filename.quote args) in
+  let cmd = quote_cmd @@ strf "%s 1>%s" cmd (Filename.quote stdout) in
+  let exit = Sys.command cmd in
+  if exit = 0 then string_of_file stdout else err_cmd exit cmd
+
+(* Create and delete directories *)
+
+let mkdir dir =
+  try match Sys.file_exists dir with
+  | true -> ()
+  | false -> run_cmd ["mkdir"; dir]
+  with
+  | Sys_error e -> err "%s: %s" dir e
+
+let rmdir dir =
+  try match Sys.file_exists dir with
+  | false -> ()
+  | true ->
+      let rm f = Sys.remove (fpath ~dir f) in
+      Array.iter rm (Sys.readdir dir);
+      run_cmd ["rmdir"; dir]
+  with
+  | Sys_error e -> err "%s: %s" dir e
+
+(* Lookup OCaml compilers and ocamldep *)
+
+let really_find_cmd alts = match find_cmd alts with
+| Some cmd -> cmd
+| None -> err "No %s found in PATH\n" (List.hd @@ List.rev alts)
+
+let ocamlc () = really_find_cmd ["ocamlc.opt"; "ocamlc"]
+let ocamlopt () = really_find_cmd ["ocamlopt.opt"; "ocamlopt"]
+let ocamldep () = really_find_cmd ["ocamldep.opt"; "ocamldep"]
+
+(* Build *)
+
+let sort_srcs srcs =
+  let srcs = List.sort String.compare srcs in
+  read_cmd (ocamldep () :: "-slash" :: "-sort" :: srcs)
+  |> String.trim |> cuts ~sep:' '
+
+let common srcs = base_ocaml_opts @ sort_srcs srcs
+
+let build_cma srcs =
+  run_cmd ([ocamlc ()] @ common srcs @ ["-a"; "-o"; "cmdliner.cma"])
+
+let build_cmxa srcs =
+  run_cmd ([ocamlopt ()] @ common srcs @ ["-a"; "-o"; "cmdliner.cmxa"])
+
+let build_cmxs srcs =
+  run_cmd ([ocamlopt ()] @ common srcs @ ["-shared"; "-o"; "cmdliner.cmxs"])
+
+let clean () = rmdir build_dir
+
+let in_build_dir f =
+  let srcs = ml_srcs src_dir in
+  let cp src = cp (fpath ~dir:src_dir src) (fpath ~dir:build_dir src) in
+  mkdir build_dir;
+  List.iter cp srcs;
+  Sys.chdir build_dir; f srcs; Sys.chdir root_dir
+
+let main () = match Array.to_list Sys.argv with
+| _ :: [ "cma" ] -> in_build_dir build_cma
+| _ :: [ "cmxa" ] -> in_build_dir build_cmxa
+| _ :: [ "cmxs" ] -> in_build_dir build_cmxs
+| _ :: [ "clean" ] -> clean ()
+| [] | [_] -> err "Missing argument: cma, cmxa, cmxs or clean\n";
+| cmd :: args ->
+    err "%s: Unknown argument(s): %s\n" cmd @@ String.concat " " args
+
+let () = main ()

cmdliner.opam

+version: "1.0.4"
+synopsis: """Declarative definition of command line interfaces for OCaml"""
+description: """\
+
+Cmdliner allows the declarative definition of command line interfaces
+for OCaml.
+
+It provides a simple and compositional mechanism to convert command
+line arguments to OCaml values and pass them to your functions. The
+module automatically handles syntax errors, help messages and UNIX man
+page generation. It supports programs with single or multiple commands
+and respects most of the [POSIX][1] and [GNU][2] conventions.
+
+Cmdliner has no dependencies and is distributed under the ISC license.
+
+[1]: http://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html
+[2]: http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html
+"""
+opam-version: "2.0"
+maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
+authors: ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
+homepage: "http://erratique.ch/software/cmdliner"
+doc: "http://erratique.ch/software/cmdliner/doc/Cmdliner"
+dev-repo: "git+http://erratique.ch/repos/cmdliner.git"
+bug-reports: "https://github.com/dbuenzli/cmdliner/issues"
+tags: [ "cli" "system" "declarative" "org:erratique" ]
+license: "ISC"
+depends:[ "ocaml" {>= "4.03.0"} ]
+build: [[ make "all" "PREFIX=%{prefix}%" ]]
+install:
+[[make "install" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%" ]
+ [make "install-doc" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%"  ]]

dune-project

+(lang dune 1.4)
+(name cmdliner)
\ No newline at end of file

opam

-version: "1.0.2"
-opam-version: "1.2"
-maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
-authors: ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
-homepage: "http://erratique.ch/software/cmdliner"
-doc: "http://erratique.ch/software/cmdliner/doc/Cmdliner"
-dev-repo: "http://erratique.ch/repos/cmdliner.git"
-bug-reports: "https://github.com/dbuenzli/cmdliner/issues"
-tags: [ "cli" "system" "declarative" "org:erratique" ]
-license: "ISC"
-available: [ocaml-version >= "4.01.0"]
-depends:[
-  "ocamlfind" {build}
-  "ocamlbuild" {build}
-  "topkg" {build}
-  "result"
-]
-build: [[
-  "ocaml" "pkg/pkg.ml" "build"
-          "--pinned" "%{pinned}%"
-]]
\ No newline at end of file

pkg/META

-version = "v1.0.2"
+version = "v1.0.4"
 description = "Declarative definition of command line interfaces"
-requires = "bytes result"
+requires = ""
 archive(byte) = "cmdliner.cma"
 archive(native) = "cmdliner.cmxa"
 plugin(byte) = "cmdliner.cma"

pkg/pkg.ml

@@ -9,8 +9,11 @@ let distrib =
   let exclude_paths () = Ok [".git";".gitignore";".gitattributes";"_build"] in
   Pkg.distrib ~exclude_paths ()
 
+let opams =
+  [Pkg.opam_file "cmdliner.opam"]
+
 let () =
-  Pkg.describe ~distrib "cmdliner" @@ fun c ->
+  Pkg.describe ~distrib "cmdliner" ~opams @@ fun c ->
   Ok [ Pkg.mllib ~api:["Cmdliner"] "src/cmdliner.mllib";
        test "test/chorus";
        test "test/cp_ex";
@@ -26,4 +29,5 @@ let () =
        Pkg.test ~run:false "test/test_pos_left";
        Pkg.test ~run:false "test/test_pos_req";
        Pkg.test ~run:false "test/test_opt_req";
-       Pkg.test ~run:false "test/test_term_dups"; ]
+       Pkg.test ~run:false "test/test_term_dups";
+       Pkg.test ~run:false "test/test_with_used_args"; ]

src/cmdliner.ml

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
-open Result
-
 module Manpage = Cmdliner_manpage
 module Arg = Cmdliner_arg
 module Term = struct
+  type ('a, 'b) stdlib_result = ('a, 'b) result
 
   include Cmdliner_term
 
@@ -51,6 +50,18 @@ module Term = struct
     Cmdliner_info.Args.empty,
     (fun ei _ -> Ok (List.rev_map choice_name (Cmdliner_info.eval_choices ei)))
 
+  let with_used_args (al, v) : (_ * string list) t =
+    al, fun ei cl ->
+      match v ei cl with
+      | Ok x ->
+          let actual_args arg_info acc =
+            let args = Cmdliner_cline.actual_args cl arg_info in
+            List.rev_append args acc
+          in
+          let used = List.rev (Cmdliner_info.Args.fold actual_args al []) in
+          Ok (x, used)
+      | Error _ as e -> e
+
   (* Term information *)
 
   type exit_info = Cmdliner_info.exit
@@ -101,7 +112,7 @@ module Term = struct
     ('a, [ term_escape
          | `Exn of exn * Printexc.raw_backtrace
          | `Parse of string
-         | `Std_help of Manpage.format | `Std_version ]) Result.result
+         | `Std_help of Manpage.format | `Std_version ]) stdlib_result
 
   let run ~catch ei cl f = try (f ei cl :> 'a eval_result) with
   | exn when catch ->
@@ -183,12 +194,14 @@ module Term = struct
       match res with
       | `Std_help fmt -> Cmdliner_docgen.pp_man err_ppf fmt help_ppf ei; `Help
       | `Std_version -> Cmdliner_msg.pp_version help_ppf ei; `Version
-      | `Parse err -> Cmdliner_msg.pp_err_usage err_ppf ei ~err; `Error `Parse
+      | `Parse err ->
+          Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err;
+          `Error `Parse
       | `Help (fmt, cmd) -> do_help help_ppf err_ppf ei fmt cmd; `Help
       | `Exn (e, bt) -> Cmdliner_msg.pp_backtrace err_ppf ei e bt; `Error `Exn
       | `Error (usage, err) ->
           (if usage
-           then Cmdliner_msg.pp_err_usage err_ppf ei ~err
+           then Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:true ~err
            else Cmdliner_msg.pp_err err_ppf ei ~err);
           `Error `Term
 
@@ -245,7 +258,8 @@ module Term = struct
     match choose_term main_f choices_f (remove_exec argv) with
     | Error err ->
         let ei = Cmdliner_info.eval ~term:main ~main ~choices ~env in
-        Cmdliner_msg.pp_err_usage err_ppf ei ~err; `Error `Parse
+        Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err;
+        `Error `Parse
     | Ok ((chosen, f), args) ->
         let ei = Cmdliner_info.eval ~term:chosen ~main ~choices ~env in
         let ei, res = term_eval ~catch ei f args in
@@ -271,9 +285,10 @@ module Term = struct
   | `Ok n -> n
   | r -> exit_status_of_result ?term_err r
 
-  let exit ?term_err r = Pervasives.exit (exit_status_of_result ?term_err r)
+  let stdlib_exit = exit
+  let exit ?term_err r = stdlib_exit (exit_status_of_result ?term_err r)
   let exit_status ?term_err r =
-    Pervasives.exit (exit_status_of_status_result ?term_err r)
+    stdlib_exit (exit_status_of_status_result ?term_err r)
 
 end
 

src/cmdliner.mli

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
 (** Declarative definition of command line interfaces.
@@ -22,12 +22,10 @@
     use. Open the module to use it, it defines only three modules in
     your scope.
 
-    {e v1.0.2 — {{:http://erratique.ch/software/cmdliner }homepage}} *)
+    {e v1.0.4 — {{:http://erratique.ch/software/cmdliner }homepage}} *)
 
 (** {1:top Interface} *)
 
-open Result
-
 (** Man page specification.
 
     Man page generation is automatically handled by [Cmdliner],
@@ -244,6 +242,11 @@ module Term : sig
   (** [choice_names] is a term that evaluates to the names of the terms
       to choose from. *)
 
+  val with_used_args : 'a t -> ('a * string list) t
+  (** [with_used_args t] is a term that evaluates to [t] tupled
+      with the arguments from the command line that where used to
+      evaluate [t]. *)
+
   (** {1:tinfo Term information}
 
       Term information defines the name and man page of a term.
@@ -446,11 +449,11 @@ module Term : sig
 
   val exit : ?term_err:int -> 'a result -> unit
   (** [exit ~term_err r] is
-      [Pervasives.exit @@ exit_status_of_result ~term_err r] *)
+      [Stdlib.exit @@ exit_status_of_result ~term_err r] *)
 
   val exit_status : ?term_err:int -> int result -> unit
   (** [exit_status ~term_err r] is
-      [Pervasives.exit @@ exit_status_of_status_result ~term_err r] *)
+      [Stdlib.exit @@ exit_status_of_status_result ~term_err r] *)
 end
 
 (** Terms for command line arguments.
@@ -991,7 +994,7 @@ that have multiple commands each with their own syntax:
 A command is defined by coupling a term with {{!Term.tinfo}term
 information}. The term information defines the command name and its
 man page. Given a list of commands the function {!Term.eval_choice}
-will execute the term corresponding to the [COMMAND] argument or or a
+will execute the term corresponding to the [COMMAND] argument or a
 specific "main" term if there is no [COMMAND] argument.
 
 {2:doclang Documentation markup language}
@@ -1211,7 +1214,7 @@ let prompt_str = function
 | Always -> "always" | Once -> "once" | Never -> "never"
 
 let rm prompt recurse files =
-  Printf.printf "prompt = %s\nrecurse = %b\nfiles = %s\n"
+  Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n"
     (prompt_str prompt) recurse (String.concat ", " files)
 
 (* Command line interface *)
@@ -1252,7 +1255,7 @@ let cmd =
     `S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ]
   in
   Term.(const rm $ prompt $ recursive $ files),
-  Term.info "rm" ~version:"v1.0.2" ~doc ~exits:Term.default_exits ~man
+  Term.info "rm" ~version:"v1.0.4" ~doc ~exits:Term.default_exits ~man
 
 let () = Term.(exit @@ eval cmd)
 ]}
@@ -1282,7 +1285,7 @@ let cp verbose recurse force srcs dest =
     `Error (false, dest ^ " is not a directory")
   else
     `Ok (Printf.printf
-     "verbose = %b\nrecurse = %b\nforce = %b\nsrcs = %s\ndest = %s\n"
+     "verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n"
       verbose recurse force (String.concat ", " srcs) dest)
 
 (* Command line interface *)
@@ -1322,7 +1325,7 @@ let cmd =
       `P "Email them to <hehey at example.org>."; ]
   in
   Term.(ret (const cp $ verbose $ recurse $ force $ srcs $ dest)),
-  Term.info "cp" ~version:"v1.0.2" ~doc ~exits ~man ~man_xrefs
+  Term.info "cp" ~version:"v1.0.4" ~doc ~exits ~man ~man_xrefs
 
 let () = Term.(exit @@ eval cmd)
 ]}
@@ -1370,7 +1373,6 @@ let tail lines follow verb pid files =
 
 (* Command line interface *)
 
-open Result
 open Cmdliner
 
 let lines =
@@ -1451,7 +1453,7 @@ use of {!Term.ret} on the lifted [help] function.
 
 If the program is invoked without a command we just want to show the
 help of the program as printed by [Cmdliner] with [--help]. This is
-done by the [no_cmd] term.
+done by the [default_cmd] term.
 
 {[
 (* Implementations, just print the args. *)
@@ -1466,14 +1468,14 @@ let verb_str = function
   | Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose"
 
 let pr_copts oc copts = Printf.fprintf oc
-    "debug = %b\nverbosity = %s\nprehook = %s\n"
+    "debug = %B\nverbosity = %s\nprehook = %s\n"
     copts.debug (verb_str copts.verb) (opt_str_str copts.prehook)
 
 let initialize copts repodir = Printf.printf
     "%arepodir = %s\n" pr_copts copts repodir
 
 let record copts name email all ask_deps files = Printf.printf
-    "%aname = %s\nemail = %s\nall = %b\nask-deps = %b\nfiles = %s\n"
+    "%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n"
     pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps
     (String.concat ", " files)
 
@@ -1596,7 +1598,7 @@ let default_cmd =
   let exits = Term.default_exits in
   let man = help_secs in
   Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)),
-  Term.info "darcs" ~version:"v1.0.2" ~doc ~sdocs ~exits ~man
+  Term.info "darcs" ~version:"v1.0.4" ~doc ~sdocs ~exits ~man
 
 let cmds = [initialize_cmd; record_cmd; help_cmd]
 

src/cmdliner_arg.ml

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
-open Result
-
 let rev_compare n0 n1 = compare n1 n0
 
 (* Invalid_argument strings **)

src/cmdliner_arg.mli

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
-open Result
-
 (** Command line arguments as terms. *)
 
 type 'a parser = string -> [ `Ok of 'a | `Error of string ]

src/cmdliner_base.ml

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
 (* Invalid argument strings *)
@@ -9,12 +9,6 @@
 let err_empty_list = "empty list"
 let err_incomplete_enum = "Incomplete enumeration for the type"
 
-(* String helpers, should be migrated to ascii_ versions once >= 4.03 *)
-
-let lowercase = String.lowercase
-let uppercase = String.lowercase
-let capitalize = String.capitalize
-
 (* Formatting tools *)
 
 let strf = Printf.sprintf
@@ -22,22 +16,28 @@ let pp = Format.fprintf
 let pp_sp = Format.pp_print_space
 let pp_str = Format.pp_print_string
 let pp_char = Format.pp_print_char
-
-let pp_white_str ~spaces ppf s =  (* hint spaces (maybe) and new lines. *)
-  let left = ref 0 and right = ref 0 and len = String.length s in
-  let flush () =
-    Format.pp_print_string ppf (String.sub s !left (!right - !left));
-    incr right; left := !right;
+let pp_text = Format.pp_print_text
+let pp_lines ppf s =
+  let rec stop_at sat ~start ~max s =
+    if start > max then start else
+    if sat s.[start] then start else
+    stop_at sat ~start:(start + 1) ~max s
   in
-  while (!right <> len) do
-    if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else
-    if spaces && s.[!right] = ' ' then (flush (); Format.pp_print_space ppf ())
-    else incr right;
-  done;
-  if !left <> len then flush ()
-
-let pp_text = pp_white_str ~spaces:true
-let pp_lines = pp_white_str ~spaces:false
+  let sub s start stop ~max =
+    if start = stop then "" else
+    if start = 0 && stop > max then s else
+    String.sub s start (stop - start)
+  in
+  let is_nl c = c = '\n' in
+  let max = String.length s - 1 in
+  let rec loop start s = match stop_at is_nl ~start ~max s with
+  | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max)
+  | stop ->
+      Format.pp_print_string ppf (sub s start stop ~max);
+      Format.pp_force_newline ppf ();
+      loop (stop + 1) s
+  in
+  loop 0 s
 
 let pp_tokens ~spaces ppf s = (* collapse white and hint spaces (maybe) *)
   let is_space = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false in
@@ -280,7 +280,7 @@ let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) =
   in
   parse, print
 
-let env_bool_parse s = match lowercase s with
+let env_bool_parse s = match String.lowercase_ascii s with
 | "" | "false" | "no" | "n" | "0" -> `Ok false
 | "true" | "yes" | "y" | "1" -> `Ok true
 | s -> `Error (err_invalid_val s (alts_str ["true"; "yes"; "false"; "no" ]))

src/cmdliner_base.mli

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
 (** A few helpful base definitions. *)
 
-(** {1:str String helpers} *)
-
-val lowercase : string -> string
-val uppercase : string -> string
-val capitalize : string -> string
-
 (** {1:fmt Formatting helpers} *)
 
 val pp_text : Format.formatter -> string -> unit

src/cmdliner_cline.ml

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
-open Result
-
 (* A command line stores pre-parsed information about the command
    line's arguments in a more structured way. Given the
    Cmdliner_info.arg values mentioned in a term and Sys.argv
@@ -29,6 +27,13 @@ type t = arg Amap.t  (* command line, maps arg_infos to arg value. *)
 let get_arg cl a = try Amap.find a cl with Not_found -> assert false
 let opt_arg cl a = match get_arg cl a with O l -> l | _ -> assert false
 let pos_arg cl a = match get_arg cl a with P l -> l | _ -> assert false
+let actual_args cl a = match get_arg cl a with
+| P args -> args
+| O l ->
+    let extract_args (_pos, name, value) =
+      name :: (match value with None -> [] | Some v -> [v])
+    in
+    List.concat (List.map extract_args l)
 
 let arg_info_indexes args =
   (* from [args] returns a trie mapping the names of optional arguments to

src/cmdliner_cline.mli

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
-open Result
-
 (** Command lines. *)
 
 type t
@@ -16,6 +14,8 @@ val create :
 
 val opt_arg : t -> Cmdliner_info.arg -> (int * string * (string option)) list
 val pos_arg : t -> Cmdliner_info.arg -> string list
+val actual_args : t -> Cmdliner_info.arg -> string list
+(** Actual command line arguments from the command line *)
 
 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli

src/cmdliner_docgen.ml

 (*---------------------------------------------------------------------------
    Copyright (c) 2011 Daniel C. Bünzli. All rights reserved.
    Distributed under the ISC license, see terms at the end of the file.
-   cmdliner v1.0.2
+   cmdliner v1.0.4
   ---------------------------------------------------------------------------*)
 
 let rev_compare n0 n1 = compare n1 n0
@@ -170,7 +170,7 @@ let arg_docs ~errs ~subst ~buf ei =
     | true, true -> (* optional by name *)
         let key names =
           let k = List.hd (List.sort rev_compare names) in
-          let k = Cmdliner_base.lowercase k in
+          let k = String.lowercase_ascii k in
           if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k
         in
         compare
@@ -178,8 +178,8 @@ let arg_docs ~errs ~subst ~buf ei =
           (key @@ Cmdliner_info.arg_opt_names a1)
     | false, false -> (* positional by variable *)
         compare
-          (Cmdliner_base.lowercase @@ Cmdliner_info.arg_docv a0)
-          (Cmdliner_base.lowercase @@ Cmdliner_info.arg_docv a1)
+          (String.lowercase_ascii @@ Cmdliner_info.arg_docv a0)
+          (String.lowercase_ascii @@ Cmdliner_info.arg_docv a1)
     | true, false -> -1 (* positional first *)
     | false, true -> 1  (* optional after *)
   in
@@ -310,8 +310,8 @@ let text ~errs ei =
 
 let title ei =
   let main = Cmdliner_info.eval_main ei in
-  let exec = Cmdliner_base.capitalize (Cmdliner_info.term_name main) in
-  let name = Cmdliner_base.uppercase (invocation ~sep:'-' ei) in
+  let exec = String.capitalize_ascii (Cmdliner_info.term_name main) in
+  let name = String.uppercase_ascii (invocation ~sep:'-' ei) in
   let center_header = esc @@ strf "%s Manual" exec in
   let left_footer =
     let version = match Cmdliner_info.term_version main with