Skip to content

Commit

Permalink
delay UI updates by 40ms, improves pasting speed (and potential deadl…
Browse files Browse the repository at this point in the history
…ocks)
  • Loading branch information
hannesm committed Nov 18, 2016
1 parent 63e7212 commit cab34ac
Show file tree
Hide file tree
Showing 3 changed files with 29 additions and 22 deletions.
2 changes: 1 addition & 1 deletion .merlin
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ PKG lwt
PKG sexplib
PKG hex
PKG nocrypto
PKG notty
PKG notty notty.lwt
PKG ptime
PKG ptime.clock.os
PKG ppx_sexp_conv
2 changes: 1 addition & 1 deletion bin/jackline.ml
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,7 @@ let start_client cfgdir debug unicode fd_gui fd_nfy () =
Lwt.async (Cli_input.read_terminal term ui_mvar input_mvar) ;
(* main loop *)
let size = Notty_lwt.Term.size term in
Cli_client.loop term size ui_mvar input_mvar state >>= fun state ->
Cli_client.loop term size Lwt_engine.fake_event ui_mvar input_mvar state >>= fun state ->

closing () >>= fun () ->

Expand Down
47 changes: 27 additions & 20 deletions cli/cli_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -361,44 +361,51 @@ let quit state =
Lwt_list.iter_s send_out otr_sessions)
!xmpp_session

(* how should I know what is smooth? *)
let redraw_interval = 0.04

(* this is rendering and drawing stuff to terminal, waiting for updates of the ui_mvar... *)
let rec loop term size mvar input_mvar state =
let rec loop term size redrawer mvar input_mvar state =
let reset state =
let buddies = Contact.fold (fun _ b acc -> Contact.reset b :: acc) state.contacts [] in
List.iter (Contact.replace_contact state.contacts) buddies
in
let image, cursorc =
try
render_state size state
with e ->
let e = A.(fg red), (Printexc.to_string e)
and note = A.empty,
"While trying to render the UI. Try to scroll to another buddy (Page \
Up/Down), switch rendering of buddy list (F12), or clear this \
buddies messages (/clear<ret>); please report this bug \
(including the offending characters and the error message)\n"
Lwt_engine.stop_event redrawer ;
let redraw = Lwt_engine.on_timer redraw_interval false (fun _ ->
let image, cursorc =
try
render_state size state
with e ->
let e = A.(fg red), (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 \
this buddies messages (/clear<ret>); please report this bug \
(including the offending characters and the error message)\n"
in
let w = fst size in
(render_wrapped_list true w [e ; A.empty, note], 1)
in
let w = fst size in
(render_wrapped_list true w [e ; note], 1)
Lwt.async (fun () ->
Notty_lwt.Term.image term image >>= fun () ->
Notty_lwt.Term.cursor term (Some (cursorc, snd size))))
in
Notty_lwt.Term.image term image >>= fun () ->
Notty_lwt.Term.cursor term (Some (cursorc, snd size)) >>= fun () ->
Lwt_mvar.take mvar >>= fun action ->
Lwt.catch (fun () -> action state)
(fun exn ->
add_status state (`Local ((`Full state.config.Xconfig.jid), "error")) (Printexc.to_string exn) ;
Lwt.return (`Failure state)) >>= function
| `Ok state -> loop term size mvar input_mvar state
| `Resize size -> loop term size mvar input_mvar state
| `Disconnect state -> reset state ; loop term size mvar input_mvar state
| `Ok state -> loop term size redraw mvar input_mvar state
| `Resize size -> loop term size redraw mvar input_mvar state
| `Disconnect state -> reset state ; loop term size redraw mvar input_mvar state
| `Failure state ->
reset state ;
ignore (Lwt_engine.on_timer 10. false
(fun _ -> Lwt.async (fun () -> Lwt_mvar.put state.connect_mvar Reconnect))) ;
loop term size mvar input_mvar state
loop term size redraw mvar input_mvar state
| `Ask c ->
c state input_mvar mvar >>= fun s ->
loop term size mvar input_mvar s
loop term size redraw mvar input_mvar s
| `Quit state ->
quit state >>= fun () ->
Lwt.return state

0 comments on commit cab34ac

Please sign in to comment.