Permalink
Browse files

cli client

  • Loading branch information...
hannesm committed Nov 27, 2014
1 parent b3a9a93 commit 17b674130f7b1fcf2542eb5e0911a40b81fc724e
Showing with 117 additions and 0 deletions.
  1. +12 −0 _oasis
  2. +105 −0 src/cli_client.ml
12 _oasis
@@ -11,13 +11,25 @@ BuildTools: ocamlbuild
Description:
Graphical XMPP client with OTR
Flag "gui"
Description : GUI interface (GTK2)
Default : false
Library "xmpp_client"
Path : src/
Modules : Config, Xmpp_connection, Xmpp_callbacks, User
Pack : true
BuildDepends : erm_xmpp, otr, tls, tls.lwt, lwt, sexplib, sexplib.syntax, hex, nocrypto
Executable "cli_client"
Path : src/
Install : false
CompiledObject : native
MainIs : cli_client.ml
BuildDepends : lambda-term, lwt.syntax, xmpp_client
Executable "gui_client"
Build $: flag(gui)
Path : src/
Install : false
CompiledObject : native
@@ -0,0 +1,105 @@
open Lwt
open LTerm_style
open LTerm_text
open LTerm_geom
open CamomileLibraryDyn.Camomile
open React
let make_prompt size time =
let tm = Unix.localtime time in
let exit_code = 10 in
eval [
B_bold true;
B_fg lcyan;
S"─( ";
B_fg lmagenta; S(Printf.sprintf "%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min); E_fg;
S" )─< ";
B_fg lyellow; S "$"; E_fg;
S" >─";
S(Zed_utf8.make
(size.cols - 23 - Zed_utf8.length "foo")
(UChar.of_int 0x2500));
S"[ ";
B_fg(if exit_code = 0 then lwhite else lred); S "foo"; E_fg;
S" ]─";
E_fg;
S"\n";
B_fg lred; S "user"; E_fg;
B_fg lgreen; S"@"; E_fg;
B_fg lblue; S "domain"; E_fg;
B_fg lgreen; S" $ "; E_fg;
E_bold;
]
let commands =
[ "connect" ; "add" ; "status" ]
let time =
let time, set_time = S.create (Unix.time ()) in
(* Update the time every 60 seconds. *)
ignore (Lwt_engine.on_timer 60.0 true (fun _ -> set_time (Unix.time ())));
time
class read_line ~term ~history ~completions = object(self)
inherit LTerm_read_line.read_line ~history ()
inherit [Zed_utf8.t] LTerm_read_line.term term
method completion =
let prefix = Zed_rope.to_string self#input_prev in
let completions = List.filter (fun f -> Zed_utf8.starts_with f prefix) completions in
self#set_completion 0 (List.map (fun f -> (f, " ")) completions)
initializer
self#set_prompt (S.l2 (fun size time -> make_prompt size time) self#size time)
end
let rec loop term history =
let completions = commands in
match_lwt
try_lwt
lwt command = (new read_line ~term ~history:(LTerm_history.contents history) ~completions)#run in
return (Some command)
with Sys.Break ->
return None
with
| Some command ->
Printf.printf "executing %s\n" command ;
LTerm_history.add history command;
loop
term
history
| None ->
loop term history
let () =
Lwt_main.run (
ignore (LTerm_inputrc.load ());
(* look for -f command line flag *)
Lwt_unix.getlogin () >>= fun user ->
Lwt_unix.getpwnam user >>= fun pw_ent ->
let cfgdir =
let home = pw_ent.Lwt_unix.pw_dir in
Filename.concat home ".config"
in
Xmpp_callbacks.init cfgdir >>= fun (config, users) ->
Printf.printf "your config %s\n%!" (Config.store_config config) ;
let history = LTerm_history.create [] in
Lazy.force LTerm.stdout >>= fun term ->
try_lwt
loop term history
with
LTerm_read_line.Interrupt ->
(
(* dump_config cfgdir !cfg >>= fun () ->
match !user_data with
| None -> return ()
| Some x -> dump_users cfgdir x.users *)
return ())
)

0 comments on commit 17b6741

Please sign in to comment.