From 53be599d91eb98d04f88611e68e96741f140555f Mon Sep 17 00:00:00 2001 From: atagen Date: Mon, 23 Mar 2026 11:40:34 +1100 Subject: [PATCH] fix parallelism, create completer --- bin/main.ml | 582 +++++++++++++++++++++++----------------------------- 1 file changed, 259 insertions(+), 323 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 9c4d4b4..90f92e7 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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 ()