Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions Makefile.options
Original file line number Diff line number Diff line change
Expand Up @@ -41,10 +41,10 @@ TEMPLATE_NAME := none.pgocaml

# OCamlfind packages for the server
SERVER_PACKAGES := calendar
SERVER_PPX_PACKAGES := lwt_ppx js_of_ocaml-ppx_deriving_json
SERVER_PPX_PACKAGES := js_of_ocaml-ppx_deriving_json
# OCamlfind packages for the client
CLIENT_PACKAGES := calendar js_of_ocaml js_of_ocaml-lwt
CLIENT_PPX_PACKAGES := js_of_ocaml-ppx lwt_ppx js_of_ocaml-ppx_deriving_json
CLIENT_PPX_PACKAGES := js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json

# Debug package (yes/no): Debugging info in compilation
DEBUG := yes
Expand Down
5 changes: 3 additions & 2 deletions src/widgets/ot_calendar.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ type button_labels =

[%%client.start]

open Lwt.Syntax
open Js_of_ocaml
open Js_of_ocaml_lwt

Expand Down Expand Up @@ -344,7 +345,7 @@ let attach_events ?action ?(click_non_highlighted = false) ?update ~intl ~period
| Some action ->
fun _ r ->
update_classes cal zero d;
let%lwt _ = action y m dom in
let* _ = action y m dom in
Lwt.return_unit
| None -> fun _ r -> update_classes cal zero d; Lwt.return_unit
in
Expand All @@ -369,7 +370,7 @@ let attach_events_lwt ?action ?click_non_highlighted ~intl ~period d cal
let f () =
let m = CalendarLib.Date.(month d |> int_of_month)
and y = CalendarLib.Date.year d in
let%lwt highlight = highlight y m in
let* highlight = highlight y m in
attach_events ?action ?click_non_highlighted ~intl ~period d cal highlight;
Lwt.return_unit
in
Expand Down
35 changes: 19 additions & 16 deletions src/widgets/ot_carousel.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -35,9 +35,11 @@
*)

open%client Js_of_ocaml

[%%client open Js_of_ocaml_lwt]
[%%shared open Eliom_content.Html]
[%%shared open Eliom_content.Html.F]
[%%shared open Lwt.Syntax]

