From 76eb2c2aeff3593b753a3410b64c159b7d5e64eb Mon Sep 17 00:00:00 2001 From: atagen Date: Mon, 23 Mar 2026 22:01:46 +1100 Subject: [PATCH] fix partial, systemctl manpage --- bin/main.ml | 22 +++++++--- inshellah.opam | 2 - lib/manpage.ml | 113 ++++++++++++++++++++++++++++++++++++++++++++++++- lib/parser.ml | 51 +++++++++++++++++++++- 4 files changed, 176 insertions(+), 12 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index f647327..7bf2ecb 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -625,23 +625,31 @@ let cmd_complete spans user_dir system_dirs = | Some _ as found -> (found, partial) | None -> (None, partial) in let found, partial = resolve lookup_tokens last_token in - (* If not found at all, try on-the-fly resolution for the base command *) + (* Try on-the-fly resolution when no match or only a parent matched *) + let n_lookup = List.length lookup_tokens in let result, partial = match found with - | Some _ -> (found, partial) - | None -> + | Some (_, _, depth) when depth >= n_lookup - 1 -> + (* Exact or near-exact match — use it *) + (found, partial) + | _ -> + (* No match, or only a parent matched — try on-the-fly resolution *) (match find_in_path cmd_name with | Some path -> (match resolve_and_cache ~dir:user_dir cmd_name path with | Some _pairs -> resolve lookup_tokens last_token - | None -> (None, partial)) - | None -> (None, partial)) in + | None -> (found, partial)) + | None -> (found, partial)) in let candidates = match result with | None -> [] - | Some (_matched_name, r, _depth) -> + | Some (_matched_name, r, depth) -> + (* When the match is shallower than requested, the user already + typed a subcommand beyond the matched level — don't show + sibling subcommands, only flags *) + let sub_candidates = if depth < n_lookup - 1 then [] else let subs = match r.subcommands with | _ :: _ -> r.subcommands | [] -> subcommands_of dirs _matched_name in - let sub_candidates = List.filter_map (fun (sc : subcommand) -> + List.filter_map (fun (sc : subcommand) -> let s = fuzzy_score partial sc.name in if s > 0 then Some (s, completion_json sc.name sc.desc) else None ) subs in diff --git a/inshellah.opam b/inshellah.opam index cf4885a..9888aa7 100644 --- a/inshellah.opam +++ b/inshellah.opam @@ -15,8 +15,6 @@ depends: [ "angstrom" "angstrom-unix" "camlzip" - "sqlite3" - "ppx_inline_test" {with-test} "odoc" {with-doc} ] build: [ diff --git a/lib/manpage.ml b/lib/manpage.ml index 606d005..aee0139 100644 --- a/lib/manpage.ml +++ b/lib/manpage.ml @@ -698,6 +698,115 @@ let parse_mdoc_lines lines = in { entries = List.rev entries; subcommands = []; positionals; description = "" } +(* --- COMMANDS section subcommand extraction --- *) + +(* Extract subcommands from COMMANDS/COMMAND sections. + These use .PP + bold name + .RS/.RE blocks, e.g.: + .PP + \fBstart\fR \fIUNIT\fR... + .RS 4 + Start (activate) one or more units. + .RE *) +let extract_commands_section lines = + let classified = List.map classify_line lines in + let rec collect_until_next_sh lines acc = + match lines with + | [] -> List.rev acc + | Macro ("SH", _) :: _ -> List.rev acc + | line :: rest -> collect_until_next_sh rest (line :: acc) + in + let is_commands_section name = + let s = String.uppercase_ascii (String.trim name) in + s = "COMMANDS" || s = "COMMAND" + in + let rec find_commands acc = function + | [] -> List.rev acc + | Macro ("SH", args) :: rest when is_commands_section args -> + find_commands (collect_until_next_sh rest [] :: acc) rest + | _ :: rest -> find_commands acc rest + in + let sections = find_commands [] classified in + List.concat sections + +(* Extract subcommand name from a bold groff text like + "\fBlist\-units\fR [\fIPATTERN\fR...]" → "list-units" *) +let extract_bold_command_name text = + let s = String.trim text in + (* Look for \fB...\fR at the start *) + if String.length s >= 4 + && s.[0] = '\\' && s.[1] = 'f' && s.[2] = 'B' then + let start = 3 in + let end_marker = "\\fR" in + match String.split_on_char '\\' (String.sub s start (String.length s - start)) with + | name_part :: _ -> + let name = strip_groff_escapes ("\\fB" ^ name_part ^ end_marker) |> String.trim in + (* Must look like a subcommand: lowercase, hyphens, no leading dash *) + if String.length name >= 2 + && name.[0] <> '-' + && String.for_all (fun c -> + (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c = '-' || c = '_' + ) name + then Some name + else None + | [] -> None + else + (* Try already-stripped text *) + let stripped = strip_groff_escapes s in + let first_word = match String.split_on_char ' ' stripped with + | w :: _ -> w | [] -> "" in + if String.length first_word >= 2 + && first_word.[0] <> '-' + && String.for_all (fun c -> + (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c = '-' || c = '_' + ) first_word + then Some first_word + else None + +let extract_subcommands_from_commands lines = + let rec walk lines acc = + match lines with + | [] -> List.rev acc + | Macro ("PP", _) :: rest -> + begin match rest with + | Text tag :: rest2 -> + (* Check if this is a subcommand (bold name, not a flag) *) + begin match extract_bold_command_name tag with + | Some name -> + (* Collect description from .RS/.RE block *) + let rec collect_desc lines desc_acc = + match lines with + | Macro ("RS", _) :: rest3 -> + collect_in_rs rest3 desc_acc + | Text s :: rest3 -> + collect_desc rest3 (s :: desc_acc) + | _ -> (String.concat " " (List.rev desc_acc), lines) + and collect_in_rs lines desc_acc = + match lines with + | Macro ("RE", _) :: rest3 -> + (String.concat " " (List.rev desc_acc), rest3) + | Text s :: rest3 -> + collect_in_rs rest3 (s :: desc_acc) + | Macro ("PP", _) :: _ | Macro ("SH", _) :: _ | Macro ("SS", _) :: _ -> + (String.concat " " (List.rev desc_acc), lines) + | _ :: rest3 -> collect_in_rs rest3 desc_acc + | [] -> (String.concat " " (List.rev desc_acc), []) + in + let (desc, rest3) = collect_desc rest2 [] in + let desc = String.trim desc in + (* Take first sentence as description *) + let short_desc = match String.split_on_char '.' desc with + | first :: _ when String.length first > 0 -> String.trim first + | _ -> desc in + let sc : subcommand = { name; desc = short_desc } in + walk rest3 (sc :: acc) + | None -> walk rest2 acc + end + | _ -> walk rest acc + end + | _ :: rest -> walk rest acc + in + walk lines [] + (* --- Top-level API --- *) let parse_manpage_lines lines = @@ -707,7 +816,9 @@ let parse_manpage_lines lines = let options_section = extract_options_section lines in let entries = extract_entries options_section in let positionals = extract_synopsis_positionals_lines lines in - { entries; subcommands = []; positionals; description = "" } + let commands_section = extract_commands_section lines in + let subcommands = extract_subcommands_from_commands commands_section in + { entries; subcommands; positionals; description = "" } end let parse_manpage_string contents = diff --git a/lib/parser.ml b/lib/parser.ml index fa65da0..dbf7cf3 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -129,12 +129,14 @@ let param_parser = space_upper_param; space_type_param ] >>| fun a -> Some a) -(* Switch parser: -a, --all | --all / -a | -a | --all *) +(* Switch parser: -a, --all | -a --all | --all / -a | -a | --all *) let switch_parser = choice [ (short_switch >>= fun s -> comma *> long_switch >>| fun l -> Both (s, l)); + (short_switch >>= fun s -> + char ' ' *> long_switch >>| fun l -> Both (s, l)); (long_switch >>= fun l -> inline_ws *> char '/' *> inline_ws *> short_switch >>| fun s -> Both (s, l)); @@ -222,16 +224,61 @@ let entry = (* --- Subcommand parsing --- *) -(* A subcommand line: " name description" *) +(* A subcommand line: " name description" + Also handles argument placeholders: " name UNIT... description" *) let is_subcommand_char = function | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' -> true | _ -> false +(* Skip argument placeholders like UNIT..., [PATTERN...|PID...], + that appear between the subcommand name and the description. + Only consumes single-space gaps — the two-space gap before the + description is left for the main parser. *) +let skip_arg_placeholders = + fix (fun self -> + (* Peek ahead: single space followed by arg-like token *) + available >>= fun avail -> + if avail < 2 then return () + else + peek_string (min avail 2) >>= fun s2 -> + if String.length s2 >= 2 && s2.[0] = ' ' && s2.[1] <> ' ' then + (* Single space — could be an arg placeholder *) + let next = s2.[1] in + if next = '[' || next = '<' + || (next >= 'A' && next <= 'Z') then + (* Peek the full token to check if it's ALL_CAPS/brackets *) + peek_string (min avail 80) >>= fun preview -> + (* Extract the token after the single space *) + let tok_start = 1 in + let tok_end = ref tok_start in + while !tok_end < String.length preview + && preview.[!tok_end] <> ' ' + && preview.[!tok_end] <> '\n' + && preview.[!tok_end] <> '\r' do + incr tok_end + done; + let tok = String.sub preview tok_start (!tok_end - tok_start) in + (* Accept as placeholder if it starts with [ or < or is ALL_CAPS + (possibly with dots, pipes, dashes) *) + let is_placeholder = + tok.[0] = '[' || tok.[0] = '<' + || String.for_all (fun c -> + (c >= 'A' && c <= 'Z') || c = '_' || c = '-' + || c = '.' || c = '|' || c = ',' || (c >= '0' && c <= '9') + ) tok + in + if is_placeholder then + advance (1 + String.length tok) *> self + else return () + else return () + else return ()) + let subcommand_entry = inline_ws *> take_while1 is_subcommand_char >>= fun name -> if String.length name < 2 then fail "subcommand name too short" else + skip_arg_placeholders *> char ' ' *> char ' ' *> inline_ws *> rest_of_line <* eol >>| fun desc -> { name = String.lowercase_ascii name;