Permalink
Browse files

make colours user-configurable

  • Loading branch information...
hannesm committed Jan 29, 2017
1 parent 634c673 commit 40bec5efba81061cc41df891cadd282120e16816
Showing with 172 additions and 36 deletions.
  1. +37 −8 README.md
  2. +8 −6 _tags
  3. +13 −5 bin/jackline.ml
  4. +10 −17 cli/cli_client.ml
  5. +93 −0 cli/cli_colour.ml
  6. +7 −0 src/persistency.ml
  7. +3 −0 src/user.ml
  8. +1 −0 src/user.mli
@@ -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 <n>" (where n is in the range 0 and 23,
- "rgb <r> <g> <b>" (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
14 _tags
@@ -13,11 +13,13 @@ true : package(sexplib astring)
<src/xmpp_callbacks.ml>: package(erm_xmpp lwt tls tls.lwt ptime)
<src/xmpp_connection.ml>: package(erm_xmpp lwt tls tls.lwt)
<cli/cli_support.ml>: package(uutf notty astring)
<cli/cli_client.ml>: package(lwt otr notty erm_xmpp ptime ptime.clock.os)
<cli/cli_input.ml>: package(notty lwt erm_xmpp otr)
<cli/cli_commands.ml>: package(lwt otr erm_xmpp)
<cli/cli_config.ml>: package(lwt nocrypto otr notty tls.lwt x509)
<cli/cli_state.ml>: package(hex lwt nocrypto erm_xmpp tls.lwt x509)
<cli/*>: package(notty lwt)
<cli/cli_colour.ml>: package(astring)
<cli/cli_support.ml>: package(uutf astring)
<cli/cli_client.ml>: package(otr erm_xmpp ptime ptime.clock.os)
<cli/cli_input.ml>: package(erm_xmpp otr)
<cli/cli_commands.ml>: package(otr erm_xmpp)
<cli/cli_config.ml>: package(nocrypto otr tls.lwt x509)
<cli/cli_state.ml>: package(hex nocrypto erm_xmpp tls.lwt x509)
<bin/jackline.{ml,byte,native}>: package(erm_xmpp hex lwt notty notty.lwt nocrypto otr sexplib tls tls.lwt ptime ptime.clock.os)
@@ -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
@@ -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 \
@@ -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
@@ -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
@@ -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 ;
@@ -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 ;

0 comments on commit 40bec5e

Please sign in to comment.