let%client clX = Ot_swipe.clX
let%client clY = Ot_swipe.clY
Expand Down Expand Up @@ -181,7 +183,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
max 1 (truncate (float (width_carousel + 1) /. float width_element))
in
Lwt.async (fun () ->
let%lwt () = Ot_nodeready.nodeready d2' in
let* () = Ot_nodeready.nodeready d2' in
~%set_nb_visible_elements (comp_nb_visible_elements ());
Lwt.return_unit);
let maxi () = ~%maxi - React.S.value ~%nb_visible_elements + 1 in
Expand Down Expand Up @@ -294,10 +296,10 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
React.Step.execute step;
set_active ();
Lwt.async (fun () ->
let%lwt () =
let* () =
if move
then
let%lwt _ = Lwt_js_events.transitionend d2' in
let* _ = Lwt_js_events.transitionend d2' in
Lwt.return_unit
else Lwt.return_unit
in
Expand All @@ -318,7 +320,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
(fun _ -> ~%set_nb_visible_elements (comp_nb_visible_elements ()))
(if vertical then Ot_size.height else Ot_size.width));
Lwt.async (fun () ->
let%lwt () = Ot_nodeready.nodeready d2' in
let* () = Ot_nodeready.nodeready d2' in
set_position ~%position; add_transition d2'; Lwt.return_unit);
let perform_animation a =
~%set_nb_visible_elements (comp_nb_visible_elements ());
Expand All @@ -335,7 +337,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
if not !animation_frame_requested
then (
animation_frame_requested := true;
let%lwt () = Lwt_js_events.request_animation_frame () in
let* () = Lwt_js_events.request_animation_frame () in
animation_frame_requested := false;
(match !action with
| `Move (delta, width_element) ->
Expand Down Expand Up @@ -569,25 +571,26 @@ let%client set_default_fail f =
:> exn -> Html_types.div_content Eliom_content.Html.elt)

let%shared generate_content generator =
try%lwt Eliom_shared.Value.local generator ()
with e -> Lwt.return (default_fail e)
Lwt.catch
(fun () -> Eliom_shared.Value.local generator ())
(fun e -> Lwt.return (default_fail e))

(* on the client side we generate the contents of the initially visible page
asynchronously so the tabs will be rendered right away *)
let%client generate_initial_contents ~spinner sleeper gen =
let s = spinner () in
( Lwt.async @@ fun () ->
let%lwt contents = generate_content gen in
let* contents = generate_content gen in
(* wait until DOM elements are created before attempting to replace them *)
let%lwt parent = sleeper in
let* parent = sleeper in
ignore @@ To_dom.of_element parent;
Manip.replaceSelf s contents;
Lwt.return () );
Lwt.return (s, ref @@ None)

(* on the server side we generate all the visible contents right away *)
let%server generate_initial_contents ~spinner:_ _ gen =
let%lwt contents = generate_content gen in
let* contents = generate_content gen in
Lwt.return (contents, ref @@ None)

let%shared make_lazy ?a ?vertical ?(position = 0) ?transition_duration ?inertia
Expand All @@ -609,7 +612,7 @@ let%shared make_lazy ?a ?vertical ?(position = 0) ?transition_duration ?inertia
let s = spinner () in
s, ref @@ Some (s, gen)
in
let%lwt contents, spinners_and_generators =
let* contents, spinners_and_generators =
Lwt.map List.split
@@ Lwt_list.map_s (fun x -> x)
@@ List.mapi mk_contents gen_contents
Expand Down Expand Up @@ -639,7 +642,7 @@ let%shared make_lazy ?a ?vertical ?(position = 0) ?transition_duration ?inertia
match !spinner_and_generator with
| Some (spinner, gen_content) ->
spinner_and_generator := None;
let%lwt content = generate_content gen_content in
let* content = generate_content gen_content in
Manip.replaceSelf spinner content;
Lwt.return_unit
| None -> Lwt.return ())
Expand Down Expand Up @@ -728,7 +731,7 @@ let%shared ribbon ?(a = [])
in
let curleft, set_curleft = React.S.create initial_gap in
Lwt.async (fun () ->
let%lwt () = Ot_nodeready.nodeready container' in
let* () = Ot_nodeready.nodeready container' in
(* Ribbon position: *)
set_containerwidth container'##.offsetWidth;
Ot_noderesize.noderesize (Ot_noderesize.attach container') (fun () ->
Expand All @@ -749,7 +752,7 @@ let%shared ribbon ?(a = [])
that runs on window resizing. So we make sure the ribbon code runs
AFTER it has been placed into the fixed container by Ot_sticky. *)
Lwt.async @@ fun () ->
let%lwt _ = Lwt_js.sleep 0.05 in
let* _ = Lwt_js.sleep 0.05 in
set_containerwidth container'##.offsetWidth;
Lwt.return_unit);
(* Changing the position of the ribbon when the carousel position
Expand Down Expand Up @@ -880,8 +883,8 @@ let%shared ribbon ?(a = [])
| _ -> ());
Lwt.return_unit);
Lwt.async (fun () ->
let%lwt () = Ot_nodeready.nodeready container' in
let%lwt () = Lwt_js_events.request_animation_frame () in
let* () = Ot_nodeready.nodeready container' in
let* () = Lwt_js_events.request_animation_frame () in
add_transition the_ul';
Eliom_lib.Option.iter add_transition cursor_elt';
Lwt.return_unit);
Expand Down
69 changes: 37 additions & 32 deletions src/widgets/ot_drawer.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ open Eliom_content.Html]

[%%shared open Eliom_content.Html.F]
open%client Js_of_ocaml
open%client Lwt.Syntax
[%%client open Js_of_ocaml_lwt]
type%client status = Stopped | Start | Aborted | In_progress

Expand All @@ -40,7 +41,7 @@ let%client clY ev =

let%client bind_click_outside bckgrnd elt close =
Lwt.async (fun () ->
let%lwt ev =
let* ev =
Ot_lib.click_outside ~use_capture:true
~inside:(To_dom.of_element bckgrnd)
(To_dom.of_element elt)
Expand Down Expand Up @@ -130,7 +131,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
add_class ~%bckgrnd "closing";
Lwt.cancel !(~%touch_thread);
Lwt_js_events.async (fun () ->
let%lwt _ = Lwt_js_events.transitionend (To_dom.of_element ~%d) in
let* _ = Lwt_js_events.transitionend (To_dom.of_element ~%d) in
remove_class ~%bckgrnd "closing";
Eliom_lib.Option.iter (fun f -> f ()) ~%onclose;
Lwt.return_unit)
Expand All @@ -148,13 +149,13 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
add_class ~%bckgrnd "opening";
Lwt.cancel !(~%touch_thread);
Lwt.async (fun () ->
let%lwt bind_touch = fst ~%bind_touch in
let* bind_touch = fst ~%bind_touch in
bind_touch (); Lwt.return_unit);
bind_click_outside ~%bckgrnd ~%d ~%close;
Eliom_client.Page_status.onactive ~stop:(fst ~%stop_open_event)
(fun () -> html_ManipClass_add "ot-drawer-open");
Lwt_js_events.async (fun () ->
let%lwt _ = Lwt_js_events.transitionend (To_dom.of_element ~%d) in
let* _ = Lwt_js_events.transitionend (To_dom.of_element ~%d) in
remove_class ~%bckgrnd "opening";
Lwt.return_unit)
: unit -> unit)]
Expand Down Expand Up @@ -205,7 +206,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
if not !animation_frame_requested
then (
animation_frame_requested := true;
let%lwt () = Lwt_js_events.request_animation_frame () in
let* () = Lwt_js_events.request_animation_frame () in
animation_frame_requested := false;
(match !action with
| `Move delta ->
Expand All @@ -225,7 +226,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
(Js.Unsafe.coerce dr##.style)##.webkitTransform
:= Js.string "";
Lwt.async (fun () ->
let%lwt _ = Lwt_js_events.transitionend dr in
let* _ = Lwt_js_events.transitionend dr in
Manip.Class.remove ~%bckgrnd "ot-swiping";
Lwt.return_unit);
cl ()
Expand All @@ -234,7 +235,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
(Js.Unsafe.coerce dr##.style)##.webkitTransform
:= Js.string "";
Lwt.async (fun () ->
let%lwt _ = Lwt_js_events.transitionend dr in
let* _ = Lwt_js_events.transitionend dr in
Manip.Class.remove ~%bckgrnd "ot-swiping";
Lwt.return_unit)
| `Abort ->
Expand Down Expand Up @@ -324,36 +325,40 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
status := Start;
startx := clX ev;
starty := clY ev;
let%lwt () = onpan ev a in
let* () = onpan ev a in
(* Lwt.pick and Lwt_js_events.touch*** seem to behave oddly.
This wrapping is an attempt to understand why. *)
let a =
try%lwt Lwt_js_events.touchmoves bckgrnd' onpan with
| Lwt.Canceled -> Lwt.return_unit
| e ->
let s = Printexc.to_string e in
Printf.printf "Ot_drawer>touchmoves>exception: %s\n%!" s;
Lwt.fail e
Lwt.catch
(fun () -> Lwt_js_events.touchmoves bckgrnd' onpan)
(function
| Lwt.Canceled -> Lwt.return_unit
| e ->
let s = Printexc.to_string e in
Printf.printf "Ot_drawer>touchmoves>exception: %s\n%!" s;
Lwt.fail e)
and b =
try%lwt
let%lwt ev = Lwt_js_events.touchend bckgrnd' in
onpanend ev ()
with
| Lwt.Canceled -> Lwt.return_unit
| e ->
let s = Printexc.to_string e in
Printf.printf "Ot_drawer>touchend>exception: %s\n%!" s;
Lwt.fail e
Lwt.catch
(fun () ->
let* ev = Lwt_js_events.touchend bckgrnd' in
onpanend ev ())
(function
| Lwt.Canceled -> Lwt.return_unit
| e ->
let s = Printexc.to_string e in
Printf.printf "Ot_drawer>touchend>exception: %s\n%!" s;
Lwt.fail e)
and c =
try%lwt
let%lwt ev = Lwt_js_events.touchcancel bckgrnd' in
onpanend ev ()
with
| Lwt.Canceled -> Lwt.return_unit
| e ->
let s = Printexc.to_string e in
Printf.printf "Ot_drawer>touchcancel>exception: %s\n%!" s;
Lwt.fail e
Lwt.catch
(fun () ->
let* ev = Lwt_js_events.touchcancel bckgrnd' in
onpanend ev ())
(function
| Lwt.Canceled -> Lwt.return_unit
| e ->
let s = Printexc.to_string e in
Printf.printf "Ot_drawer>touchcancel>exception: %s\n%!" s;
Lwt.fail e)
in
Lwt.pick [a; b; c]
in
Expand Down
20 changes: 12 additions & 8 deletions src/widgets/ot_lib.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,8 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
open Js_of_ocaml]
open Js_of_ocaml
open Lwt.Syntax]

[%%client open Js_of_ocaml_lwt]

Expand All @@ -46,7 +47,7 @@ let%client window_scrolls ?(ios_html_scroll_hack = false) ?use_capture handler =
if ios_html_scroll_hack
then
let rec loop () =
let%lwt e =
let* e =
Lwt.pick
(List.map
(* We listen to several elements because scroll events are
Expand All @@ -59,12 +60,15 @@ let%client window_scrolls ?(ios_html_scroll_hack = false) ?use_capture handler =
in
let continue = ref true in
let w =
try%lwt fst (Lwt.task ())
with Lwt.Canceled ->
continue := false;
Lwt.return_unit
Lwt.catch
(fun () -> fst (Lwt.task ()))
(function
| Lwt.Canceled ->
continue := false;
Lwt.return_unit
| exc -> Lwt.reraise exc)
in
let%lwt () = handler e w in
let* () = handler e w in
if !continue then loop () else Lwt.return_unit
in
loop ()
Expand All @@ -91,7 +95,7 @@ let%client rec in_ancestors ~elt ~ancestor =
let%client rec click_outside ?use_capture
?(inside = (Dom_html.document##.body :> Dom_html.element Js.t)) elt
=
let%lwt ev = Lwt_js_events.click ?use_capture inside in
let* ev = Lwt_js_events.click ?use_capture inside in
Js.Opt.case ev##.target
(fun () -> click_outside ?use_capture elt)
(fun target ->
Expand Down
Loading
Loading