<commit_before>open Cli_state

open Lwt.Infix

let string_normalize_fingerprint fpstr =
  let fpstr = Astring.String.Ascii.lowercase fpstr in
  Astring.String.fold_right
    (fun c acc -> if Astring.Char.Ascii.is_hex_digit c then
                    Astring.String.of_char c ^ acc
                  else
                    acc)
    fpstr ""

type command = {
  name : string ;
  command_line : string ;
  documentation : string ;
  subcommands : state -> string list ;
}

module StringHash =
  struct
    type t = string
    let equal a b = a = b
    let hash = Hashtbl.hash
  end
module Commands = Hashtbl.Make(StringHash)
type commands = command Commands.t

let commands = Commands.create 10

let keys () = List.sort compare (Commands.fold (fun k _ acc -> k :: acc) commands [])

let new_command name command_line documentation subcommands =
  Commands.add commands name { name ; command_line ; documentation ; subcommands }

let _ =
  (* global *)
  new_command
    "connect" "/connect" "connects to the server" (fun _ -> []) ;
  new_command
    "disconnect" "/disconnect" "disconnects from the server" (fun _ -> []) ;
  new_command
    "quit" "/quit" "exits this client" (fun _ -> []) ;

  new_command
    "logheight" "/logheight [number]" "adjusts height of log to n" (fun _ -> []) ;
  new_command
    "buddywidth" "/buddywidth [number]" "adjusts width of buddy list to n" (fun _ -> []) ;

  (* global roster commands *)
  new_command
    "add" "/add [jid]"
    "adds jid to your contact list, and sends a subscription request" (fun _ -> []) ;

  new_command
    "go" "/go [jid]" "jump to contact jid" (fun s -> List.map Xjid.jid_to_string (all_jids s)) ;

  (* things affecting you *)
  new_command
    "status" "/status [presence] [message]"
    "sets your presence (free/away/dnd/xa/offline/online) and status message"
    (fun _ -> [ "free" ; "away" ; "dnd" ; "xa" ; "offline" ; "online" ]) ;
  new_command
    "priority" "/priority [number]" "set your presence priority to number" (fun _ -> []) ;

  (* user as context *)
  new_command
    "otrpolicy" "/otrpolicy +-[policy version]" "prints (without argument) or adjusts (prefix with add (+) or remove (-)) the otr policies and versions: require_encryption, send_whitespace_tag, whitespace_start_ake, error_start_ake, reveal_macs, v2, v3"
    (fun _ -> [ "+REQUIRE_ENCRYPTION" ; "+SEND_WHITESPACE_TAG" ; "+WHITESPACE_START_AKE" ; "+ERROR_START_AKE" ; "+REVEAL_MACS" ; "+V2" ; "+V3" ; "-REQUIRE_ENCRYPTION" ; "-SEND_WHITESPACE_TAG" ; "-WHITESPACE_START_AKE" ; "-ERROR_START_AKE" ; "-REVEAL_MACS" ; "-V2" ; "-V3" ]) ;
  new_command
    "log" "/log [on|off]" "enable or disable logging for current contact" (fun _ -> [ "on" ; "off" ]) ;
  new_command
    "clear" "/clear" "clears the active window chat backlog" (fun _ -> []) ;
  new_command
    "authorization" "/authorization [argument]"
    "changes presence subscription of the current contact to argument -- one of 'allow', 'cancel', 'request', 'request_unsubscribe'"
    (fun _ -> [ "allow" ; "cancel" ; "request" ; "request_unsubscribe" ]) ;
  new_command
    "fingerprint" "/fingerprint [fp]"
    "marks the given OTR fingerprint verified for the current contact ; prints own and session fingerprint if no argument is given"
    (fun _ -> []) ;
  new_command
    "revoke" "/revoke [fp]"
    "revokes the given OTR fingerprint" (fun _ -> []) ;
  new_command
    "info" "/info" "displays information about the current session" (fun _ -> []) ;
  new_command
    "otr" "/otr [argument]" "manages OTR session by argument -- one of 'start' 'stop' or 'info'"
    (fun _ -> [ "start" ; "stop" ; "info" ]) ;
  new_command
    "smp" "/smp [argument]" "manages SMP session by argument -- one of 'shared [secret]', 'question [question]', 'answer' or 'abort'"
    (fun _ -> [ "shared" ; "question" ; "answer" ; "abort" ]) ;
  new_command
    "remove" "/remove" "remove current user from roster" (fun _ -> []) ;

  (* multi user chat *)
  new_command
    "join" "/join [?chatroom]" "joins chatroom (or active contact)"
    (fun s ->
       " " :: List.map Xjid.bare_jid_to_string
         (Contact.fold (fun _ c acc ->
              match c with `Room r -> r.Muc.room_jid :: acc | _ -> acc)
             s.contacts [])) ;
  new_command
    "leave" "/leave [?reason]" "leaves active chatroom (using reason)" (fun _ -> []) ;
  new_command
    "rooms" "/rooms [server]" "queries chatrooms on server" (fun _ -> []) ;

  (* nothing below here, please *)
  new_command
    "help" "/help [cmd]" "shows available commands or detailed help for cmd"
    (fun _ -> keys ())

let split_ws s =
  match Astring.String.cut ~sep:" " s with
  | None -> (s, None)
  | Some (x, y) when y = "" -> (x, None)
  | Some (x, y) -> (x, Some y)

let cmd_arg input =
  let open String in
  let l = length input in
  assert (l > 0) ;
  assert (get input 0 = '/') ;
  split_ws (sub input 1 (pred l))

let might_match cmd prefix =
  let upper = min (String.length cmd) (String.length prefix) in
  let rec cmp_i idx =
    if idx < upper then
      if String.get cmd idx = String.get prefix idx then
        cmp_i (succ idx)
      else
        false<commit_msg>minor fix to join documentation: how to use a different nickname<commit_after>open Cli_state

open Lwt.Infix

let string_normalize_fingerprint fpstr =
  let fpstr = Astring.String.Ascii.lowercase fpstr in
  Astring.String.fold_right
    (fun c acc -> if Astring.Char.Ascii.is_hex_digit c then
                    Astring.String.of_char c ^ acc
                  else
                    acc)
    fpstr ""

type command = {
  name : string ;
  command_line : string ;
  documentation : string ;
  subcommands : state -> string list ;
}

module StringHash =
  struct
    type t = string
    let equal a b = a = b
    let hash = Hashtbl.hash
  end
module Commands = Hashtbl.Make(StringHash)
type commands = command Commands.t

let commands = Commands.create 10

let keys () = List.sort compare (Commands.fold (fun k _ acc -> k :: acc) commands [])

let new_command name command_line documentation subcommands =
  Commands.add commands name { name ; command_line ; documentation ; subcommands }

let _ =
  (* global *)
  new_command
    "connect" "/connect" "connects to the server" (fun _ -> []) ;
  new_command
    "disconnect" "/disconnect" "disconnects from the server" (fun _ -> []) ;
  new_command
    "quit" "/quit" "exits this client" (fun _ -> []) ;

  new_command
    "logheight" "/logheight [number]" "adjusts height of log to n" (fun _ -> []) ;
  new_command
    "buddywidth" "/buddywidth [number]" "adjusts width of buddy list to n" (fun _ -> []) ;

  (* global roster commands *)
  new_command
    "add" "/add [jid]"
    "adds jid to your contact list, and sends a subscription request" (fun _ -> []) ;

  new_command
    "go" "/go [jid]" "jump to contact jid" (fun s -> List.map Xjid.jid_to_string (all_jids s)) ;

  (* things affecting you *)
  new_command
    "status" "/status [presence] [message]"
    "sets your presence (free/away/dnd/xa/offline/online) and status message"
    (fun _ -> [ "free" ; "away" ; "dnd" ; "xa" ; "offline" ; "online" ]) ;
  new_command
    "priority" "/priority [number]" "set your presence priority to number" (fun _ -> []) ;

  (* user as context *)
  new_command
    "otrpolicy" "/otrpolicy +-[policy version]" "prints (without argument) or adjusts (prefix with add (+) or remove (-)) the otr policies and versions: require_encryption, send_whitespace_tag, whitespace_start_ake, error_start_ake, reveal_macs, v2, v3"
    (fun _ -> [ "+REQUIRE_ENCRYPTION" ; "+SEND_WHITESPACE_TAG" ; "+WHITESPACE_START_AKE" ; "+ERROR_START_AKE" ; "+REVEAL_MACS" ; "+V2" ; "+V3" ; "-REQUIRE_ENCRYPTION" ; "-SEND_WHITESPACE_TAG" ; "-WHITESPACE_START_AKE" ; "-ERROR_START_AKE" ; "-REVEAL_MACS" ; "-V2" ; "-V3" ]) ;
  new_command
    "log" "/log [on|off]" "enable or disable logging for current contact" (fun _ -> [ "on" ; "off" ]) ;
  new_command
    "clear" "/clear" "clears the active window chat backlog" (fun _ -> []) ;
  new_command
    "authorization" "/authorization [argument]"
    "changes presence subscription of the current contact to argument -- one of 'allow', 'cancel', 'request', 'request_unsubscribe'"
    (fun _ -> [ "allow" ; "cancel" ; "request" ; "request_unsubscribe" ]) ;
  new_command
    "fingerprint" "/fingerprint [fp]"
    "marks the given OTR fingerprint verified for the current contact ; prints own and session fingerprint if no argument is given"
    (fun _ -> []) ;
  new_command
    "revoke" "/revoke [fp]"
    "revokes the given OTR fingerprint" (fun _ -> []) ;
  new_command
    "info" "/info" "displays information about the current session" (fun _ -> []) ;
  new_command
    "otr" "/otr [argument]" "manages OTR session by argument -- one of 'start' 'stop' or 'info'"
    (fun _ -> [ "start" ; "stop" ; "info" ]) ;
  new_command
    "smp" "/smp [argument]" "manages SMP session by argument -- one of 'shared [secret]', 'question [question]', 'answer' or 'abort'"
    (fun _ -> [ "shared" ; "question" ; "answer" ; "abort" ]) ;
  new_command
    "remove" "/remove" "remove current user from roster" (fun _ -> []) ;

  (* multi user chat *)
  new_command
    "join" "/join [?muc/nick]" "join (<EMAIL>/bla) chatroom foo on bar.org (or active contact) using nick bla (defaults to username)"
    (fun s ->
       " " :: List.map Xjid.bare_jid_to_string
         (Contact.fold (fun _ c acc ->
              match c with `Room r -> r.Muc.room_jid :: acc | _ -> acc)
             s.contacts [])) ;
  new_command
    "leave" "/leave [?reason]" "leaves active multi-user chat (with reason)" (fun _ -> []) ;
  new_command
    "rooms" "/rooms [server]" "queries chatrooms on server" (fun _ -> []) ;

  (* nothing below here, please *)
  new_command
    "help" "/help [cmd]" "shows available commands or detailed help for cmd"
    (fun _ -> keys ())

let split_ws s =
  match Astring.String.cut ~sep:" " s with
  | None -> (s, None)
  | Some (x, y) when y = "" -> (x, None)
  | Some (x, y) -> (x, Some y)

let cmd_arg input =
  let open String in
  let l = length input in
  assert (l > 0) ;
  assert (get input 0 = '/') ;
  split_ws (sub input 1 (pred l))

let might_match cmd prefix =
  let upper = min (String.length cmd) (String.length prefix) in
  let rec cmp_i idx =
    if idx < upper then
      if String.get cmd idx = String.get prefix idx then
        cmp_i (succ idx)
      else
        false
{'fraction_non_alphanumeric': 0.14087626384207994, 'fraction_numerical': 0.002118440057775638, 'mean_word_length': 3.0475448168355417, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 70, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1312816', 'n_tokens_mistral': 3573, 'n_tokens_neox': 3455, 'n_words': 1100}