summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/yypkg/gui/GUI_Settings.ml141
-rw-r--r--src/yypkg/gui/GUI_Settings.mli2
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)
]