The unpac monorepo manager self-hosting as a monorepo using unpac
One more attempt at fixing cmdliner tool on Windows (#233)
+18
-15
+18
-15
vendor/opam/cmdliner/src/tool/cmdliner_main.ml
+18
-15
vendor/opam/cmdliner/src/tool/cmdliner_main.ml
···
6
6
let strf = Printf.sprintf
7
7
let error_to_failure = function Ok v -> v | Error e -> failwith e
8
8
9
-
let quote_tool tool =
10
-
(* Can be replaced by Filename.quote_command once we drop OCaml < 4.10 *)
11
-
Filename.quote @@
12
-
if Sys.win32 then String.map (function '/' -> '\\' | c -> c) tool else tool
13
-
14
9
let find_sub ?(start = 0) ~sub s =
15
10
(* naive algorithm, worst case O(length sub * length s) *)
16
11
let len_sub = String.length sub in
···
83
78
try let () = set_binary_mode_out stdout true in f () with
84
79
| Sys_error e | Failure e -> prerr_endline e; Cmdliner.Cmd.Exit.some_error
85
80
86
-
let exec_stdout cmd =
81
+
let exec_stdout tool ~args =
82
+
(* The cmd munging logic can be replaced by Filename.quote_command once we
83
+
drop OCaml < 4.10 *)
84
+
let quote_tool tool =
85
+
Filename.quote @@
86
+
if Sys.win32 then String.map (function '/' -> '\\' | c -> c) tool else tool
87
+
in
87
88
try
88
89
let tmp = Filename.temp_file "cmd" "stdout" in
90
+
let tool = quote_tool tool and args = List.map Filename.quote args in
91
+
let cmd = String.concat " " (tool :: args) in
89
92
let exec = String.concat " > " [cmd; Filename.quote tmp] in
93
+
let exec = if Sys.win32 then strf {|"%s"|} exec else exec in
90
94
match Sys.command exec with
91
95
| 0 ->
92
96
let ic = open_in_bin tmp in
···
168
172
| _ :: lines -> find_subs lines
169
173
| [] -> []
170
174
in
171
-
let exec =
172
-
strf "%s --__complete %s --__complete=" (quote_tool tool) cmd
173
-
in
174
-
let comps = exec_stdout exec |> error_to_failure in
175
+
let subs = if cmd = "" then [] else String.split_on_char ' ' cmd in
176
+
let args = "--__complete" :: (subs @ ["--__complete="]) in
177
+
let comps = exec_stdout tool ~args |> error_to_failure in
175
178
let comps = String.split_on_char '\n' comps in
176
179
match comps with
177
180
| "1" :: comps -> find_subs comps
···
190
193
with Failure e -> Error e
191
194
192
195
let get_tool_command_man tool ~name cmd =
193
-
let tool = quote_tool tool in
194
-
let exec = if cmd = "" then tool else String.concat " " [tool; cmd] in
195
196
let man_basename =
196
197
let exec = if cmd = "" then name else String.concat " " [name; cmd] in
197
198
(String.map (function ' ' -> '-' | c -> c) exec)
···
204
205
| exception Scanf.Scan_failure _ -> extract_section lines
205
206
end
206
207
| [] ->
207
-
Error (strf "%s command: Could not extract section from manual" exec)
208
+
Error (strf "%s command: Could not extract section from manual"
209
+
(tool ^ " " ^ cmd))
208
210
in
209
211
extract_section (String.split_on_char '\n' man)
210
212
in
211
-
let get_groff = exec ^ " --help=groff" in
212
-
match exec_stdout get_groff with
213
+
let subs = if cmd = "" then [] else String.split_on_char ' ' cmd in
214
+
let args = subs @ ["--help=groff"] in
215
+
match exec_stdout tool ~args with
213
216
| Error _ as e -> e
214
217
| Ok man -> add_section man
215
218