diff options
| -rw-r--r-- | stdlib/arg.ml | 45 | ||||
| -rw-r--r-- | stdlib/arg.mli | 13 |
2 files changed, 40 insertions, 18 deletions
diff --git a/stdlib/arg.ml b/stdlib/arg.ml index 86c8255f5..b6ddd3dd6 100644 --- a/stdlib/arg.ml +++ b/stdlib/arg.ml @@ -38,6 +38,7 @@ type spec = function with each remaining argument *) exception Bad of string +exception Help of string type error = | Unknown of string @@ -60,43 +61,51 @@ let make_symlist prefix sep suffix l = | h::t -> (List.fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix ;; -let print_spec (key, spec, doc) = +let print_spec buf (key, spec, doc) = match spec with - | Symbol (l, _) -> eprintf " %s %s %s\n" key (make_symlist "{" "|" "}" l) doc - | _ -> eprintf " %s %s\n" key doc + | Symbol (l, _) -> bprintf buf " %s %s %s\n" key (make_symlist "{" "|" "}" l) + doc + | _ -> bprintf buf " %s %s\n" key doc ;; -let usage speclist errmsg = - eprintf "%s\n" errmsg; - List.iter print_spec speclist; +let usage_b buf speclist errmsg = + bprintf buf "%s\n" errmsg; + List.iter (print_spec buf) speclist; try ignore (assoc3 "-help" speclist) - with Not_found -> eprintf " -help Display this list of options\n"; + with Not_found -> bprintf buf " -help Display this list of options\n"; try ignore (assoc3 "--help" speclist) - with Not_found -> eprintf " --help Display this list of options\n"; + with Not_found -> bprintf buf " --help Display this list of options\n"; +;; + +let usage speclist errmsg = + let b = Buffer.create 200 in + usage_b b speclist errmsg; + eprintf "%s" (Buffer.contents b); ;; let current = ref 0;; let parse_argv argv speclist anonfun errmsg = + let b = Buffer.create 200 in let stop error = let progname = if Array.length argv > 0 then argv.(0) else "(?)" in begin match error with | Unknown "-help" -> () | Unknown "--help" -> () | Unknown s -> - eprintf "%s: unknown option `%s'.\n" progname s + bprintf b "%s: unknown option `%s'.\n" progname s | Missing s -> - eprintf "%s: option `%s' needs an argument.\n" progname s + bprintf b "%s: option `%s' needs an argument.\n" progname s | Wrong (opt, arg, expected) -> - eprintf "%s: wrong argument `%s'; option `%s' expects %s.\n" + bprintf b "%s: wrong argument `%s'; option `%s' expects %s.\n" progname arg opt expected | Message s -> - eprintf "%s: %s.\n" progname s + bprintf b "%s: %s.\n" progname s end; - usage speclist errmsg; + usage_b b speclist errmsg; if error = Unknown "-help" || error = Unknown "--help" - then exit 0 - else exit 2 + then raise (Help (Buffer.contents b)) + else raise (Bad (Buffer.contents b)) in let l = Array.length argv in incr current; @@ -178,5 +187,9 @@ let parse_argv argv speclist anonfun errmsg = let parse = current := 0; - parse_argv Sys.argv; + try + parse_argv Sys.argv; + with + | Bad msg -> eprintf "%s" msg; exit 0; + | Help msg -> eprintf "%s" msg; exit 2; ;; diff --git a/stdlib/arg.mli b/stdlib/arg.mli index 58d71e161..fa54cebc4 100644 --- a/stdlib/arg.mli +++ b/stdlib/arg.mli @@ -99,11 +99,20 @@ val parse_argv : string array -> (** [Arg.parse_argv args speclist anon_fun usage_msg] parses the array [args] as if it were the command line. It uses and updates the value of [Arg.current]. You must set [Arg.current] before calling - [parse_argv], and restore it afterward if needed. *) + [parse_argv], and restore it afterward if needed. + If an error occurs, [Arg.parse_argv] raises [Arg.Bad] with + the error message as argument. If option [-help] or [--help] is + given, [Arg.parse_argv] raises [Arg.Help] with the help message + as argument. +*) + +exception Help of string +(** Raised by [Arg.parse_argv] when the user asks for help. *) exception Bad of string (** Functions in [spec] or [anon_fun] can raise [Arg.Bad] with an error - message to reject invalid arguments. *) + message to reject invalid arguments. + [Arg.Bad] is also raised by [Arg.parse_argv] in case of an error. *) val usage : (key * spec * doc) list -> usage_msg -> unit (** [Arg.usage speclist usage_msg] prints an error message including |