diff options
-rw-r--r-- | src/yypkg/gui/GUI_Settings.ml | 141 | ||||
-rw-r--r-- | src/yypkg/gui/GUI_Settings.mli | 2 |
2 files changed, 92 insertions, 51 deletions
diff --git a/src/yypkg/gui/GUI_Settings.ml b/src/yypkg/gui/GUI_Settings.ml index 5e10080..d2a0aad 100644 --- a/src/yypkg/gui/GUI_Settings.ml +++ b/src/yypkg/gui/GUI_Settings.ml @@ -17,6 +17,9 @@ end type checks_ev = [ | `Show | `Push of (string * string) + | `Passed of conf + | `Commit + | `Cancel ] type ev = [ | `Show @@ -24,9 +27,9 @@ type ev = [ | `BeAdopted of (Evas_object.t -> unit) | `Cancelled | `CheckFailed - | `CheckValidated of conf | `Checks of checks_ev | `SettingIter of (conf * next) + | `CommitConf of conf option ] type event += T of ev @@ -48,12 +51,13 @@ module Checks : sig val state_machine : t -> ev -> t end = struct type ev = checks_ev - let send msg = send (`Checks msg) type t = { iw : Evas_object.t; box : Evas_object.t; - labels : (string * Evas_object.t) list; + entries : (string * (Evas_object.t * Evas_object.t)) list; + apply : Evas_object.t; + temp_conf : conf option } let t shared = @@ -63,27 +67,57 @@ end = struct Elm_scroller.content_min_limit scroller true false; let hbox = Elm_box.addx ~box ~size_hint:[ `hexpand; `fill ] box in Elm_box.horizontal_set hbox true; - ignore @@ Elm_button.addx hbox ~box:hbox ~text:"Cancel"; - Elm_object.disabled_set (Elm_button.addx hbox ~box:hbox ~text:"Apply" - ~cb:[ Elm.connect Elm_sig.clicked (fun _ -> Evas_object.hide iw); - ]) true; - { iw; box = Elm_box.addx ~content_of:scroller scroller; labels = [] } + ignore @@ Elm_button.addx hbox ~box:hbox ~text:"Cancel" ~cb:[ + Elm.connect Elm_sig.clicked (fun _ -> send (`Checks `Cancel)); + ]; + let apply = + Elm_button.addx hbox ~box:hbox ~text:"Apply" + ~cb:[ Elm.connect Elm_sig.clicked (fun _ -> + send (`Checks `Commit); + )] + |> (fun btn -> Elm_object.disabled_set btn true; btn) + in + let box = Elm_box.addx ~content_of:scroller scroller in + { iw; box; entries = []; apply; temp_conf = None } let push ~t ~title ~text = try - let label = List.assoc title t.labels in + let (_frame, label) = List.assoc title t.entries in Elm_object.(part_text_set label ((part_text_get label ()) ^ "<br>" ^ text)); t with Not_found -> let frame = Elm_frame.addx t.box ~size_hint:[ `vexpand; `hfill; `valign 0. ] ~box:t.box ~text:title in let label = Elm_label.addx frame ~content_of:frame ~text in - { t with labels = (title, label) :: t.labels } + Elm_label.line_wrap_set label `word; + { t with entries = (title, (frame, label)) :: t.entries } + + let init_or_over t = + List.iter (fun (_title, (label, _frame)) -> + Evas_object.del label + ) t.entries; + { t with temp_conf = None; entries = [] } + + let finish t msg = + (if msg = `Commit && t.temp_conf = None then + Log.err "Trying to commit a non-existing temporary config."); + Evas_object.hide t.iw; + send (`CommitConf t.temp_conf); + init_or_over t let state_machine t = function | `Show -> - Evas_object.show t.iw; t + Evas_object.show t.iw; + init_or_over t | `Push (title, text) -> push ~t ~title ~text + | `Passed conf -> + Elm_object.disabled_set t.apply false; + { t with temp_conf = Some conf } + | `Commit + | `Cancel as msg -> + finish t msg + + let send msg = send (`Checks msg) end class mirror ~box = @@ -280,21 +314,21 @@ class repo_predicates ~box = end -let settings_message ~settings ~conf_get ~f ~on_done = - let k next conf = - send (`SettingIter (conf, next)) - in +let settings_message ~settings ~init ~f ~on_done = let wrap next setting conf = - f setting conf (k next) + f setting conf (fun conf' -> send (`SettingIter (conf', next))) in let first = List.fold_left wrap on_done (List.rev settings) in if List.length settings <> 0 then - first (conf_get ()) + first (init ()) type t = { - check_failed : unit -> unit; + checks_over : unit -> unit; box : Evas_object.t; checks_progress : Checks.t; + check : Evas_object.t; + check_button_text : string; + message : init:(unit -> conf) -> f:(setting -> conf -> next -> unit) -> on_done:next -> unit } let t shared = @@ -307,42 +341,51 @@ let t shared = |> (fun b -> Elm_object.content_set scroller b; b) in let checks_progress = Checks.t shared in - let settings = [ - (new mirror ~box:box_scroller :> setting); - (new local_predicates ~box:box_scroller :> setting); - (new repo_predicates ~box:box_scroller :> setting); - ] in - let settings_message = settings_message ~settings ~conf_get:Config.read in - let send_inits () = settings_message - ~f:(fun s conf -> s#init conf) - ~on_done:ignore in - let send_checks () = settings_message - ~f:(fun s conf -> s#check conf) - ~on_done:(fun conf -> send (`CheckValidated conf)) in - let apply = + let settings = + let box = box_scroller in + let mirror = (new mirror ~box :> setting) in + let local = (new local_predicates ~box :> setting) in + let repo = (new repo_predicates ~box :> setting) in + [ mirror; local; repo ] + in + let settings_message = settings_message ~settings in + let check = Elm_box.addx ~box ~size_hint:[ `hfill; `hexpand ] box |> (fun box -> Elm_box.horizontal_set box true; box) |> (fun box -> Elm_box.homogeneous_set box true; box) |> (fun box -> Elm_button.addx box ~box ~text:check_button_text) - |> (fun apply -> - ignore @@ Elm_connect.Button.clicked apply (fun _o -> - Elm_object.part_text_set apply "Validating..."; - Elm_object.disabled_set apply true; - Checks.send `Show; - send_checks ()); - apply) - |> (fun apply -> Elm_object.focus_set apply true; apply) + |> (fun check -> + ignore @@ Elm_connect.Button.clicked check (fun _o -> + settings_message + ~f:(fun s -> s#check) + ~on_done:(fun conf -> Checks.send (`Passed conf)) + ~init:(fun () -> + Elm_object.part_text_set check "Validating..."; + Elm_object.disabled_set check true; + Checks.send `Show; + Config.read () + ) + ); + check) + |> (fun check -> Elm_object.focus_set check true; check) in - let check_failed () = - Elm_object.part_text_set apply check_button_text; - Elm_object.disabled_set apply false + let checks_over () = + Elm_object.part_text_set check check_button_text; + Elm_object.disabled_set check false in - send_inits (); - { check_failed; box; checks_progress } + { checks_over; box; checks_progress; check; check_button_text; message = settings_message } + +let commit_conf conf = + let current_conf = Config.read () in + if conf <> current_conf then + ignore (Config.update (fun _ -> conf)) + else + () let state_machine settings _shared (msg : ev) = match msg with | `Show -> + settings.message ~f:(fun s -> s#init) ~on_done:ignore ~init:Config.read; Evas_object.show settings.box; settings | `Hide -> @@ -355,13 +398,11 @@ let state_machine settings _shared (msg : ev) = next conf; settings | `CheckFailed -> - settings.check_failed (); + settings.checks_over (); settings - | `CheckValidated conf -> - (* XXX: this should be in-memory, not through disk *) - let current_conf = Config.read () in - (if conf <> current_conf then - ignore (Config.update (fun _ -> conf))); + | `CommitConf conf -> + Lib.may commit_conf conf; + settings.checks_over (); settings | `Cancelled -> settings diff --git a/src/yypkg/gui/GUI_Settings.mli b/src/yypkg/gui/GUI_Settings.mli index 1231eaf..2eaefc7 100644 --- a/src/yypkg/gui/GUI_Settings.mli +++ b/src/yypkg/gui/GUI_Settings.mli @@ -11,7 +11,7 @@ type ev = [ | `BeAdopted of (Efl.Evas_object.t -> unit) | `Cancelled | `CheckFailed - | `CheckValidated of Types.conf + | `CommitConf of Types.conf option | `Checks of checks_ev | `SettingIter of (Types.conf * next) ] |