atagen/inshellah
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix parallelism, create completer

Browse source
This commit is contained in:
atagen 2026-03-23 11:40:34 +11:00
parent 3080a5f64d
commit 53be599d91
1 changed files with 259 additions and 323 deletions
Download patch file Download diff file Expand all files Collapse all files

582
bin/main.ml
View file

@ -14,19 +14,13 @@ Usage:
Index completions into a SQLite database.
PREFIX is a directory containing bin/ and share/man/.
Default db: $XDG_CACHE_HOME/inshellah/completions.db
inshellah complete CMD [ARGS...] [--db PATH]
Nushell custom completer. Outputs JSON completion candidates.
Falls back to --help resolution if command is not in the database.
inshellah dump [--db PATH]
Show stats and commands in the database.
inshellah generate BINDIR MANDIR -o OUTDIR
Full generation: native completions, manpages, and --help fallback.
One .nu file per command.
inshellah manpage FILE Parse a manpage and emit nushell extern
inshellah manpage-dir DIR Batch-process manpages under DIR
inshellah help [--iterative] CMD [ARGS...]
Run CMD ARGS --help, parse and emit extern.
Recursively resolves subcommands unless
--iterative is given.
inshellah parse-help CMD Read --help text from stdin, emit extern
inshellah demo Run built-in demo
|};
exit 1
@ -43,13 +37,6 @@ let is_nushell_source text =
|| contains_str text "export def"
|| (contains_str text "module " && contains_str text "export"))
let filename_of_cmd cmd =
String.map (function
| ('a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' | '.') as c -> c | _ -> '-') cmd
let write_file path contents =
let oc = open_out path in output_string oc contents; close_out oc
let cmd_name_of_manpage path =
let base = Filename.basename path in
let base =
@ -66,6 +53,23 @@ let safe_env = lazy (
|| String.starts_with ~prefix:"XAUTHORITY=" s))
(Array.to_list (Unix.environment ()))))
(* Non-blocking drain of a pipe fd into a buffer. Safe to call repeatedly;
reads whatever is available without blocking. Used by all fork-pipe sites
to keep pipes drained so children never block on write. *)
let drain_fd rd buf =
let chunk = Bytes.create 8192 in
let continue = ref true in
while !continue do
match Unix.select [rd] [] [] 0.0 with
| (_ :: _, _, _) ->
(try
let n = Unix.read rd chunk 0 8192 in
if n = 0 then continue := false
else Buffer.add_subbytes buf chunk 0 n
with Unix.Unix_error _ -> continue := false)
| _ -> continue := false
done
let run_cmd args timeout_ms =
let (rd, wr) = Unix.pipe () in
let devnull = Unix.openfile "/dev/null" [Unix.O_RDONLY] 0 in
@ -264,136 +268,6 @@ let cmd_manpage_dir dir =
let max_resolve_results = 500
let help_resolve ?(timeout=10_000) cmd rest name =
let max_jobs = num_cores () in
let queue = Queue.create () in
Queue.push (rest, name, 0, "") queue;
let results = ref [] in
(* pending: (pid, rd, rest, name, depth, desc) *)
let pending = ref [] in
let collect rd p_rest p_name p_depth p_desc =
let ic = Unix.in_channel_of_descr rd in
let[@warning "-8"] result : (string * (string * string) list) option =
try Marshal.from_channel ic with _ -> None in
close_in ic;
match result with
| None ->
if p_desc <> "" then
results := Printf.sprintf "export extern \"%s\" [ # %s\n]\n"
(escape_nu p_name) (escape_nu p_desc) :: !results
| Some (code, subs) ->
results := code :: !results;
if p_depth < 5 && List.length !results < max_resolve_results then
List.iter (fun (sc_name, sc_desc) ->
Queue.push
(p_rest @ [sc_name], p_name ^ " " ^ sc_name,
p_depth + 1, sc_desc) queue
) subs in
let reap () =
pending := List.filter (fun (pid, rd, p_rest, p_name, p_depth, p_desc) ->
match Unix.waitpid [Unix.WNOHANG] pid with
| (0, _) -> true
| _ -> collect rd p_rest p_name p_depth p_desc; false
| exception Unix.Unix_error (Unix.ECHILD, _, _) ->
collect rd p_rest p_name p_depth p_desc; false
) !pending in
let wait_slot () =
while List.length !pending >= max_jobs do
reap ();
if List.length !pending >= max_jobs then
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
reap ()
done in
while not (Queue.is_empty queue) || !pending <> [] do
while not (Queue.is_empty queue) do
let (q_rest, q_name, q_depth, q_desc) = Queue.pop queue in
wait_slot ();
let (rd, wr) = Unix.pipe () in
let pid = Unix.fork () in
if pid = 0 then begin
Unix.close rd;
List.iter (fun (_, prd, _, _, _, _) ->
try Unix.close prd with _ -> ()) !pending;
let result =
let text = match run_cmd (cmd :: q_rest @ ["--help"]) timeout with
| Some _ as r -> r
| None -> run_cmd (cmd :: q_rest @ ["-h"]) timeout in
match text with
| None -> None
| Some text ->
(match parse_help text with
| Error _ -> None
| Ok r when r.entries = [] && r.subcommands = [] && r.positionals = [] -> None
| Ok r ->
(* If the subcommand we just queried appears in its own
subcommand list, the command is echoing the parent help
(e.g. nil ignores subcommands when --help is present).
Abandon this branch to avoid infinite recursion. *)
let self_listed = match q_rest with
| [] -> false
| _ ->
let leaf = List.nth q_rest (List.length q_rest - 1) in
List.exists (fun (sc : subcommand) -> sc.name = leaf) r.subcommands in
if self_listed then None
else
let at_limit = q_depth >= 5 in
let code = generate_extern q_name
(if at_limit then r else { r with subcommands = [] }) in
let subs = if at_limit then []
else List.map (fun (sc : subcommand) -> (sc.name, sc.desc))
r.subcommands in
Some (code, subs)) in
let oc = Unix.out_channel_of_descr wr in
Marshal.to_channel oc (result : (string * (string * string) list) option) [];
close_out oc;
exit 0
end else begin
Unix.close wr;
pending := (pid, rd, q_rest, q_name, q_depth, q_desc) :: !pending
end
done;
if !pending <> [] then begin
reap ();
if !pending <> [] && Queue.is_empty queue then begin
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
reap ()
end
end
done;
match !results with
| [] -> None
| rs -> Some (String.concat "\n" (List.rev rs))
let cmd_help args =
let iterative, cmd_args = match args with
| "--iterative" :: rest -> (true, rest)
| _ -> (false, args)
in
match cmd_args with
| [] -> Printf.eprintf "error: help requires a command name\n"; exit 1
| cmd :: rest ->
let name = String.concat " " (Filename.basename cmd :: rest) in
if iterative then
(match run_cmd (cmd :: rest @ ["--help"]) 10_000 with
| None -> Printf.eprintf "no output from %s --help\n" name; exit 1
| Some text ->
(match parse_help text with
| Ok r -> print_string (generate_extern name r)
| Error msg -> Printf.eprintf "parse error for %s: %s\n" name msg; exit 1))
else
(match help_resolve cmd rest name with
| None -> Printf.eprintf "no output from %s --help\n" name; exit 1
| Some output -> print_string output)
let cmd_parse_help cmd =
let buf = Buffer.create 4096 in
(try while true do
Buffer.add_string buf (input_line stdin); Buffer.add_char buf '\n'
done with End_of_file -> ());
(match parse_help (Buffer.contents buf) with
| Ok r -> print_string (generate_extern cmd r)
| Error msg -> Printf.eprintf "parse error for %s: %s\n" cmd msg; exit 1)
let process_manpage file =
try
let contents = read_manpage_file file in
@ -415,142 +289,103 @@ let manpaged_commands mandir =
else acc
) SSet.empty command_sections
let cmd_generate bindir mandir outdir ignorelist =
let done_cmds = ref SSet.empty in
let bins = Sys.readdir bindir in
Array.sort String.compare bins;
let manpaged = manpaged_commands mandir in
(* Parallel structured help resolver — returns (name, help_result) pairs
like the old sequential version but forks per subcommand for parallelism. *)
let help_resolve_par ?(timeout=200) cmd rest name =
let max_jobs = num_cores () in
let classified = Array.map (fun name ->
if SSet.mem name manpaged || SSet.mem name ignorelist then (name, Skip)
else (name, classify_binary bindir name)
) bins in
let pending = ref [] in
let reap () =
pending := List.filter (fun pid ->
match Unix.waitpid [Unix.WNOHANG] pid with
| (0, _) -> true | _ -> false
| exception Unix.Unix_error (Unix.ECHILD, _, _) -> false
) !pending in
let wait_slot () =
while List.length !pending >= max_jobs do
reap ();
if List.length !pending >= max_jobs then
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
reap ()
done in
Array.iter (fun (name, cls) ->
match cls with
| Skip -> ()
| Try_help | Try_native_and_help ->
wait_slot ();
let pid = Unix.fork () in
if pid = 0 then begin
(try
let path = Filename.concat bindir name in
let native_ok = match cls with
| Try_native_and_help ->
(match try_native_completion path with
| Some src ->
write_file (Filename.concat outdir (filename_of_cmd name ^ ".nu")) src;
true
| None -> false)
| _ -> false in
if not native_ok then begin
match help_resolve ~timeout:200 path [] name with
| Some content when String.length content > 0 ->
let m = module_name_of name in
let src = Printf.sprintf "module %s {\n%s}\n\nuse %s *\n" m content m in
write_file (Filename.concat outdir (filename_of_cmd name ^ ".nu")) src
| _ -> ()
end;
exit 0
with _ -> exit 1)
end else begin
pending := pid :: !pending;
done_cmds := SSet.add name !done_cmds
end
) classified;
while !pending <> [] do
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
reap ()
done;
List.iter (fun section ->
let subdir = Filename.concat mandir (Printf.sprintf "man%d" section) in
if Sys.file_exists subdir && Sys.is_directory subdir then begin
let files = Sys.readdir subdir in
Array.sort String.compare files;
Array.iter (fun file ->
match process_manpage (Filename.concat subdir file) with
| None -> ()
| Some (cmd, result) ->
let base = List.hd (String.split_on_char ' ' cmd) in
if SSet.mem cmd !done_cmds then ()
else begin
done_cmds := SSet.add cmd !done_cmds;
let outpath = Filename.concat outdir (filename_of_cmd base ^ ".nu") in
if Sys.file_exists outpath then begin
let existing =
let ic = open_in outpath in
let n = in_channel_length ic in
let s = Bytes.create n in
really_input ic s 0 n; close_in ic;
Bytes.to_string s in
let mod_name = module_name_of base in
let use_line = Printf.sprintf "\nuse %s *\n" mod_name in
let base_content =
if contains_str existing use_line then
String.sub existing 0
(Str.search_forward (Str.regexp_string use_line) existing 0)
else existing in
write_file outpath
(String.concat "" [base_content; generate_extern cmd result; use_line])
end else
write_file outpath (generate_module base result)
end
) files
end
) command_sections
(* Sequential help resolver for use inside forked children.
No forking — just iterates through subcommands with run_cmd directly. *)
let help_resolve_seq ?(timeout=200) cmd rest name =
let queue = Queue.create () in
Queue.push (rest, name, 0) queue;
let results = ref [] in
while not (Queue.is_empty queue) do
let (q_rest, q_name, q_depth) = Queue.pop queue in
let text = match run_cmd (cmd :: q_rest @ ["--help"]) timeout with
| Some _ as r -> r
| None -> run_cmd (cmd :: q_rest @ ["-h"]) timeout in
match text with
(* pending: (pid, rd, buf, rest, name, depth) *)
let pending = ref [] in
let collect rd buf q_rest q_name q_depth =
drain_fd rd buf;
(try Unix.close rd with _ -> ());
let data = Buffer.contents buf in
let result : (help_result * subcommand list) option =
if String.length data > 0 then
try Marshal.from_string data 0 with _ -> None
else None in
match result with
| None -> ()
| Some text ->
(match parse_help text with
| Error _ -> ()
| Ok r when r.entries = [] && r.subcommands = [] && r.positionals = [] -> ()
| Ok r ->
let self_listed = match q_rest with
| [] -> false
| _ ->
let leaf = List.nth q_rest (List.length q_rest - 1) in
List.exists (fun (sc : subcommand) -> sc.name = leaf) r.subcommands in
if not self_listed then begin
let at_limit = q_depth >= 5 || List.length !results >= max_resolve_results in
results := (q_name, { r with subcommands = [] }) :: !results;
if not at_limit then
List.iter (fun (sc : subcommand) ->
Queue.push (q_rest @ [sc.name], q_name ^ " " ^ sc.name, q_depth + 1) queue
) r.subcommands
end)
| Some (r, subs) ->
let at_limit = q_depth >= 5 || List.length !results >= max_resolve_results in
results := (q_name, r) :: !results;
if not at_limit then
List.iter (fun (sc : subcommand) ->
Queue.push (q_rest @ [sc.name], q_name ^ " " ^ sc.name, q_depth + 1) queue
) subs in
let reap () =
pending := List.filter (fun (pid, rd, buf, q_rest, q_name, q_depth) ->
drain_fd rd buf;
match Unix.waitpid [Unix.WNOHANG] pid with
| (0, _) -> true
| _ -> collect rd buf q_rest q_name q_depth; false
| exception Unix.Unix_error (Unix.ECHILD, _, _) ->
(try Unix.close rd with _ -> ()); false
) !pending in
let wait_for_slot () =
while List.length !pending >= max_jobs do
reap ();
if List.length !pending >= max_jobs then begin
let fds = List.map (fun (_, rd, _, _, _, _) -> rd) !pending in
ignore (Unix.select fds [] [] 0.05)
end
done in
while not (Queue.is_empty queue) || !pending <> [] do
while not (Queue.is_empty queue) do
let (q_rest, q_name, q_depth) = Queue.pop queue in
wait_for_slot ();
let (rd, wr) = Unix.pipe () in
let pid = Unix.fork () in
if pid = 0 then begin
Unix.close rd;
List.iter (fun (_, prd, _, _, _, _) ->
try Unix.close prd with _ -> ()) !pending;
let result =
let text = match run_cmd (cmd :: q_rest @ ["--help"]) timeout with
| Some _ as r -> r
| None -> run_cmd (cmd :: q_rest @ ["-h"]) timeout in
match text with
| None -> None
| Some text ->
(match parse_help text with
| Error _ -> None
| Ok r when r.entries = [] && r.subcommands = [] && r.positionals = [] -> None
| Ok r ->
let self_listed = match q_rest with
| [] -> false
| _ ->
let leaf = List.nth q_rest (List.length q_rest - 1) in
List.exists (fun (sc : subcommand) -> sc.name = leaf) r.subcommands in
if self_listed then None
else
let at_limit = q_depth >= 5 in
let subs = if at_limit then [] else r.subcommands in
Some ({ r with subcommands = [] }, subs)) in
let oc = Unix.out_channel_of_descr wr in
Marshal.to_channel oc (result : (help_result * subcommand list) option) [];
close_out oc;
exit 0
end else begin
Unix.close wr;
pending := (pid, rd, Buffer.create 4096, q_rest, q_name, q_depth) :: !pending
end
done;
if !pending <> [] then begin
reap ();
if !pending <> [] && Queue.is_empty queue then begin
let fds = List.map (fun (_, rd, _, _, _, _) -> rd) !pending in
ignore (Unix.select fds [] [] 0.05)
end
end
done;
List.rev !results
(* Index: mirrors cmd_generate's fork-per-binary pattern.
(* Index: fork-per-binary pattern with pipe-based result marshaling.
Each child handles one binary completely (including subcommand resolution)
and marshals all results back in one shot. No nested forking — children
use help_resolve_seq which is purely sequential. *)
and marshals results back via pipe. Children use help_resolve_par
which forks per subcommand for parallelism. *)
let cmd_index bindirs mandirs ignorelist db_path =
let db = init db_path in
begin_transaction db;
@ -570,50 +405,57 @@ let cmd_index bindirs mandirs ignorelist db_path =
else (name, classify_binary bindir name)
) bins in
let pending = ref [] in
let process_result name rd buf =
drain_fd rd buf;
(try Unix.close rd with _ -> ());
let data = Buffer.contents buf in
if String.length data > 0 then begin
let result : [`Native of string | `Parsed of (string * help_result) list | `None] =
try Marshal.from_string data 0 with _ -> `None in
(match result with
| `Native src ->
upsert_raw db ~source:"native" name src;
incr n_results
| `Parsed pairs ->
List.iter (fun (cmd_name, r) ->
if not (SSet.mem cmd_name !done_cmds) then begin
upsert db ~source:"help" cmd_name r;
done_cmds := SSet.add cmd_name !done_cmds;
incr n_results
end
) pairs
| `None -> ())
end;
done_cmds := SSet.add name !done_cmds in
let reap () =
pending := List.filter (fun (pid, rd, name) ->
pending := List.filter (fun (pid, rd, buf, name) ->
drain_fd rd buf;
match Unix.waitpid [Unix.WNOHANG] pid with
| (0, _) -> true
| _ ->
let ic = Unix.in_channel_of_descr rd in
(let[@warning "-8"] result : [`Native of string | `Parsed of (string * help_result) list | `None] =
try Marshal.from_channel ic with _ -> `None in
match result with
| `Native src ->
upsert_raw db ~source:"native" name src;
incr n_results
| `Parsed pairs ->
List.iter (fun (cmd_name, r) ->
if not (SSet.mem cmd_name !done_cmds) then begin
upsert db ~source:"help" cmd_name r;
done_cmds := SSet.add cmd_name !done_cmds;
incr n_results
end
) pairs
| `None -> ());
close_in ic;
done_cmds := SSet.add name !done_cmds;
process_result name rd buf;
false
| exception Unix.Unix_error (Unix.ECHILD, _, _) ->
(try Unix.close rd with _ -> ()); false
) !pending in
let wait_slot () =
let wait_for_slot () =
while List.length !pending >= max_jobs do
reap ();
if List.length !pending >= max_jobs then
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
reap ()
if List.length !pending >= max_jobs then begin
let fds = List.map (fun (_, rd, _, _) -> rd) !pending in
ignore (Unix.select fds [] [] 0.05)
end
done in
Array.iter (fun (name, cls) ->
match cls with
| Skip -> ()
| Try_help | Try_native_and_help ->
wait_slot ();
wait_for_slot ();
let (rd, wr) = Unix.pipe () in
let pid = Unix.fork () in
if pid = 0 then begin
Unix.close rd;
List.iter (fun (_, prd, _) ->
List.iter (fun (_, prd, _, _) ->
try Unix.close prd with _ -> ()) !pending;
let result =
try
@ -626,7 +468,7 @@ let cmd_index bindirs mandirs ignorelist db_path =
match native with
| Some src -> `Native src
| None ->
let pairs = help_resolve_seq ~timeout:200 path [] name in
let pairs = help_resolve_par ~timeout:200 path [] name in
if pairs <> [] then `Parsed pairs else `None
with _ -> `None in
let oc = Unix.out_channel_of_descr wr in
@ -636,12 +478,15 @@ let cmd_index bindirs mandirs ignorelist db_path =
exit 0
end else begin
Unix.close wr;
pending := (pid, rd, name) :: !pending
pending := (pid, rd, Buffer.create 4096, name) :: !pending
end
) classified;
while !pending <> [] do
(try ignore (Unix.wait ()) with Unix.Unix_error _ -> ());
reap ()
reap ();
if !pending <> [] then begin
let fds = List.map (fun (_, rd, _, _) -> rd) !pending in
ignore (Unix.select fds [] [] 0.05)
end
done;
(* Phase 2: manpages *)
if Sys.file_exists mandir && Sys.is_directory mandir then
@ -682,20 +527,111 @@ let cmd_dump db_path =
) cmds;
close db
let cmd_demo () =
Printf.printf "# Generated by: inshellah demo\n\n";
match parse_help
{|Usage: ls [OPTION]... [FILE]...
-a, --all do not ignore entries starting with .
-A, --almost-all do not list implied . and ..
--block-size=SIZE with -l, scale sizes by SIZE when printing
--color[=WHEN] color the output WHEN
-h, --human-readable with -l and -s, print sizes like 1K 234M 2G etc.
--help display this help and exit
--version output version information and exit
|} with
| Ok r -> print_string (generate_extern "ls" r)
| Error msg -> Printf.eprintf "parse error: %s\n" msg
let find_in_path name =
try
let path_var = Sys.getenv "PATH" in
let dirs = String.split_on_char ':' path_var in
let rec go = function
| [] -> None
| dir :: rest ->
let p = Filename.concat dir name in
if is_executable p then Some p else go rest in
go dirs
with Not_found -> None
let resolve_and_cache db name path =
let pairs = help_resolve_par ~timeout:200 path [] name in
if pairs <> [] then begin
List.iter (fun (cmd_name, r) -> upsert db cmd_name r) pairs;
Some pairs
end else None
let completion_json value desc =
Printf.sprintf "{\"value\":\"%s\",\"description\":\"%s\"}"
(escape_json value) (escape_json desc)
let flag_completions prefix entries =
let candidates = ref [] in
List.iter (fun (e : entry) ->
let desc = match e.param with
| Some (Mandatory p) -> if e.desc <> "" then e.desc ^ " <" ^ p ^ ">" else "<" ^ p ^ ">"
| Some (Optional p) -> if e.desc <> "" then e.desc ^ " [" ^ p ^ "]" else "[" ^ p ^ "]"
| None -> e.desc in
(match e.switch with
| Long l ->
let flag = "--" ^ l in
if String.starts_with ~prefix flag then
candidates := completion_json flag desc :: !candidates
| Short c ->
let flag = Printf.sprintf "-%c" c in
if String.starts_with ~prefix flag then
candidates := completion_json flag desc :: !candidates
| Both (c, l) ->
let long = "--" ^ l in
let short = Printf.sprintf "-%c" c in
if String.starts_with ~prefix long then
candidates := completion_json long desc :: !candidates
else if String.starts_with ~prefix short then
candidates := completion_json short desc :: !candidates)
) entries;
List.rev !candidates
let cmd_complete spans db_path =
match spans with
| [] -> print_string "[]\n"
| cmd_name :: rest ->
let db = init db_path in
(* Try longest subcommand match first: "git add" before "git" *)
let rec find_result tokens =
match tokens with
| [] -> None
| _ ->
let try_name = String.concat " " tokens in
match lookup_result db try_name with
| Some r -> Some (try_name, r, List.length tokens)
| None ->
find_result (List.rev (List.tl (List.rev tokens))) in
let all_tokens = cmd_name :: (match rest with
| _ :: _ when List.length rest >= 1 ->
(* exclude the partial last token from subcommand lookup *)
List.rev (List.tl (List.rev rest))
| _ -> []) in
let found = find_result all_tokens in
(* If not found at all, try on-the-fly resolution for the base command *)
let result = match found with
| Some _ -> found
| None ->
(match find_in_path cmd_name with
| Some path ->
(match resolve_and_cache db cmd_name path with
| Some _pairs ->
(* Look up again after caching *)
find_result all_tokens
| None -> None)
| None -> None) in
let partial = match rest with
| [] -> ""
| _ -> List.nth rest (List.length rest - 1) in
(match result with
| None -> print_string "[]\n"
| Some (_matched_name, r, _depth) ->
let candidates = ref [] in
(* Flag completions when partial starts with - *)
if String.starts_with ~prefix:"-" partial then
candidates := flag_completions partial r.entries
else begin
(* Subcommand completions *)
List.iter (fun (sc : subcommand) ->
if partial = "" || String.starts_with ~prefix:partial sc.name then
candidates := completion_json sc.name sc.desc :: !candidates
) r.subcommands;
candidates := List.rev !candidates;
(* Also offer flags if no subcommand prefix or few subcommand matches *)
if partial = "" || !candidates = [] then
candidates := !candidates @ flag_completions partial r.entries
end;
Printf.printf "[%s]\n" (String.concat "," !candidates));
close db
let load_ignorelist path =
try
@ -720,16 +656,19 @@ let parse_index_args args =
let () =
match Array.to_list Sys.argv |> List.tl with
| ["generate"; bindir; mandir; "-o"; outdir] ->
cmd_generate bindir mandir outdir SSet.empty
| ["generate"; bindir; mandir; "-o"; outdir; "--ignore"; ignore_file] ->
cmd_generate bindir mandir outdir (load_ignorelist ignore_file)
| "index" :: rest ->
let (prefixes, db_path, ignorelist) = parse_index_args rest in
if prefixes = [] then (Printf.eprintf "error: index requires at least one prefix dir\n"; exit 1);
let bindirs = List.map (fun p -> Filename.concat p "bin") prefixes in
let mandirs = List.map (fun p -> Filename.concat p "share/man") prefixes in
cmd_index bindirs mandirs ignorelist db_path
| "complete" :: rest ->
let rec parse_complete_args spans db = function
| [] -> (List.rev spans, db)
| "--db" :: path :: rest -> parse_complete_args spans path rest
| arg :: rest -> parse_complete_args (arg :: spans) db rest in
let (spans, db_path) = parse_complete_args [] (default_db_path ()) rest in
cmd_complete spans db_path
| "dump" :: rest ->
let db_path = match rest with
| ["--db"; path] -> path
@ -738,7 +677,4 @@ let () =
cmd_dump db_path
| ["manpage"; file] -> cmd_manpage file
| ["manpage-dir"; dir] -> cmd_manpage_dir dir
| "help" :: rest -> cmd_help rest
| ["parse-help"; cmd] -> cmd_parse_help cmd
| ["demo"] -> cmd_demo ()
| _ -> usage ()