diff --git a/README.md b/README.md index 24d7b86..802edae 100644 --- a/README.md +++ b/README.md @@ -114,7 +114,7 @@ a = away, d = do not disturb, x = extended away, _ = offline). A single contact is active, which can be modified by `PgUp/PdDown`. The active contact is shown in reversed foreground and background -color. Its chat content is displayed in the chat window. Certain +colour. Its chat content is displayed in the chat window. Certain commands and operations (such as sending a message) require an active contact. @@ -170,20 +170,49 @@ Active keys: `/help` prints the available commands, `/help command` more detailed help of the given command. -#### Colors +#### Colours + +default foreground colours are: +- Chat empty +- GroupChat empty +- Presence gray 18 +- Info gray 18 +- Warning yellow +- Error red +- Success green + +To customise, create a file `colours.sexp` in your config folder +(`~/.config/ocaml-xmpp-client` unless `-f` is provided). Sample content: +``` +((Chat "empty") + (GroupChat "empty") + (Presence "gray 18") + (Info "gray 18") + (Warning "yellow") + (Error "red") + (Success "green")) +``` + +Available colours: +- "empty", +- "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white", +- "lightblack", "lightred", "lightgreen", "lightyellow", "lightblue", "lightmagenta", "lightcyan", "lightwhite", +- "gray " (where n is in the range 0 and 23, +- "rgb " (where r, g, b in the range 0 and 5) + +frame: red means the active session is unencrypted, green encrypted contact list: -- green frame and contact: OTR session established -- red frame and contact: no OTR session -- black: no active session exists +- green contact: OTR session established +- red contact: no OTR session +- black/white: groupchat, offline, self horizontal line - red OTR fingerprint: not verified (use a second channel) - green OTR: key is verified -status line -- own jabber id in reverse colors: logging to disk is enabled for this contact -- own jabber id in usual colors: no logging to disk for this contact +logging (`/log on|off`): +- jabber id in status line in reverse: logging is turned on ### FAQ diff --git a/_tags b/_tags index 88318d9..51b5eae 100644 --- a/_tags +++ b/_tags @@ -13,11 +13,13 @@ true : package(sexplib astring) : package(erm_xmpp lwt tls tls.lwt ptime) : package(erm_xmpp lwt tls tls.lwt) -: package(uutf notty astring) -: package(lwt otr notty erm_xmpp ptime ptime.clock.os) -: package(notty lwt erm_xmpp otr) -: package(lwt otr erm_xmpp) -: package(lwt nocrypto otr notty tls.lwt x509) -: package(hex lwt nocrypto erm_xmpp tls.lwt x509) +: package(notty lwt) +: package(astring) +: package(uutf astring) +: package(otr erm_xmpp ptime ptime.clock.os) +: package(erm_xmpp otr) +: package(otr erm_xmpp) +: package(nocrypto otr tls.lwt x509) +: package(hex nocrypto erm_xmpp tls.lwt x509) : package(erm_xmpp hex lwt notty notty.lwt nocrypto otr sexplib tls tls.lwt ptime ptime.clock.os) diff --git a/bin/jackline.ml b/bin/jackline.ml index 6f01a77..17819fc 100644 --- a/bin/jackline.ml +++ b/bin/jackline.ml @@ -59,6 +59,11 @@ let start_client cfgdir debug unicode fd_gui fd_nfy () = config | Some cfg -> Lwt.return cfg) >>= fun config -> + Cli_colour.init () ; + (Persistency.load_colours cfgdir >|= function + | None -> () + | Some colours -> Cli_colour.load colours) >>= fun () -> + (match config.Xconfig.password with | None -> Persistency.load_password cfgdir | Some x -> Lwt.return (Some x)) >>= (function @@ -113,11 +118,14 @@ let start_client cfgdir debug unicode fd_gui fd_nfy () = let connect_mvar = Cli_state.Connect.connect_me config ui_mvar state_mvar users in let state = Cli_state.empty_state cfgdir config users connect_mvar state_mvar in - let greeting = - "multi user chat support: see you at /join jackline@conference.jabber.ccc.de (use ArrowUp key); \ - type /help for help" - and sender = `Local (`Full myjid, "welcome to jackline " ^ Utils.version) in - Cli_state.add_status ~kind:`Info state sender greeting ; + let greetings = [ + "welcome to jackline r" ^ Utils.version ; + "type /help for command list" ; + "* configurable colours! '((Presence \"cyan\") (Success \"lightgreen\"))' in your ~/.config/ocaml-xmpp-client/colours.sexp (see https://github.com/hannesm/jackline for details)" ; + "* improved MUC support: join&leave messages; autojoin on (re)connect; /rooms discovery" ] + and sender = `Local (`Full myjid,"") + in + List.iter (Cli_state.add_status ~kind:`Info state sender) greetings ; let us = Contact.fold (fun _ v acc -> v :: acc) users [] in diff --git a/cli/cli_client.ml b/cli/cli_client.ml index dbc6489..7fe5517 100644 --- a/cli/cli_client.ml +++ b/cli/cli_client.ml @@ -13,13 +13,6 @@ let print_time ~now ~tz_offset_s timestamp = else Printf.sprintf "%02d-%02d %02d:%02d " m d hh mm -let st_to_a = function - | `Chat | `GroupChat -> A.empty - | `Presence | `Info -> A.(fg (gray 18)) - | `Warning -> A.(fg yellow) - | `Error -> A.(fg red) - | `Success -> A.(fg green) - let format_log tz_offset_s now log = let { User.direction ; timestamp ; message ; kind ; _ } = log in let time = print_time ~now ~tz_offset_s timestamp in @@ -29,7 +22,7 @@ let format_log tz_offset_s now log = | `Local (_, x) -> "* " ^ x ^ " *" | `To _ -> ">>>" in - (st_to_a kind, time ^ from ^ " " ^ message) + (Cli_colour.kind kind, time ^ from ^ " " ^ message) let format_message tz_offset_s now self buddy resource { User.direction ; encrypted ; received ; timestamp ; message ; kind ; _ } = let time = print_time ~now ~tz_offset_s timestamp @@ -75,11 +68,11 @@ let format_message tz_offset_s now self buddy resource { User.direction ; encryp (style, r ^ pre) and to_style st = match st, kind with - | `Default, x -> st_to_a x + | `Default, x -> Cli_colour.kind x | `Highlight, `Chat | `Highlight, `GroupChat -> A.(st bold) - | `Highlight, x -> st_to_a x + | `Highlight, x -> Cli_colour.kind x | `Underline, `Chat | `Underline, `GroupChat -> A.(st underline) - | `Underline, x -> A.(st underline ++ st_to_a x) + | `Underline, x -> A.(st underline ++ Cli_colour.kind x) in let p, msg = if String.length message >= 3 && String.sub message 0 3 = "/me" then @@ -103,8 +96,8 @@ let format_message tz_offset_s now self buddy resource { User.direction ; encryp let buddy_to_color = function | `Default -> A.empty - | `Good -> A.(fg green) - | `Bad -> A.(fg red) + | `Good -> Cli_colour.kind `Success + | `Bad -> Cli_colour.kind `Error let format_buddy state width s contact resource = let jid = Contact.jid contact resource in @@ -211,7 +204,7 @@ let horizontal_line buddy resource a scrollback width = let status_line self mysession notify log a width = let a = A.(a ++ st bold) in - let notify = if notify then I.string A.(a ++ st blink ++ fg cyan) "##" else Char.hdash a 2 + let notify = if notify then I.string A.(a ++ st blink ++ Cli_colour.kind `Warning) "##" else Char.hdash a 2 and jid = let data = User.userid self mysession and a' = if log then A.(st reverse) else a @@ -287,8 +280,8 @@ let render_state (width, height) state = let input = char_list_to_str pre in ( match Cli_commands.completion state input with | [] -> I.empty - | [x] -> I.string A.(fg (gray 18)) x - | xs -> I.string A.(fg (gray 18)) (String.concat "|" xs) ) + | [x] -> I.string (Cli_colour.kind `Info) x + | xs -> I.string (Cli_colour.kind `Info) (String.concat "|" xs) ) | _ -> iinp2 in v_center iinp r width @@ -386,7 +379,7 @@ let rec loop term size redrawer mvar input_mvar state = try render_state size state with e -> - let e = A.(fg red), (Printexc.to_string e) + let e = Cli_colour.kind `Error, (Printexc.to_string e) and note = "While trying to render the UI. Try to scroll to another buddy \ (Page Up/Down), switch rendering of buddy list (F12), or clear \ diff --git a/cli/cli_colour.ml b/cli/cli_colour.ml new file mode 100644 index 0000000..0f32363 --- /dev/null +++ b/cli/cli_colour.ml @@ -0,0 +1,93 @@ +open Notty +open Astring + +module OrderedKind = struct + type t = User.chatkind + + let compare (a : [< t]) (b : [< t]) = match a, b with + | `Chat, `Chat -> 0 + | `GroupChat, `GroupChat -> 0 + | `Presence, `Presence -> 0 + | `Info, `Info -> 0 + | `Warning, `Warning -> 0 + | `Error, `Error -> 0 + | `Success, `Success -> 0 + | `Chat, _ -> 1 + | _, `Chat -> -1 + | `GroupChat, _ -> 1 + | _, `GroupChat -> -1 + | `Presence, _ -> 1 + | _, `Presence -> -1 + | `Info, _ -> 1 + | _, `Info -> -1 + | `Warning, _ -> 1 + | _, `Warning -> -1 + | `Error, _ -> 1 + | _, `Error -> -1 +end + +module M = Map.Make(OrderedKind) + +let c = ref M.empty + +let init () = + let m = + M.add `Presence A.(gray 18) + (M.add `Info A.(gray 18) + (M.add `Warning A.yellow + (M.add `Error A.red + (M.add `Success A.green M.empty)))) + in + c := m + +let parse_value = + let open A in + function + | "empty" -> None + | x -> Some (match x with + | "black" -> Some black + | "red" -> Some red + | "green" -> Some green + | "yellow" -> Some yellow + | "blue" -> Some blue + | "magenta" -> Some magenta + | "cyan" -> Some cyan + | "white" -> Some white + | "lightblack" -> Some lightblack + | "lightred" -> Some lightred + | "lightgreen" -> Some lightgreen + | "lightyellow" -> Some lightyellow + | "lightblue" -> Some lightblue + | "lightmagenta" -> Some lightmagenta + | "lightcyan" -> Some lightcyan + | "lightwhite" -> Some lightwhite + | x when String.is_prefix ~affix:"gray" x -> + (match String.cut ~sep:" " x with + | None -> None + | Some (_, i) -> match String.to_int i with + | Some x when x >= 0 && x <= 23 -> Some (gray x) + | _ -> None) + | x when String.is_prefix ~affix:"rgb" x -> + (match String.cuts ~sep:" " x with + | _::xs when List.length xs = 3 -> + (match + List.filter + (function None -> false | Some _ -> true) + (List.map String.to_int xs) + with + | Some r::Some g::Some b::[] when r >= 0 && r <= 5 && g >= 0 && g <= 5 && b >= 0 && b <= 5 -> + Some (rgb ~r ~g ~b) + | _ -> None) + | _ -> None) + | _ -> None) + +let load_c (kind, value) = + match parse_value value with + | None -> c := (M.remove kind !c) + | Some None -> invalid_arg ("couldn't parse your colour for " ^ User.chatkind_to_string kind ^ ": " ^ value) + | Some (Some col) -> c := (M.add kind col !c) + +let load = List.iter load_c + +let kind k = try A.fg (M.find k !c) with Not_found -> A.empty + diff --git a/src/persistency.ml b/src/persistency.ml index 9c70e22..cb33673 100644 --- a/src/persistency.ml +++ b/src/persistency.ml @@ -77,6 +77,7 @@ let write dir filename buf = Lwt.return () let config = "config.sexp" +let colours = "colours.sexp" let users = "users.sexp" let maybe_create_dir dir = @@ -103,6 +104,12 @@ let load_config load_dsa cfg = Some (Xconfig.load_config (Some dsa) x) | None -> Lwt.return_none + +let load_colours cfg = + read cfg colours >|= function + | Some x -> Some (Sexplib.Conv.(list_of_sexp (pair_of_sexp User.chatkind_of_sexp string_of_sexp)) (Sexplib.Sexp.of_string x)) + | None -> None + let dump_user cfgdir user = user_dir cfgdir >>= fun userdir -> let out = Xjid.bare_jid_to_string (Contact.bare user) in diff --git a/src/user.ml b/src/user.ml index aac6323..43f7b51 100644 --- a/src/user.ml +++ b/src/user.ml @@ -216,6 +216,9 @@ type chatkind = [ | `Success ] [@@deriving sexp] +let chatkind_to_string k = + Sexplib.Sexp.to_string (sexp_of_chatkind k) + type message = { direction : direction ; encrypted : bool ; diff --git a/src/user.mli b/src/user.mli index 8c20546..cb849ac 100644 --- a/src/user.mli +++ b/src/user.mli @@ -99,6 +99,7 @@ type chatkind = [ val chatkind_of_sexp : Sexplib.Type.t -> chatkind val sexp_of_chatkind : chatkind -> Sexplib.Type.t +val chatkind_to_string : chatkind -> string type message = { direction : direction ;